Tekening

Check-in [55e48dcebd]
Login
☰Home Timeline Branches Tags Tickets Wiki

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 | SQL archive
Timelines: family | ancestors | descendants | both | develop
Files: files | file ages | folders
SHA1: 55e48dcebd171c2a8987d9de32fe1a24cc0d7188
User & Date: tinus 2017-05-22 19:27:33
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
Hide Diffs Unified Diffs 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. 

2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
..
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
..
62
63
64
65
66
67
68






69
70
71
72
73
74
75
...
158
159
160
161
162
163
164



165
166
167
168
169
170
171
...
198
199
200
201
202
203
204






205
206
207
208
209
210
211


{$mode objfpc}{$H+}

interface

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

type

  TDrawingState = (dsNothing, dsDrawing, dsErasing);

  { TfrmTekening }

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

{$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);
................................................................................
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
................................................................................
  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);








|







 







>
>











>
>







 







>
>
>
>
>
>







 







>
>
>







 







>
>
>
>
>
>








2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
..
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
..
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
...
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
...
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230


{$mode objfpc}{$H+}

interface

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

type

  TDrawingState = (dsNothing, dsDrawing, dsErasing);

  { TfrmTekening }

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

{$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);
................................................................................
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
................................................................................
  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);

This page was generated in about 0.012s by Fossil 2.11 [c6dfb55802] 2019-11-28 10:27:30