(* * 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, LCLType, LMessages, Buttons, UPlatformTypes, UStatics, Menus, 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.