CentrED/Client/Tools/UfrmFilter.pas

481 lines
13 KiB
Plaintext

(*
* CDDL HEADER START
*
* The contents of this file are subject to the terms of the
* Common Development and Distribution License, Version 1.0 only
* (the "License"). You may not use this file except in compliance
* with the License.
*
* You can obtain a copy of the license at
* http://www.opensource.org/licenses/cddl1.php.
* See the License for the specific language governing permissions
* and limitations under the License.
*
* When distributing Covered Code, include this CDDL HEADER in each
* file and include the License file at
* http://www.opensource.org/licenses/cddl1.php. If applicable,
* add the following below this CDDL HEADER, with the fields enclosed
* by brackets "[]" replaced with your own identifying * information:
* Portions Copyright [yyyy] [name of copyright owner]
*
* CDDL HEADER END
*
*
* Portions Copyright 2009 Andreas Schneider
*)
unit UfrmFilter;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, LResources, Forms, Controls, Graphics, Dialogs, StdCtrls,
ExtCtrls, VirtualTrees, VirtualList, LCLIntf, LMessages, Buttons, UPlatformTypes,
UStatics, Menus, Windows, Logging;
type
{ TfrmFilter }
TfrmFilter = class(TForm)
btnClear: TSpeedButton;
btnDelete: TSpeedButton;
btnRandomPresetDelete: TSpeedButton;
btnRandomPresetSave: TSpeedButton;
cbRandomPreset: TComboBox;
cbTileFilter: TCheckBox;
cbHueFilter: TCheckBox;
GroupBox1: TGroupBox;
GroupBox2: TGroupBox;
Label1: TLabel;
mnuUncheckHues: TMenuItem;
mnuCheckHues: TMenuItem;
pnlRandomPreset: TPanel;
pmHues: TPopupMenu;
rgFilterType: TRadioGroup;
Splitter1: TSplitter;
tFormClose: TTimer;
vdtFilter: TVirtualList;
vdtHues: TVirtualDrawTree;
procedure btnClearClick(Sender: TObject);
procedure btnDeleteClick(Sender: TObject);
procedure cbHueFilterChange(Sender: TObject);
procedure cbTileFilterChange(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
procedure FormMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure FormMouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure FormShow(Sender: TObject);
procedure GroupBox1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure mnuUncheckHuesClick(Sender: TObject);
procedure mnuCheckHuesClick(Sender: TObject);
procedure rgFilterTypeClick(Sender: TObject);
procedure tFormCloseTimer(Sender: TObject);
procedure vdtFilterDragDrop(Sender: TBaseVirtualTree; Source: TObject;
DataObject: IDataObject; Formats: TFormatArray; Shift: TShiftState;
Pt: TPoint; var Effect: Integer; Mode: TDropMode);
procedure vdtFilterDragOver(Sender: TBaseVirtualTree; Source: TObject;
Shift: TShiftState; State: TDragState; Pt: TPoint; Mode: TDropMode;
var Effect: Integer; var Accept: Boolean);
procedure vdtFilterDrawNode(Sender: TBaseVirtualTree;
const PaintInfo: TVTPaintInfo);
procedure vdtHuesChecked(Sender: TBaseVirtualTree; Node: PVirtualNode);
procedure vdtHuesDrawNode(Sender: TBaseVirtualTree;
const PaintInfo: TVTPaintInfo);
private
FLastRMouseDown: DWORD;
protected
FLocked: Boolean;
FCheckedHues: TBits;
procedure MouseLeave(var msg: TLMessage); message CM_MouseLeave;
public
property Locked: Boolean read FLocked write FLocked;
function Filter(AStatic: TStaticItem): Boolean;
procedure JumpToHue(AHueID: Word);
procedure AddTile(ATileID: LongWord);
procedure AddHue(AHueID: Word);
end;
var
frmFilter: TfrmFilter;
implementation
uses
UfrmMain, UGameResources, UHue, UGraphicHelper, UGUIPlatformUtils, Language;
type
PTileInfo = ^TTileInfo;
TTileInfo = record
ID: LongWord;
ptr: Pointer;
end;
PHueInfo = ^THueInfo;
THueInfo = record
ID: LongWord;
Hue: THue;
end;
{ TfrmFilter }
procedure TfrmFilter.FormShow(Sender: TObject);
var
wspos : TPoint;
wrect : TRect;
begin
SetWindowParent(Handle, frmMain.Handle);
GetWindowRect(frmFilter.Handle, wrect);
wspos := frmMain.oglGameWindow.ClientToScreen(Classes.Point(0, 0));
Left := wspos.X - 1;
Top := wspos.Y - 1;
Height:= frmMain.oglGameWindow.ClientHeight - (wrect.Bottom - wrect.Top - ClientHeight);
end;
procedure TfrmFilter.GroupBox1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
end;
procedure TfrmFilter.mnuUncheckHuesClick(Sender: TObject);
begin
vdtHues.ClearChecked;
end;
procedure TfrmFilter.mnuCheckHuesClick(Sender: TObject);
var
node: PVirtualNode;
begin
node := vdtHues.GetFirst;
while node <> nil do
begin
vdtHues.CheckState[node] := csCheckedNormal;
node := vdtHues.GetNext(node);
end;
end;
procedure TfrmFilter.rgFilterTypeClick(Sender: TObject);
begin
frmMain.InvalidateFilter;
end;
procedure TfrmFilter.vdtFilterDragDrop(Sender: TBaseVirtualTree;
Source: TObject; DataObject: IDataObject; Formats: TFormatArray;
Shift: TShiftState; Pt: TPoint; var Effect: Integer; Mode: TDropMode);
var
sourceTree: TVirtualList;
selected: PVirtualItem;
node: PVirtualNode;
sourceTileInfo, targetTileInfo: PTileInfo;
begin
sourceTree := Source as TVirtualList;
if (sourceTree <> Sender) and (sourceTree <> nil) then
begin
Sender.BeginUpdate;
selected := sourceTree.GetFirstSelected;
while selected <> nil do
begin
sourceTileInfo := sourceTree.GetNodeData(selected);
if (sourceTileInfo^.ID > $3FFF) and (sourceTileInfo^.ID < $0F000000) then
begin
//node := Sender.AddChild(nil);
//targetTileInfo := Sender.GetNodeData(node);
//targetTileInfo^.ID := sourceTileInfo^.ID;
Logger.Send([lcClient, lcDebug], 'TfrmFilter.vdtFilterDragDrop TileID', Format('0x%.8x', [sourceTileInfo^.ID]));
AddTile(sourceTileInfo^.ID);
cbTileFilter.Checked := True;
frmMain.InvalidateFilter;
end;
selected := sourceTree.GetNextSelected(selected);
end;
Sender.EndUpdate;
end;
end;
procedure TfrmFilter.vdtFilterDragOver(Sender: TBaseVirtualTree;
Source: TObject; Shift: TShiftState; State: TDragState; Pt: TPoint;
Mode: TDropMode; var Effect: Integer; var Accept: Boolean);
begin
if (Source <> Sender) and (Source is TVirtualDrawTree) then
begin
Accept := True;
end;
end;
procedure TfrmFilter.vdtFilterDrawNode(Sender: TBaseVirtualTree;
const PaintInfo: TVTPaintInfo);
begin
frmMain.vdtTilesDrawNode(Sender, PaintInfo);
end;
procedure TfrmFilter.vdtHuesChecked(Sender: TBaseVirtualTree; Node: PVirtualNode);
var
hueInfo: PHueInfo;
begin
hueInfo := Sender.GetNodeData(Node);
FCheckedHues.Bits[hueInfo^.ID] := (Sender.CheckState[node] = csCheckedNormal);
cbHueFilter.Checked := True;
frmMain.InvalidateFilter;
end;
procedure TfrmFilter.vdtHuesDrawNode(Sender: TBaseVirtualTree;
const PaintInfo: TVTPaintInfo);
var
hueInfo: PHueInfo;
hueColor: TColor;
i: Integer;
textStyle: TTextStyle;
begin
hueInfo := Sender.GetNodeData(PaintInfo.Node);
textStyle := PaintInfo.Canvas.TextStyle;
textStyle.Alignment := taLeftJustify;
textStyle.Layout := tlCenter;
textStyle.Wordbreak := True;
case PaintInfo.Column of
1:
begin
for i := 0 to 31 do
begin
hueColor := ARGB2RGB(hueInfo^.Hue.ColorTable[i]);
PaintInfo.Canvas.Pen.Color := hueColor;
PaintInfo.Canvas.MoveTo(PaintInfo.CellRect.Left + 2 + i, PaintInfo.CellRect.Top + 1);
PaintInfo.Canvas.LineTo(PaintInfo.CellRect.Left + 2 + i, PaintInfo.CellRect.Bottom - 1);
end;
end;
2:
begin
PaintInfo.Canvas.TextRect(PaintInfo.CellRect, PaintInfo.CellRect.Left, PaintInfo.CellRect.Top, Format('$%x (%s)', [hueInfo^.ID, hueInfo^.Hue.Name]), textStyle);
end;
end;
end;
procedure TfrmFilter.MouseLeave(var msg: TLMessage);
begin
{if Active and (not PtInRect(ClientRect, ScreenToClient(Mouse.CursorPos))) then
Close;}
end;
function TfrmFilter.Filter(AStatic: TStaticItem): Boolean;
var
found: Boolean;
tileInfo: PTileInfo;
node: PVirtualItem;
id: LongWord;
begin
if cbTileFilter.Checked then
begin
id := AStatic.TileID + $4000;
found := False;
node := vdtFilter.GetFirst;
while (node <> nil) and (not found) do
begin
tileInfo := vdtFilter.GetNodeData(node);
if tileInfo^.ID = id then
found := True
else
node := vdtFilter.GetNext(node);
end;
Result := ((rgFilterType.ItemIndex = 0) and (not found)) or
((rgFilterType.ItemIndex = 1) and found);
end else
Result := True;
if cbHueFilter.Checked then
begin
Result := Result and (
((rgFilterType.ItemIndex = 0) and (not FCheckedHues.Bits[AStatic.Hue])) or
((rgFilterType.ItemIndex = 1) and (FCheckedHues.Bits[AStatic.Hue]))
);
end;
end;
procedure TfrmFilter.JumpToHue(AHueID: Word);
var
hueInfo: PHueInfo;
node: PVirtualNode;
begin
node := vdtHues.GetFirst;
while node <> nil do
begin
hueInfo := vdtHues.GetNodeData(node);
if hueInfo^.ID = AHueID then
begin
vdtHues.ClearSelection;
vdtHues.Selected[node] := True;
vdtHues.FocusedNode := node;
node := nil;
end else
node := vdtHues.GetNext(node);
end;
end;
procedure TfrmFilter.AddTile(ATileID: LongWord);
var
selected, node: PVirtualItem;
sourceTileInfo, targetTileInfo: PTileInfo;
exists: Boolean;
begin
if (ATileID > $3FFF) and (ATileID < $0F000000) then
begin
exists := False;
vdtFilter.BeginUpdate;
selected := vdtFilter.GetFirst();
while selected <> nil do
begin
sourceTileInfo := vdtFilter.GetNodeData(selected);
if sourceTileInfo^.ID = ATileID then
begin
exists := True;
break;
end;
selected := vdtFilter.GetNext(selected);
end;
if not exists then
begin
node := vdtFilter.AddItem(nil);
targetTileInfo := vdtFilter.GetNodeData(node);
targetTileInfo^.ID := ATileID;
end;
vdtFilter.EndUpdate;
end;
end;
procedure TfrmFilter.AddHue(AHueID: Word);
var
hueInfo: PHueInfo;
node: PVirtualNode;
begin
node := vdtHues.GetFirst;
while node <> nil do
begin
hueInfo := vdtHues.GetNodeData(node);
if hueInfo^.ID = AHueID then
begin
//FCheckedHues.Bits[AHueID] := True;
vdtHues.CheckState[node] := csCheckedNormal;
vdtHues.ClearSelection;
vdtHues.Selected[node] := True;
vdtHues.FocusedNode := node;
node := nil;
end else
node := vdtHues.GetNext(node);
end;
end;
procedure TfrmFilter.FormCreate(Sender: TObject);
var
i: Integer;
hueInfo: PHueInfo;
node: PVirtualNode;
begin
vdtFilter := TVirtualList.Create(vdtFilter);
LanguageTranslate(Self);
FLocked := False;
vdtFilter.NodeDataSize := SizeOf(TTileInfo);
vdtHues.NodeDataSize := SizeOf(THueInfo);
vdtHues.BeginUpdate;
vdtHues.Clear;
for i := 0 to ResMan.Hue.Count - 1 do
begin
node := vdtHues.AddChild(nil);
hueInfo := vdtHues.GetNodeData(node);
hueInfo^.ID := i + 1;
hueInfo^.Hue := ResMan.Hue.Hues[i];
vdtHues.CheckType[node] := ctCheckBox;
end;
vdtHues.EndUpdate;
FCheckedHues := TBits.Create(ResMan.Hue.Count + 1);
//FCheckedHues.Bits[0] := True;
end;
procedure TfrmFilter.FormDestroy(Sender: TObject);
begin
if FCheckedHues <> nil then FreeAndNil(FCheckedHues);
end;
procedure TfrmFilter.FormKeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
begin
if (Key = VK_SPACE) and Visible then begin
frmFilter.Locked := True;
frmFilter.Hide;
frmFilter.Locked := False;
// Говно код для задержки чтобы дать время обработать события что возвращают фокус
tFormClose.Interval := 10;
tFormClose.Tag := PtrInt(False);
tFormClose.Enabled := True;
end;
end;
procedure TfrmFilter.tFormCloseTimer(Sender: TObject);
begin
if (Boolean(tFormClose.Tag)) then begin
frmFilter.Locked := True;
frmFilter.Hide;
frmFilter.Locked := False;
end;
frmMain.SetFocus;
tFormClose.Enabled := False;
end;
procedure TfrmFilter.FormMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
If Button = mbRight then
FLastRMouseDown := GetTickCount;
end;
procedure TfrmFilter.FormMouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
if (Visible and not frmMain.mnuAutoShowFilterWindow.Checked and (GetTickCount - FLastRMouseDown < 1000)) then
begin
frmFilter.Locked := True;
frmFilter.Hide;
frmFilter.Locked := False;
frmMain.SetFocus;
end;
end;
procedure TfrmFilter.btnDeleteClick(Sender: TObject);
begin
vdtFilter.BeginUpdate;
vdtFilter.DeleteSelectedNodes;
vdtFilter.EndUpdate;
frmMain.InvalidateFilter;
end;
procedure TfrmFilter.cbHueFilterChange(Sender: TObject);
begin
frmMain.InvalidateFilter;
end;
procedure TfrmFilter.cbTileFilterChange(Sender: TObject);
begin
frmMain.InvalidateFilter;
end;
procedure TfrmFilter.btnClearClick(Sender: TObject);
begin
vdtFilter.Clear;
frmMain.InvalidateFilter;
end;
initialization
{$I UfrmFilter.lrs}
end.