Tekening

Check-in [004b9a6753]
Login

Many hyperlinks are disabled.
Use anonymous login to enable hyperlinks.

Overview
Comment:Added color selection buttons at the bottom. Move the (mouse) cursor using the cursor keys.
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | develop
Files: files | file ages | folders
SHA1: 004b9a67530919c6d3a6ed04fd65e2bd43de4a6d
User & Date: tinus 2017-04-01 10:45:53
Context
2017-04-01
11:08
Made the changes compile in Lazarus 1.0.10 as well. check-in: 02427c3a51 user: tinus tags: develop
10:45
Added color selection buttons at the bottom. Move the (mouse) cursor using the cursor keys. check-in: 004b9a6753 user: tinus tags: develop
10:44
Ignore hint about unused parameters. check-in: 7df93cda49 user: tinus tags: develop
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Changes to src/f_main.lfm.

1
2
3
4
5
6


7
8
9
10
11
12
13
14
15

16
17
18
19






































20

object frmTekening: TfrmTekening
  Left = 272
  Height = 240
  Top = 140
  Width = 320
  Caption = 'Tekening'


  Color = clWhite
  KeyPreview = True
  OnClose = FormClose
  OnCreate = FormCreate
  OnKeyDown = FormKeyDown
  OnMouseDown = FormMouseDown
  OnMouseMove = FormMouseMove
  OnMouseUp = FormMouseUp
  OnPaint = FormPaint

  OnUTF8KeyPress = FormUTF8KeyPress
  Position = poDesktopCenter
  LCLVersion = '1.6.4.0'
  WindowState = wsFullScreen






































end



|

|

>
>







<

>




>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
|
>
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15

16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
object frmTekening: TfrmTekening
  Left = 272
  Height = 518
  Top = 140
  Width = 762
  Caption = 'Tekening'
  ClientHeight = 518
  ClientWidth = 762
  Color = clWhite
  KeyPreview = True
  OnClose = FormClose
  OnCreate = FormCreate
  OnKeyDown = FormKeyDown
  OnMouseDown = FormMouseDown
  OnMouseMove = FormMouseMove

  OnPaint = FormPaint
  OnResize = FormResize
  OnUTF8KeyPress = FormUTF8KeyPress
  Position = poDesktopCenter
  LCLVersion = '1.6.4.0'
  WindowState = wsFullScreen
  object grdColors: TDrawGrid
    Cursor = crHandPoint
    Left = 0
    Height = 46
    Top = 472
    Width = 762
    Align = alBottom
    AutoEdit = False
    ColCount = 16
    DefaultRowHeight = 64
    ExtendedSelect = False
    FixedCols = 0
    GridLineWidth = 0
    RowCount = 1
    ScrollBars = ssNone
    TabOrder = 0
    OnDrawCell = grdColorsDrawCell
    OnHeaderClick = grdColorsHeaderClick
    OnMouseEnter = grdColorsMouseEnter
    OnMouseLeave = grdColorsMouseLeave
    ColWidths = (
      64
      26
      26
      26
      26
      26
      26
      26
      26
      26
      26
      26
      26
      26
      26
      64
    )
  end
end

Changes to src/f_main.pas.

1
2
3
4
5
6
7
8

9
10
11
12
13
14
15
16

17
18
19
20
21
22
23
24
25

26






27
28
29
30
31
32
33
34
35
36
37

38



39
40
41
42

43
44
45
46
47
48
49
..
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81


82
83
84
85
86
87
88

89
90
91
92
93
94
95
96
97
98
99
100
101

102
103

104
105
106
















107

































108
109
110
111
112
113
114
...
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
...
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165





166
167
168
169
170
171
172
173
174
175












































































176
177
178
179
180























181
182
183
184
185
186
187
...
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213






















214
215
216
217
218
219
220
221
222
223
unit f_main;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, ExtCtrls, LCLType;


type

  TDrawingState = (dsNothing, dsDrawing, dsErasing);

  { TfrmTekening }

  TfrmTekening = class(TForm)

    procedure FormClose(Sender: TObject; var CloseAction: TCloseAction);
    procedure FormCreate(Sender: TObject);
    procedure FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
    procedure FormMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure FormMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
    procedure FormMouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure FormPaint(Sender: TObject);

    procedure FormUTF8KeyPress(Sender: TObject; var UTF8Key: TUTF8Char);






  private
    { private declarations }
    FPNG: TPortableNetworkGraphic;
    FColor: TColor;
    FDrawing: TDrawingState;
    FSkip: Boolean;

    procedure MoveTo(const X, Y: Integer);
    procedure LineTo(const X, Y: Integer); overload;
    procedure LineTo(const X, Y: Integer; const AColor: TColor); overload;
    procedure SetDrawing(const AValue: TDrawingState);

    procedure TextOut(const ACanvas: TCanvas; const AText: string);



  public
    { public declarations }

    property Drawing: TDrawingState read FDrawing write SetDrawing;

  end;

