Statistics
| Branch: | Tag: | Revision:

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

History | View | Annotate | Download (8.8 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 UfrmFilter;
27
28
{$mode objfpc}{$H+}
29
30
interface
31
32
uses
33
  Classes, SysUtils, LResources, Forms, Controls, Graphics, Dialogs, StdCtrls,
34
  ExtCtrls, VirtualTrees, LCLIntf, LMessages, Buttons, UPlatformTypes, UStatics,
35
  PairSplitter, Menus;
36
37
type
38
39
  { TfrmFilter }
40
41
  TfrmFilter = class(TForm)
42
    btnClear: TSpeedButton;
43
    btnDelete: TSpeedButton;
44
    btnRandomPresetDelete: TSpeedButton;
45
    btnRandomPresetSave: TSpeedButton;
46
    cbRandomPreset: TComboBox;
47
    cbTileFilter: TCheckBox;
48
    cbHueFilter: TCheckBox;
49
    GroupBox1: TGroupBox;
50
    GroupBox2: TGroupBox;
51
    Label1: TLabel;
52
    mnuUncheckHues: TMenuItem;
53
    mnuCheckHues: TMenuItem;
54
    pnlControls: TPanel;
55
    pnlRandomPreset: TPanel;
56
    pmHues: TPopupMenu;
57
    rgFilterType: TRadioGroup;
58
    Splitter1: TSplitter;
59
    vdtFilter: TVirtualDrawTree;
60
    vdtHues: TVirtualDrawTree;
61
    procedure btnClearClick(Sender: TObject);
62
    procedure btnDeleteClick(Sender: TObject);
63
    procedure FormCreate(Sender: TObject);
64
    procedure FormShow(Sender: TObject);
65
    procedure mnuUncheckHuesClick(Sender: TObject);
66
    procedure mnuCheckHuesClick(Sender: TObject);
67
    procedure vdtFilterDragDrop(Sender: TBaseVirtualTree; Source: TObject;
68
      DataObject: IDataObject; Formats: TFormatArray; Shift: TShiftState;
69
      Pt: TPoint; var Effect: Integer; Mode: TDropMode);
70
    procedure vdtFilterDragOver(Sender: TBaseVirtualTree; Source: TObject;
71
      Shift: TShiftState; State: TDragState; Pt: TPoint; Mode: TDropMode;
72
      var Effect: Integer; var Accept: Boolean);
73
    procedure vdtFilterDrawNode(Sender: TBaseVirtualTree;
74
      const PaintInfo: TVTPaintInfo);
75
    procedure vdtHuesChecked(Sender: TBaseVirtualTree; Node: PVirtualNode);
76
    procedure vdtHuesDrawNode(Sender: TBaseVirtualTree;
77
      const PaintInfo: TVTPaintInfo);
78
  protected
79
    FLocked: Boolean;
80
    FCheckedHues: TBits;
81
    procedure MouseLeave(var msg: TLMessage); message CM_MouseLeave;
82
  public
83
    property Locked: Boolean read FLocked write FLocked;
84
    function Filter(AStatic: TStaticItem): Boolean;
85
    procedure JumpToHue(AHueID: Word);
86
  end; 
87
88
var
89
  frmFilter: TfrmFilter;
90
91
implementation
92
93
uses
94
  UfrmMain, UGameResources, UHue, UGraphicHelper, UGUIPlatformUtils;
95
  
96
type
97
  PTileInfo = ^TTileInfo;
98
  TTileInfo = record
99
    ID: Word;
100
  end;
101
  PHueInfo = ^THueInfo;
102
  THueInfo = record
103
    ID: Word;
104
    Hue: THue;
105
  end;
106
107
{ TfrmFilter }
108
109
procedure TfrmFilter.FormShow(Sender: TObject);
110
var
111
  upperLeft, lowerLeft: TPoint;
112
begin
113
  upperLeft := frmMain.pnlMain.ClientToScreen(Point(0, 0));
114
  lowerLeft := frmMain.pnlMain.ClientToScreen(Point(0, frmMain.pnlMain.Height));
115
  Left := upperLeft.x;
116
  Top := upperLeft.y;
117
  Height := lowerLeft.y - upperLeft.y;
118
119
  SetWindowParent(Handle, frmMain.Handle);
120
end;
121
122
procedure TfrmFilter.mnuUncheckHuesClick(Sender: TObject);
123
begin
124
  vdtHues.ClearChecked;
125
end;
126
127
procedure TfrmFilter.mnuCheckHuesClick(Sender: TObject);
128
var
129
  node: PVirtualNode;
130
begin
131
  node := vdtHues.GetFirst;
132
  while node <> nil do
133
  begin
134
    vdtHues.CheckState[node] := csCheckedNormal;
135
    node := vdtHues.GetNext(node);
136
  end;
137
end;
138
139
procedure TfrmFilter.vdtFilterDragDrop(Sender: TBaseVirtualTree;
140
  Source: TObject; DataObject: IDataObject; Formats: TFormatArray;
141
  Shift: TShiftState; Pt: TPoint; var Effect: Integer; Mode: TDropMode);
142
var
143
  sourceTree: TVirtualDrawTree;
144
  selected, node: PVirtualNode;
145
  sourceTileInfo, targetTileInfo: PTileInfo;
146
begin
147
  sourceTree := Source as TVirtualDrawTree;
148
  if (sourceTree <> Sender) and (sourceTree <> nil) and
149
     (sourceTree.Tag = 1) then
150
  begin
151
    Sender.BeginUpdate;
152
    selected := sourceTree.GetFirstSelected;
153
    while selected <> nil do
154
    begin
155
      sourceTileInfo := sourceTree.GetNodeData(selected);
156
      if sourceTileInfo^.ID > $3FFF then
157
      begin
158
        node := Sender.AddChild(nil);
159
        targetTileInfo := Sender.GetNodeData(node);
160
        targetTileInfo^.ID := sourceTileInfo^.ID;
161
      end;
162
      selected := sourceTree.GetNextSelected(selected);
163
    end;
164
    Sender.EndUpdate;
165
  end;
166
end;
167
168
procedure TfrmFilter.vdtFilterDragOver(Sender: TBaseVirtualTree;
169
  Source: TObject; Shift: TShiftState; State: TDragState; Pt: TPoint;
170
  Mode: TDropMode; var Effect: Integer; var Accept: Boolean);
171
begin
172
  if (Source <> Sender) and (Source is TVirtualDrawTree) and
173
    (TVirtualDrawTree(Source).Tag = 1) then
174
  begin
175
    Accept := True;
176
  end;
177
end;
178
179
procedure TfrmFilter.vdtFilterDrawNode(Sender: TBaseVirtualTree;
180
  const PaintInfo: TVTPaintInfo);
181
begin
182
  frmMain.vdtTilesDrawNode(Sender, PaintInfo);
183
end;
184
185
procedure TfrmFilter.vdtHuesChecked(Sender: TBaseVirtualTree; Node: PVirtualNode);
186
var
187
  hueInfo: PHueInfo;
188
begin
189
  hueInfo := Sender.GetNodeData(Node);
190
  FCheckedHues.Bits[hueInfo^.ID] := (Sender.CheckState[node] = csCheckedNormal);
191
end;
192
193
procedure TfrmFilter.vdtHuesDrawNode(Sender: TBaseVirtualTree;
194
  const PaintInfo: TVTPaintInfo);
195
var
196
  hueInfo: PHueInfo;
197
  hueColor: TColor;
198
  i: Integer;
199
  textStyle: TTextStyle;
200
begin
201
  hueInfo := Sender.GetNodeData(PaintInfo.Node);
202
  textStyle := PaintInfo.Canvas.TextStyle;
203
  textStyle.Alignment := taLeftJustify;
204
  textStyle.Layout := tlCenter;
205
  textStyle.Wordbreak := True;
206
  case PaintInfo.Column of
207
    1:
208
      begin
209
        for i := 0 to 31 do
210
        begin
211
          hueColor := ARGB2RGB(hueInfo^.Hue.ColorTable[i]);
212
          PaintInfo.Canvas.Pen.Color := hueColor;
213
          PaintInfo.Canvas.MoveTo(PaintInfo.CellRect.Left + 2 + i, PaintInfo.CellRect.Top + 1);
214
          PaintInfo.Canvas.LineTo(PaintInfo.CellRect.Left + 2 + i, PaintInfo.CellRect.Bottom - 1);
215
        end;
216
      end;
217
    2:
218
      begin
219
        PaintInfo.Canvas.TextRect(PaintInfo.CellRect, PaintInfo.CellRect.Left, PaintInfo.CellRect.Top, Format('$%x (%s)', [hueInfo^.ID, hueInfo^.Hue.Name]), textStyle);
220
      end;
221
  end;
222
end;
223
224
procedure TfrmFilter.MouseLeave(var msg: TLMessage);
225
begin
226
  {if Active and (not PtInRect(ClientRect, ScreenToClient(Mouse.CursorPos))) then
227
    Close;}
228
end;
229
230
function TfrmFilter.Filter(AStatic: TStaticItem): Boolean;
231
var
232
  found: Boolean;
233
  tileInfo: PTileInfo;
234
  node: PVirtualNode;
235
  id: Word;
236
begin
237
  if cbTileFilter.Checked then
238
  begin
239
    id := AStatic.TileID + $4000;
240
241
    found := False;
242
    node := vdtFilter.GetFirst;
243
    while (node <> nil) and (not found) do
244
    begin
245
      tileInfo := vdtFilter.GetNodeData(node);
246
      if tileInfo^.ID = id then
247
        found := True
248
      else
249
        node := vdtFilter.GetNext(node);
250
    end;
251
252
    Result := ((rgFilterType.ItemIndex = 0) and (not found)) or
253
              ((rgFilterType.ItemIndex = 1) and found);
254
  end else
255
    Result := True;
256
    
257
  if cbHueFilter.Checked then
258
  begin
259
    Result := Result and (
260
                ((rgFilterType.ItemIndex = 0) and (not FCheckedHues.Bits[AStatic.Hue])) or
261
                ((rgFilterType.ItemIndex = 1) and (FCheckedHues.Bits[AStatic.Hue]))
262
              );
263
  end;
264
end;
265
266
procedure TfrmFilter.JumpToHue(AHueID: Word);
267
var
268
  hueInfo: PHueInfo;
269
  node: PVirtualNode;
270
begin
271
  node := vdtHues.GetFirst;
272
  while node <> nil do
273
  begin
274
    hueInfo := vdtHues.GetNodeData(node);
275
    if hueInfo^.ID = AHueID then
276
    begin
277
      vdtHues.ClearSelection;
278
      vdtHues.Selected[node] := True;
279
      vdtHues.FocusedNode := node;
280
      node := nil;
281
    end else
282
      node := vdtHues.GetNext(node);
283
  end;
284
end;
285
286
procedure TfrmFilter.FormCreate(Sender: TObject);
287
var
288
  i: Integer;
289
  hueInfo: PHueInfo;
290
  node: PVirtualNode;
291
begin
292
  FLocked := False;
293
  vdtFilter.NodeDataSize := SizeOf(TTileInfo);
294
  vdtHues.NodeDataSize := SizeOf(THueInfo);
295
  
296
  vdtHues.BeginUpdate;
297
  vdtHues.Clear;
298
  for i := 0 to ResMan.Hue.Count - 1 do
299
  begin
300
    node := vdtHues.AddChild(nil);
301
    hueInfo := vdtHues.GetNodeData(node);
302
    hueInfo^.ID := i + 1;
303
    hueInfo^.Hue := ResMan.Hue.Hues[i];
304
    vdtHues.CheckType[node] := ctCheckBox;
305
  end;
306
  vdtHues.EndUpdate;
307
  FCheckedHues := TBits.Create(ResMan.Hue.Count + 1);
308
  //FCheckedHues.Bits[0] := True;
309
end;
310
311
procedure TfrmFilter.btnDeleteClick(Sender: TObject);
312
begin
313
  vdtFilter.DeleteSelectedNodes;
314
end;
315
316
procedure TfrmFilter.btnClearClick(Sender: TObject);
317
begin
318
  vdtFilter.Clear;
319
end;
320
321
initialization
322
  {$I UfrmFilter.lrs}
323
324
end.
325