- Changed TVirtualTile to inherit directly from TWorldItem

- Added FRepaintNeeded to minimize unnecessary repaints
This commit is contained in:
Andreas Schneider 2009-09-29 16:06:52 +02:00
parent 0cee996fbc
commit 94d77d4a00
2 changed files with 35 additions and 17 deletions

View File

@ -614,11 +614,11 @@ object frmMain: TfrmMain
end
object tsClients: TTabSheet
Caption = 'Clients'
ClientHeight = 495
ClientHeight = 492
ClientWidth = 218
object lbClients: TListBox
Left = 0
Height = 495
Height = 492
Top = 0
Width = 218
Align = alClient
@ -632,7 +632,7 @@ object frmMain: TfrmMain
end
object tsLocations: TTabSheet
Caption = 'Locations'
ClientHeight = 495
ClientHeight = 492
ClientWidth = 218
object btnClearLocations: TSpeedButton
AnchorSideLeft.Control = btnDeleteLocation
@ -641,7 +641,7 @@ object frmMain: TfrmMain
Left = 128
Height = 22
Hint = 'Clear'
Top = 453
Top = 450
Width = 23
BorderSpacing.Left = 4
Color = clBtnFace
@ -694,7 +694,7 @@ object frmMain: TfrmMain
Left = 101
Height = 22
Hint = 'Delete'
Top = 453
Top = 450
Width = 23
Anchors = [akLeft, akBottom]
BorderSpacing.Bottom = 4
@ -746,7 +746,7 @@ object frmMain: TfrmMain
Left = 74
Height = 22
Hint = 'Add'
Top = 453
Top = 450
Width = 23
Anchors = [akTop, akRight]
BorderSpacing.Right = 4
@ -800,7 +800,7 @@ object frmMain: TfrmMain
AnchorSideBottom.Control = btnDeleteLocation
Cursor = 63
Left = 4
Height = 431
Height = 428
Top = 18
Width = 210
Anchors = [akTop, akLeft, akRight, akBottom]
@ -2418,7 +2418,7 @@ object frmMain: TfrmMain
end
object pmClients: TPopupMenu
left = 184
top = 168
top = 176
object mnuGoToClient: TMenuItem
Caption = 'GoTo'
Default = True
@ -2431,12 +2431,12 @@ object frmMain: TfrmMain
OnTimer = tmMovementTimer
OnStartTimer = tmMovementTimer
left = 232
top = 64
top = 80
end
object ActionList1: TActionList
Images = ImageList1
left = 264
top = 64
top = 80
object acSelect: TAction
Category = 'Tools'
Caption = 'Select'
@ -2536,14 +2536,14 @@ object frmMain: TfrmMain
Enabled = False
Interval = 250
OnTimer = tmGrabTileInfoTimer
left = 367
top = 64
left = 368
top = 80
end
object tmTileHint: TTimer
Enabled = False
OnTimer = tmTileHintTimer
left = 185
top = 200
left = 184
top = 224
end
object pmGrabTileInfo: TPopupMenu
OnPopup = pmGrabTileInfoPopup

View File

@ -38,7 +38,7 @@ uses
type
TVirtualTile = class(TStaticItem);
TVirtualTile = class(TWorldItem);
TAccessChangedListener = procedure(AAccessLevel: TAccessLevel) of object;
TScreenBufferState = (sbsValid, sbsIndexed, sbsFiltered);
@ -288,6 +288,7 @@ type
FRandomPresetLocation: string;
FLastDraw: TDateTime;
FAccessChangedListeners: array of TAccessChangedListener;
FRepaintNeeded: Boolean;
{ Methods }
procedure BuildTileList;
function ConfirmAction: Boolean;
@ -370,6 +371,9 @@ type
Name: string;
end;
const
CScreenBufferValid = [sbsValid, sbsIndexed, sbsFiltered];
{ TfrmMain }
procedure TfrmMain.mnuExitClick(Sender: TObject);
@ -461,6 +465,8 @@ begin
if acSelect.Checked then //***** Selection Mode *****//
tmGrabTileInfo.Enabled := True;
FRepaintNeeded := True;
end;
procedure TfrmMain.oglGameWindowMouseEnter(Sender: TObject);
@ -476,6 +482,8 @@ begin
frmFilter.Hide;
frmFilter.Locked := False;
end;
FRepaintNeeded := True;
end;
procedure TfrmMain.oglGameWindowMouseLeave(Sender: TObject);
@ -488,6 +496,8 @@ begin
CurrentTile := nil;
FOverlayUI.Visible := False;
end;
FRepaintNeeded := True;
end;
procedure TfrmMain.oglGameWindowMouseMove(Sender: TObject; Shift: TShiftState;
@ -514,6 +524,8 @@ begin
CurrentTile := nil;
UpdateCurrentTile(X, Y);
FRepaintNeeded := True;
end;
procedure TfrmMain.oglGameWindowMouseUp(Sender: TObject; Button: TMouseButton;
@ -684,6 +696,7 @@ begin
end;
end;
SelectedTile := nil;
FRepaintNeeded := True;
end;
procedure TfrmMain.oglGameWindowMouseWheel(Sender: TObject; Shift: TShiftState;
@ -721,6 +734,8 @@ begin
SetCursorPos(Mouse.CursorPos.X, Mouse.CursorPos.Y - 4 * WheelDelta);
UpdateCurrentTile(MousePos.X, MousePos.Y - 4 * WheelDelta);
end;
FRepaintNeeded := True;
end;
procedure TfrmMain.FormCreate(Sender: TObject);
@ -852,10 +867,13 @@ end;
procedure TfrmMain.ApplicationProperties1Idle(Sender: TObject; var Done: Boolean);
begin
if MilliSecondsBetween(FLastDraw, Now) > 30 then
if (FScreenBufferState <> CScreenBufferValid) or
(FRepaintNeeded and (MilliSecondsBetween(Now, FLastDraw) > 50)) then
begin
Logger.Send([lcClient, lcDebug], 'Repainting Game Window');
oglGameWindow.Repaint;
FLastDraw := Now;
FRepaintNeeded := False;
end;
Sleep(1);
Done := False;
@ -2291,7 +2309,7 @@ begin
virtualTile := TVirtualTile(FVirtualTiles[i]);
end else
begin
virtualTile := TVirtualTile.Create(nil, nil, 0, 0);
virtualTile := TVirtualTile.Create(nil);
FVirtualTiles.Add(virtualTile);
end;