var
  frmTekening: TfrmTekening;

implementation
uses
................................................................................
  FPNG.PixelFormat := pf24bit;
  FPNG.Transparent := False;
  FPNG.SetSize(Screen.DesktopWidth, Screen.DesktopHeight);
  FPNG.Canvas.Brush.Style := bsSolid;
  FPNG.Canvas.Brush.Color := Self.Color;
  FPNG.Canvas.FillRect(0, 0, FPNG.Width, FPNG.Height);

  FColor := clPurple;
  FPNG.Canvas.Pen.Color := FColor;
  FPNG.Canvas.Pen.Width := 10;
  FPNG.Canvas.Font.Size := 30;

  Self.Canvas.Pen.Color := FColor;
  Self.Canvas.Pen.Width := 10;
  Self.Canvas.Font.Size := 30;

  Drawing := dsDrawing;
  FSkip := True;

  Self.BorderStyle := bsNone;
  Self.SetBounds(Screen.DesktopLeft, Screen.DesktopTop, Screen.DesktopWidth, Screen.DesktopHeight);

  Randomize;


end;

procedure TfrmTekening.FormKeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
const
  cKeyColors: array[VK_F1..VK_F12] of TColor =
    ( $00000000  // F1

    , $000000FF  // F2
    , $0000FF00  // F3
    , $0000FFFF  // F4
    , $00FF0000  // F5
    , $00FF00FF  // F6
    , $00FFFF00  // F7
    , $00000088  // F8
    , $00008800  // F9
    , $00880000  // F10
    , $00888888  // F11
    , $00880088  // F12
    );
begin

  if Key in [VK_F1..VK_F12] then begin
    FColor := cKeyColors[Key];

    if Shift = [] then
      Key := 0;
  end;
















end;


































procedure TfrmTekening.FormClose(Sender: TObject; var CloseAction: TCloseAction);
begin
  OnMouseDown := nil;
  OnMouseMove := nil;

  FPNG.SaveToFile(IncludeTrailingPathDelimiter(GetUserDir) + 'tekening-' + FormatDateTime('yyyy-MM-dd_hh.nn.ss', Now) + '.png');
................................................................................
    mbLeft: begin
      if Drawing <> dsDrawing then
        Drawing := dsDrawing
      else
        Drawing := dsNothing;
    end;
    mbMiddle: begin
      FColor := RGB(Random(255), Random(255), Random(255));
      Drawing := dsDrawing;
    end;
    mbRight: begin
      if Drawing <> dsErasing then
        Drawing := dsErasing
      else
        Drawing := dsNothing;
................................................................................
begin
  if FSkip then begin
    MoveTo(X, Y);
    FSkip := False;
  end;
  case Drawing of
    dsNothing: MoveTo(X, Y);
    dsDrawing: LineTo(X, Y, FColor);
    dsErasing: LineTo(X, Y, Self.Color);
  end;
end;

procedure TfrmTekening.FormMouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin

end;

procedure TfrmTekening.FormPaint(Sender: TObject);
begin
  Self.Canvas.Draw(ClientOrigin.X, ClientOrigin.Y, FPNG);
end;






procedure TfrmTekening.FormUTF8KeyPress(Sender: TObject; var UTF8Key: TUTF8Char
  );
