Tekening

Check-in [345996d2bc]
Login

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

Overview
Comment:Change cursor depending on drawing mode.
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | develop
Files: files | file ages | folders
SHA1: 345996d2bcc31932732b3a3bff58e437ce8fca06
User & Date: tinus 2017-04-01 08:20:07
Context
2017-04-01
08:21
Added debug and release build modes to the project. check-in: 4c0cac166d user: tinus tags: develop
08:20
Change cursor depending on drawing mode. check-in: 345996d2bc user: tinus tags: develop
2017-03-28
18:21
Changed parse mode to Delphi, since Lazarus 1.0 doesn't support DelphiUnicode. check-in: e90bec57c7 user: tinus tags: develop
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Changes to src/f_main.pas.

30
31
32
33
34
35
36

37
38
39


40
41
42
43
44
45
46
..
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
...
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
...
194
195
196
197
198
199
200










201
202
203
204
205
206
207
208
209
210
    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
................................................................................
  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;

  Self.BorderStyle := bsNone;
  Self.SetBounds(Screen.DesktopLeft, Screen.DesktopTop, Screen.DesktopWidth, Screen.DesktopHeight);

  Randomize;
end;
................................................................................
end;

procedure TfrmTekening.FormMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  case Button of
    mbLeft: begin
      if FDrawing <> dsDrawing then
        FDrawing := dsDrawing
      else
        FDrawing := dsNothing;
    end;
    mbMiddle: begin
      FColor := RGB(Random(255), Random(255), Random(255));
      FDrawing := dsDrawing;
    end;
    mbRight: begin
      if FDrawing <> dsErasing then
        FDrawing := dsErasing
      else
        FDrawing := dsNothing;
    end;
  end;
end;

procedure TfrmTekening.FormMouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
  if FSkip then begin
    MoveTo(X, Y);
    FSkip := False;
  end;
  case FDrawing of
    dsNothing: MoveTo(X, Y);
    dsDrawing: LineTo(X, Y, FColor);
    dsErasing: LineTo(X, Y, Self.Color);
  end;
end;

procedure TfrmTekening.FormMouseUp(Sender: TObject; Button: TMouseButton;
................................................................................

    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.








>



>
>







 







|







 







|
|

|



|


|
|

|











|







 







>
>
>
>
>
>
>
>
>
>










30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
..
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
...
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
...
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
    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 SetDrawing(const AValue: TDrawingState);
    procedure TextOut(const ACanvas: TCanvas; const AText: string);
  public
    { public declarations }

    property Drawing: TDrawingState read FDrawing write SetDrawing;
  end;

var
  frmTekening: TfrmTekening;

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

  Drawing := dsDrawing;
  FSkip := True;

  Self.BorderStyle := bsNone;
  Self.SetBounds(Screen.DesktopLeft, Screen.DesktopTop, Screen.DesktopWidth, Screen.DesktopHeight);

  Randomize;
end;
................................................................................
end;

procedure TfrmTekening.FormMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  case Button of
    mbLeft: begin
      if Drawing <> dsDrawing then
        Drawing := dsDrawing
      else
        Drawing := dsNothing;
    end;
    mbMiddle: begin
      FColor := RGB(Random(255), Random(255), Random(255));
      Drawing := dsDrawing;
    end;
    mbRight: begin
      if Drawing <> dsErasing then
        Drawing := dsErasing
      else
        Drawing := dsNothing;
    end;
  end;
end;

procedure TfrmTekening.FormMouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
  if FSkip then begin
    MoveTo(X, Y);
    FSkip := False;
  end;
  case Drawing of
    dsNothing: MoveTo(X, Y);
    dsDrawing: LineTo(X, Y, FColor);
    dsErasing: LineTo(X, Y, Self.Color);
  end;
end;

procedure TfrmTekening.FormMouseUp(Sender: TObject; Button: TMouseButton;
................................................................................

    LineTo(X, Y);
  finally
    FPNG.Canvas.Pen.Color := OldPNGColor;
    Self.Canvas.Pen.Color := OldColor;
  end;
end;

procedure TfrmTekening.SetDrawing(const AValue: TDrawingState);
begin
  FDrawing := AValue;
  case FDrawing of
    dsDrawing: Cursor := crHandPoint;
    dsErasing: Cursor := crNo;
    else       Cursor := crDefault;
  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.