Tekening

Check-in [02427c3a51]
Login

Check-in [02427c3a51]

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

Overview
Comment:Made the changes compile in Lazarus 1.0.10 as well.
Downloads: Tarball | ZIP archive
Timelines: family | ancestors | descendants | both | develop
Files: files | file ages | folders
SHA1: 02427c3a51942c6a8b64ff1cb4b377636be030b7
User & Date: tinus 2017-04-01 11:08:12.204
Context
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
10:45
Added color selection buttons at the bottom. Move the (mouse) cursor using the cursor keys. check-in: 004b9a6753 user: tinus tags: develop
Changes
Unified Diff 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
21
22
23
24
25
26
27

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


|

















|








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

object frmTekening: TfrmTekening
  Left = 262
  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.0.10.0'
  WindowState = wsFullScreen
  object grdColors: TDrawGrid
    Cursor = crHandPoint
    Left = 0
    Height = 46
    Top = 472
    Width = 762
︙︙
Changes to src/f_main.pas.
︙︙
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

    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








|






|







|
|








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

    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;
    procedure SetDrawing(const AValue: TDrawingState);
    procedure SetSelectedColor(const AValue: TColorRef);
    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: TColorRef read FSelectedColor write SetSelectedColor;
  end;

var
  frmTekening: TfrmTekening;

implementation
uses
︙︙
103
104
105
106
107
108
109
110
111
112
113
114
115

116
117
118
119
120
121
122

  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








<





>








103
104
105
106
107
108
109

110
111
112
113
114
115
116
117
118
119
120
121
122

  case Key of
    VK_F1..VK_F12: begin
      SelectedColor := ColumnColor(Key - VK_F1);
      if Shift = [] then
        Key := 0;
    end;
    VK_PRIOR..VK_DOWN: begin

      FontHeight := Canvas.Font.Height;
      if FontHeight < 0 then
        FontHeight := -FontHeight
      else if FontHeight = 0 then
        FontHeight := 10;
      CP := Point(0, 0);
      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
︙︙
250
251
252
253
254
255
256
257
258
259
260




261
262
263
264
265



266
267
268
269
270
271
272

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








|
|
|
|
>
>
>
>




|
>
>
>








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

    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 begin
      Inc(aRect.Left, 10);
    end else begin
      Inc(aRect.Left,   10);
      Inc(aRect.Top,    10);
      Dec(aRect.Right,  10);
      Dec(aRect.Bottom, 10);
    end;
  end else if CellColor = SelectedColor then begin
    grdColors.Canvas.Brush.Color := clWhite;
    grdColors.Canvas.FillRect(aRect);
    grdColors.Canvas.DrawFocusRect(aRect);
    Inc(aRect.Left,   10);
    Inc(aRect.Top,    10);
    Dec(aRect.Right,  10);
    Dec(aRect.Bottom, 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);
︙︙
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295

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;








<








288
289
290
291
292
293
294

295
296
297
298
299
300
301

end;

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

  end;
end;

procedure TfrmTekening.grdColorsMouseEnter(Sender: TObject);
begin
  Self.Cursor := grdColors.Cursor;
end;
︙︙
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385

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








|








377
378
379
380
381
382
383
384
385
386
387
388
389
390
391

    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: TColorRef);
begin
  if FSelectedColor = AValue then Exit;
  FSelectedColor := AValue;
  grdColors.Invalidate;
end;

procedure TfrmTekening.TextOut(const ACanvas: TCanvas; const AText: string);
︙︙
Changes to src/tekening.lpi. 
1
2
3
4
5
6
7
8
9
10
11

<?xml version="1.0" encoding="UTF-8"?>
<CONFIG>
  <ProjectOptions>
    <Version Value="10"/>
    <General>
      <SessionStorage Value="InProjectDir"/>
      <MainUnit Value="0"/>
      <Title Value="tekening"/>
      <ResourceType Value="res"/>
      <UseXPManifest Value="True"/>
      <Icon Value="0"/>

|


|








1
2
3
4
5
6
7
8
9
10
11

<?xml version="1.0"?>
<CONFIG>
  <ProjectOptions>
    <Version Value="9"/>
    <General>
      <SessionStorage Value="InProjectDir"/>
      <MainUnit Value="0"/>
      <Title Value="tekening"/>
      <ResourceType Value="res"/>
      <UseXPManifest Value="True"/>
      <Icon Value="0"/>
︙︙
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63

64
65
66
67
68
69
70

            </Checks>
            <VerifyObjMethodCallValidity Value="True"/>
          </CodeGeneration>
          <Linking>
            <Debugging>
              <DebugInfoType Value="dsDwarf2Set"/>
              <UseHeaptrc Value="True"/>
              <TrashVariables Value="True"/>
              <UseExternalDbgSyms Value="True"/>
            </Debugging>
            <Options>
              <Win32>
                <GraphicApplication Value="True"/>
              </Win32>
            </Options>
          </Linking>
          <Other>
            <CompilerMessages>
              <IgnoredMessages idx5024="True"/>
            </CompilerMessages>

          </Other>
        </CompilerOptions>
      </Item2>
      <Item3 Name="Release">
        <CompilerOptions>
          <Version Value="11"/>
          <Target>








