home *** CD-ROM | disk | FTP | other *** search
/ Chip 2005 November / CDVD1105.ISO / Software / Freeware / programare / graphics32 / Examples / Clx / ImgView_Layers_Ex / MainUnit.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  2004-07-15  |  25.0 KB  |  900 lines

  1. unit MainUnit;
  2.  
  3. (* ***** BEGIN LICENSE BLOCK *****
  4.  * Version: MPL 1.1
  5.  *
  6.  * The contents of this file are subject to the Mozilla Public License Version
  7.  * 1.1 (the "License"); you may not use this file except in compliance with
  8.  * the License. You may obtain a copy of the License at
  9.  * http://www.mozilla.org/MPL/
  10.  *
  11.  * Software distributed under the License is distributed on an "AS IS" basis,
  12.  * WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License
  13.  * for the specific language governing rights and limitations under the
  14.  * License.
  15.  *
  16.  * The Original Code is Graphics32
  17.  *
  18.  * The Initial Developer of the Original Code is
  19.  * Alex A. Denisov
  20.  *
  21.  * Portions created by the Initial Developer are Copyright (C) 2000-2004
  22.  * the Initial Developer. All Rights Reserved.
  23.  *
  24.  * Contributor(s):
  25.  *   Andre Beckedorf <Andre@metaException.de>
  26.  *   Mattias Andersson <mattias@centaurix.com>
  27.  *
  28.  * ***** END LICENSE BLOCK ***** *)
  29.  
  30. interface
  31.  
  32. uses
  33.   Types, SysUtils, Classes, QForms, QDialogs, QMenus, QTypes, QStdCtrls,
  34.   QControls, QExtCtrls, QGraphics, GR32, GR32_Image, GR32_Layers,
  35.   GR32_RangeBars, GR32_Filters, GR32_Transforms;
  36.  
  37. type
  38.   TMainForm = class(TForm)
  39.     ImgView: TImgView32;
  40.     SidePanel: TPanel;
  41.     MainMenu: TMainMenu;
  42.     mnFileNew: TMenuItem;
  43.     mnFile: TMenuItem;
  44.     mnFileOpen: TMenuItem;
  45.     mnLayers: TMenuItem;
  46.     mnNewBitmapLayer: TMenuItem;
  47.     mnDelete: TMenuItem;
  48.     pnlImage: TPanel;
  49.     ScaleCombo: TComboBox;
  50.     Label1: TLabel;
  51.     Panel2: TPanel;
  52.     ImageInterpolate: TCheckBox;
  53.     pnlBitmapLayer: TPanel;
  54.     Panel3: TPanel;
  55.     Label2: TLabel;
  56.     LayerOpacity: TGaugeBar;
  57.     LayerInterpolate: TCheckBox;
  58.     mnNewBitmapRGBA: TMenuItem;
  59.     LayerRescale: TButton;
  60.     LayerResetScale: TButton;
  61.     Cropped: TCheckBox;
  62.     mnNewCustomLayer: TMenuItem;
  63.     mnMagnifier: TMenuItem;
  64.     PnlMagn: TPanel;
  65.     Label3: TLabel;
  66.     Panel4: TPanel;
  67.     MagnOpacity: TGaugeBar;
  68.     SaveDialog1: TSaveDialog;
  69.     Label4: TLabel;
  70.     MagnMagnification: TGaugeBar;
  71.     Label5: TLabel;
  72.     MagnRotation: TGaugeBar;
  73.     MagnInterpolate: TCheckBox;
  74.     mnSimpleDrawing: TMenuItem;
  75.     mnArrange: TMenuItem;
  76.     mnBringFront: TMenuItem;
  77.     mnSendBack: TMenuItem;
  78.     N1: TMenuItem;
  79.     mnLevelUp: TMenuItem;
  80.     mnLevelDown: TMenuItem;
  81.     N2: TMenuItem;
  82.     mnScaled: TMenuItem;
  83.     N4: TMenuItem;
  84.     mnFlatten: TMenuItem;
  85.     N3: TMenuItem;
  86.     mnFlipHorz: TMenuItem;
  87.     mnFlipVert: TMenuItem;
  88.     N5: TMenuItem;
  89.     mnRotate90: TMenuItem;
  90.     mnRotate180: TMenuItem;
  91.     mnRotate270: TMenuItem;
  92.     N6: TMenuItem;
  93.     mnPrint: TMenuItem;
  94.     OpenPictureDialog1: TOpenDialog;
  95.     procedure mnFileNewClick(Sender: TObject);
  96.     procedure mnFileOpenClick(Sender: TObject);
  97.     procedure mnNewBitmapLayerClick(Sender: TObject);
  98.     procedure mnDeleteClick(Sender: TObject);
  99.     procedure mnLayersClick(Sender: TObject);
  100.     procedure mnNewBitmapRGBAClick(Sender: TObject);
  101.     procedure mnMagnifierClick(Sender: TObject);
  102.     procedure mnSimpleDrawingClick(Sender: TObject);
  103.     procedure mnArrangeClick(Sender: TObject);
  104.     procedure mnScaledClick(Sender: TObject);
  105.     procedure mnReorder(Sender: TObject);
  106.     procedure ScaleComboChange(Sender: TObject);
  107.     procedure FormDestroy(Sender: TObject);
  108.     procedure ImageInterpolateClick(Sender: TObject);
  109.     procedure LayerOpacityChange(Sender: TObject);
  110.     procedure LayerInterpolateClick(Sender: TObject);
  111.     procedure FormCreate(Sender: TObject);
  112.     procedure LayerRescaleClick(Sender: TObject);
  113.     procedure LayerResetScaleClick(Sender: TObject);
  114.     procedure CroppedClick(Sender: TObject);
  115.     procedure MagnChange(Sender: TObject);
  116.     procedure ImgViewMouseDown(Sender: TObject; Button: TMouseButton;
  117.       Shift: TShiftState; X, Y: Integer; Layer: TCustomLayer);
  118.     procedure ImgViewPaintStage(Sender: TObject; Buffer: TBitmap32;
  119.       StageNum: Cardinal);
  120.     procedure mnFlattenClick(Sender: TObject);
  121.     procedure ImgViewMouseWheelUp(Sender: TObject; Shift: TShiftState;
  122.       MousePos: TPoint; var Handled: Boolean);
  123.     procedure ImgViewMouseWheelDown(Sender: TObject; Shift: TShiftState;
  124.       MousePos: TPoint; var Handled: Boolean);
  125.     procedure mnFlipHorzClick(Sender: TObject);
  126.     procedure mnFlipVertClick(Sender: TObject);
  127.     procedure mnRotate90Click(Sender: TObject);
  128.     procedure mnRotate180Click(Sender: TObject);
  129.     procedure mnRotate270Click(Sender: TObject);
  130.     procedure mnFileClick(Sender: TObject);
  131.     procedure mnPrintClick(Sender: TObject);
  132.   private
  133.     FSelection: TPositionedLayer;
  134.     procedure SetSelection(Value: TPositionedLayer);
  135.   protected
  136.     RBLayer: TRubberbandLayer;
  137.     function CreatePositionedLayer: TPositionedLayer;
  138.     procedure LayerMouseDown(Sender: TObject; Buttons: TMouseButton; Shift: TShiftState; X, Y: Integer);
  139.     procedure RBResizing(Sender: TObject; const OldLocation: TFloatRect; var NewLocation: TFloatRect; DragState: TDragState; Shift: TShiftState);
  140.     procedure PaintMagnifierHandler(Sender: TObject; Buffer: TBitmap32);
  141.     procedure PaintSimpleDrawingHandler(Sender: TObject; Buffer: TBitmap32);
  142.   public
  143.     procedure CreateNewImage(AWidth, AHeight: Integer; FillColor: TColor32);
  144.     procedure OpenImage(const FileName: string);
  145.     property Selection: TPositionedLayer read FSelection write SetSelection;
  146.   end;
  147.  
  148. var
  149.   MainForm: TMainForm;
  150.  
  151. implementation
  152.  
  153. uses NewImageUnit, RGBALoaderUnit, Math, GR32_LowLevel, QPrinters;
  154.  
  155. {$R *.xfm}
  156.  
  157. { TForm1 }
  158.  
  159. procedure TMainForm.CreateNewImage(AWidth, AHeight: Integer; FillColor: TColor32);
  160. begin
  161.   with ImgView do
  162.   begin
  163.     Selection := nil;
  164.     RBLayer := nil;
  165.     Layers.Clear;
  166.     Scale := 1;
  167.     Bitmap.SetSize(AWidth, AHeight);
  168.     Bitmap.Clear(FillColor);
  169.     pnlImage.Visible := not Bitmap.Empty;
  170.   end;
  171. end;
  172.  
  173. function TMainForm.CreatePositionedLayer: TPositionedLayer;
  174. var
  175.   P: TPoint;
  176. begin
  177.   // get coordinates of the center of viewport
  178.   with ImgView.GetViewportRect do
  179.     P := ImgView.ControlToBitmap(Point((Right + Left) div 2, (Top + Bottom) div 2));
  180.  
  181.   Result := TPositionedLayer.Create(ImgView.Layers);
  182.   Result.Location := FloatRect(P.X - 32, P.Y - 32, P.X + 32, P.Y + 32);
  183.   Result.Scaled := True;
  184.   Result.MouseEvents := True;
  185.   Result.OnMouseDown := LayerMouseDown;
  186. end;
  187.  
  188. procedure TMainForm.CroppedClick(Sender: TObject);
  189. begin
  190.   if Selection is TBitmapLayer then
  191.     TBitmapLayer(Selection).Cropped := Cropped.Checked;
  192. end;
  193.  
  194. procedure TMainForm.FormCreate(Sender: TObject);
  195. begin
  196.   // by default, PST_CLEAR_BACKGND is executed at this stage,
  197.   // which, in turn, calls ExecClearBackgnd method of ImgView.
  198.   // Here I substitute PST_CLEAR_BACKGND with PST_CUSTOM, so force ImgView
  199.   // to call the OnPaintStage event instead of performing default action.
  200.   with ImgView.PaintStages[0]^ do
  201.   begin
  202.     if Stage = PST_CLEAR_BACKGND then Stage := PST_CUSTOM;
  203.   end;
  204.  
  205.   OpenPictureDialog1.Filter := GraphicFilter(TGraphic, True); 
  206. end;
  207.  
  208. procedure TMainForm.FormDestroy(Sender: TObject);
  209. begin
  210.   Selection := nil;
  211.   RBLayer := nil;
  212. end;
  213.  
  214. procedure TMainForm.ImageInterpolateClick(Sender: TObject);
  215. const
  216.   STRETCH_FILTER: array [Boolean] of TStretchFilter = (sfNearest, sfLinear);
  217. begin
  218.   ImgView.Bitmap.StretchFilter := STRETCH_FILTER[ImageInterpolate.Checked];
  219. end;
  220.  
  221. procedure TMainForm.LayerInterpolateClick(Sender: TObject);
  222. const
  223.   STRETCH_FILTER: array [Boolean] of TStretchFilter = (sfNearest, sfLinear);
  224. begin
  225.   if Selection is TBitmapLayer then
  226.   begin
  227.     TBitmapLayer(Selection).Bitmap.StretchFilter := STRETCH_FILTER[LayerInterpolate.Checked];
  228.   end;
  229. end;
  230.  
  231. procedure TMainForm.LayerMouseDown(Sender: TObject; Buttons: TMouseButton;
  232.   Shift: TShiftState; X, Y: Integer);
  233. begin
  234.   if Sender <> nil then Selection := TPositionedLayer(Sender);
  235. end;
  236.  
  237. procedure TMainForm.LayerOpacityChange(Sender: TObject);
  238. begin
  239.   if Selection is TBitmapLayer then
  240.     TBitmapLayer(Selection).Bitmap.MasterAlpha := LayerOpacity.Position;
  241. end;
  242.  
  243. procedure TMainForm.LayerRescaleClick(Sender: TObject);
  244. var
  245.   T: TBitmap32;
  246. begin
  247.   // resize the layer's bitmap to the size of the layer
  248.   if Selection is TBitmapLayer then
  249.     with TBitmapLayer(Selection) do
  250.     begin
  251.       T := TBitmap32.Create;
  252.       T.Assign(Bitmap);
  253.       with MakeRect(Location) do
  254.         Bitmap.SetSize(Right - Left, Bottom - Top);
  255.       T.StretchFilter := sfLinear;
  256.       T.DrawMode := dmOpaque;
  257.       T.DrawTo(Bitmap, Rect(0, 0, Bitmap.Width, Bitmap.Height));
  258.       T.Free;
  259.       LayerResetScaleClick(Self);
  260.     end;
  261. end;
  262.  
  263. procedure TMainForm.LayerResetScaleClick(Sender: TObject);
  264. var
  265.   L: TFloatRect;
  266. begin
  267.   // resize the layer to the size of its bitmap
  268.   if Selection is TBitmapLayer then
  269.     with RBLayer, TBitmapLayer(Selection).Bitmap do
  270.     begin
  271.       L := Location;
  272.       L.Right := L.Left + Width;
  273.       L.Bottom := L.Top + Height;
  274.       Location := L;
  275.       Changed;
  276.     end;
  277. end;
  278.  
  279. procedure TMainForm.MagnChange(Sender: TObject);
  280. begin
  281.   ImgView.Invalidate;
  282. end;
  283.  
  284. procedure TMainForm.mnArrangeClick(Sender: TObject);
  285. var
  286.   B: Boolean;
  287. begin
  288.   B := Selection <> nil;
  289.   mnBringFront.Enabled := B and (Selection.Index < ImgView.Layers.Count - 2);
  290.   mnSendBack.Enabled := B and (Selection.Index > 0);
  291.   mnLevelUp.Enabled := B and (Selection.Index < ImgView.Layers.Count - 2);
  292.   mnLevelDown.Enabled := B and (Selection.Index > 0);
  293.   mnScaled.Enabled := B;
  294.   mnScaled.Checked := B and Selection.Scaled;
  295.   mnDelete.Enabled := B;
  296.   B := B and (Selection is TBitmapLayer);
  297.   mnFlipHorz.Enabled := B;
  298.   mnFlipVert.Enabled := B;
  299.   mnRotate90.Enabled := B;
  300.   mnRotate180.Enabled := B;
  301.   mnRotate270.Enabled := B;
  302. end;
  303.  
  304. procedure TMainForm.mnDeleteClick(Sender: TObject);
  305. var
  306.   ALayer: TPositionedLayer;
  307. begin
  308.   if Selection <> nil then
  309.   begin
  310.     ALayer := Selection;
  311.     Selection := nil;
  312.     ALayer.Free;
  313.   end;
  314. end;
  315.  
  316. procedure TMainForm.mnFileNewClick(Sender: TObject);
  317. begin
  318.   with NewImageForm do
  319.   begin
  320.     ShowModal;
  321.     if ModalResult = mrOK then
  322.       CreateNewImage(StrToInt(ImageWidth.Text), StrToInt(ImageHeight.Text), Color32(Panel1.Color));
  323.   end;
  324. end;
  325.  
  326. procedure TMainForm.mnFileOpenClick(Sender: TObject);
  327. begin
  328.   with OpenPictureDialog1 do
  329.     if Execute then OpenImage(FileName);
  330. end;
  331.  
  332. procedure TMainForm.mnLayersClick(Sender: TObject);
  333. var
  334.   B: Boolean;
  335. begin
  336.   B := not ImgView.Bitmap.Empty;
  337.   mnNewBitmapLayer.Enabled := B;
  338.   mnNewBitmapRGBA.Enabled := B;
  339.   mnNewCustomLayer.Enabled := B;
  340.   mnFlatten.Enabled := B and (ImgView.Layers.Count > 0);
  341. end;
  342.  
  343. procedure TMainForm.mnMagnifierClick(Sender: TObject);
  344. var
  345.   L: TPositionedLayer;
  346. begin
  347.   L := CreatePositionedLayer;
  348.   L.OnPaint := PaintMagnifierHandler;
  349.   L.Tag := 2;
  350.   Selection := L;
  351. end;
  352.  
  353. procedure TMainForm.mnNewBitmapLayerClick(Sender: TObject);
  354. var
  355.   B: TBitmapLayer;
  356.   P: TPoint;
  357.   W, H: Single;
  358. begin
  359.   with OpenPictureDialog1 do
  360.     if Execute then
  361.     begin
  362.       B := TBitmapLayer.Create(ImgView.Layers);
  363.       with B do
  364.       try
  365.         Bitmap.LoadFromFile(FileName);
  366.         Bitmap.DrawMode := dmBlend;
  367.  
  368.         with ImgView.GetViewportRect do
  369.           P := ImgView.ControlToBitmap(Point((Right + Left) div 2, (Top + Bottom) div 2));
  370.  
  371.         W := Bitmap.Width / 2;
  372.         H := Bitmap.Height / 2;
  373.  
  374.         with ImgView.Bitmap do
  375.           Location := FloatRect(P.X - W, P.Y - H, P.X + W, P.Y + H);
  376.  
  377.         Scaled := True;
  378.         OnMouseDown := LayerMouseDown;
  379.       except
  380.         Free;
  381.         raise;
  382.       end;
  383.       Selection := B;
  384.     end;
  385. end;
  386.  
  387. procedure TMainForm.mnNewBitmapRGBAClick(Sender: TObject);
  388. var
  389.   B: TBitmapLayer;
  390.   P: TPoint;
  391.   Tmp: TBitmap32;
  392.   W, H: Single;
  393. begin
  394.   with RGBALoaderForm do
  395.   begin
  396.     ImgRGB.Bitmap.Delete;
  397.     ImgRGB.Scale := 1;
  398.     ImgAlpha.Bitmap.Delete;
  399.     ImgAlpha.Scale := 1;
  400.     ShowModal;
  401.     if (ModalResult = mrOK) and not ImgRGB.Bitmap.Empty then
  402.     begin
  403.       B := TBitmapLayer.Create(ImgView.Layers);
  404.       B.Bitmap := ImgRGB.Bitmap;
  405.       B.Bitmap.DrawMode := dmBlend; 
  406.  
  407.       if not ImgAlpha.Bitmap.Empty then
  408.       begin
  409.         Tmp := TBitmap32.Create;
  410.         try
  411.           Tmp.SetSize(B.Bitmap.Width, B.Bitmap.Height);
  412.           ImgAlpha.Bitmap.DrawTo(Tmp, Rect(0, 0, Tmp.Width, Tmp.Height));
  413.  
  414.           // combine Alpha into already loaded RGB colors
  415.           IntensityToAlpha(B.Bitmap, Tmp);
  416.         finally
  417.           Tmp.Free;
  418.         end;
  419.       end;
  420.  
  421.       with ImgView.GetViewportRect do
  422.         P := ImgView.ControlToBitmap(Point((Right + Left) div 2, (Top + Bottom) div 2));
  423.  
  424.       with B do
  425.       begin
  426.         W := Bitmap.Width / 2;
  427.         H := Bitmap.Height / 2;
  428.  
  429.         with ImgView.Bitmap do
  430.           Location := FloatRect(P.X - W, P.Y - H, P.X + W, P.Y + H);
  431.  
  432.         Scaled := True;
  433.         OnMouseDown := LayerMouseDown;
  434.       end;
  435.       Selection := B;
  436.     end;
  437.   end;
  438. end;
  439.  
  440. procedure TMainForm.mnReorder(Sender: TObject);
  441. begin
  442.   // note that the top-most layer is occupied with the rubber-banding layer
  443.   if Selection <> nil then
  444.     case TMenuItem(Sender).Tag of
  445.       1: // Bring to front, do not use BringToFront here, see note above
  446.         Selection.Index := ImgView.Layers.Count - 2; 
  447.       2: Selection.SendToBack;
  448.       3: Selection.Index := Selection.Index + 1; // up one level
  449.       4: Selection.Index := Selection.Index - 1; // down one level
  450.     end;
  451. end;
  452.  
  453. procedure TMainForm.mnSimpleDrawingClick(Sender: TObject);
  454. var
  455.   L: TPositionedLayer;
  456. begin
  457.   L := CreatePositionedLayer;
  458.   L.OnPaint := PaintSimpleDrawingHandler;
  459.   L.Tag := 1;
  460.   Selection := L;
  461. end;
  462.  
  463. procedure TMainForm.OpenImage(const FileName: string);
  464. begin
  465.   with ImgView do
  466.   try
  467.     Selection := nil;
  468.     RBLayer := nil;
  469.     Layers.Clear;
  470.     Scale := 1;
  471.     Bitmap.LoadFromFile(FileName);
  472.   finally
  473.     pnlImage.Visible := not Bitmap.Empty;
  474.   end;
  475. end;
  476.  
  477. procedure TMainForm.PaintMagnifierHandler(Sender: TObject; Buffer: TBitmap32);
  478. var
  479.   Magnification, Rotation: Single;
  480.   SrcRect, DstRect: TFloatRect;
  481.   R: TRect;
  482.   T: TAffineTransformation;
  483.   B: TBitmap32;
  484.   W2, H2: Single;
  485.   I: Integer;
  486. begin
  487.   if Sender is TPositionedLayer then
  488.     with TPositionedLayer(Sender) do
  489.     begin
  490.       Magnification := Power(10, (MagnMagnification.Position / 50));
  491.       Rotation := -MagnRotation.Position;
  492.  
  493.       DstRect := GetAdjustedLocation;
  494.       R := MakeRect(DstRect);
  495.       B := TBitmap32.Create;
  496.       try
  497.         with R do
  498.         begin
  499.           B.SetSize(Right - Left, Bottom - Top);
  500.           W2 := (Right - Left) / 2;
  501.           H2 := (Bottom - Top) / 2;
  502.         end;
  503.  
  504.         SrcRect := DstRect;
  505.         with SrcRect do
  506.         begin
  507.           Left := Left - H2;
  508.           Right := Right + H2;
  509.           Top := Top - W2;
  510.           Bottom := Bottom + W2;
  511.         end;
  512.  
  513.         T := TAffineTransformation.Create;
  514.         try
  515.           T.SrcRect := SrcRect;
  516.           T.Translate(-R.Left, -R.Top);
  517.  
  518.           T.Translate(-W2, -H2);
  519.           T.Scale(Magnification, Magnification);
  520.           T.Rotate(0, 0, Rotation);
  521.           T.Translate(W2, H2);
  522.  
  523.           if MagnInterpolate.Checked then
  524.           begin
  525.             Buffer.BeginUpdate;
  526.             Buffer.StretchFilter := sfLinear;
  527.             Transform(B, Buffer, T);
  528.             Buffer.StretchFilter := sfNearest;
  529.             Buffer.EndUpdate;
  530.           end
  531.           else
  532.              Transform(B, Buffer, T);
  533.  
  534.           B.ResetAlpha;
  535.           B.DrawMode := dmBlend;
  536.           B.MasterAlpha := MagnOpacity.Position;
  537.           B.DrawTo(Buffer, R);
  538.  
  539.           // draw frame
  540.           for I := 0 to 4 do
  541.           begin
  542.              with R do Buffer.RaiseRectTS(Left, Top, Right, Bottom, 35 - I * 8);
  543.              InflateRect(R, -1, -1);
  544.           end;
  545.         finally
  546.           T.Free;
  547.         end;
  548.       finally
  549.         B.Free;
  550.       end;
  551.     end;
  552. end;
  553.  
  554. procedure TMainForm.PaintSimpleDrawingHandler(Sender: TObject; Buffer: TBitmap32);
  555. var
  556.   Cx, Cy: Single;
  557.   W2, H2: Single;
  558.   I: Integer;
  559. begin
  560.   if Sender is TPositionedLayer then
  561.     with TPositionedLayer(Sender).GetAdjustedLocation do
  562.     begin
  563.       W2 := (Right - Left) / 2;
  564.       H2 := (Bottom - Top) / 2;
  565.       Cx := Left + W2;
  566.       Cy := Top + H2;
  567.       Buffer.PenColor := clRed32;
  568.       Buffer.MoveToF(Cx,Cy);
  569.       for I := 0 to 240 do
  570.       begin
  571.         Buffer.LineToFS(Cx + W2 * I / 200 * Cos(I / 8), Cy + H2 * I / 200 * Sin(I / 8));
  572.       end;
  573.     end;
  574. end;
  575.  
  576. procedure TMainForm.ScaleComboChange(Sender: TObject);
  577. var
  578.   S: string;
  579.   I: Integer;
  580. begin
  581.   S := ScaleCombo.Text;
  582.   S := StringReplace(S, '%', '', [rfReplaceAll]);
  583.   S := StringReplace(S, ' ', '', [rfReplaceAll]);
  584.   if S = '' then Exit;
  585.   I := StrToIntDef(S, -1);
  586.   if (I < 1) or (I > 2000) then I := Round(ImgView.Scale * 100)
  587.   else ImgView.Scale := I / 100;
  588.   ScaleCombo.Text := IntToStr(I) + '%';
  589.   ScaleCombo.SelStart := Length(ScaleCombo.Text) - 1;
  590. end;
  591.  
  592. procedure TMainForm.SetSelection(Value: TPositionedLayer);
  593. begin
  594.   if Value <> FSelection then
  595.   begin
  596.     if RBLayer <> nil then
  597.     begin
  598.       RBLayer.ChildLayer := nil;
  599.       RBLayer.LayerOptions := LOB_NO_UPDATE;
  600.       pnlBitmapLayer.Visible := False;
  601.       pnlMagn.Visible := False;
  602.       ImgView.Invalidate;
  603.     end;
  604.  
  605.     FSelection := Value;
  606.  
  607.     if Value <> nil then
  608.     begin
  609.       if RBLayer = nil then
  610.       begin
  611.         RBLayer := TRubberBandLayer.Create(ImgView.Layers);
  612.         RBLayer.MinHeight := 1;
  613.         RBLayer.MinWidth := 1;
  614.       end
  615.       else RBLayer.BringToFront;
  616.       RBLayer.ChildLayer := Value;
  617.       RBLayer.LayerOptions := LOB_VISIBLE or LOB_MOUSE_EVENTS or LOB_NO_UPDATE;
  618.       RBLayer.OnResizing := RBResizing;
  619.  
  620.       if Value is TBitmapLayer then
  621.         with TBitmapLayer(Value) do
  622.         begin
  623.           pnlBitmapLayer.Visible := True;
  624.           LayerOpacity.Position := Bitmap.MasterAlpha;
  625.           LayerInterpolate.Checked := Bitmap.StretchFilter = sfLinear;
  626.         end
  627.       else if Value.Tag = 2 then
  628.       begin
  629.         // tag = 2 for magnifiers
  630.         pnlMagn.Visible := True;
  631.       end;
  632.     end;
  633.   end;
  634. end;
  635.  
  636. procedure TMainForm.mnScaledClick(Sender: TObject);
  637. begin
  638.   if Selection <> nil then Selection.Scaled := not Selection.Scaled;
  639.   RBLayer.Scaled := Selection.Scaled;
  640. end;
  641.  
  642. procedure TMainForm.ImgViewMouseDown(Sender: TObject; Button: TMouseButton;
  643.   Shift: TShiftState; X, Y: Integer; Layer: TCustomLayer);
  644. begin
  645.   if Layer = nil then
  646.   begin
  647.     Selection := nil;
  648. //    ReleaseCapture;
  649.   end;
  650. end;
  651.  
  652. procedure TMainForm.ImgViewPaintStage(Sender: TObject; Buffer: TBitmap32;
  653.   StageNum: Cardinal);
  654. const
  655.   Colors: array [0..1] of TColor32 = ($FFFFFFFF, $FFB0B0B0);
  656. var
  657.   W, I, J, Parity: Integer;
  658.   Line1, Line2: TArrayOfColor32; // a buffer for a couple of scanlines
  659. begin
  660.   with ImgView.Buffer do
  661.   begin
  662.     W := Width;
  663.     SetLength(Line1, W);
  664.     SetLength(Line2, W);
  665.     for I := 0 to W - 1 do
  666.     begin
  667.       Parity := I shr 3 and $1;
  668.       Line1[I] := Colors[Parity];
  669.       Line2[I] := Colors[1 - Parity];
  670.     end;
  671.     for J := 0 to Height - 1 do
  672.     begin
  673.       Parity := J shr 3 and $1;
  674.       if Boolean(Parity) then MoveLongword(Line1[0], ScanLine[J]^, W)
  675.       else MoveLongword(Line2[0], ScanLine[J]^, W);
  676.     end;
  677.   end;
  678. end;
  679.  
  680. procedure TMainForm.RBResizing(Sender: TObject;
  681.   const OldLocation: TFloatRect; var NewLocation: TFloatRect;
  682.   DragState: TDragState; Shift: TShiftState);
  683. var
  684.   w, h, cx, cy: Single;
  685.   nw, nh: Single;
  686.  
  687. begin
  688.   if DragState = dsMove then Exit; // we are interested only in scale operations
  689.   if Shift = [] then Exit; // special processing is not required
  690.  
  691.   if ssCtrl in Shift then
  692.   begin
  693.     { make changes symmetrical }
  694.  
  695.     with OldLocation do
  696.     begin
  697.       cx := (Left + Right) / 2;
  698.       cy := (Top + Bottom) / 2;
  699.       w := Right - Left;
  700.       h := Bottom - Top;
  701.     end;
  702.  
  703.     with NewLocation do
  704.     begin
  705.       nw := w / 2;
  706.       nh := h / 2;
  707.       case DragState of
  708.         dsSizeL: nw := cx - Left;
  709.         dsSizeT: nh := cy - Top;
  710.         dsSizeR: nw := Right - cx;
  711.         dsSizeB: nh := Bottom - cy;
  712.         dsSizeTL: begin nw := cx - Left; nh := cy - Top; end;
  713.         dsSizeTR: begin nw := Right - cx; nh := cy - Top; end;
  714.         dsSizeBL: begin nw := cx - Left; nh := Bottom - cy; end;
  715.         dsSizeBR: begin nw := Right - cx; nh := Bottom - cy; end;
  716.       end;
  717.       if nw < 2 then nw := 2;
  718.       if nh < 2 then nh := 2;
  719.  
  720.       Left := cx - nw;
  721.       Right := cx + nw;
  722.       Top := cy - nh;
  723.       Bottom := cy + nh;
  724.     end;
  725.   end;
  726. end;
  727.  
  728. procedure TMainForm.mnFlattenClick(Sender: TObject);
  729. var
  730.   B: TBitmap32;
  731.   W, H: Integer;
  732. begin
  733.   { deselect everything }
  734.   Selection := nil;
  735.   W := ImgView.Bitmap.Width;
  736.   H := ImgView.Bitmap.Height;
  737.  
  738.   { Create a new bitmap to store a flattened image }
  739.   B := TBitmap32.Create;
  740.   try
  741.     B.SetSize(W, H);
  742.     ImgView.PaintTo(B, Rect(0, 0, W, H));
  743.  
  744.     { destroy all the layers of the original image... }
  745.     ImgView.Layers.Clear;
  746.     RBLayer := nil; // note that RBLayer reference is destroyed here as well.
  747.                     // The rubber band will be recreated during the next
  748.                     // SetSelection call. Alternatively, you can delete
  749.                     // all the layers except the rubber band.
  750.  
  751.     { ...and overwrite it with the flattened one }
  752.     ImgView.Bitmap := B;
  753.   finally
  754.     B.Free;
  755.   end;
  756. end;
  757.  
  758. procedure TMainForm.mnPrintClick(Sender: TObject);
  759. var
  760.   B: TBitmap32;
  761.   W, H: Integer;
  762.   R: TRect;
  763.  
  764.   function GetCenteredRectToFit(const src, dst: TRect): TRect;
  765.   var
  766.     srcWidth, srcHeight, dstWidth, dstHeight, ScaledSide: Integer;
  767.   begin
  768.     with src do begin
  769.       srcWidth := Right - Left;
  770.       srcHeight := Bottom - Top;
  771.     end;
  772.     with dst do begin
  773.       dstWidth := Right - Left;
  774.       dstHeight := Bottom - Top;
  775.     end;
  776.     if (srcWidth = 0) or (srcHeight = 0) then exit;
  777.     if srcWidth / srcHeight > dstWidth / dstHeight then begin
  778.       ScaledSide := Round(dstWidth * srcHeight / srcWidth);
  779.       with Result do begin
  780.         Left := dst.Left;
  781.         Top := dst.Top + (dstHeight - ScaledSide) div 2;
  782.         Right := dst.Right;
  783.         Bottom := Top + ScaledSide;
  784.       end;
  785.     end else begin
  786.       ScaledSide := Round(dstHeight * srcWidth / srcHeight);
  787.       with Result do begin
  788.         Left := dst.Left + (dstWidth - ScaledSide) div 2;
  789.         Top := dst.Top;
  790.         Right := Left + ScaledSide;
  791.         Bottom := dst.Bottom;
  792.       end;
  793.     end;
  794.   end;
  795.  
  796. begin
  797.   { deselect everything }
  798.   Selection := nil;
  799.   W := ImgView.Bitmap.Width;
  800.   H := ImgView.Bitmap.Height;
  801.  
  802.   { Create a new bitmap to store a flattened image }
  803.   B := TBitmap32.Create;
  804.   Screen.Cursor := crHourGlass;
  805.   try
  806.     B.SetSize(W, H);
  807.     ImgView.PaintTo(B, Rect(0, 0, W, H));
  808.     Printer.BeginDoc;
  809.     Printer.Title := 'Graphics32 Demo';
  810.     B.StretchFilter := sfLinear;
  811.     R := GetCenteredRectToFit(Rect(0, 0, W, H), Rect(0, 0, Printer.PageWidth, Printer.PageHeight));
  812.     B.TileTo(Printer.Canvas.Handle, R, Rect(0, 0, W, H));
  813.     Printer.EndDoc;
  814.   finally
  815.     B.Free;
  816.     Screen.Cursor := crDefault;
  817.   end;
  818. end;
  819.  
  820. procedure TMainForm.ImgViewMouseWheelUp(Sender: TObject;
  821.   Shift: TShiftState; MousePos: TPoint; var Handled: Boolean);
  822. var
  823.   s: Single;
  824. begin
  825.   s := ImgView.Scale / 1.1;
  826.   if s < 0.2 then s := 0.2;
  827.   ImgView.Scale := s;
  828.   ScaleCombo.Text := IntToStr(Round(s * 100)) + '%';
  829. end;
  830.  
  831. procedure TMainForm.ImgViewMouseWheelDown(Sender: TObject;
  832.   Shift: TShiftState; MousePos: TPoint; var Handled: Boolean);
  833. var
  834.   s: Single;
  835. begin
  836.   s := ImgView.Scale * 1.1;
  837.   if s > 20 then s := 20;
  838.   ImgView.Scale := s;
  839.   ScaleCombo.Text := IntToStr(Round(s * 100)) + '%';
  840. end;
  841.  
  842. procedure TMainForm.mnFlipHorzClick(Sender: TObject);
  843. begin
  844.   if Selection is TBitmapLayer then
  845.     TBitmapLayer(Selection).Bitmap.FlipHorz;
  846. end;
  847.  
  848. procedure TMainForm.mnFlipVertClick(Sender: TObject);
  849. begin
  850.   if Selection is TBitmapLayer then
  851.     TBitmapLayer(Selection).Bitmap.FlipVert;
  852. end;
  853.  
  854. procedure TMainForm.mnRotate90Click(Sender: TObject);
  855. var
  856.   R: TFloatRect;
  857.   Cx, Cy, W2, H2: Single;
  858. begin
  859.   if Selection is TBitmapLayer then
  860.   begin
  861.     R := Selection.Location;
  862.     TBitmapLayer(Selection).Bitmap.Rotate90;
  863.     Cx := (R.Left + R.Right) / 2;
  864.     Cy := (R.Top + R.Bottom) / 2;
  865.     W2 := (R.Right - R.Left) / 2;
  866.     H2 := (R.Bottom - R.Top) / 2;
  867.     RBLayer.Location := FloatRect(Cx - H2, Cy - W2, Cx + H2, Cy + W2);
  868.   end;
  869. end;
  870.  
  871. procedure TMainForm.mnRotate180Click(Sender: TObject);
  872. begin
  873.   if Selection is TBitmapLayer then
  874.     TBitmapLayer(Selection).Bitmap.Rotate180;
  875. end;
  876.  
  877. procedure TMainForm.mnRotate270Click(Sender: TObject);
  878. var
  879.   R: TFloatRect;
  880.   Cx, Cy, W2, H2: Single;
  881. begin
  882.   if Selection is TBitmapLayer then
  883.   begin
  884.     R := Selection.Location;
  885.     TBitmapLayer(Selection).Bitmap.Rotate270;
  886.     Cx := (R.Left + R.Right) / 2;
  887.     Cy := (R.Top + R.Bottom) / 2;
  888.     W2 := (R.Right - R.Left) / 2;
  889.     H2 := (R.Bottom - R.Top) / 2;
  890.     RBLayer.Location := FloatRect(Cx - H2, Cy - W2, Cx + H2, Cy + W2);
  891.   end;
  892. end;
  893.  
  894. procedure TMainForm.mnFileClick(Sender: TObject);
  895. begin
  896.   mnPrint.Enabled := not ImgView.Bitmap.Empty;
  897. end;
  898.  
  899. end.
  900.