- Added Keyboard movement to oglGameWindow (fixes #5)

This commit is contained in:
Andreas Schneider 2009-12-07 16:26:47 +01:00
parent 09bd74675e
commit c0b5051b00
3 changed files with 44 additions and 16 deletions

View File

@ -319,7 +319,8 @@
<CompilerMessages> <CompilerMessages>
<IgnoredMessages idx5024="True"/> <IgnoredMessages idx5024="True"/>
</CompilerMessages> </CompilerMessages>
<CustomOptions Value="-FE../bin/ "/> <CustomOptions Value="-FE../bin/
"/>
<CompilerPath Value="$(CompPath)"/> <CompilerPath Value="$(CompPath)"/>
</Other> </Other>
</CompilerOptions> </CompilerOptions>

View File

@ -614,11 +614,11 @@ object frmMain: TfrmMain
end end
object tsClients: TTabSheet object tsClients: TTabSheet
Caption = 'Clients' Caption = 'Clients'
ClientHeight = 495 ClientHeight = 492
ClientWidth = 218 ClientWidth = 218
object lbClients: TListBox object lbClients: TListBox
Left = 0 Left = 0
Height = 495 Height = 492
Top = 0 Top = 0
Width = 218 Width = 218
Align = alClient Align = alClient
@ -632,7 +632,7 @@ object frmMain: TfrmMain
end end
object tsLocations: TTabSheet object tsLocations: TTabSheet
Caption = 'Locations' Caption = 'Locations'
ClientHeight = 495 ClientHeight = 492
ClientWidth = 218 ClientWidth = 218
object btnClearLocations: TSpeedButton object btnClearLocations: TSpeedButton
AnchorSideLeft.Control = btnDeleteLocation AnchorSideLeft.Control = btnDeleteLocation
@ -641,7 +641,7 @@ object frmMain: TfrmMain
Left = 128 Left = 128
Height = 22 Height = 22
Hint = 'Clear' Hint = 'Clear'
Top = 453 Top = 450
Width = 23 Width = 23
BorderSpacing.Left = 4 BorderSpacing.Left = 4
Color = clBtnFace Color = clBtnFace
@ -694,7 +694,7 @@ object frmMain: TfrmMain
Left = 101 Left = 101
Height = 22 Height = 22
Hint = 'Delete' Hint = 'Delete'
Top = 453 Top = 450
Width = 23 Width = 23
Anchors = [akLeft, akBottom] Anchors = [akLeft, akBottom]
BorderSpacing.Bottom = 4 BorderSpacing.Bottom = 4
@ -746,7 +746,7 @@ object frmMain: TfrmMain
Left = 74 Left = 74
Height = 22 Height = 22
Hint = 'Add' Hint = 'Add'
Top = 453 Top = 450
Width = 23 Width = 23
Anchors = [akTop, akRight] Anchors = [akTop, akRight]
BorderSpacing.Right = 4 BorderSpacing.Right = 4
@ -800,7 +800,7 @@ object frmMain: TfrmMain
AnchorSideBottom.Control = btnDeleteLocation AnchorSideBottom.Control = btnDeleteLocation
Cursor = 63 Cursor = 63
Left = 4 Left = 4
Height = 431 Height = 428
Top = 18 Top = 18
Width = 210 Width = 210
Anchors = [akTop, akLeft, akRight, akBottom] Anchors = [akTop, akLeft, akRight, akBottom]
@ -1146,6 +1146,7 @@ object frmMain: TfrmMain
Width = 542 Width = 542
Anchors = [akTop, akLeft, akRight, akBottom] Anchors = [akTop, akLeft, akRight, akBottom]
OnDblClick = oglGameWindowDblClick OnDblClick = oglGameWindowDblClick
OnKeyDown = oglGameWindowKeyDown
OnMouseDown = oglGameWindowMouseDown OnMouseDown = oglGameWindowMouseDown
OnMouseEnter = oglGameWindowMouseEnter OnMouseEnter = oglGameWindowMouseEnter
OnMouseLeave = oglGameWindowMouseLeave OnMouseLeave = oglGameWindowMouseLeave

View File

@ -209,6 +209,8 @@ type
procedure mnuRegionControlClick(Sender: TObject); procedure mnuRegionControlClick(Sender: TObject);
procedure mnuShutdownClick(Sender: TObject); procedure mnuShutdownClick(Sender: TObject);
procedure oglGameWindowDblClick(Sender: TObject); procedure oglGameWindowDblClick(Sender: TObject);
procedure oglGameWindowKeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
procedure oglGameWindowMouseDown(Sender: TObject; Button: TMouseButton; procedure oglGameWindowMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer); Shift: TShiftState; X, Y: Integer);
procedure oglGameWindowMouseEnter(Sender: TObject); procedure oglGameWindowMouseEnter(Sender: TObject);
@ -309,6 +311,7 @@ type
function GetSelectedRect: TRect; function GetSelectedRect: TRect;
procedure InitRender; procedure InitRender;
procedure InitSize; procedure InitSize;
procedure MoveBy(AOffsetX, AOffsetY: Integer); inline;
procedure PrepareMapCell(AMapCell: TMapCell); procedure PrepareMapCell(AMapCell: TMapCell);
procedure PrepareScreenBlock(ABlockInfo: PBlockInfo); procedure PrepareScreenBlock(ABlockInfo: PBlockInfo);
procedure ProcessToolState; procedure ProcessToolState;
@ -362,7 +365,7 @@ uses
UfrmBoundaries, UfrmElevateSettings, UfrmConfirmation, UfrmMoveSettings, UfrmBoundaries, UfrmElevateSettings, UfrmConfirmation, UfrmMoveSettings,
UfrmAbout, UPacketHandlers, UfrmHueSettings, UfrmRadar, UfrmLargeScaleCommand, UfrmAbout, UPacketHandlers, UfrmHueSettings, UfrmRadar, UfrmLargeScaleCommand,
UfrmLogin, UResourceManager, UfrmVirtualLayer, UfrmFilter, UfrmTileInfo, UfrmLogin, UResourceManager, UfrmVirtualLayer, UfrmFilter, UfrmTileInfo,
UfrmRegionControl, Logging, LConvEncoding; UfrmRegionControl, Logging, LConvEncoding, LCLType;
type type
TGLArrayf4 = array[0..3] of GLfloat; TGLArrayf4 = array[0..3] of GLfloat;
@ -472,6 +475,29 @@ begin
btnAddRandomClick(Sender); btnAddRandomClick(Sender);
end; end;
procedure TfrmMain.oglGameWindowKeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
begin
case Key of
VK_W, VK_NUMPAD8, VK_UP:
MoveBy(-8, -8);
VK_S, VK_NUMPAD2, VK_DOWN:
MoveBy(8, 8);
VK_A, VK_NUMPAD4, VK_LEFT:
MoveBy(-8, 8);
VK_D, VK_NUMPAD6, VK_RIGHT:
MoveBy(8, -8);
VK_Q, VK_NUMPAD7:
MoveBy(-8, 0);
VK_E, VK_NUMPAD9:
MoveBy(0, -8);
VK_Y, VK_NUMPAD1:
MoveBy(0, 8);
VK_C, VK_NUMPAD3:
MoveBy(8, 0);
end;
end;
procedure TfrmMain.oglGameWindowMouseDown(Sender: TObject; procedure TfrmMain.oglGameWindowMouseDown(Sender: TObject;
Button: TMouseButton; Shift: TShiftState; X, Y: Integer); Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin begin
@ -1345,13 +1371,6 @@ begin
end; end;
procedure TfrmMain.tmMovementTimer(Sender: TObject); procedure TfrmMain.tmMovementTimer(Sender: TObject);
procedure MoveBy(AOffsetX, AOffsetY: Integer);
begin
SetPos(EnsureRange(FX + AOffsetX, 0, FLandscape.CellWidth - 1),
EnsureRange(FY + AOffsetY, 0, FLandscape.CellHeight - 1));
end;
begin begin
case FOverlayUI.ActiveArrow of case FOverlayUI.ActiveArrow of
0: MoveBy(-8, 0); 0: MoveBy(-8, 0);
@ -1832,6 +1851,13 @@ begin
glLoadIdentity; glLoadIdentity;
end; end;
procedure TfrmMain.MoveBy(AOffsetX, AOffsetY: Integer); inline;
begin
SetPos(EnsureRange(FX + AOffsetX, 0, FLandscape.CellWidth - 1),
EnsureRange(FY + AOffsetY, 0, FLandscape.CellHeight - 1));
UpdateCurrentTile;
end;
procedure TfrmMain.PrepareMapCell(AMapCell: TMapCell); procedure TfrmMain.PrepareMapCell(AMapCell: TMapCell);
var var
current, north, east, west: PBlockInfo; current, north, east, west: PBlockInfo;