- Fixed WheelDelta not being adjusted right

This commit is contained in:
Andreas Schneider 2008-09-06 23:08:50 +02:00
parent cc8eee1b1b
commit 7399b13fd0
4 changed files with 54 additions and 49 deletions

View File

@ -40,7 +40,7 @@
<MinVersion Major="4" Minor="5" Release="1" Valid="True"/> <MinVersion Major="4" Minor="5" Release="1" Valid="True"/>
</Item4> </Item4>
</RequiredPackages> </RequiredPackages>
<Units Count="29"> <Units Count="30">
<Unit0> <Unit0>
<Filename Value="CentrED.lpr"/> <Filename Value="CentrED.lpr"/>
<IsPartOfProject Value="True"/> <IsPartOfProject Value="True"/>
@ -244,6 +244,11 @@
<IsPartOfProject Value="True"/> <IsPartOfProject Value="True"/>
<UnitName Value="UAdminHandling"/> <UnitName Value="UAdminHandling"/>
</Unit28> </Unit28>
<Unit29>
<Filename Value="UOpenGLUI.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="UOpenGLUI"/>
</Unit29>
</Units> </Units>
</ProjectOptions> </ProjectOptions>
<CompilerOptions> <CompilerOptions>

View File

@ -48,7 +48,6 @@ uses
begin begin
Application.Initialize; Application.Initialize;
Application.CreateForm(TdmNetwork, dmNetwork); Application.CreateForm(TdmNetwork, dmNetwork);
//Application.CreateForm(TfrmMain, frmMain);
Application.Run; Application.Run;
end. end.

View File

