- Added option to set the render background to white (fixes #59)
This commit is contained in:
parent
46d045a46b
commit
f2764e928e
|
@ -356,7 +356,7 @@
|
|||
<Linking>
|
||||
<Debugging>
|
||||
<UseLineInfoUnit Value="False"/>
|
||||
<UseExternalDbgSyms Value="True"/>
|
||||
<StripSymbols Value="True"/>
|
||||
</Debugging>
|
||||
<LinkSmart Value="True"/>
|
||||
<Options>
|
||||
|
|
|
@ -16,7 +16,7 @@ object frmMain: TfrmMain
|
|||
OnCreate = FormCreate
|
||||
OnDestroy = FormDestroy
|
||||
Position = poScreenCenter
|
||||
SessionProperties = 'acFlat.Checked;acNoDraw.Checked;Height;Left;mnuFlatShowHeight.Checked;mnuSecurityQuestion.Checked;mnuShowAnimations.Checked;tbStatics.Down;tbTerrain.Down;Top;Width;WindowState;spTileList.Top'
|
||||
SessionProperties = 'acFlat.Checked;acNoDraw.Checked;Height;Left;mnuFlatShowHeight.Checked;mnuSecurityQuestion.Checked;mnuShowAnimations.Checked;spTileList.Top;tbStatics.Down;tbTerrain.Down;Top;Width;WindowState;mnuWhiteBackground.Checked'
|
||||
ShowInTaskBar = stAlways
|
||||
LCLVersion = '0.9.29'
|
||||
WindowState = wsMaximized
|
||||
|
@ -1447,6 +1447,11 @@ object frmMain: TfrmMain
|
|||
Checked = True
|
||||
Hint = 'Ask for permission before processing area commands.'
|
||||
end
|
||||
object mnuWhiteBackground: TMenuItem
|
||||
AutoCheck = True
|
||||
Caption = '&White Background'
|
||||
OnClick = mnuWhiteBackgroundClick
|
||||
end
|
||||
end
|
||||
object mnuHelp: TMenuItem
|
||||
Caption = '&?'
|
||||
|
|
|
@ -99,6 +99,7 @@ type
|
|||
lblY: TLabel;
|
||||
lbClients: TListBox;
|
||||
MainMenu1: TMainMenu;
|
||||
mnuWhiteBackground: TMenuItem;
|
||||
mnuSecurityQuestion: TMenuItem;
|
||||
mnuShowAnimations: TMenuItem;
|
||||
mnuSettings: TMenuItem;
|
||||
|
@ -228,6 +229,7 @@ type
|
|||
procedure mnuRegionControlClick(Sender: TObject);
|
||||
procedure mnuShowAnimationsClick(Sender: TObject);
|
||||
procedure mnuShutdownClick(Sender: TObject);
|
||||
procedure mnuWhiteBackgroundClick(Sender: TObject);
|
||||
procedure oglGameWindowDblClick(Sender: TObject);
|
||||
procedure oglGameWindowKeyDown(Sender: TObject; var Key: Word;
|
||||
Shift: TShiftState);
|
||||
|
@ -509,6 +511,11 @@ begin
|
|||
dmNetwork.Send(TQuitServerPacket.Create(''));
|
||||
end;
|
||||
|
||||
procedure TfrmMain.mnuWhiteBackgroundClick(Sender: TObject);
|
||||
begin
|
||||
FRepaintNeeded := True;
|
||||
end;
|
||||
|
||||
procedure TfrmMain.oglGameWindowDblClick(Sender: TObject);
|
||||
begin
|
||||
if (acSelect.Checked) and (CurrentTile <> nil) then
|
||||
|
@ -1403,6 +1410,9 @@ end;
|
|||
|
||||
procedure TfrmMain.oglGameWindowPaint(Sender: TObject);
|
||||
begin
|
||||
if mnuWhiteBackground.Checked then
|
||||
glClearColor(1, 1, 1, 1)
|
||||
else
|
||||
glClearColor(0, 0, 0, 1);
|
||||
glClear(GL_COLOR_BUFFER_BIT);
|
||||
|
||||
|
|
Loading…
Reference in New Issue