Tekening

Check-in [02427c3a51]
Login
☰Home Timeline Branches Tags Tickets Wiki

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 | SQL archive
Timelines: family | ancestors | descendants | both | develop
Files: files | file ages | folders
SHA1: 02427c3a51942c6a8b64ff1cb4b377636be030b7
User & Date: tinus 2017-04-01 11:08:12
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
Hide Diffs Unified Diffs Ignore Whitespace Patch

Changes to src/f_main.lfm. 

1
2
3
4
5
6
7
8
9
..
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
................................................................................
  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
..
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
................................................................................
  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
...
103
104
105
106
107
108
109
110
111
112
113
114
115

116
117
118
119
120
121
122
...
250
251
252
253
254
255
256
257
258
259
260




261
262
263
264
265



266
267
268
269
270
271
272
...
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
...
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385

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








|






|







|
|







 







<





>







 







|
|
|
|
>
>
>
>




|
>
>
>







 







<







 







|








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
...
103
104
105
106
107
108
109

110
111
112
113
114
115
116
117
118
119
120
121
122
...
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
...
288
289
290
291
292
293
294

295
296
297
298
299
300
301
...
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391

    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
................................................................................
  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
................................................................................
    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);
................................................................................
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;
................................................................................
    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
..
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
..
92
93
94
95
96
97
98






99
100
101
102
103
104
105
...
115
116
117
118
119
120
121

122
123
124
125
126
127
128

129
130
131
132
133
134
135
...
146
147
148
149
150
151
152



153
154
155
156
157
158
159

<?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"/>
................................................................................
            </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>
................................................................................
            <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"/>
................................................................................
        <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"/>
................................................................................
    <Linking>
      <Options>
        <Win32>
          <GraphicApplication Value="True"/>
        </Win32>
      </Options>
    </Linking>



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

|


|







 







<












>







 







>
>
>
>
>
>







 







>







>







 







>
>
>








1
2
3
4
5
6
7
8
9
10
11
..
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
..
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
...
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
...
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170

<?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"/>
................................................................................
            </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>
................................................................................
            <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"/>
................................................................................
        <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"/>
................................................................................
    <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

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