begin
  if (UTF8Key >= #32) then begin
    TextOut(FPNG.Canvas, UnicodeUpperCase(UTF8String(UTF8Key)));
    TextOut(Self.Canvas, UnicodeUpperCase(UTF8String(UTF8Key)));
    FSkip := True;
  end;
end;













































































procedure TfrmTekening.MoveTo(const X, Y: Integer);
begin
  FPNG.Canvas.MoveTo(X, Y);
  Canvas.MoveTo(X, Y);
end;
























procedure TfrmTekening.LineTo(const X, Y: Integer);
begin
  FPNG.Canvas.LineTo(X, Y);
  Canvas.LineTo(X, Y);
end;

................................................................................

    LineTo(X, Y);
  finally
    FPNG.Canvas.Pen.Color := OldPNGColor;
    Self.Canvas.Pen.Color := OldColor;
  end;
end;

procedure TfrmTekening.SetDrawing(const AValue: TDrawingState);
begin
  FDrawing := AValue;
  case FDrawing of
    dsDrawing: Cursor := crHandPoint;
    dsErasing: Cursor := crNo;
    else       Cursor := crDefault;
  end;
end;























procedure TfrmTekening.TextOut(const ACanvas: TCanvas; const AText: string);
begin
  ACanvas.Font.Color := FColor;
  ACanvas.Brush.Style := bsClear;
  ACanvas.TextOut(ACanvas.PenPos.X, ACanvas.PenPos.Y, AText);
end;

end.








|
>








>






<
<

>

>
>
>
>
>
>



|


<




>

>
>
>



|
>







 







|
|



|










>
>




<
<
<
>
|
|
<
<
<
<
<
<
<
<
<
<

>
|
<
>
|
|
|
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
|
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>







 







|







 







|


<
<
<
<
<
<







>
>
>
>
>










>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>





>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>







 








|

<

|
|
|


>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>



|






1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24


25
26
27
28
29
30
31
32
33
34
35
36
37
38
39

40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
..
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98



99
100
101










102
103
104

105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
...
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
...
194
195
196
197
198
199
200
201
202
203






204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
...
346
347
348
349
350
351
352
353
354
355

356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
unit f_main;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, ExtCtrls,
  LCLType, Grids;

type

  TDrawingState = (dsNothing, dsDrawing, dsErasing);

  { TfrmTekening }

  TfrmTekening = class(TForm)
    grdColors: TDrawGrid;
    procedure FormClose(Sender: TObject; var CloseAction: TCloseAction);
    procedure FormCreate(Sender: TObject);
    procedure FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
    procedure FormMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure FormMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);


    procedure FormPaint(Sender: TObject);
    procedure FormResize(Sender: TObject);
    procedure FormUTF8KeyPress(Sender: TObject; var UTF8Key: TUTF8Char);
    procedure grdColorsDrawCell(Sender: TObject; aCol, aRow: Integer;
      aRect: TRect; aState: TGridDrawState);
    procedure grdColorsHeaderClick(Sender: TObject; IsColumn: Boolean;
      Index: Integer);
    procedure grdColorsMouseEnter(Sender: TObject);
    procedure grdColorsMouseLeave(Sender: TObject);
  private
    { private declarations }
    FPNG: TPortableNetworkGraphic;
    FSelectedColor: TColor;
    FDrawing: TDrawingState;
    FSkip: Boolean;

    procedure MoveTo(const X, Y: Integer);
    procedure LineTo(const X, Y: Integer); overload;
    procedure LineTo(const X, Y: Integer; const AColor: TColor); overload;
    procedure SetDrawing(const AValue: TDrawingState);
    procedure SetSelectedColor(const AValue: TColor);
    procedure TextOut(const ACanvas: TCanvas; const AText: string);

    function  ColumnColor(const ColumnIndex: Integer): TColorRef;
    function  DrawingCursor(const DrawingState: TDrawingState): TCursor;
  public
    { public declarations }

    property Drawing: TDrawingState read FDrawing       write SetDrawing;
    property SelectedColor: TColor  read FSelectedColor write SetSelectedColor;
  end;

var
  frmTekening: TfrmTekening;

implementation
uses
................................................................................
  FPNG.PixelFormat := pf24bit;
  FPNG.Transparent := False;
  FPNG.SetSize(Screen.DesktopWidth, Screen.DesktopHeight);
  FPNG.Canvas.Brush.Style := bsSolid;
  FPNG.Canvas.Brush.Color := Self.Color;
  FPNG.Canvas.FillRect(0, 0, FPNG.Width, FPNG.Height);

  FSelectedColor := clBlack;
  FPNG.Canvas.Pen.Color := SelectedColor;
  FPNG.Canvas.Pen.Width := 10;
  FPNG.Canvas.Font.Size := 30;

  Self.Canvas.Pen.Color := SelectedColor;
  Self.Canvas.Pen.Width := 10;
  Self.Canvas.Font.Size := 30;

  Drawing := dsDrawing;
  FSkip := True;

  Self.BorderStyle := bsNone;
  Self.SetBounds(Screen.DesktopLeft, Screen.DesktopTop, Screen.DesktopWidth, Screen.DesktopHeight);

  Randomize;

  grdColors.AutoFillColumns := True;
end;

procedure TfrmTekening.FormKeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);



var
  CP: TPoint;
  FontHeight: Integer;










