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