Statistics
| Branch: | Tag: | Revision:

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

History | View | Annotate | Download (3.9 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 UfrmMoveSettings;
27
28
{$mode objfpc}{$H+}
29
30
interface
31
32
uses
33
  Classes, SysUtils, LResources, Forms, Controls, Graphics, Dialogs, StdCtrls,
34
  Buttons, Spin, LMessages, LCLIntf, math;
35
36
type
37
38
  { TfrmMoveSettings }
39
40
  TfrmMoveSettings = class(TForm)
41
    btnCancel: TButton;
42
    cbAsk: TCheckBox;
43
    gbDirection: TGroupBox;
44
    btnTopLeft: TSpeedButton;
45
    btnTop: TSpeedButton;
46
    btnTopRight: TSpeedButton;
47
    btnRight: TSpeedButton;
48
    btnBottomRight: TSpeedButton;
49
    btnBottom: TSpeedButton;
50
    btnBottomLeft: TSpeedButton;
51
    btnLeft: TSpeedButton;
52
    seOffset: TSpinEdit;
53
    procedure btnTopLeftClick(Sender: TObject);
54
    procedure FormClose(Sender: TObject; var CloseAction: TCloseAction);
55
    procedure FormDeactivate(Sender: TObject);
56
    procedure FormShow(Sender: TObject);
57
  protected
58
    procedure MouseLeave(var msg: TLMessage); message CM_MouseLeave;
59
  public
60
    function GetOffsetX: Integer;
61
    function GetOffsetY: Integer;
62
  end; 
63
64
var
65
  frmMoveSettings: TfrmMoveSettings;
66
67
implementation
68
69
uses
70
  UdmNetwork, UfrmMain, UEnums;
71
72
{ TfrmMoveSettings }
73
74
procedure TfrmMoveSettings.FormClose(Sender: TObject; var CloseAction: TCloseAction);
75
begin
76
  CloseAction := caHide;
77
end;
78
79
procedure TfrmMoveSettings.FormDeactivate(Sender: TObject);
80
begin
81
  if not (fsModal in FormState) then
82
    Close;
83
end;
84
85
procedure TfrmMoveSettings.FormShow(Sender: TObject);
86
begin
87
  btnCancel.Visible := (fsModal in FormState);
88
  if dmNetwork.AccessLevel = alAdministrator then
89
    seOffset.MaxValue := Max(frmMain.Landscape.CellWidth, frmMain.Landscape.CellHeight);
90
end;
91
92
procedure TfrmMoveSettings.MouseLeave(var msg: TLMessage);
93
begin
94
  if Visible and (not (fsModal in FormState)) and
95
    (not PtInRect(ClientRect, ScreenToClient(Mouse.CursorPos))) then
96
    Close;
97
end;
98
99
function TfrmMoveSettings.GetOffsetX: Integer;
100
begin
101
  if btnTopLeft.Down then
102
    Result := -seOffset.Value
103
  else if btnTop.Down then
104
    Result := -seOffset.Value
105
  else if btnTopRight.Down then
106
    Result := 0
107
  else if btnRight.Down then
108
    Result := seOffset.Value
109
  else if btnBottomRight.Down then
110
    Result := seOffset.Value
111
  else if btnBottom.Down then
112
    Result := seOffset.Value
113
  else if btnBottomLeft.Down then
114
    Result := 0
115
  else if btnLeft.Down then
116
    Result := -seOffset.Value
117
  else
118
    Result := 0;
119
end;
120
121
function TfrmMoveSettings.GetOffsetY: Integer;
122
begin
123
  if btnTopLeft.Down then
124
    Result := 0
125
  else if btnTop.Down then
126
    Result := -seOffset.Value
127
  else if btnTopRight.Down then
128
    Result := -seOffset.Value
129
  else if btnRight.Down then
130
    Result := -seOffset.Value
131
  else if btnBottomRight.Down then
132
    Result := 0
133
  else if btnBottom.Down then
134
    Result := seOffset.Value
135
  else if btnBottomLeft.Down then
136
    Result := seOffset.Value
137
  else if btnLeft.Down then
138
    Result := seOffset.Value
139
  else
140
    Result := 0;
141
end;
142
143
procedure TfrmMoveSettings.btnTopLeftClick(Sender: TObject);
144
begin
145
  ModalResult := mrYes;
146
end;
147
148
initialization
149
  {$I UfrmMoveSettings.lrs}
150
151
end.
152