begin
  case Key of
    VK_F1..VK_F12: begin

      SelectedColor := ColumnColor(Key - VK_F1);
      if Shift = [] then
        Key := 0;
    end;
    VK_PRIOR..VK_DOWN: begin
      CP := Default(TPoint);
      FontHeight := Canvas.Font.Height;
      if FontHeight < 0 then
        FontHeight := -FontHeight
      else if FontHeight = 0 then
        FontHeight := 10;
      if GetCursorPos(CP) then begin
        case Key of
          VK_LEFT:  Dec(CP.x, FontHeight);
          VK_RIGHT: Inc(CP.x, FontHeight);
          VK_UP:    Dec(CP.y, FontHeight);
          VK_DOWN:  Inc(CP.y, FontHeight);
          VK_PRIOR: begin
            Inc(CP.x, FontHeight);
            Dec(CP.y, FontHeight);
          end;
          VK_NEXT: begin
            Inc(CP.x, FontHeight);
            Inc(CP.y, FontHeight);
          end;
          VK_HOME: begin
            Dec(CP.x, FontHeight);
            Dec(CP.y, FontHeight);
          end;
          VK_END: begin
            Dec(CP.x, FontHeight);
            Inc(CP.y, FontHeight);
          end;
        end;
        SetCursorPos(CP.x, CP.y);
      end;
    end {cursor keys};
    VK_INSERT: begin
      if Drawing = dsDrawing then
        Drawing := dsNothing
      else
        Drawing := dsDrawing;
    end;
    VK_DELETE: begin
      if Drawing = dsErasing then
        Drawing := dsNothing
      else
        Drawing := dsErasing;
    end;
    VK_RETURN: begin
      SelectedColor := RGB(Random(255), Random(255), Random(255));
    end;
  end {case};
end {TfrmTekening.FormKeyDown};

procedure TfrmTekening.FormClose(Sender: TObject; var CloseAction: TCloseAction);
begin
  OnMouseDown := nil;
  OnMouseMove := nil;

  FPNG.SaveToFile(IncludeTrailingPathDelimiter(GetUserDir) + 'tekening-' + FormatDateTime('yyyy-MM-dd_hh.nn.ss', Now) + '.png');
................................................................................
    mbLeft: begin
      if Drawing <> dsDrawing then
        Drawing := dsDrawing
      else
        Drawing := dsNothing;
    end;
    mbMiddle: begin
      SelectedColor := RGB(Random(255), Random(255), Random(255));
      Drawing := dsDrawing;
    end;
    mbRight: begin
      if Drawing <> dsErasing then
        Drawing := dsErasing
      else
        Drawing := dsNothing;
................................................................................
begin
  if FSkip then begin
    MoveTo(X, Y);
    FSkip := False;
  end;
  case Drawing of
    dsNothing: MoveTo(X, Y);
    dsDrawing: LineTo(X, Y, SelectedColor);
    dsErasing: LineTo(X, Y, Self.Color);
  end;






end;

procedure TfrmTekening.FormPaint(Sender: TObject);
begin
  Self.Canvas.Draw(ClientOrigin.X, ClientOrigin.Y, FPNG);
end;

procedure TfrmTekening.FormResize(Sender: TObject);
begin
  grdColors.RowHeights[0] := grdColors.ClientHeight;
end;

procedure TfrmTekening.FormUTF8KeyPress(Sender: TObject; var UTF8Key: TUTF8Char
  );
