Statistics
| Branch: | Tag: | Revision:

root / Client / Tools / UfrmDrawSettings.pas @ 0:95bd93c28625

History | View | Annotate | Download (3.3 kB)

1
(*
2
 * CDDL HEADER START
3
 *
4
 * The contents of this file are subject to the terms of the
5
 * Common Development and Distribution License, Version 1.0 only
6
 * (the "License").  You may not use this file except in compliance
7
 * with the License.
8
 *
9
 * You can obtain a copy of the license at
10
 * http://www.opensource.org/licenses/cddl1.php.
11
 * See the License for the specific language governing permissions
12
 * and limitations under the License.
13
 *
14
 * When distributing Covered Code, include this CDDL HEADER in each
15
 * file and include the License file at
16
 * http://www.opensource.org/licenses/cddl1.php.  If applicable,
17
 * add the following below this CDDL HEADER, with the fields enclosed
18
 * by brackets "[]" replaced with your own identifying * information:
19
 *      Portions Copyright [yyyy] [name of copyright owner]
20
 *
21
 * CDDL HEADER END
22
 *
23
 *
24
 *      Portions Copyright 2007 Andreas Schneider
25
 *)
26
unit UfrmDrawSettings;
27
28
{$mode objfpc}{$H+}
29
30
interface
31
32
uses
33
  Classes, SysUtils, LResources, Forms, Controls, Graphics, Dialogs, StdCtrls,
34
  Spin, ExtCtrls, LMessages, LCLIntf;
35
36
type
37
38
  { TfrmDrawSettings }
39
40
  TfrmDrawSettings = class(TForm)
41
    cbForceAltitude: TCheckBox;
42
    gbHue: TGroupBox;
43
    pbHue: TPaintBox;
44
    rbRandom: TRadioButton;
45
    rbTileList: TRadioButton;
46
    seForceAltitude: TSpinEdit;
47
    procedure FormClose(Sender: TObject; var CloseAction: TCloseAction);
48
    procedure FormDeactivate(Sender: TObject);
49
    procedure FormShow(Sender: TObject);
50
    procedure pbHueClick(Sender: TObject);
51
    procedure pbHuePaint(Sender: TObject);
52
    procedure seForceAltitudeChange(Sender: TObject);
53
  protected
54
    procedure MouseLeave(var msg: TLMessage); message CM_MouseLeave;
55
  public
56
    { public declarations }
57
  end; 
58
59
var
60
  frmDrawSettings: TfrmDrawSettings;
61
62
implementation
63
64
uses
65
  UGameResources, UHue, UfrmHueSettings;
66
67
{ TfrmDrawSettings }
68
69
procedure TfrmDrawSettings.FormClose(Sender: TObject;
70
  var CloseAction: TCloseAction);
71
begin
72
  CloseAction := caHide;
73
end;
74
75
procedure TfrmDrawSettings.FormDeactivate(Sender: TObject);
76
begin
77
  if not frmHueSettings.Visible then
78
    Close;
79
end;
80
81
procedure TfrmDrawSettings.FormShow(Sender: TObject);
82
begin
83
  Left := Mouse.CursorPos.x - 8;
84
  Top := Mouse.CursorPos.y - 8;
85
end;
86
87
procedure TfrmDrawSettings.pbHueClick(Sender: TObject);
88
var
89
  msg: TLMessage;
90
begin
91
  frmHueSettings.Left := Mouse.CursorPos.x - 8;
92
  frmHueSettings.Top := Mouse.CursorPos.y - 8;
93
  frmHueSettings.ShowModal;
94
  pbHue.Repaint;
95
  MouseLeave(msg);
96
end;
97
98
procedure TfrmDrawSettings.pbHuePaint(Sender: TObject);
99
var
100
  hue: THue;
101
begin
102
  if frmHueSettings <> nil then
103
  begin
104
    if frmHueSettings.lbHue.ItemIndex > 0 then
105
      hue := ResMan.Hue.Hues[frmHueSettings.lbHue.ItemIndex - 1]
106
    else
107
      hue := nil;
108
    TfrmHueSettings.DrawHue(hue, pbHue.Canvas, pbHue.Canvas.ClipRect,
109
      frmHueSettings.lbHue.Items.Strings[frmHueSettings.lbHue.ItemIndex]);
110
  end;
111
end;
112
113
procedure TfrmDrawSettings.seForceAltitudeChange(Sender: TObject);
114
begin
115
  cbForceAltitude.Checked := True;
116
end;
117
118
procedure TfrmDrawSettings.MouseLeave(var msg: TLMessage);
119
begin
120
  try
121
    if (not frmHueSettings.Visible) and (not PtInRect(ClientRect, ScreenToClient(Mouse.CursorPos))) then
122
      Close;
123
  except
124
    Close;
125
  end;
126
end;
127
128
initialization
129
  {$I UfrmDrawSettings.lrs}
130
131
end.
132