Tekening

Check-in [cdec613baa]
Login

Check-in [cdec613baa]

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

Overview
Comment:First commit. Working program.
Downloads: Tarball | ZIP archive
Timelines: family | ancestors | descendants | both | develop
Files: files | file ages | folders
SHA1: cdec613baa084db24df12fee11a24f115fe06dc2
User & Date: tinus 2017-03-26 15:42:27.940
Context
2017-03-26
16:01
Added ignore-glob. check-in: 6409f446ba user: tinus tags: develop
15:42
First commit. Working program. check-in: cdec613baa user: tinus tags: develop
15:34
initial empty check-in Leaf check-in: e228009c56 user: tinus tags: trunk
Changes
Unified Diff Ignore Whitespace Patch
Added 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.0.10.0'
  WindowState = wsFullScreen
end
Added 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
50
51
52
53
54
55
56
57
58
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
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
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206

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 TextOut(const ACanvas: TCanvas; const AText: string);
  public
    { public declarations }
  end;

var
  frmTekening: TfrmTekening;

implementation
uses
  LCLIntf;

{$R *.lfm}

{ TfrmTekening }

procedure TfrmTekening.FormCreate(Sender: TObject);
var
  XY: TPoint;
begin
  FPNG := TPortableNetworkGraphic.Create;
  FPNG.PixelFormat := pf32bit;
  FPNG.Transparent := False;
  FPNG.SetSize(ClientWidth, ClientHeight);
  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;

  FDrawing := dsDrawing;
  FSkip := True;
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];
    Key := 0;
  end;
end;

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

  FPNG.SaveToFile(IncludeTrailingPathDelimiter(GetEnvironmentVariable('HOME')) + '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);
var
  LColor: TColor;
begin
  MoveTo(X, Y);
  if FDrawing <> dsNothing then begin
    FDrawing := dsNothing;
  end else begin
    if ssLeft in Shift then begin
      FDrawing := dsDrawing;
      LColor := FColor;
    end else begin
      FDrawing := dsErasing;
      LColor := Self.Color;
    end;
    LineTo(X, Y, LColor);
  end;
end;

procedure TfrmTekening.FormMouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
var
  LColor: TColor;
begin
  if FSkip or (FDrawing = dsNothing) then begin
    MoveTo(X, Y);
  end else begin
    if FDrawing = dsDrawing then
      LColor := FColor
    else
      LColor := Self.Color;
    LineTo(X, Y, LColor);
  end;
  FSkip := False;
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, UTF8String(UTF8Key));
    TextOut(Self.Canvas, 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;

procedure TfrmTekening.LineTo(const X, Y: Integer; const AColor: TColor);
var
  OldColor, OldPNGColor: TColor;
begin
  OldPNGColor := FPNG.Canvas.Pen.Color;
  OldColor := Self.Canvas.Pen.Color;
  try
    FPNG.Canvas.Pen.Color := AColor;
    Self.Canvas.Pen.Color := AColor;

    LineTo(X, Y);
  finally
    FPNG.Canvas.Pen.Color := OldPNGColor;
    Self.Canvas.Pen.Color := OldColor;
  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.
Added src/tekening.ico.

cannot compute difference between binary files

Added src/tekening.lpi. 






















































































































































































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

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

<?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"/>
    </General>
    <i18n>
      <EnableI18N LFM="False"/>
    </i18n>
    <VersionInfo>
      <StringTable ProductVersion=""/>
    </VersionInfo>
    <BuildModes Count="1">
      <Item1 Name="Default" Default="True"/>
    </BuildModes>
    <PublishOptions>
      <Version Value="2"/>
      <IncludeFileFilter Value="*.(pas|pp|inc|lfm|lpr|lrs|lpi|lpk|sh|xml)"/>
      <ExcludeFileFilter Value="*.(bak|ppu|o|so);*~;backup"/>
    </PublishOptions>
    <RunParams>
      <local>
        <FormatVersion Value="1"/>
        <LaunchingApplication PathPlusParams="/usr/bin/xterm -T 'Lazarus Run Output' -e $(LazarusDir)/tools/runwait.sh $(TargetCmdLine)"/>
      </local>
    </RunParams>
    <RequiredPackages Count="1">
      <Item1>
        <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"/>
    </Target>
    <SearchPaths>
      <IncludeFiles Value="$(ProjOutDir)"/>
      <UnitOutputDirectory Value="lib/$(TargetCPU)-$(TargetOS)"/>
    </SearchPaths>
    <Linking>
      <Options>
        <Win32>
          <GraphicApplication Value="True"/>
        </Win32>
      </Options>
    </Linking>
    <Other>
      <CompilerMessages>
        <MsgFileName Value=""/>
      </CompilerMessages>
      <CompilerPath Value="$(CompPath)"/>
    </Other>
  </CompilerOptions>
  <Debugging>
    <Exceptions Count="3">
      <Item1>
        <Name Value="EAbort"/>
      </Item1>
      <Item2>
        <Name Value="ECodetoolError"/>
      </Item2>
      <Item3>
        <Name Value="EFOpenError"/>
      </Item3>
    </Exceptions>
  </Debugging>
</CONFIG>
Added src/tekening.pas. 












































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

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

program tekening;

{$mode objfpc}{$H+}

uses
  {$IFDEF UNIX}{$IFDEF UseCThreads}
  cthreads,
  {$ENDIF}{$ENDIF}
  Interfaces, // this includes the LCL widgetset
  Forms, f_main
  { you can add units after this };

{$R *.res}

begin
  RequireDerivedFormResource := True;
  Application.Initialize;
  Application.CreateForm(TfrmTekening, frmTekening);
  Application.Run;
end.
Added src/tekening.res.

cannot compute difference between binary files