home *** CD-ROM | disk | FTP | other *** search
/ Chip 2005 November / CDVD1105.ISO / Software / Freeware / programare / graphics32 / Examples / Clx / Polygons_Ex / MainUnit.pas next >
Encoding:
Pascal/Delphi Source File  |  2004-07-16  |  4.5 KB  |  187 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.   QForms, QStdCtrls, QExtCtrls, QControls,
  32.   SysUtils, Classes, GR32, GR32_Image, GR32_Layers, GR32_Polygons;
  33.  
  34. type
  35.   TForm1 = class(TForm)
  36.     Image: TImage32;
  37.     Panel1: TPanel;
  38.     Antialiase: TCheckBox;
  39.     Label1: TLabel;
  40.     LineAlpha: TScrollBar;
  41.     Label2: TLabel;
  42.     FillAlpha: TScrollBar;
  43.     FillMode: TRadioGroup;
  44.     Button1: TButton;
  45.     LineThickness: TScrollBar;
  46.     Label3: TLabel;
  47.     ThickOutline: TCheckBox;
  48.     Label4: TLabel;
  49.     BitmapList: TBitmap32List;
  50.     AntialiasMode: TRadioGroup;
  51.     Memo1: TMemo;
  52.     Memo2: TMemo;
  53.     procedure FormCreate(Sender: TObject);
  54.     procedure FormDestroy(Sender: TObject);
  55.     procedure ImageMouseDown(Sender: TObject; Button: TMouseButton;
  56.       Shift: TShiftState; X, Y: Integer; Layer: TCustomLayer);
  57.     procedure ImageResize(Sender: TObject);
  58.     procedure ParamsChanged(Sender: TObject);
  59.     procedure Button1Click(Sender: TObject);
  60.     procedure ThicknessChanged(Sender: TObject);
  61.   private
  62.     Polygon: TPolygon32;
  63.     Outline: TPolygon32;
  64.     UseOutlinePoly: Boolean;
  65.     LineSize: Single;
  66.     procedure Build;
  67.     procedure Draw;
  68.   end;
  69.  
  70. var
  71.   Form1: TForm1;
  72.  
  73. implementation
  74.  
  75. {$R *.xfm}
  76.  
  77. procedure TForm1.Draw;
  78. var
  79.   AAMode: TAntialiasMode;
  80. begin
  81.   Case AntialiasMode.ItemIndex of
  82.     0: AAMode := am16times;
  83.     1: AAMode := am8times;
  84.     2: AAMode := am4times;
  85.   else
  86.     AAMode := am4times;
  87.   end;
  88.  
  89.   Image.Bitmap.BeginUpdate;
  90.   Image.Bitmap.Clear(clWhite32);
  91.   Image.Bitmap.Draw(50, 50, BitmapList.Bitmaps[0].Bitmap);
  92.   Polygon.Antialiased := Antialiase.Checked;
  93.   Polygon.AntialiasMode := AAMode;
  94.  
  95.   if UseOutlinePoly then
  96.   begin
  97.     Outline.Antialiased := Antialiase.Checked;
  98.     Outline.AntialiasMode := AAMode;
  99.   end;
  100.  
  101.   if FillMode.ItemIndex = 0 then Polygon.FillMode := pfAlternate else Polygon.FillMode := pfWinding;
  102.  
  103.   Polygon.DrawFill(Image.Bitmap, SetAlpha(clGreen32, FillAlpha.Position));
  104.  
  105.   if UseOutlinePoly then
  106.     Outline.DrawFill(Image.Bitmap, SetAlpha(clBlack32, LineAlpha.Position))
  107.   else
  108.     Polygon.DrawEdge(Image.Bitmap, SetAlpha(clBlack32, LineAlpha.Position));
  109.  
  110.   Image.Bitmap.EndUpdate;
  111.   Image.Bitmap.Changed;
  112.   Image.Refresh; // force repaint
  113. end;
  114.  
  115. procedure TForm1.FormCreate(Sender: TObject);
  116. begin
  117.   Image.SetupBitmap;
  118.   AntialiasMode.ItemIndex := 1;
  119.   FillMode.ItemIndex := 0;
  120.   Polygon := TPolygon32.Create;
  121. end;
  122.  
  123. procedure TForm1.FormDestroy(Sender: TObject);
  124. begin
  125.   Outline.Free;
  126.   Polygon.Free;
  127. end;
  128.  
  129. procedure TForm1.ImageMouseDown(Sender: TObject; Button: TMouseButton;
  130.   Shift: TShiftState; X, Y: Integer; Layer: TCustomLayer);
  131. begin
  132.   if Button = mbLeft then Polygon.Add(FixedPoint(X, Y))
  133.   else Polygon.Clear;
  134.   Build;
  135.   Draw;
  136. end;
  137.  
  138. procedure TForm1.ImageResize(Sender: TObject);
  139. begin
  140.   Image.SetupBitmap;
  141.   Build;
  142.   Draw;
  143. end;
  144.  
  145. procedure TForm1.ParamsChanged(Sender: TObject);
  146. begin
  147.   AntialiasMode.Enabled := Antialiase.Checked and ThickOutline.Checked;
  148.   Draw;
  149. end;
  150.  
  151. procedure TForm1.Button1Click(Sender: TObject);
  152. begin
  153.   Polygon.NewLine;
  154. end;
  155.  
  156. procedure TForm1.Build;
  157. var
  158.   TmpPoly: TPolygon32;
  159. begin
  160.   Outline.Free;
  161.   Outline := nil;
  162.  
  163.   if UseOutlinePoly then
  164.   begin
  165.     TmpPoly := Polygon.Outline;
  166.     Outline := TmpPoly.Grow(Fixed(LineSize / 2), 0.5);
  167.     Outline.FillMode := pfWinding;
  168.     TmpPoly.Free;
  169.   end;
  170.  
  171.   if UseOutlinePoly then
  172.     Label4.Caption := Format('(%.1f)', [LineSize])
  173.   else
  174.     Label4.Caption := '(1)';
  175. end;
  176.  
  177. procedure TForm1.ThicknessChanged(Sender: TObject);
  178. begin
  179.   AntialiasMode.Enabled := Antialiase.Checked and ThickOutline.Checked;
  180.   UseOutlinePoly := ThickOutline.Checked;
  181.   LineSize := LineThickness.Position / 10;
  182.   Build;
  183.   Draw;
  184. end;
  185.  
  186. end.
  187.