<












>








44
45
46
47
48
49
50

51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70

            </Checks>
            <VerifyObjMethodCallValidity Value="True"/>
          </CodeGeneration>
          <Linking>
            <Debugging>
              <DebugInfoType Value="dsDwarf2Set"/>
              <UseHeaptrc Value="True"/>

              <UseExternalDbgSyms Value="True"/>
            </Debugging>
            <Options>
              <Win32>
                <GraphicApplication Value="True"/>
              </Win32>
            </Options>
          </Linking>
          <Other>
            <CompilerMessages>
              <IgnoredMessages idx5024="True"/>
            </CompilerMessages>
            <CompilerPath Value="$(CompPath)"/>
          </Other>
        </CompilerOptions>
      </Item2>
      <Item3 Name="Release">
        <CompilerOptions>
          <Version Value="11"/>
          <Target>
︙︙
92
93
94
95
96
97
98






99
100
101
102
103
104
105

            <LinkSmart Value="True"/>
            <Options>
              <Win32>
                <GraphicApplication Value="True"/>
              </Win32>
            </Options>
          </Linking>






        </CompilerOptions>
      </Item3>
    </BuildModes>
    <PublishOptions>
      <Version Value="2"/>
      <IncludeFileFilter Value="*.(pas|pp|inc|lfm|lpr|lrs|lpi|lpk|sh|xml)"/>
      <ExcludeFileFilter Value="*.(bak|ppu|o|so);*~;backup"/>








>
>
>
>
>
>








92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111

            <LinkSmart Value="True"/>
            <Options>
              <Win32>
                <GraphicApplication Value="True"/>
              </Win32>
            </Options>
          </Linking>
          <Other>
            <CompilerMessages>
              <IgnoredMessages idx5024="True"/>
            </CompilerMessages>
            <CompilerPath Value="$(CompPath)"/>
          </Other>
        </CompilerOptions>
      </Item3>
    </BuildModes>
    <PublishOptions>
      <Version Value="2"/>
      <IncludeFileFilter Value="*.(pas|pp|inc|lfm|lpr|lrs|lpi|lpk|sh|xml)"/>
      <ExcludeFileFilter Value="*.(bak|ppu|o|so);*~;backup"/>
︙︙
115
116
117
118
119
120
121

122
123
124
125
126
127
128

129
130
131
132
133
134
135

        <PackageName Value="LCL"/>
      </Item1>
    </RequiredPackages>
    <Units Count="2">
      <Unit0>
        <Filename Value="tekening.pas"/>
        <IsPartOfProject Value="True"/>

      </Unit0>
      <Unit1>
        <Filename Value="f_main.pas"/>
        <IsPartOfProject Value="True"/>
        <ComponentName Value="frmTekening"/>
        <HasResources Value="True"/>
        <ResourceBaseClass Value="Form"/>

      </Unit1>
    </Units>
  </ProjectOptions>
  <CompilerOptions>
    <Version Value="11"/>
    <Target>
      <Filename Value="tekening"/>








>







>








121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143

        <PackageName Value="LCL"/>
      </Item1>
    </RequiredPackages>
    <Units Count="2">
      <Unit0>
        <Filename Value="tekening.pas"/>
        <IsPartOfProject Value="True"/>
        <UnitName Value="tekening"/>
      </Unit0>
      <Unit1>
        <Filename Value="f_main.pas"/>
        <IsPartOfProject Value="True"/>
        <ComponentName Value="frmTekening"/>
        <HasResources Value="True"/>
        <ResourceBaseClass Value="Form"/>
        <UnitName Value="f_main"/>
      </Unit1>
    </Units>
  </ProjectOptions>
  <CompilerOptions>
    <Version Value="11"/>
    <Target>
      <Filename Value="tekening"/>
︙︙
146
147
148
149
150
151
152



153
154
155
156
157
158
159

    <Linking>
      <Options>
        <Win32>
          <GraphicApplication Value="True"/>
        </Win32>
      </Options>
    </Linking>



  </CompilerOptions>
  <Debugging>
    <Exceptions Count="3">
      <Item1>
        <Name Value="EAbort"/>
      </Item1>
      <Item2>








>
>
>








154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170

    <Linking>
      <Options>
        <Win32>
          <GraphicApplication Value="True"/>
        </Win32>
      </Options>
    </Linking>
    <Other>
      <CompilerPath Value="$(CompPath)"/>
    </Other>
  </CompilerOptions>
  <Debugging>
    <Exceptions Count="3">
      <Item1>
        <Name Value="EAbort"/>
      </Item1>
      <Item2>
︙︙
Deleted src/tekening.res.

cannot compute difference between binary files