Resize Image Scaline

unit ScreenScanlineResize;

interface

uses

Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,

ExtDlgs, ExtCtrls, StdCtrls, Spin;

type

TFormResize = class(TForm)

ButtonLoadImage: TButton;

SpinEditFactor: TSpinEdit;

Label1: TLabel;

CheckBoxStretch: TCheckBox;

Image: TImage;

OpenPictureDialog: TOpenPictureDialog;

procedure ButtonLoadImageClick(Sender: TObject);

procedure FormCreate(Sender: TObject);

procedure FormDestroy(Sender: TObject);

procedure CheckBoxStretchClick(Sender: TObject);

procedure SpinEditFactorChange(Sender: TObject);

private

BitmapOriginal: TBitmap;

PROCEDURE ScanlineResize (CONST factor: INTEGER);

public

{ Public declarations }

end;

var

FormResize: TFormResize;

implementation

{$R *.DFM}

USES Math; // MinIntValue

procedure TFormResize.ButtonLoadImageClick(Sender: TObject);

begin

IF OpenPictureDialog.Execute

THEN BEGIN

// Free existing image

IF Assigned(BitmapOriginal)

THEN BitmapOriginal.Free;

BitmapOriginal := TBitmap.Create;

BitmapOriginal.LoadFromFile(OpenPictureDialog.Filename);

SpinEditFactor.Value := 1;

ScanlineResize (SpinEditFactor.Value);

END

end;

procedure TFormResize.FormCreate(Sender: TObject);

CONST

GridCount = 16;

VAR

i : INTEGER;

iDelta: INTEGER;

j : INTEGER;

jDelta: INTEGER;

begin

BitmapOriginal := TBitmap.Create;

BitmapOriginal.Width := 640;

BitmapOriginal.Height := 480;

BitmapOriginal.PixelFormat := pf24bit;

iDelta := BitmapOriginal.Width DIV GridCount;

jDelta := BitmapOriginal.Height DIV GridCount;

BitmapOriginal.Canvas.Pen.Color := clBlack;

FOR j := 0 TO GridCount-1 DO

BEGIN

FOR i := 0 TO GridCount-1 DO

BEGIN

// Red-Green combinations

BitmapOriginal.Canvas.Brush.Color := RGB(GridCount*i, GridCount*j, 0);

BitmapOriginal.Canvas.Rectangle(i *iDelta,

j *jDelta,

(i+1)*iDelta-1,

(j+1)*jDelta-1);

END

END;

ScanlineResize (SpinEditFactor.Value);

end;

procedure TFormResize.FormDestroy(Sender: TObject);

begin

BitmapOriginal.Free

end;

procedure TFormResize.CheckBoxStretchClick(Sender: TObject);

begin

Image.Stretch := CheckBoxStretch.Checked

end;

procedure TFormResize.SpinEditFactorChange(Sender: TObject);

begin

ScanlineResize (SpinEditFactor.Value);

end;

PROCEDURE TFormResize.ScanlineResize (CONST factor: INTEGER);

TYPE

TRGBTripleArray = ARRAY[WORD] OF TRGBTriple;

pRGBTripleArray = ^TRGBTripleArray;

VAR

BitmapSmaller: TBitmap;

i : INTEGER;

j : INTEGER;

lookup : INTEGER;

RowIn : pRGBTripleArray;

RowOut : pRGBTripleArray;

BEGIN

ASSERT ( (factor >= 1) AND (factor <= MinIntValue([BitmapOriginal.Width,

BitmapOriginal.Height])));

BitmapSmaller := TBitmap.Create;

TRY

BitmapSmaller.Width := BitmapOriginal.Width DIV factor;

BitmapSmaller.Height := BitmapOriginal.Height DIV factor;

BitmapSmaller.PixelFormat := pf24bit;

// Fetch RGB triples from original bitmap

FOR j := 0 TO BitmapSmaller.Height-1 DO

BEGIN

RowIn := BitmapOriginal.Scanline[factor*j];

RowOut := BitmapSmaller.Scanline[j];

FOR i := 0 To BitmapSmaller.Width-1 DO

BEGIN

lookup := factor*i;

{$IFDEF VER100} // D3

RowOut[i].rgbtRed := RowIn[lookup].rgbtRed;

RowOut[i].rgbtGreen := RowIn[lookup].rgbtGreen;

RowOut[i].rgbtBlue := RowIn[lookup].rgbtBlue;

{$ENDIF}

{$IFDEF VER120} // D4: Need update pack 2 (or use D3 solution if not)

RowOut[i] := RowIn[lookup]

{$ENDIF}

{$IFDEF VER130} // D5

RowOut[i] := RowIn[lookup]

{$ENDIF}

END

END;

// Display New Bitap

Image.Picture.Graphic := BitmapSmaller

FINALLY

BitmapSmaller.Free

END

END {ScanlineResize};

end.