- Added filter management to TfrmMain

- Changed screen buffer state handling to enums
This commit is contained in:
Andreas Schneider 2009-08-06 17:34:55 +02:00
parent 2cfde3eea5
commit 237c9765cd
4 changed files with 73 additions and 11 deletions

View File

@ -92,11 +92,13 @@ end;
procedure TfrmBoundaries.tbMaxZChange(Sender: TObject); procedure TfrmBoundaries.tbMaxZChange(Sender: TObject);
begin begin
seMaxZ.Value := tbMaxZ.Position; seMaxZ.Value := tbMaxZ.Position;
frmMain.InvalidateFilter;
end; end;
procedure TfrmBoundaries.tbMinZChange(Sender: TObject); procedure TfrmBoundaries.tbMinZChange(Sender: TObject);
begin begin
seMinZ.Value := tbMinZ.Position; seMinZ.Value := tbMinZ.Position;
frmMain.InvalidateFilter;
end; end;
procedure TfrmBoundaries.MouseLeave(var msg: TLMessage); procedure TfrmBoundaries.MouseLeave(var msg: TLMessage);

View File

@ -39,6 +39,7 @@ object frmFilter: TfrmFilter
'Exclusive' 'Exclusive'
'Inclusive' 'Inclusive'
) )
OnClick = rgFilterTypeClick
TabOrder = 0 TabOrder = 0
end end
object GroupBox1: TGroupBox object GroupBox1: TGroupBox
@ -230,6 +231,7 @@ object frmFilter: TfrmFilter
Width = 85 Width = 85
BorderSpacing.Around = 4 BorderSpacing.Around = 4
Caption = 'Filter active' Caption = 'Filter active'
OnChange = cbTileFilterChange
TabOrder = 1 TabOrder = 1
end end
end end
@ -252,6 +254,7 @@ object frmFilter: TfrmFilter
Align = alTop Align = alTop
BorderSpacing.Around = 4 BorderSpacing.Around = 4
Caption = 'Filter active' Caption = 'Filter active'
OnChange = cbHueFilterChange
TabOrder = 0 TabOrder = 0
end end
object vdtHues: TVirtualDrawTree object vdtHues: TVirtualDrawTree

View File