@ -5,7 +5,7 @@ object frmMain: TfrmMain
Width = 766 Width = 766
ActiveControl = pcLeft ActiveControl = pcLeft
Caption = 'UO CentrED' Caption = 'UO CentrED'
ClientHeight = 578 ClientHeight = 580
ClientWidth = 766 ClientWidth = 766
Constraints.MinHeight = 603 Constraints.MinHeight = 603
Constraints.MinWidth = 766 Constraints.MinWidth = 766
@ -21,7 +21,7 @@ object frmMain: TfrmMain
WindowState = wsMaximized WindowState = wsMaximized
object pnlBottom: TPanel object pnlBottom: TPanel
Height = 31 Height = 31
Top = 547 Top = 549
Width = 766 Width = 766
Align = alBottom Align = alBottom
BevelOuter = bvNone BevelOuter = bvNone
@ -110,7 +110,7 @@ object frmMain: TfrmMain
end end
end end
object pcLeft: TPageControl object pcLeft: TPageControl
Height = 523 Height = 525
Top = 24 Top = 24
Width = 224 Width = 224
ActivePage = tsTiles ActivePage = tsTiles
@ -120,16 +120,16 @@ object frmMain: TfrmMain
TabOrder = 1 TabOrder = 1
object tsTiles: TTabSheet object tsTiles: TTabSheet
Caption = 'Tiles' Caption = 'Tiles'
ClientHeight = 494 ClientHeight = 500
ClientWidth = 220 ClientWidth = 222
ParentFont = True ParentFont = True
object pnlTileListSettings: TPanel object pnlTileListSettings: TPanel
Height = 56 Height = 56
Width = 220 Width = 222
Align = alTop Align = alTop
BevelOuter = bvNone BevelOuter = bvNone
ClientHeight = 56 ClientHeight = 56
ClientWidth = 220 ClientWidth = 222
ParentFont = True ParentFont = True
TabOrder = 0 TabOrder = 0
object lblFilter: TLabel object lblFilter: TLabel
@ -143,9 +143,9 @@ object frmMain: TfrmMain
end end
object cbTerrain: TCheckBox object cbTerrain: TCheckBox
Left = 4 Left = 4
Height = 21 Height = 18
Top = 8 Top = 8
Width = 60 Width = 57
Caption = 'Terrain' Caption = 'Terrain'
Checked = True Checked = True
OnChange = cbTerrainChange OnChange = cbTerrainChange
@ -155,9 +155,9 @@ object frmMain: TfrmMain
end end
object cbStatics: TCheckBox object cbStatics: TCheckBox
Left = 4 Left = 4
Height = 21 Height = 18
Top = 32 Top = 32
Width = 59 Width = 56
Caption = 'Statics' Caption = 'Statics'
Checked = True Checked = True
OnChange = cbStaticsChange OnChange = cbStaticsChange
@ -177,9 +177,9 @@ object frmMain: TfrmMain
end end
object vdtTiles: TVirtualDrawTree object vdtTiles: TVirtualDrawTree
Tag = 1 Tag = 1
Height = 240 Height = 246
Top = 56 Top = 56
Width = 220 Width = 222
Align = alClient Align = alClient
DefaultNodeHeight = 44 DefaultNodeHeight = 44
DragMode = dmAutomatic DragMode = dmAutomatic
@ -221,20 +221,20 @@ object frmMain: TfrmMain
end end
object gbRandom: TGroupBox object gbRandom: TGroupBox
Height = 193 Height = 193
Top = 301 Top = 307
Width = 220 Width = 222
Align = alBottom Align = alBottom
Caption = 'Random pool' Caption = 'Random pool'
ClientHeight = 178 ClientHeight = 179
ClientWidth = 216 ClientWidth = 220
ParentFont = True ParentFont = True
TabOrder = 2 TabOrder = 2
object vdtRandom: TVirtualDrawTree object vdtRandom: TVirtualDrawTree
Tag = 1 Tag = 1
Cursor = 63 Cursor = 63
Height = 126 Height = 127
Top = 22 Top = 22
Width = 216 Width = 220
Align = alClient Align = alClient
DefaultNodeHeight = 44 DefaultNodeHeight = 44
DragType = dtVCL DragType = dtVCL
@ -268,11 +268,11 @@ object frmMain: TfrmMain
end end
object pnlRandomControl: TPanel object pnlRandomControl: TPanel
Height = 22 Height = 22
Width = 216 Width = 220
Align = alTop Align = alTop
BevelOuter = bvNone BevelOuter = bvNone
ClientHeight = 22 ClientHeight = 22
ClientWidth = 216 ClientWidth = 220
ParentFont = True ParentFont = True
TabOrder = 1 TabOrder = 1
object btnAddRandom: TSpeedButton object btnAddRandom: TSpeedButton
@ -420,13 +420,13 @@ object frmMain: TfrmMain
object pnlRandomPreset: TPanel object pnlRandomPreset: TPanel
Left = 4 Left = 4
Height = 22 Height = 22
Top = 152 Top = 153
Width = 208 Width = 212
Align = alBottom Align = alBottom
BorderSpacing.Around = 4 BorderSpacing.Around = 4
BevelOuter = bvNone BevelOuter = bvNone
ClientHeight = 22 ClientHeight = 22
ClientWidth = 208 ClientWidth = 212
ParentFont = True ParentFont = True
TabOrder = 2 TabOrder = 2
object btnRandomPresetSave: TSpeedButton object btnRandomPresetSave: TSpeedButton
@ -526,10 +526,8 @@ object frmMain: TfrmMain
ParentShowHint = False ParentShowHint = False
end end
object cbRandomPreset: TComboBox object cbRandomPreset: TComboBox
Height = 29 Height = 25
Width = 152 Width = 152
AutoCompleteText = [cbactEndOfLineComplete, cbactSearchAscending]
MaxLength = 0
OnChange = cbRandomPresetChange OnChange = cbRandomPresetChange
ParentFont = True ParentFont = True
Style = csDropDownList Style = csDropDownList
@ -540,8 +538,8 @@ object frmMain: TfrmMain
object spTileList: TSplitter object spTileList: TSplitter
Cursor = crVSplit Cursor = crVSplit
Height = 5 Height = 5
Top = 296 Top = 302
Width = 220 Width = 222
Align = alBottom Align = alBottom
ResizeAnchor = akBottom ResizeAnchor = akBottom
end end
@ -563,12 +561,12 @@ object frmMain: TfrmMain
end end
object tsClients: TTabSheet object tsClients: TTabSheet
Caption = 'Clients' Caption = 'Clients'
ClientHeight = 494 ClientHeight = 498
ClientWidth = 220 ClientWidth = 222
ParentFont = True ParentFont = True
object lbClients: TListBox object lbClients: TListBox
Height = 494 Height = 498
Width = 220 Width = 222
Align = alClient Align = alClient
OnDblClick = mnuGoToClientClick OnDblClick = mnuGoToClientClick
ParentFont = True ParentFont = True
@ -580,15 +578,15 @@ object frmMain: TfrmMain
end end
object tsLocations: TTabSheet object tsLocations: TTabSheet
Caption = 'Locations' Caption = 'Locations'
ClientHeight = 494 ClientHeight = 498
ClientWidth = 220 ClientWidth = 222
ParentFont = True ParentFont = True
object vstLocations: TVirtualStringTree object vstLocations: TVirtualStringTree
Cursor = 63 Cursor = 63
Left = 4 Left = 4
Height = 458 Height = 462
Top = 4 Top = 4
Width = 212 Width = 214
Align = alClient Align = alClient
BorderSpacing.Around = 4 BorderSpacing.Around = 4
BorderStyle = bsSingle BorderStyle = bsSingle
@ -614,20 +612,20 @@ object frmMain: TfrmMain
end end
item item
Position = 1 Position = 1
Width = 137 Width = 135
WideText = 'Name' WideText = 'Name'
end> end>
end end
object pnlLocationControls: TPanel object pnlLocationControls: TPanel
Left = 4 Left = 4
Height = 24 Height = 24
Top = 466 Top = 470
Width = 212 Width = 214
Align = alBottom Align = alBottom
BorderSpacing.Around = 4 BorderSpacing.Around = 4
BevelOuter = bvNone BevelOuter = bvNone
ClientHeight = 24 ClientHeight = 24
ClientWidth = 212 ClientWidth = 214
ParentFont = True ParentFont = True
TabOrder = 1 TabOrder = 1
object btnClearLocations: TSpeedButton object btnClearLocations: TSpeedButton
@ -951,17 +949,17 @@ object frmMain: TfrmMain
end end
object pnlMain: TPanel object pnlMain: TPanel
Left = 224 Left = 224
Height = 523 Height = 525
Top = 24 Top = 24
Width = 542 Width = 542
Align = alClient Align = alClient
BevelOuter = bvNone BevelOuter = bvNone
ClientHeight = 523 ClientHeight = 525
ClientWidth = 542 ClientWidth = 542
ParentFont = True ParentFont = True
TabOrder = 3 TabOrder = 3
object oglGameWindow: TOpenGLControl object oglGameWindow: TOpenGLControl
Height = 372 Height = 374
Width = 542 Width = 542
Align = alClient Align = alClient
OnDblClick = oglGameWindowDblClick OnDblClick = oglGameWindowDblClick
@ -975,7 +973,7 @@ object frmMain: TfrmMain
end end
object pnlChatHeader: TPanel object pnlChatHeader: TPanel
Height = 24 Height = 24
Top = 372 Top = 374
Width = 542 Width = 542
Align = alBottom Align = alBottom
BevelInner = bvRaised BevelInner = bvRaised
@ -1003,7 +1001,7 @@ object frmMain: TfrmMain
end end
object pnlChat: TPanel object pnlChat: TPanel
Height = 122 Height = 122
Top = 401 Top = 403
Width = 542 Width = 542
Align = alBottom Align = alBottom
BevelOuter = bvNone BevelOuter = bvNone
@ -1060,7 +1058,7 @@ object frmMain: TfrmMain
object spChat: TSplitter object spChat: TSplitter
Cursor = crVSplit Cursor = crVSplit
Height = 5 Height = 5
Top = 396 Top = 398
Width = 542 Width = 542
Align = alBottom Align = alBottom
AutoSnap = False AutoSnap = False

View File

@ -665,6 +665,9 @@ procedure TfrmMain.oglGameWindowMouseWheel(Sender: TObject; Shift: TShiftState;
var var
cursorNeedsUpdate: Boolean; cursorNeedsUpdate: Boolean;
begin begin
//We want single steps ...
WheelDelta := WheelDelta div WHEEL_DELTA;
cursorNeedsUpdate := False; cursorNeedsUpdate := False;
if (CurrentTile is TVirtualTile) or ((ssCtrl in Shift) and (frmVirtualLayer.cbShowLayer.Checked)) then if (CurrentTile is TVirtualTile) or ((ssCtrl in Shift) and (frmVirtualLayer.cbShowLayer.Checked)) then
begin begin