Templot5/mouse_colour_unit.pas at main · mattharris/Templot5 · GitHub

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

(*
================================================================================

    This file is part of OpenTemplot2024, a computer program for the design of model railway track.
    Copyright (C) 2024  Martin Wynne.  email: martin@85a.uk

    This program is free software: you may redistribute it and/or modify
    it under the terms of the GNU General Public Licence as published by
    the Free Software Foundation, either version 3 of the Licence, or
    (at your option) any later version.

    This program is distributed in the hope that it will be useful,
    but WITHOUT ANY WARRANTY; without even the implied warranty of
    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
    See the GNU General Public Licence for more details.

    You should have received a copy of the GNU General Public Licence
    along with this program. See the file: licence.txt

    Or if not, refer to the web site: https://www.gnu.org/licenses/

================================================================================

   This file was saved from Delphi5

   This file was derived from Templot2 version 244e

*)

unit mouse_colour_unit;

{$MODE Delphi}

{$ALIGN OFF}

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  ExtCtrls, StdCtrls;

type
  Tmouse_colour_form = class(TForm)
    Label2: TLabel;
    add_label: TLabel;
    mouse_colour_shape: TShape;
    ok_panel: TPanel;
    ok_button: TButton;
    cancel_panel: TPanel;
    datestamp_label: TLabel;
    procedure FormShow(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormKeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure cancel_panelClick(Sender: TObject);
    procedure ok_buttonClick(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  mouse_colour_form:Tmouse_colour_form;

implementation

uses colour_unit, control_room;

{$R *.lfm}

var
  got_colour:TColor=clWhite;


//______________________________________________________________________________

procedure Tmouse_colour_form.FormShow(Sender: TObject);

begin
  mouse_colour_shape.Brush.Color:=Color;  // hidden at first
  add_label.Visible:=False;
  ok_panel.Visible:=False;
end;
//______________________________________________________________________________

function get_colour_at_mouse:TColor;

var
  canv:TCanvas;
  mouse_point:TPoint;

begin
  RESULT:=clWhite;       // init

  canv:=TCanvas.Create;
  try
    canv.Handle:=GetDC(0);
    GetCursorPos(mouse_point);
    RESULT:=canv.Pixels[mouse_point.X,mouse_point.Y];
    ReleaseDC(0,canv.Handle);
  finally
    canv.Free;
  end;//try
end;
//______________________________________________________________________________

procedure Tmouse_colour_form.FormKeyDown(Sender:TObject; var Key:Word; Shift:TShiftState);

begin
  if Key=VK_SPACE
     then begin
            got_colour:=get_colour_at_mouse;
            mouse_colour_shape.Brush.Color:=got_colour;
            add_label.Visible:=True;
            ok_panel.Visible:=True;
            Key:=0;
          end;
end;
//______________________________________________________________________________

procedure Tmouse_colour_form.FormCreate(Sender: TObject);

begin

  AutoScroll:=False;

  ClientWidth:=440;
  ClientHeight:=180;
end;
//______________________________________________________________________________

procedure Tmouse_colour_form.cancel_panelClick(Sender: TObject);

begin
  ModalResult:=mrCancel;
end;
//______________________________________________________________________________

procedure Tmouse_colour_form.ok_buttonClick(Sender: TObject);

var
  n:integer;
  name_str:string;
  colour_changed:boolean;

begin

  colour_changed:=False;

  with colour_form.colour_dialog.CustomColors do begin

    for n:=0 to 15 do begin

      name_str:='Color'+Char(Ord('A')+n);

      if Values[name_str]='FFFFFF'                          // replace first clWhite found
         then begin
                Values[name_str]:=IntToHex(got_colour,6);
                colour_changed:=True;
                BREAK;
              end
    end;//next

    if colour_changed=False then Values['ColorP']:=IntToHex(got_colour,6);     // or overwrite final one if all used

  end;//with

  ModalResult:=mrOk;
end;
//______________________________________________________________________________

end.