1 unit Unit1;
2 
3 {$mode objfpc}{$H+}
4 
5 interface
6 
7 uses
8   Classes, SysUtils, Forms, Graphics, StdCtrls, ExtCtrls, Buttons, ColorBox,
9   LCLIntf, FPCanvas;
10 
11 type
12 
13   { TForm1 }
14 
15   TForm1 = class(TForm)
16     Bevel1: TBevel;
17     Bevel2: TBevel;
18     Button1: TBitBtn;
19     cbCosmetic: TCheckBox;
20     cbAntialiasing: TCheckBox;
21     FigureCombo: TComboBox;
22     Label10: TLabel;
23     Label7: TLabel;
24     Label8: TLabel;
25     Label9: TLabel;
26     BrushColorBox: TColorBox;
27     PenStyleCombo: TComboBox;
28     Label1: TLabel;
29     Label2: TLabel;
30     PenColorBox: TColorBox;
31     Label6: TLabel;
32     BrushStyleCombo: TComboBox;
33     WidthCombo: TComboBox;
34     CapsCombo: TComboBox;
35     JoinCombo: TComboBox;
36     Label3: TLabel;
37     Label4: TLabel;
38     Label5: TLabel;
39     PaintBox: TPaintBox;
40     procedure BrushChange(Sender: TObject);
41     procedure cbAntialiasingChange(Sender: TObject);
42     procedure FigureComboChange(Sender: TObject);
43     procedure FormCreate(Sender: TObject);
44     procedure FormDestroy(Sender: TObject);
45     procedure PaintBoxPaint(Sender: TObject);
46     procedure PenChange(Sender: TObject);
47   private
48     FPattern: TBitmap;
49   public
50 
51   end;
52 
53 var
54   Form1: TForm1;
55 
56 implementation
57 
58 {$R *.lfm}
59 
60 uses
61   TypInfo;
62 
63 { TForm1 }
64 
65 procedure TForm1.cbAntialiasingChange(Sender: TObject);
66 const
67   AntialiasingMode: array[TCheckBoxState] of TAntialiasingMode =
68   (
69     amOff,
70     amOn,
71     amDontCare
72   );
73 begin
74   PaintBox.Canvas.AntialiasingMode := AntialiasingMode[cbAntialiasing.State];
75   PaintBox.Invalidate;
76 end;
77 
78 procedure TForm1.FigureComboChange(Sender: TObject);
79 begin
80   PaintBox.Invalidate;
81 end;
82 
83 procedure TForm1.BrushChange(Sender: TObject);
84 begin
85   if BrushStyleCombo.ItemIndex <> -1 then
86     PaintBox.Canvas.Brush.Style := TBrushStyle(BrushStyleCombo.ItemIndex);
87 
88   if PaintBox.Canvas.Brush.Style = bsPattern then
89     PaintBox.Canvas.Brush.Bitmap := FPattern
90   else
91     PaintBox.Canvas.Brush.Bitmap := nil;
92 
93   PaintBox.Invalidate;
94 end;
95 
96 procedure TForm1.FormCreate(Sender: TObject);
97 const
98   LineBitsDotted: array[0..7] of Word = ($55, $AA, $55, $AA, $55, $AA, $55, $AA);
99 var
100   ps: TPenStyle;
101   bs: TBrushStyle;
102 begin
103   case PaintBox.Canvas.AntialiasingMode of
104     amDontCare: cbAntialiasing.State := cbGrayed;
105     amOn: cbAntialiasing.State := cbChecked;
106     amOff: cbAntialiasing.State := cbUnchecked;
107   end;
108 
109 
110   FPattern := TBitmap.Create;
111   FPattern.SetHandles(CreateBitmap(8, 8, 1, 1, @LineBitsDotted), 0);
112 
113   PenStyleCombo.Items.BeginUpdate;
114   for ps := Low(ps) to High(ps) do
115     PenStyleCombo.Items.Add(GetEnumName(TypeInfo(TPenStyle), Ord(ps)));
116   PenStyleCombo.Items.EndUpdate;
117   PenStyleCombo.ItemIndex := 0;
118 
119   BrushStyleCombo.Items.BeginUpdate;
120   for bs := Low(bs) to High(bs) do
121     BrushStyleCombo.Items.Add(GetEnumName(TypeInfo(TBrushStyle), Ord(bs)));
122   BrushStyleCombo.Items.EndUpdate;
123   BrushStyleCombo.ItemIndex := 0;
124 end;
125 
126 procedure TForm1.FormDestroy(Sender: TObject);
127 begin
128   FPattern.Free;
129 end;
130 
131 procedure TForm1.PaintBoxPaint(Sender: TObject);
132 
RandomPointnull133   function RandomPoint(R: TRect): TPoint;
134   begin
135     Result.x := Random(R.Right - R.Left) + R.Left;
136     Result.y := Random(R.Bottom - R.Top) + R.Top;
137   end;
138 
139   procedure DrawFigure(R: TRect); inline;
140   var
141     Points: array of TPoint;
142   begin
143     inflateRect(R, -10, -10);
144     case FigureCombo.ItemIndex of
145       0: // Line
146         PaintBox.Canvas.Line(R.TopLeft, R.BottomRight);
147       1: // PolyLine
148         begin
149           SetLength(Points, 4);
150           Points[0] := R.TopLeft;
151           Points[1] := RandomPoint(R);
152           Points[2] := RandomPoint(R);
153           Points[3] := R.BottomRight;
154           PaintBox.Canvas.Polyline(Points);
155         end;
156       2: // Ellipse
157         PaintBox.Canvas.Ellipse(R);
158       3: // Rectangle
159         begin
160           PaintBox.Canvas.FillRect(R);
161           PaintBox.Canvas.Rectangle(R);
162         end;
163       4: // Triangle
164         begin
165           SetLength(Points, 4);
166           Points[0] := Point(R.Left, R.Bottom);
167           Points[3] := Points[0];
168           Points[1] := Point((R.Left + R.Right) div 2, R.Top);
169           Points[2] := R.BottomRight;
170           PaintBox.Canvas.Polygon(Points);
171         end;
172     end;
173   end;
174 
175 var
176   i, j: integer;
177   ColWidth, RowHeight: Integer;
178   R: TRect;
179 begin
180   PaintBox.Canvas.Brush.Color := BrushColorBox.Selected;
181 
182   ColWidth := PaintBox.Width div 3;
183   RowHeight := PaintBox.Height div 2;
184 
185   for i := 0 to 2 do
186     for j := 0 to 2 do
187     begin
188       R := Rect(i * ColWidth, j * RowHeight, (i + 1) * ColWidth, (j + 1) * RowHeight);
189       DrawFigure(R);
190     end;
191 end;
192 
193 procedure TForm1.PenChange(Sender: TObject);
194 var
195   Dashes: array[0..3] of DWord = (3, 7, 8, 6);
196 begin
197   if PenStyleCombo.ItemIndex <> -1 then
198     PaintBox.Canvas.Pen.Style := TPenStyle(PenStyleCombo.ItemIndex);
199   PaintBox.Canvas.Pen.Color := PenColorBox.Selected;
200 
201   PaintBox.Canvas.Pen.Width := StrToInt(WidthCombo.Text);
202   PaintBox.Canvas.Pen.Cosmetic := cbCosmetic.Checked;
203   PaintBox.Canvas.Pen.EndCap := TPenEndCap(CapsCombo.ItemIndex);
204   PaintBox.Canvas.Pen.JoinStyle := TPenJoinStyle(JoinCombo.ItemIndex);
205   PaintBox.Canvas.Pen.SetPattern(Dashes);
206   PaintBox.Invalidate;
207 end;
208 
209 end.
210 
211