aksdb
/
CentrED
1
0
Fork 0
Code Issues 2 Pull Requests Releases Wiki Activity

- Added option to set the render background to white (fixes #59)

This commit is contained in:
Andreas Schneider 2009-12-23 20:54:56 +01:00
parent 46d045a46b
commit f2764e928e
3 changed files with 18 additions and 3 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
Client/CentrED.lpi
View File

@ -356,7 +356,7 @@
<Linking> <Linking>
<Debugging> <Debugging>
<UseLineInfoUnit Value="False"/> <UseLineInfoUnit Value="False"/>
<UseExternalDbgSyms Value="True"/> <StripSymbols Value="True"/>
</Debugging> </Debugging>
<LinkSmart Value="True"/> <LinkSmart Value="True"/>
<Options> <Options>

7
Client/UfrmMain.lfm
View File

@ -16,7 +16,7 @@ object frmMain: TfrmMain
OnCreate = FormCreate OnCreate = FormCreate
OnDestroy = FormDestroy OnDestroy = FormDestroy
Position = poScreenCenter 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 ShowInTaskBar = stAlways
LCLVersion = '0.9.29' LCLVersion = '0.9.29'
WindowState = wsMaximized WindowState = wsMaximized
@ -1447,6 +1447,11 @@ object frmMain: TfrmMain
Checked = True Checked = True
Hint = 'Ask for permission before processing area commands.' Hint = 'Ask for permission before processing area commands.'
end end
object mnuWhiteBackground: TMenuItem
AutoCheck = True
Caption = '&White Background'
OnClick = mnuWhiteBackgroundClick
end
end end
object mnuHelp: TMenuItem object mnuHelp: TMenuItem
Caption = '&?' Caption = '&?'

10
Client/UfrmMain.pas
View File

@ -99,6 +99,7 @@ type
lblY: TLabel; lblY: TLabel;
lbClients: TListBox; lbClients: TListBox;
MainMenu1: TMainMenu; MainMenu1: TMainMenu;
mnuWhiteBackground: TMenuItem;
mnuSecurityQuestion: TMenuItem; mnuSecurityQuestion: TMenuItem;
mnuShowAnimations: TMenuItem; mnuShowAnimations: TMenuItem;
mnuSettings: TMenuItem; mnuSettings: TMenuItem;
@ -228,6 +229,7 @@ type
procedure mnuRegionControlClick(Sender: TObject); procedure mnuRegionControlClick(Sender: TObject);
procedure mnuShowAnimationsClick(Sender: TObject); procedure mnuShowAnimationsClick(Sender: TObject);
procedure mnuShutdownClick(Sender: TObject); procedure mnuShutdownClick(Sender: TObject);
procedure mnuWhiteBackgroundClick(Sender: TObject);
procedure oglGameWindowDblClick(Sender: TObject); procedure oglGameWindowDblClick(Sender: TObject);
procedure oglGameWindowKeyDown(Sender: TObject; var Key: Word; procedure oglGameWindowKeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState); Shift: TShiftState);
@ -509,6 +511,11 @@ begin
dmNetwork.Send(TQuitServerPacket.Create('')); dmNetwork.Send(TQuitServerPacket.Create(''));
end; end;
procedure TfrmMain.mnuWhiteBackgroundClick(Sender: TObject);
begin
FRepaintNeeded := True;
end;
procedure TfrmMain.oglGameWindowDblClick(Sender: TObject); procedure TfrmMain.oglGameWindowDblClick(Sender: TObject);
begin begin
if (acSelect.Checked) and (CurrentTile <> nil) then if (acSelect.Checked) and (CurrentTile <> nil) then
@ -1403,6 +1410,9 @@ end;
procedure TfrmMain.oglGameWindowPaint(Sender: TObject); procedure TfrmMain.oglGameWindowPaint(Sender: TObject);
begin begin
if mnuWhiteBackground.Checked then
glClearColor(1, 1, 1, 1)
else
glClearColor(0, 0, 0, 1); glClearColor(0, 0, 0, 1);
glClear(GL_COLOR_BUFFER_BIT); glClear(GL_COLOR_BUFFER_BIT);