- 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>
<IgnoredMessages idx5024="True"/>
</CompilerMessages>
<CustomOptions Value="-FE../bin/ "/>
<CustomOptions Value="-FE../bin/
"/>
<CompilerPath Value="$(CompPath)"/>
</Other>
</CompilerOptions>

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]
@ -1146,6 +1146,7 @@ object frmMain: TfrmMain
Width = 542
Anchors = [akTop, akLeft, akRight, akBottom]
OnDblClick = oglGameWindowDblClick
OnKeyDown = oglGameWindowKeyDown
OnMouseDown = oglGameWindowMouseDown
OnMouseEnter = oglGameWindowMouseEnter
OnMouseLeave = oglGameWindowMouseLeave

View File

@ -209,6 +209,8 @@ type
procedure mnuRegionControlClick(Sender: TObject);
procedure mnuShutdownClick(Sender: TObject);
procedure oglGameWindowDblClick(Sender: TObject);
procedure oglGameWindowKeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
procedure oglGameWindowMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure oglGameWindowMouseEnter(Sender: TObject);
@ -309,6 +311,7 @@ type
function GetSelectedRect: TRect;
procedure InitRender;
procedure InitSize;
procedure MoveBy(AOffsetX, AOffsetY: Integer); inline;
procedure PrepareMapCell(AMapCell: TMapCell);
procedure PrepareScreenBlock(ABlockInfo: PBlockInfo);
procedure ProcessToolState;
@ -362,7 +365,7 @@ uses
UfrmBoundaries, UfrmElevateSettings, UfrmConfirmation, UfrmMoveSettings,
UfrmAbout, UPacketHandlers, UfrmHueSettings, UfrmRadar, UfrmLargeScaleCommand,
UfrmLogin, UResourceManager, UfrmVirtualLayer, UfrmFilter, UfrmTileInfo,
UfrmRegionControl, Logging, LConvEncoding;
UfrmRegionControl, Logging, LConvEncoding, LCLType;
type
TGLArrayf4 = array[0..3] of GLfloat;
@ -472,6 +475,29 @@ begin
btnAddRandomClick(Sender);
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;
Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
@ -1345,13 +1371,6 @@ begin
end;
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
case FOverlayUI.ActiveArrow of
0: MoveBy(-8, 0);
@ -1832,6 +1851,13 @@ begin
glLoadIdentity;
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);
var
current, north, east, west: PBlockInfo;