@ -59,11 +59,14 @@ type
vdtHues: TVirtualDrawTree; vdtHues: TVirtualDrawTree;
procedure btnClearClick(Sender: TObject); procedure btnClearClick(Sender: TObject);
procedure btnDeleteClick(Sender: TObject); procedure btnDeleteClick(Sender: TObject);
procedure cbHueFilterChange(Sender: TObject);
procedure cbTileFilterChange(Sender: TObject);
procedure FormCreate(Sender: TObject); procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject); procedure FormDestroy(Sender: TObject);
procedure FormShow(Sender: TObject); procedure FormShow(Sender: TObject);
procedure mnuUncheckHuesClick(Sender: TObject); procedure mnuUncheckHuesClick(Sender: TObject);
procedure mnuCheckHuesClick(Sender: TObject); procedure mnuCheckHuesClick(Sender: TObject);
procedure rgFilterTypeClick(Sender: TObject);
procedure vdtFilterDragDrop(Sender: TBaseVirtualTree; Source: TObject; procedure vdtFilterDragDrop(Sender: TBaseVirtualTree; Source: TObject;
DataObject: IDataObject; Formats: TFormatArray; Shift: TShiftState; DataObject: IDataObject; Formats: TFormatArray; Shift: TShiftState;
Pt: TPoint; var Effect: Integer; Mode: TDropMode); Pt: TPoint; var Effect: Integer; Mode: TDropMode);
@ -137,6 +140,11 @@ begin
end; end;
end; end;
procedure TfrmFilter.rgFilterTypeClick(Sender: TObject);
begin
frmMain.InvalidateFilter;
end;
procedure TfrmFilter.vdtFilterDragDrop(Sender: TBaseVirtualTree; procedure TfrmFilter.vdtFilterDragDrop(Sender: TBaseVirtualTree;
Source: TObject; DataObject: IDataObject; Formats: TFormatArray; Source: TObject; DataObject: IDataObject; Formats: TFormatArray;
Shift: TShiftState; Pt: TPoint; var Effect: Integer; Mode: TDropMode); Shift: TShiftState; Pt: TPoint; var Effect: Integer; Mode: TDropMode);
@ -160,6 +168,7 @@ begin
targetTileInfo := Sender.GetNodeData(node); targetTileInfo := Sender.GetNodeData(node);
targetTileInfo^.ID := sourceTileInfo^.ID; targetTileInfo^.ID := sourceTileInfo^.ID;
cbTileFilter.Checked := True; cbTileFilter.Checked := True;
frmMain.InvalidateFilter;
end; end;
selected := sourceTree.GetNextSelected(selected); selected := sourceTree.GetNextSelected(selected);
end; end;
@ -191,6 +200,7 @@ begin
hueInfo := Sender.GetNodeData(Node); hueInfo := Sender.GetNodeData(Node);
FCheckedHues.Bits[hueInfo^.ID] := (Sender.CheckState[node] = csCheckedNormal); FCheckedHues.Bits[hueInfo^.ID] := (Sender.CheckState[node] = csCheckedNormal);
cbHueFilter.Checked := True; cbHueFilter.Checked := True;
frmMain.InvalidateFilter;
end; end;
procedure TfrmFilter.vdtHuesDrawNode(Sender: TBaseVirtualTree; procedure TfrmFilter.vdtHuesDrawNode(Sender: TBaseVirtualTree;
@ -321,6 +331,16 @@ begin
vdtFilter.DeleteSelectedNodes; vdtFilter.DeleteSelectedNodes;
end; end;
procedure TfrmFilter.cbHueFilterChange(Sender: TObject);
begin
frmMain.InvalidateFilter;
end;
procedure TfrmFilter.cbTileFilterChange(Sender: TObject);
begin
frmMain.InvalidateFilter;
end;
procedure TfrmFilter.btnClearClick(Sender: TObject); procedure TfrmFilter.btnClearClick(Sender: TObject);
begin begin
vdtFilter.Clear; vdtFilter.Clear;

View File

@ -42,6 +42,8 @@ type
TVirtualTileArray = array of TVirtualTile; TVirtualTileArray = array of TVirtualTile;
TAccessChangedListener = procedure(AAccessLevel: TAccessLevel) of object; TAccessChangedListener = procedure(AAccessLevel: TAccessLevel) of object;
TScreenBufferState = (sbsValid, sbsIndexed, sbsFiltered);
TScreenBufferStates = set of TScreenBufferState;
{ TfrmMain } { TfrmMain }
@ -276,8 +278,7 @@ type
FLandscape: TLandscape; FLandscape: TLandscape;
FTextureManager: TLandTextureManager; FTextureManager: TLandTextureManager;
FScreenBuffer: TScreenBuffer; FScreenBuffer: TScreenBuffer;
FScreenBufferValid: Boolean; FScreenBufferState: TScreenBufferStates;
FScreenBufferIndexed: Boolean;
FCurrentTile: TWorldItem; FCurrentTile: TWorldItem;
FSelectedTile: TWorldItem; FSelectedTile: TWorldItem;
FGhostTile: TWorldItem; FGhostTile: TWorldItem;
@ -312,6 +313,7 @@ type
procedure SetY(const AValue: Integer); procedure SetY(const AValue: Integer);
procedure UpdateCurrentTile; procedure UpdateCurrentTile;
procedure UpdateCurrentTile(AX, AY: Integer); procedure UpdateCurrentTile(AX, AY: Integer);
procedure UpdateFilter;
procedure UpdateSelection; procedure UpdateSelection;
procedure WriteChatMessage(ASender, AMessage: string); procedure WriteChatMessage(ASender, AMessage: string);
{ Events } { Events }
@ -332,6 +334,7 @@ type
property CurrentTile: TWorldItem read FCurrentTile write SetCurrentTile; property CurrentTile: TWorldItem read FCurrentTile write SetCurrentTile;
property SelectedTile: TWorldItem read FSelectedTile write SetSelectedTile; property SelectedTile: TWorldItem read FSelectedTile write SetSelectedTile;
{ Methods } { Methods }
procedure InvalidateFilter;
procedure RegisterAccessChangedListener(AListener: TAccessChangedListener); procedure RegisterAccessChangedListener(AListener: TAccessChangedListener);
procedure SetPos(AX, AY: Word); procedure SetPos(AX, AY: Word);
procedure UnregisterAccessChangedListener(AListener: TAccessChangedListener); procedure UnregisterAccessChangedListener(AListener: TAccessChangedListener);
@ -738,7 +741,7 @@ begin
FTextureManager := TLandTextureManager.Create; FTextureManager := TLandTextureManager.Create;
FScreenBuffer := TScreenBuffer.Create; FScreenBuffer := TScreenBuffer.Create;
FScreenBufferValid := False; FScreenBufferState := [];
X := 0; X := 0;
Y := 0; Y := 0;
edX.MaxValue := FLandscape.CellWidth; edX.MaxValue := FLandscape.CellWidth;
@ -854,6 +857,7 @@ begin
oglGameWindow.Repaint; oglGameWindow.Repaint;
FLastDraw := Now; FLastDraw := Now;
end; end;
Sleep(1);
Done := False; Done := False;
end; end;
@ -932,6 +936,7 @@ begin
frmFilter.Locked := False; frmFilter.Locked := False;
end else end else
frmFilter.Hide; frmFilter.Hide;
InvalidateFilter;
end; end;
procedure TfrmMain.acFlatExecute(Sender: TObject); procedure TfrmMain.acFlatExecute(Sender: TObject);
@ -1675,9 +1680,14 @@ begin
glLoadIdentity; glLoadIdentity;
end; end;
procedure TfrmMain.InvalidateFilter;
begin
Exclude(FScreenBufferState, sbsFiltered);
end;
procedure TfrmMain.InvalidateScreenBuffer; procedure TfrmMain.InvalidateScreenBuffer;
begin begin
FScreenBufferValid := False; Exclude(FScreenBufferState, sbsValid);
end; end;
procedure TfrmMain.PrepareScreenBlock(ABlockInfo: PBlockInfo); procedure TfrmMain.PrepareScreenBlock(ABlockInfo: PBlockInfo);
@ -1791,14 +1801,17 @@ var
begin begin
tileRect := GetSelectedRect; tileRect := GetSelectedRect;
if not FScreenBufferValid then if not (sbsValid in FScreenBufferState) then
RebuildScreenBuffer; RebuildScreenBuffer;
if not FScreenBufferIndexed then if not (sbsIndexed in FScreenBufferState) then
begin begin
FScreenBuffer.UpdateShortcuts; FScreenBuffer.UpdateShortcuts;
FScreenBufferIndexed := True; Include(FScreenBufferState, sbsIndexed);
end; end;
if not (sbsFiltered in FScreenBufferState) then
UpdateFilter;
{if acFilter.Checked then {if acFilter.Checked then
staticsFilter := @frmFilter.Filter staticsFilter := @frmFilter.Filter
@ -2060,7 +2073,7 @@ var
cell: TMapCell; cell: TMapCell;
begin begin
PrepareScreenBlock(FScreenBuffer.UpdateSortOrder(AMapCell)); PrepareScreenBlock(FScreenBuffer.UpdateSortOrder(AMapCell));
FScreenBufferIndexed := False; Exclude(FScreenBufferState, sbsIndexed);
//Find surrounding cells //Find surrounding cells
current := nil; current := nil;
@ -2102,7 +2115,7 @@ procedure TfrmMain.OnStaticElevated(AStaticItem: TStaticItem);
begin begin
AStaticItem.PrioritySolver := FScreenBuffer.GetSerial; AStaticItem.PrioritySolver := FScreenBuffer.GetSerial;
PrepareScreenBlock(FScreenBuffer.UpdateSortOrder(AStaticItem)); PrepareScreenBlock(FScreenBuffer.UpdateSortOrder(AStaticItem));
FScreenBufferIndexed := False; Exclude(FScreenBufferState, sbsIndexed);
end; end;
procedure TfrmMain.OnStaticHued(AStaticItem: TStaticItem); procedure TfrmMain.OnStaticHued(AStaticItem: TStaticItem);
@ -2277,8 +2290,7 @@ begin
PrepareScreenBlock(blockInfo); PrepareScreenBlock(blockInfo);
FScreenBuffer.UpdateShortcuts; FScreenBuffer.UpdateShortcuts;
FScreenBufferValid := True; FScreenBufferState := [sbsValid, sbsIndexed];
FScreenBufferIndexed := True;
end; end;
procedure TfrmMain.UpdateCurrentTile; procedure TfrmMain.UpdateCurrentTile;
@ -2327,6 +2339,31 @@ begin
end; end;
end; end;
procedure TfrmMain.UpdateFilter;
var
blockInfo: PBlockInfo;
begin
blockInfo := nil;
while FScreenBuffer.Iterate(blockInfo) do
begin
if blockInfo^.State in [ssNormal, ssFiltered] then
begin
blockInfo^.State := ssNormal;
if (blockInfo^.Item.Z < frmBoundaries.tbMinZ.Position) or
(blockInfo^.Item.Z > frmBoundaries.tbMaxZ.Position) then
begin
blockInfo^.State := ssFiltered;
end else
if tbFilter.Down and (blockInfo^.Item is TStaticItem) and
(not frmFilter.Filter(TStaticItem(blockInfo^.Item))) then
begin
blockInfo^.State := ssFiltered;
end;
end;
end;
Include(FScreenBufferState, sbsFiltered);
end;
procedure TfrmMain.UpdateSelection; procedure TfrmMain.UpdateSelection;
var var
selectedRect: TRect; selectedRect: TRect;