begin
  if (UTF8Key >= #32) then begin
    TextOut(FPNG.Canvas, UnicodeUpperCase(UTF8String(UTF8Key)));
    TextOut(Self.Canvas, UnicodeUpperCase(UTF8String(UTF8Key)));
    FSkip := True;
  end;
end;

procedure TfrmTekening.grdColorsDrawCell(Sender: TObject; aCol, aRow: Integer;
  aRect: TRect; aState: TGridDrawState);
const
  TS: TTextStyle = (Alignment: taCenter;
                    Layout: tlCenter;
                    SingleLine: True;
                    Clipping: True;
                    ExpandTabs: False;
                    ShowPrefix: False;
                    WordBreak: False;
                    Opaque: False;
                    SystemFont: False;
                    RightToLeft: False;
                    EndEllipsis: False);
var
  CellColor, TextColor: TColorRef;
  R, G, B, Y: Byte;
  IsDefaultColor: Boolean;
  Col: Integer;
begin
  CellColor := ColumnColor(aCol);
  if aCol = grdColors.ColCount - 1 then begin
    grdColors.Canvas.Brush.Color := clWhite;
    grdColors.Canvas.FillRect(aRect);
    IsDefaultColor := False;
    for Col := 0 to aCol - 1 do begin
      if CellColor = ColumnColor(Col) then begin
        IsDefaultColor := True;
        Break;
      end;
    end {for};
    if IsDefaultColor then
      aRect.Inflate(-10, 0, 0, 0)
    else
      aRect.Inflate(-10, -10, -10, -10);
  end else if CellColor = SelectedColor then begin
    grdColors.Canvas.Brush.Color := clWhite;
    grdColors.Canvas.FillRect(aRect);
    grdColors.Canvas.DrawFocusRect(aRect);
    aRect.Inflate(-10, -10, -10, -10);
  end;
  grdColors.Canvas.Brush.Color := CellColor;
  grdColors.Canvas.FillRect(aRect);

  if aCol < 12 then begin
    RedGreenBlue(CellColor, R, G, B);
    Y := Round(0.299 * R + 0.587 * g + 0.114 * b);
    if Y >= 127 then
      TextColor := clBlack
    else
      TextColor := clWhite;
    grdColors.Canvas.Font.Color := TextColor;
    grdColors.Canvas.Font.Style := [fsBold];
    grdColors.Canvas.TextRect(aRect, 0, 0, 'F' + IntToStr(aCol + 1), TS);
  end;
end;

procedure TfrmTekening.grdColorsHeaderClick(Sender: TObject; IsColumn: Boolean;
  Index: Integer);
begin
  if IsColumn then begin
    SelectedColor := ColumnColor(Index);
    grdColors.InvalidateCol(15);
  end;
end;

procedure TfrmTekening.grdColorsMouseEnter(Sender: TObject);
begin
  Self.Cursor := grdColors.Cursor;
end;

procedure TfrmTekening.grdColorsMouseLeave(Sender: TObject);
begin
  Self.Cursor := DrawingCursor(FDrawing);
end;

procedure TfrmTekening.MoveTo(const X, Y: Integer);
begin
  FPNG.Canvas.MoveTo(X, Y);
  Canvas.MoveTo(X, Y);
end;

function TfrmTekening.ColumnColor(const ColumnIndex: Integer): TColorRef;
var
  Intensity: Byte;
  R, G, B: Byte;
begin
  if ColumnIndex = 15 then begin
    RedGreenBlue(SelectedColor, R, G, B);
  end else if ColumnIndex = 8 then begin
    R := 91;
    G := 91;
    B := 91;
  end else begin
    if ColumnIndex >= 8 then
      Intensity := 255
    else
      Intensity := 127;
    R := Byte((ColumnIndex and 1) <> 0) * Intensity;
    G := Byte((ColumnIndex and 2) <> 0) * Intensity;
    B := Byte((ColumnIndex and 4) <> 0) * Intensity;
  end;
  Result := RGB(R, G, B);
end;

procedure TfrmTekening.LineTo(const X, Y: Integer);
begin
  FPNG.Canvas.LineTo(X, Y);
  Canvas.LineTo(X, Y);
end;

................................................................................

    LineTo(X, Y);
  finally
    FPNG.Canvas.Pen.Color := OldPNGColor;
    Self.Canvas.Pen.Color := OldColor;
  end;
end;

function TfrmTekening.DrawingCursor(const DrawingState: TDrawingState): TCursor;
begin

  case FDrawing of
    dsDrawing: Result := crHandPoint;
    dsErasing: Result := crNo;
    else       Result := crDefault;
  end;
end;

procedure TfrmTekening.SetDrawing(const AValue: TDrawingState);
const
  PenWidth = 10;
begin
  FDrawing := AValue;
  Self.Cursor := DrawingCursor(FDrawing);
  if FDrawing = dsErasing then begin
    Self.Canvas.Pen.Width := PenWidth * 2;
    FPNG.Canvas.Pen.Width := PenWidth * 2;
  end else begin
    Self.Canvas.Pen.Width := PenWidth;
    FPNG.Canvas.Pen.Width := PenWidth;
  end;
end;

procedure TfrmTekening.SetSelectedColor(const AValue: TColor);
begin
  if FSelectedColor = AValue then Exit;
  FSelectedColor := AValue;
  grdColors.Invalidate;
end;

procedure TfrmTekening.TextOut(const ACanvas: TCanvas; const AText: string);
begin
  ACanvas.Font.Color := SelectedColor;
  ACanvas.Brush.Style := bsClear;
  ACanvas.TextOut(ACanvas.PenPos.X, ACanvas.PenPos.Y, AText);
end;

end.