123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778 |
- unit MainUnit;
- (* ***** BEGIN LICENSE BLOCK *****
- * Version: MPL 1.1 or LGPL 2.1 with linking exception
- *
- * The contents of this file are subject to the Mozilla Public License Version
- * 1.1 (the "License"); you may not use this file except in compliance with
- * the License. You may obtain a copy of the License at
- * http://www.mozilla.org/MPL/
- *
- * Software distributed under the License is distributed on an "AS IS" basis,
- * WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License
- * for the specific language governing rights and limitations under the
- * License.
- *
- * Alternatively, the contents of this file may be used under the terms of the
- * Free Pascal modified version of the GNU Lesser General Public License
- * Version 2.1 (the "FPC modified LGPL License"), in which case the provisions
- * of this license are applicable instead of those above.
- * Please see the file LICENSE.txt for additional information concerning this
- * license.
- *
- * The Original Code is Graphics32
- *
- * The Initial Developer of the Original Code is
- * Alex A. Denisov
- *
- * Portions created by the Initial Developer are Copyright (C) 2000-2005
- * the Initial Developer. All Rights Reserved.
- *
- * Contributor(s):
- * Michael Hansen <[email protected]>
- *
- * ***** END LICENSE BLOCK ***** *)
- interface
- {$include GR32.inc}
- uses
- {$IFNDEF FPC} Windows, {$ELSE} LResources, LCLType, {$ENDIF}
- SysUtils, Classes, Graphics, Controls, Forms, Dialogs, ComCtrls, Grids,
- ExtCtrls, StdCtrls, Buttons, GR32, GR32_Image, GR32_Transforms,
- GR32_Resamplers, GR32_Layers, GR32_RangeBars;
- type
- TOpType = (opNone, opTranslate, opScale, opRotate, opSkew);
- TOpRec = record
- OpType: TOpType;
- Dx, Dy: Extended; // shifts for opTranslate mode
- Sx, Sy: Extended; // scale factors for opScale mode
- Cx, Cy, Alpha: Extended; // rotation center and angle (deg) for opRotate mode
- Fx, Fy: Extended; // skew factors for opSkew mode
- end;
- TOpRecs = array[0..7] of TOpRec;
- const
- OpTypes: array [0..4] of TOpType = (opNone, opTranslate, opScale, opRotate,
- opSkew);
- type
- TTransformMode = (tmAffine, tmProjective, tmBilinear);
- { TFormTranformExample }
- TFormTranformExample = class(TForm)
- BtnClearAll: TButton;
- CbxRepeat: TCheckBox;
- CmbKernelClassNames: TComboBox;
- CmbResamplerClassNames: TComboBox;
- ComboBox: TComboBox;
- Dst: TImage32;
- EdtAlpha: TEdit;
- EdtCodeString: TEdit;
- EdtCx: TEdit;
- EdtCy: TEdit;
- EdtDx: TEdit;
- EdtDy: TEdit;
- EdtFx: TEdit;
- EdtFy: TEdit;
- EdtSx: TEdit;
- EdtSy: TEdit;
- GbrAlpha: TGaugeBar;
- GbrDx: TGaugeBar;
- GbrDy: TGaugeBar;
- GbrFx: TGaugeBar;
- GbrFy: TGaugeBar;
- GbrSx: TGaugeBar;
- GbrSy: TGaugeBar;
- LblAlpha: TLabel;
- LblCodeString: TLabel;
- LblCx: TLabel;
- LblCy: TLabel;
- LblDx: TLabel;
- LblDy: TLabel;
- LblFx: TLabel;
- LblFy: TLabel;
- LblInfoRotate: TLabel;
- LblInfoSkew: TLabel;
- LblInfoTranslate: TLabel;
- LblKernel: TLabel;
- LblNoOperation: TLabel;
- LblProjectiveNote: TLabel;
- LblResampler: TLabel;
- LblScale: TLabel;
- LblSx: TLabel;
- LblSy: TLabel;
- LblTransformationMatrix: TLabel;
- LblType: TLabel;
- ListBox: TListBox;
- Notebook: TNotebook;
- OpacityBar: TGaugeBar;
- PageControl: TPageControl;
- {$IFDEF FPC}
- PageNone: TPage;
- PageTranslate: TPage;
- PageScale: TPage;
- PageRotate: TPage;
- PageSkew: TPage;
- {$ENDIF}
- PnlOpacity: TPanel;
- PnlOperation: TPanel;
- PnlTransformationMatrix: TPanel;
- Shape1: TShape;
- Shape2: TShape;
- Src: TImage32;
- StringGrid: TStringGrid;
- TstAffine: TTabSheet;
- TstProjective: TTabSheet;
- procedure FormCreate(Sender: TObject);
- procedure FormDestroy(Sender: TObject);
- procedure BtnClearAllClick(Sender: TObject);
- procedure ComboBoxChange(Sender: TObject);
- procedure ListBoxClick(Sender: TObject);
- procedure OpacityChange(Sender: TObject);
- procedure PageControlChange(Sender: TObject);
- procedure RotationChanged(Sender: TObject);
- procedure RotationScrolled(Sender: TObject);
- procedure ScaleChanged(Sender: TObject);
- procedure ScaleScrolled(Sender: TObject);
- procedure SkewChanged(Sender: TObject);
- procedure SkewScrolled(Sender: TObject);
- procedure TranslationChanged(Sender: TObject);
- procedure TranslationScrolled(Sender: TObject);
- procedure SrcRBResizingEvent(Sender: TObject; const OldLocation: TFloatRect;
- var NewLocation: TFloatRect; DragState: TRBDragState; Shift: TShiftState);
- procedure RubberLayerMouseDown(Sender: TObject; Button: TMouseButton;
- Shift: TShiftState; X, Y: Integer; Layer: TCustomLayer);
- procedure RubberLayerMouseMove(Sender: TObject; Shift: TShiftState; X,
- Y: Integer; Layer: TCustomLayer);
- procedure RubberLayerMouseUp(Sender: TObject; Button: TMouseButton;
- Shift: TShiftState; X, Y: Integer; Layer: TCustomLayer);
- procedure AppEventsIdle(Sender: TObject; var Done: Boolean);
- procedure ResamplerClassNamesListClick(Sender: TObject);
- procedure CmbResamplerClassNamesChange(Sender: TObject);
- procedure CmbKernelClassNamesChange(Sender: TObject);
- procedure DstPaintStage(Sender: TObject; Buffer: TBitmap32;
- StageNum: Cardinal);
- procedure CbxRepeatClick(Sender: TObject);
- procedure SrcDblClick(Sender: TObject);
- protected
- LoadingValues: Boolean;
- DraggedVertex: Integer;
- LastMousePos: TPoint;
- StippleStart: Single;
- procedure PaintHandles(Sender: TObject; BackBuffer: TBitmap32);
- public
- SrcRubberBandLayer: TRubberBandLayer;
- Operation: TOpRecs;
- Current: ^TOpRec;
- AffineTransformation: TAffineTransformation;
- ProjectiveTransformation: TProjectiveTransformation;
- Transformation: TTransformation;
- Vertices: array [0..3] of TPoint;
- Mode: TTransformMode;
- procedure ClearTransformations;
- procedure DoTransform;
- procedure GenTransform;
- procedure PrepareSource;
- procedure ShowSettings(OperationNum: Integer);
- procedure InitVertices; // for projective mapping
- end;
- var
- FormTranformExample: TFormTranformExample;
- implementation
- {$R *.dfm}
- uses
- Types,
- {$IFDEF Darwin}
- MacOSAll,
- {$ENDIF}
- GR32.ImageFormats.JPG;
- const
- CAccessMode: array [Boolean] of TPixelAccessMode = (pamSafe, pamWrap);
- function GetVal(Src: string; var Dst: Extended): Boolean;
- var
- Code: Integer;
- begin
- Val(Src, Dst, Code);
- Result := Code = 0;
- end;
- procedure TFormTranformExample.FormCreate(Sender: TObject);
- begin
- // load example image
- Src.Bitmap.LoadFromResourceName(HInstance, 'Delphi', RT_RCDATA);
- //Setup custom paintstages ("checkerboard" and border)
- with Dst do
- begin
- with PaintStages[0]^ do //Set up custom paintstage to draw checkerboard
- begin
- Stage := PST_CUSTOM;
- Parameter := 1; // use parameter to tag the stage, we inspect this in OnPaintStage
- end;
- with PaintStages.Add^ do //Insert new paintstage on top of everything else, we use this to draw border
- begin
- Stage := PST_CUSTOM;
- Parameter := 2;
- end;
- end;
- with Src do
- begin
- with PaintStages[0]^ do
- begin
- Stage := PST_CUSTOM;
- Parameter := 1;
- end;
- with PaintStages.Add^ do
- begin
- Stage := PST_CUSTOM;
- Parameter := 2;
- end;
- end;
- ResamplerList.GetClassNames(CmbResamplerClassNames.Items);
- KernelList.GetClassNames(CmbKernelClassNames.Items);
- CmbResamplerClassNames.ItemIndex := 0;
- CmbKernelClassNames.ItemIndex := 0;
- SrcRubberBandLayer := TRubberBandLayer.Create(Src.Layers);
- SrcRubberBandLayer.OnResizing := SrcRBResizingEvent;
- SrcRubberBandLayer.Location := FloatRect(0, 0, Src.Bitmap.Width - 1, Src.Bitmap.Height - 1);
- with TCustomLayer.Create(Dst.Layers) do
- begin
- OnPaint := PaintHandles;
- end;
- DraggedVertex := -1;
- Dst.SetupBitmap; // set the destination bitmap size to match the image size
- PrepareSource;
- ClearTransformations;
- ShowSettings(0);
- AffineTransformation := TAffineTransformation.Create;
- ProjectiveTransformation := TProjectiveTransformation.Create;
- Transformation := AffineTransformation;
- DoTransform;
- Application.OnIdle := AppEventsIdle;
- end;
- procedure TFormTranformExample.ClearTransformations;
- var
- I: Integer;
- begin
- FillChar(Operation[0], SizeOf(TOpRecs), 0);
- for I := 0 to 7 do
- begin
- Operation[I].Sx := 1;
- Operation[I].Sy := 1;
- Operation[I].Cx := Src.Bitmap.Width * 0.5;
- Operation[I].Cy := Src.Bitmap.Height * 0.5;
- end;
- end;
- procedure TFormTranformExample.PrepareSource;
- begin
- // make the border pixels transparent while keeping their RGB components
- if not CbxRepeat.Checked then
- SetBorderTransparent(Src.Bitmap, Src.Bitmap.BoundsRect);
- end;
- procedure TFormTranformExample.DoTransform;
- var
- i, j: Integer;
- begin
- GenTransform;
- Dst.BeginUpdate;
- Dst.Bitmap.Clear(clNone32);
- Transform(Dst.Bitmap, Src.Bitmap, Transformation);
- Dst.EndUpdate;
- Dst.Invalidate;
- if Mode = tmAffine then
- begin
- // fill the string grid
- for j := 0 to 2 do
- for i := 0 to 2 do
- StringGrid.Cells[i, j] := Format('%.3g', [AffineTransformation.Matrix[i, j]]);
- StringGrid.Col := 3; // hide grid cursor
- end;
- end;
- procedure TFormTranformExample.GenTransform;
- var
- I: Integer;
- Rec: TOpRec;
- S: string;
- begin
- if Mode = tmProjective then
- begin
- ProjectiveTransformation.X0 := Vertices[0].X;
- ProjectiveTransformation.Y0 := Vertices[0].Y;
- ProjectiveTransformation.X1 := Vertices[1].X;
- ProjectiveTransformation.Y1 := Vertices[1].Y;
- ProjectiveTransformation.X2 := Vertices[2].X;
- ProjectiveTransformation.Y2 := Vertices[2].Y;
- ProjectiveTransformation.X3 := Vertices[3].X;
- ProjectiveTransformation.Y3 := Vertices[3].Y;
- end
- else
- begin
- // affine mode
- AffineTransformation.Clear;
- for I := 0 to 7 do
- begin
- Rec := Operation[I];
- case Rec.OpType of
- opTranslate: AffineTransformation.Translate(Rec.Dx, Rec.Dy);
- opScale: AffineTransformation.Scale(Rec.Sx, Rec.Sy);
- opRotate: AffineTransformation.Rotate(Rec.Cx, Rec.Cy, Rec.Alpha);
- opSkew: AffineTransformation.Skew(Rec.Fx, Rec.Fy);
- end;
- case Rec.OpType of
- opTranslate: s := s + Format('Translate(%.3g, %.3g); ', [Rec.Dx, Rec.Dy]);
- opScale: s := s + Format('Scale(%.3g, %.3g); ', [Rec.Sx, Rec.Sy]);
- opRotate: s := s + Format('Rotate(%.3g, %.3g, %3g); ', [Rec.Cx, Rec.Cy, Rec.Alpha]);
- opSkew: s := s + Format('Skew(%.3g, %.3g); ', [Rec.Fx, Rec.Fy]);
- end;
- end;
- if Length(s) = 0 then s := 'Clear;';
- EdtCodeString.Text := s;
- end;
- Transformation.SrcRect := SrcRubberBandLayer.Location;
- end;
- procedure TFormTranformExample.FormDestroy(Sender: TObject);
- begin
- AffineTransformation.Free;
- ProjectiveTransformation.Free;
- end;
- procedure TFormTranformExample.BtnClearAllClick(Sender: TObject);
- begin
- ClearTransformations;
- ShowSettings(Listbox.ItemIndex);
- DoTransform;
- end;
- procedure TFormTranformExample.ListBoxClick(Sender: TObject);
- begin
- ShowSettings(ListBox.ItemIndex);
- end;
- procedure TFormTranformExample.ShowSettings(OperationNum: Integer);
- begin
- LoadingValues := True;
- ListBox.ItemIndex := OperationNum;
- Current := @Operation[OperationNum];
- Combobox.ItemIndex := Ord(Current.OpType);
- NoteBook.PageIndex := Ord(Current.OpType);
- EdtDx.Text := Format('%.4g', [Current.Dx]);
- EdtDy.Text := Format('%.4g', [Current.Dy]);
- GbrDx.Position := Round(Current.Dx * 10);
- GbrDy.Position := Round(Current.Dy * 10);
- EdtSx.Text := Format('%.4g', [Current.Sx]);
- EdtSy.Text := Format('%.4g', [Current.Sy]);
- GbrSx.Position := Round(Current.Sx * 100);
- GbrSy.Position := Round(Current.Sy * 100);
- EdtCx.Text := Format('%.4g', [Current.Cx]);
- EdtCy.Text := Format('%.4g', [Current.Cy]);
- EdtAlpha.Text := Format('%.4g', [Current.Alpha]);
- GbrAlpha.Position := Round(Current.Alpha * 2);
- EdtFx.Text := Format('%.4g', [Current.Fx]);
- EdtFy.Text := Format('%.4g', [Current.Fy]);
- GbrFx.Position := Round(Current.Fx * 100);
- GbrFy.Position := Round(Current.Fy * 100);
- LoadingValues := False;
- end;
- procedure TFormTranformExample.ComboBoxChange(Sender: TObject);
- begin
- Current.OpType := OpTypes[ComboBox.ItemIndex];
- ShowSettings(ListBox.ItemIndex);
- DoTransform;
- end;
- procedure TFormTranformExample.TranslationChanged(Sender: TObject);
- var
- Tx, Ty: Extended;
- begin
- if LoadingValues then Exit;
- if GetVal(EdtDx.Text, Tx) and GetVal(EdtDy.Text, Ty) then
- begin
- Current.Dx := Tx;
- Current.Dy := Ty;
- DoTransform;
- LoadingValues := True;
- GbrDx.Position := Round(Current.Dx * 10);
- GbrDy.Position := Round(Current.Dy * 10);
- LoadingValues := False;
- end;
- end;
- procedure TFormTranformExample.TranslationScrolled(Sender: TObject);
- begin
- if LoadingValues then Exit;
- Current.Dx := GbrDx.Position * 0.1;
- Current.Dy := GbrDy.Position * 0.1;
- DoTransform;
- LoadingValues := True;
- EdtDx.Text := FloatToStr(Current.Dx);
- EdtDy.Text := FloatToStr(Current.Dy);
- LoadingValues := False;
- end;
- procedure TFormTranformExample.ScaleChanged(Sender: TObject);
- var
- Sx, Sy: Extended;
- begin
- if LoadingValues then Exit;
- if GetVal(EdtSx.Text, Sx) and GetVal(EdtSy.Text, Sy) then
- begin
- Current.Sx := Sx;
- Current.Sy := Sy;
- DoTransform;
- LoadingValues := True;
- GbrSx.Position := Round(Current.Sx * 100);
- GbrSy.Position := Round(Current.Sy * 100);
- LoadingValues := False;
- end;
- end;
- procedure TFormTranformExample.ScaleScrolled(Sender: TObject);
- begin
- if LoadingValues then Exit;
- Current.Sx := GbrSx.Position * 0.01;
- Current.Sy := GbrSy.Position * 0.01;
- DoTransform;
- LoadingValues := True;
- EdtSx.Text := FloatToStr(Current.Sx);
- EdtSy.Text := FloatToStr(Current.Sy);
- LoadingValues := False;
- end;
- procedure TFormTranformExample.RotationChanged(Sender: TObject);
- var
- Cx, Cy, Alpha: Extended;
- begin
- if LoadingValues then Exit;
- if GetVal(EdtCx.Text, Cx) and GetVal(EdtCy.Text, Cy) and
- GetVal(EdtAlpha.Text, Alpha) then
- begin
- Current.Cx := Cx;
- Current.Cy := Cy;
- Current.Alpha := Alpha;
- DoTransform;
- LoadingValues := True;
- GbrAlpha.Position := Round(Alpha * 2);
- LoadingValues := False;
- end;
- end;
- procedure TFormTranformExample.RotationScrolled(Sender: TObject);
- begin
- if LoadingValues then Exit;
- Current.Alpha := GbrAlpha.Position * 0.5;
- DoTransform;
- LoadingValues := True;
- EdtAlpha.Text := FloatToStr(Current.Alpha * 0.5);
- LoadingValues := False;
- end;
- procedure TFormTranformExample.SkewChanged(Sender: TObject);
- var
- Fx, Fy: Extended;
- begin
- if LoadingValues then Exit;
- if GetVal(EdtFx.Text, Fx) and GetVal(EdtFy.Text, Fy) then
- begin
- Current.Fx := Fx;
- Current.Fy := Fy;
- DoTransform;
- LoadingValues := True;
- GbrFx.Position := Round(Current.Fx * 10);
- GbrFy.Position := Round(Current.Fy * 10);
- LoadingValues := False;
- end;
- end;
- procedure TFormTranformExample.SkewScrolled(Sender: TObject);
- begin
- if LoadingValues then Exit;
- Current.Fx := GbrFx.Position * 0.1;
- Current.Fy := GbrFy.Position * 0.1;
- DoTransform;
- LoadingValues := True;
- EdtFx.Text := FloatToStr(Current.Fx);
- EdtFy.Text := FloatToStr(Current.Fy);
- LoadingValues := False;
- end;
- procedure TFormTranformExample.OpacityChange(Sender: TObject);
- begin
- OpacityBar.Update;
- Src.Bitmap.MasterAlpha := OpacityBar.Position;
- DoTransform;
- end;
- procedure TFormTranformExample.InitVertices;
- begin
- Vertices[0].X := 0;
- Vertices[0].Y := 0;
- Vertices[1].X := Src.Bitmap.Width - 1;
- Vertices[1].Y := 0;
- Vertices[2].X := Src.Bitmap.Width - 1;
- Vertices[2].Y := Src.Bitmap.Height - 1;
- Vertices[3].X := 0;
- Vertices[3].Y := Src.Bitmap.Height - 1;
- end;
- procedure TFormTranformExample.PageControlChange(Sender: TObject);
- begin
- if Src = nil then
- Exit;
- if PageControl.ActivePage = TstAffine then
- begin
- Mode := tmAffine;
- Transformation := AffineTransformation;
- CmbResamplerClassNames.Parent := TstAffine;
- LblResampler.Parent := TstAffine;
- CmbKernelClassNames.Parent := TstAffine;
- LblKernel.Parent := TstAffine;
- end
- else
- begin
- // set current transformation as projective
- Mode := tmProjective;
- Transformation := ProjectiveTransformation;
- InitVertices;
- CmbResamplerClassNames.Parent := TstProjective;
- LblResampler.Parent := TstProjective;
- CmbKernelClassNames.Parent := TstProjective;
- LblKernel.Parent := TstProjective;
- end;
- DoTransform;
- end;
- procedure TFormTranformExample.RubberLayerMouseDown(Sender: TObject;
- Button: TMouseButton; Shift: TShiftState; X, Y: Integer; Layer: TCustomLayer);
- var
- I: Integer;
- begin
- if Mode = tmAffine then Exit;
- DraggedVertex := -1;
- // find the vertex to drag
- for I := 0 to 3 do
- if (Abs(Vertices[I].X - X) < 3) and (Abs(Vertices[I].Y - Y) < 3) then
- begin
- DraggedVertex := I;
- Break;
- end;
- // or drag all of them, (DragVertex = 4)
- if DraggedVertex = -1 then DraggedVertex := 4;
- // store current mouse position
- LastMousePos := Classes.Point(X, Y);
- end;
- procedure TFormTranformExample.RubberLayerMouseMove(Sender: TObject; Shift: TShiftState;
- X, Y: Integer; Layer: TCustomLayer);
- var
- Dx, Dy, I: Integer;
- begin
- if Mode = tmAffine then Exit;
-
- if DraggedVertex = -1 then Exit; // mouse is not pressed
- Dx := X - LastMousePos.X;
- Dy := Y - LastMousePos.Y;
- LastMousePos := Classes.Point(X, Y);
- // update coords
- if DraggedVertex = 4 then
- begin
- for I := 0 to 3 do
- begin
- Inc(Vertices[I].X, Dx);
- Inc(Vertices[I].Y, Dy);
- end;
- end
- else
- begin
- Inc(Vertices[DraggedVertex].X, Dx);
- Inc(Vertices[DraggedVertex].Y, Dy);
- end;
- DoTransform;
- end;
- procedure TFormTranformExample.RubberLayerMouseUp(Sender: TObject; Button: TMouseButton;
- Shift: TShiftState; X, Y: Integer; Layer: TCustomLayer);
- begin
- DraggedVertex := -1;
- end;
- procedure TFormTranformExample.AppEventsIdle(Sender: TObject; var Done: Boolean);
- begin
- if DraggedVertex >= 0 then Exit;
- StippleStart := StippleStart - 0.05;
- Dst.Invalidate;
- end;
- procedure TFormTranformExample.PaintHandles(Sender: TObject; BackBuffer: TBitmap32);
- var
- I, X0, Y0, X1, Y1: Integer;
- procedure PaintVertex(X, Y: Integer);
- begin
- BackBuffer.FillRectS(X - 2, Y - 2, X + 2, Y + 2, clWhite32);
- BackBuffer.FrameRectS(X - 3, Y - 3, X + 3, Y + 3, clBlack32);
- end;
- begin
- if PageControl.ActivePage = TstAffine then Exit;
- BackBuffer.SetStipple([clBlack32, clBlack32, clWhite32, clWhite32]);
- BackBuffer.StippleStep := 0.5;
- BackBuffer.StippleCounter := StippleStart;
- X0 := Vertices[3].X;
- Y0 := Vertices[3].Y;
- for I := 0 to 3 do
- begin
- X1 := Vertices[I].X;
- Y1 := Vertices[I].Y;
- BackBuffer.LineFSP(X0, Y0, X1, Y1);
- X0 := X1;
- Y0 := Y1;
- end;
- for I := 0 to 3 do PaintVertex(Vertices[I].X, Vertices[I].Y);
- end;
- procedure TFormTranformExample.ResamplerClassNamesListClick(Sender: TObject);
- begin
- with CmbResamplerClassNames do
- if ItemIndex >= 0 then
- Src.Bitmap.ResamplerClassName:= Items[ ItemIndex ];
- DoTransform;
- end;
- procedure TFormTranformExample.SrcDblClick(Sender: TObject);
- begin
- SrcRubberBandLayer.Location := FloatRect(0, 0, Src.Bitmap.Width - 1,
- Src.Bitmap.Height - 1);
- end;
- procedure TFormTranformExample.SrcRBResizingEvent(Sender: TObject;
- const OldLocation: TFloatRect; var NewLocation: TFloatRect;
- DragState: TRBDragState; Shift: TShiftState);
- begin
- Src.Invalidate;
- DoTransform;
- end;
- procedure TFormTranformExample.CmbResamplerClassNamesChange(Sender: TObject);
- var
- R: TCustomResampler;
- begin
- with CmbResamplerClassNames do
- if ItemIndex >= 0 then
- begin
- Src.Bitmap.BeginUpdate;
- R := ResamplerList[ItemIndex].Create(Src.Bitmap);
- if CbxRepeat.Checked then
- begin
- Src.Bitmap.WrapMode := wmRepeat;
- Src.Bitmap.Resampler.PixelAccessMode := CAccessMode[CbxRepeat.Checked];
- end;
- CmbKernelClassNamesChange(nil);
- Src.Bitmap.EndUpdate;
- Src.Bitmap.Changed;
- CmbKernelClassNames.Visible := R is TKernelResampler;
- LblKernel.Visible := CmbKernelClassNames.Visible;
- end;
- end;
- procedure TFormTranformExample.CmbKernelClassNamesChange(Sender: TObject);
- var
- Index: Integer;
- begin
- Index := CmbKernelClassNames.ItemIndex;
- if Src.Bitmap.Resampler is TKernelResampler then
- begin
- TKernelResampler(Src.Bitmap.Resampler).Kernel := KernelList[Index].Create;
- end;
- DoTransform;
- end;
- procedure TFormTranformExample.DstPaintStage(Sender: TObject; Buffer: TBitmap32;
- StageNum: Cardinal);
- const //0..1
- Colors: array [Boolean] of TColor32 = ($FFFFFFFF, $FFB0B0B0);
- var
- R: TRect;
- I, J: Integer;
- OddY: Integer;
- TilesHorz, TilesVert: Integer;
- TileX, TileY: Integer;
- TileHeight, TileWidth: Integer;
- begin
- if Sender is TImage32 then with TImage32(Sender) do
- begin
- BeginUpdate;
- R := GetViewportRect;
- case PaintStages[StageNum].Parameter of
- 1: begin //Draw Checkerboard
- TileHeight := 8;
- TileWidth := 8;
- TilesHorz := (R.Right - R.Left) div TileWidth;
- TilesVert := (R.Bottom - R.Top) div TileHeight;
- TileY := 0;
- for J := 0 to TilesVert do
- begin
- TileX := 0;
- OddY := J and $1;
- for I := 0 to TilesHorz do
- begin
- Buffer.FillRectS(TileX, TileY, TileX + TileWidth, TileY + TileHeight,Colors[I and $1 = OddY]);
- Inc(TileX, TileWidth);
- end;
- Inc(TileY, TileHeight);
- end
- end;
- 2: Buffer.FrameRectS(R , $FF000000); //Draw Frame
- end;
- EndUpdate;
- end;
- end;
- procedure TFormTranformExample.CbxRepeatClick(Sender: TObject);
- begin
- Src.Bitmap.WrapMode := wmRepeat;
- Src.Bitmap.Resampler.PixelAccessMode := CAccessMode[CbxRepeat.Checked];
- DoTransform;
- end;
- end.
|