Tekening

Check-in [55e48dcebd]
Login

Check-in [55e48dcebd]

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

Overview
Comment:Slow down the mouse sensitivity for the duration of the program (it's for children, after all). Works on Windows, untested on Linux.
Downloads: Tarball | ZIP archive
Timelines: family | ancestors | descendants | both | develop
Files: files | file ages | folders
SHA1: 55e48dcebd171c2a8987d9de32fe1a24cc0d7188
User & Date: tinus 2017-05-22 19:27:33.101
Context
2017-06-11
08:11
De muissnelheid on-the-fly kunnen aanpassen met Shift+Alt+Up/Down. Deze onthouden in een .ini. Met Shift+Escape de tekening opslaan en het blad weer leegmaken. check-in: 90ffd07634 user: tinus tags: develop
2017-05-22
19:27
Slow down the mouse sensitivity for the duration of the program (it's for children, after all). Works on Windows, untested on Linux. check-in: 55e48dcebd user: tinus tags: develop
2017-04-01
11:08
Made the changes compile in Lazarus 1.0.10 as well. check-in: 02427c3a51 user: tinus tags: develop
Changes
Unified Diff Ignore Whitespace Patch
Changes to src/f_main.lfm.
︙︙
9
10
11
12
13
14
15

16
17
18
19
20
21
22
23
24
25
26
27

  Color = clWhite
  KeyPreview = True
  OnClose = FormClose
  OnCreate = FormCreate
  OnKeyDown = FormKeyDown
  OnMouseDown = FormMouseDown
  OnMouseMove = FormMouseMove

  OnPaint = FormPaint
  OnResize = FormResize
  OnUTF8KeyPress = FormUTF8KeyPress
  Position = poDesktopCenter
  LCLVersion = '1.0.10.0'
  WindowState = wsFullScreen
  object grdColors: TDrawGrid
    Cursor = crHandPoint
    Left = 0
    Height = 46
    Top = 472
    Width = 762








>




|








9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28

  Color = clWhite
  KeyPreview = True
  OnClose = FormClose
  OnCreate = FormCreate
  OnKeyDown = FormKeyDown
  OnMouseDown = FormMouseDown
  OnMouseMove = FormMouseMove
  OnMouseWheel = FormMouseWheel
  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
︙︙
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

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: TColorRef;
    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;









|















>
>











>
>








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

unit f_main;

{$mode objfpc}{$H+}

interface

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

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 FormMouseWheel(Sender: TObject; Shift: TShiftState;
      WheelDelta: Integer; MousePos: TPoint; var Handled: Boolean);
    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 }
    FOrgMouseSpeed: Integer;
    FOrgMouseSonar: boolean;
    FPNG: TPortableNetworkGraphic;
    FSelectedColor: TColorRef;
    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;
︙︙
62
63
64
65
66
67
68






69
70
71
72
73
74
75


{$R *.lfm}

{ TfrmTekening }

procedure TfrmTekening.FormCreate(Sender: TObject);
begin






  FPNG := TPortableNetworkGraphic.Create;
  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);








>
>
>
>
>
>








66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85


{$R *.lfm}

{ TfrmTekening }

procedure TfrmTekening.FormCreate(Sender: TObject);
begin
  SystemParametersInfo(SPI_GETMOUSESPEED, 0, @FOrgMouseSpeed, 0);
  SystemParametersInfo(SPI_GETMOUSESONAR, 0, @FOrgMouseSonar, 0);

  SystemParametersInfo(SPI_SETMOUSESPEED, 0, Pointer(1), 0);
  SystemParametersInfo(SPI_SETMOUSESONAR, 0, Pointer(True), 0);

  FPNG := TPortableNetworkGraphic.Create;
  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);
︙︙
158
159
160
161
162
163
164



165
166
167
168
169
170
171

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');
  FPNG.Free;
end;

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








>
>
>








168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184

end {TfrmTekening.FormKeyDown};

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

  SystemParametersInfo(SPI_SETMOUSESPEED, 0, Pointer(FOrgMouseSpeed), 0);
  SystemParametersInfo(SPI_SETMOUSESONAR, 0, Pointer(Integer(FOrgMouseSonar)), 0);

  FPNG.SaveToFile(IncludeTrailingPathDelimiter(GetUserDir) + 'tekening-' + FormatDateTime('yyyy-MM-dd_hh.nn.ss', Now) + '.png');
  FPNG.Free;
end;

procedure TfrmTekening.FormMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
︙︙
198
199
200
201
202
203
204






205
206
207
208
209
210
211

  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);








>
>
>
>
>
>








211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230

  end;
  case Drawing of
    dsNothing: MoveTo(X, Y);
    dsDrawing: LineTo(X, Y, SelectedColor);
    dsErasing: LineTo(X, Y, Self.Color);
  end;
end;

procedure TfrmTekening.FormMouseWheel(Sender: TObject; Shift: TShiftState;
  WheelDelta: Integer; MousePos: TPoint; var Handled: Boolean);
begin
  // TODO: shift hue of current color
end;

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

procedure TfrmTekening.FormResize(Sender: TObject);
︙︙