503 lines
13 KiB
ObjectPascal
503 lines
13 KiB
ObjectPascal
unit Forms.Main;
|
|
|
|
interface
|
|
uses
|
|
System.Bindings.Expression,
|
|
System.Classes,
|
|
System.Generics.Collections,
|
|
Vcl.ComCtrls,
|
|
Vcl.Controls,
|
|
Vcl.ExtCtrls,
|
|
Vcl.Forms,
|
|
Vcl.Imaging.pngimage,
|
|
Vcl.ImgList,
|
|
Vcl.Mask,
|
|
Vcl.StdCtrls,
|
|
Vcl.ToolWin,
|
|
|
|
JvExControls,
|
|
JvExMask,
|
|
JvGradient,
|
|
JvGroupHeader,
|
|
JvSpin,
|
|
VirtualTrees,
|
|
X2CLGraphicList,
|
|
X2CLMenuBar,
|
|
X2CLmusikCubeMenuBarPainter,
|
|
|
|
Game.Base,
|
|
Game.Intf, Vcl.ActnList;
|
|
|
|
|
|
type
|
|
TMainForm = class(TForm)
|
|
edtMessageOfTheDay: TEdit;
|
|
edtServerName: TEdit;
|
|
gbPorts: TGroupBox;
|
|
gbServerName: TGroupBox;
|
|
gcMenu: TX2GraphicContainer;
|
|
gcMenuAbout: TX2GraphicContainerItem;
|
|
gcMenuGames: TX2GraphicContainerItem;
|
|
gcMenuMaplist: TX2GraphicContainerItem;
|
|
gcMenuNetwork: TX2GraphicContainerItem;
|
|
gcMenuSettings: TX2GraphicContainerItem;
|
|
gcToolbar: TX2GraphicContainer;
|
|
gcToolbaradd: TX2GraphicContainerItem;
|
|
gcToolbarremove: TX2GraphicContainerItem;
|
|
glMenu: TX2GraphicList;
|
|
glToolbar: TX2GraphicList;
|
|
grdMenu: TJvGradient;
|
|
imgGamesWarning: TImage;
|
|
imgLogo: TImage;
|
|
lblChivalry: TLabel;
|
|
lblPixelophilia: TLabel;
|
|
lblGamesWarning: TLabel;
|
|
lblGentleface: TLabel;
|
|
lblJCL: TLabel;
|
|
lblMessageOfTheDay: TLabel;
|
|
lblPeerPort: TLabel;
|
|
lblQueryPort: TLabel;
|
|
lblServerName: TLabel;
|
|
lblServerPort: TLabel;
|
|
lblVirtualTreeview: TLabel;
|
|
llChivalry: TLinkLabel;
|
|
llPixelophilia: TLinkLabel;
|
|
llGentleface: TLinkLabel;
|
|
llPixelophiliaCC: TLinkLabel;
|
|
llGentlefaceCC: TLinkLabel;
|
|
llJCL: TLinkLabel;
|
|
llVirtualTreeview: TLinkLabel;
|
|
mbMenu: TX2MenuBar;
|
|
mbpMenuPainter: TX2MenuBarmusikCubePainter;
|
|
pcMain: TPageControl;
|
|
pnlLogo: TPanel;
|
|
pnlGamesWarning: TPanel;
|
|
sePeerPort: TJvSpinEdit;
|
|
seQueryPort: TJvSpinEdit;
|
|
seServerPort: TJvSpinEdit;
|
|
shpMenu: TShape;
|
|
tbGames: TToolBar;
|
|
tbGameAdd: TToolButton;
|
|
tbGameRemove: TToolButton;
|
|
tsAbout: TTabSheet;
|
|
tsConfiguration: TTabSheet;
|
|
tsGames: TTabSheet;
|
|
tsMapList: TTabSheet;
|
|
tsNetwork: TTabSheet;
|
|
vstMapList: TVirtualStringTree;
|
|
VirtualStringTree2: TVirtualStringTree;
|
|
alMain: TActionList;
|
|
actGameAdd: TAction;
|
|
actGameRemove: TAction;
|
|
lblSuperObject: TLabel;
|
|
llSuperObject: TLinkLabel;
|
|
|
|
procedure FormCreate(Sender: TObject);
|
|
procedure FormDestroy(Sender: TObject);
|
|
procedure mbMenuCollapsing(Sender: TObject; Group: TX2MenuBarGroup; var Allowed: Boolean);
|
|
procedure mbMenuSelectedChanged(Sender: TObject; Item: TX2CustomMenuBarItem);
|
|
procedure llLinkClick(Sender: TObject; const Link: string; LinkType: TSysLinkType);
|
|
procedure SpinEditChange(Sender: TObject);
|
|
procedure EditChange(Sender: TObject);
|
|
procedure actGameAddExecute(Sender: TObject);
|
|
procedure actGameRemoveExecute(Sender: TObject);
|
|
private type
|
|
TBindingExpressionList = TList<TBindingExpression>;
|
|
TPageMenuMap = TDictionary<TTabSheet, TX2MenuBarItem>;
|
|
private
|
|
FActiveGame: TCustomGame;
|
|
FPageMenuMap: TPageMenuMap;
|
|
FUIBindings: TBindingExpressionList;
|
|
|
|
procedure SetActiveGame(const Value: TCustomGame);
|
|
protected
|
|
procedure ActiveGameChanged;
|
|
|
|
procedure ClearUIBindings;
|
|
procedure Bind(const APropertyName: string; ADestObject: TObject; const ADestPropertyName: string);
|
|
procedure BindGameNetwork;
|
|
procedure BindGameName;
|
|
procedure BindGameMapList;
|
|
procedure UpdateMenu;
|
|
|
|
property ActiveGame: TCustomGame read FActiveGame write SetActiveGame;
|
|
property PageMenuMap: TPageMenuMap read FPageMenuMap;
|
|
property UIBindings: TBindingExpressionList read FUIBindings;
|
|
end;
|
|
|
|
|
|
implementation
|
|
uses
|
|
System.Bindings.Helper,
|
|
System.Math,
|
|
System.StrUtils,
|
|
System.SysUtils,
|
|
System.Types,
|
|
Vcl.Graphics,
|
|
Vcl.GraphUtil,
|
|
Vcl.Themes,
|
|
Winapi.ShellAPI,
|
|
Winapi.Windows,
|
|
|
|
X2UtGraphics,
|
|
|
|
Forms.Game,
|
|
Game.Chivalry.MedievalWarfare,
|
|
Game.List,
|
|
Persist.GameList;
|
|
|
|
|
|
type
|
|
TINIHintWindow = class(THintWindow)
|
|
protected
|
|
function IsINIHint(const AHint: string): Boolean;
|
|
function GetINIHint(const AHint: string; out ASection, AKey: string): Boolean;
|
|
|
|
procedure Paint; override;
|
|
public
|
|
function CalcHintRect(MaxWidth: Integer; const AHint: string; AData: Pointer): TRect; override;
|
|
end;
|
|
|
|
|
|
const
|
|
INIHintPrefix = 'INI:';
|
|
INIHintSeparator = '>';
|
|
|
|
|
|
{$R *.dfm}
|
|
|
|
|
|
{ TMainForm }
|
|
procedure TMainForm.FormCreate(Sender: TObject);
|
|
var
|
|
lightBtnFace: TColor;
|
|
pageIndex: Integer;
|
|
menuGroup: TX2MenuBarGroup;
|
|
menuItem: TX2MenuBarItem;
|
|
// game: TCustomGame;
|
|
|
|
begin
|
|
FUIBindings := TBindingExpressionList.Create;
|
|
FPageMenuMap := TPageMenuMap.Create(pcMain.PageCount);
|
|
|
|
|
|
{ Configure pages }
|
|
for pageIndex := 0 to Pred(pcMain.PageCount) do
|
|
pcMain.Pages[pageIndex].TabVisible := False;
|
|
|
|
pageIndex := 0;
|
|
|
|
for menuGroup in mbMenu.Groups do
|
|
for menuItem in menuGroup.Items do
|
|
begin
|
|
Assert(pageIndex < pcMain.PageCount);
|
|
|
|
FPageMenuMap.Add(pcMain.Pages[pageIndex], menuItem);
|
|
menuItem.Tag := pageIndex;
|
|
Inc(pageIndex);
|
|
end;
|
|
|
|
|
|
{ Eye-candy }
|
|
lightBtnFace := BlendColors(clBtnFace, clWindow, 196);
|
|
pnlGamesWarning.Color := lightBtnFace;
|
|
|
|
// #ToDo1 -oMvR: 30-6-2014: load last active game
|
|
// game := TChivalryMedievalWarfareGame.Create('D:\Steam\steamapps\common\chivalry_ded_server');
|
|
// game.Load;
|
|
// ActiveGame := game;
|
|
|
|
|
|
{ Initialize menu }
|
|
mbpMenuPainter.GroupColors.Hot.Assign(mbpMenuPainter.GroupColors.Normal);
|
|
|
|
mbMenu.SelectFirst;
|
|
end;
|
|
|
|
|
|
procedure TMainForm.FormDestroy(Sender: TObject);
|
|
begin
|
|
ClearUIBindings;
|
|
|
|
FreeAndNil(FPageMenuMap);
|
|
FreeAndNil(FUIBindings);
|
|
end;
|
|
|
|
|
|
procedure TMainForm.ActiveGameChanged;
|
|
begin
|
|
ClearUIBindings;
|
|
|
|
// #ToDo1 -oMvR: 30-6-2014: attach observer to monitor changes
|
|
|
|
if Supports(ActiveGame, IGameNetwork) then
|
|
BindGameNetwork;
|
|
|
|
if Supports(ActiveGame, IGameName) then
|
|
BindGameName;
|
|
|
|
if Supports(ActiveGame, IGameMapList) then
|
|
BindGameMapList;
|
|
|
|
UpdateMenu;
|
|
end;
|
|
|
|
|
|
procedure TMainForm.ClearUIBindings;
|
|
var
|
|
binding: TBindingExpression;
|
|
|
|
begin
|
|
for binding in UIBindings do
|
|
TBindings.RemoveBinding(binding);
|
|
|
|
UIBindings.Clear;
|
|
end;
|
|
|
|
|
|
procedure TMainForm.Bind(const APropertyName: string; ADestObject: TObject; const ADestPropertyName: string);
|
|
begin
|
|
{ Source -> Destination }
|
|
UIBindings.Add(TBindings.CreateManagedBinding(
|
|
[TBindings.CreateAssociationScope([Associate(ActiveGame, 'src')])],
|
|
'src.' + APropertyName,
|
|
|
|
[TBindings.CreateAssociationScope([Associate(ADestObject, 'dst')])],
|
|
'dst.' + ADestPropertyName,
|
|
|
|
nil, nil, [coNotifyOutput, coEvaluate]));
|
|
|
|
{ Destination -> Source }
|
|
UIBindings.Add(TBindings.CreateManagedBinding(
|
|
[TBindings.CreateAssociationScope([Associate(ADestObject, 'src')])],
|
|
'src.' + ADestPropertyName,
|
|
|
|
[TBindings.CreateAssociationScope([Associate(ActiveGame, 'dst')])],
|
|
'dst.' + APropertyName,
|
|
|
|
nil, nil, [coNotifyOutput]));
|
|
end;
|
|
|
|
|
|
procedure TMainForm.BindGameNetwork;
|
|
begin
|
|
Bind('ServerPort', seServerPort, 'Value');
|
|
Bind('PeerPort', sePeerPort, 'Value');
|
|
Bind('QueryPort', seQueryPort, 'Value');
|
|
end;
|
|
|
|
|
|
procedure TMainForm.BindGameName;
|
|
begin
|
|
Bind('ServerName', edtServerName, 'Text');
|
|
Bind('MessageOfTheDay', edtMessageOfTheDay, 'Text');
|
|
end;
|
|
|
|
|
|
procedure TMainForm.BindGameMapList;
|
|
begin
|
|
// #ToDo1 -oMvR: 30-6-2014: load map list
|
|
end;
|
|
|
|
|
|
procedure TMainForm.UpdateMenu;
|
|
|
|
procedure EnablePageByInterface(APage: TTabSheet; AInterface: TGUID);
|
|
begin
|
|
PageMenuMap[APage].Enabled := Supports(ActiveGame, AInterface);
|
|
end;
|
|
|
|
begin
|
|
EnablePageByInterface(tsNetwork, IGameNetwork);
|
|
EnablePageByInterface(tsConfiguration, IGameName);
|
|
EnablePageByInterface(tsMapList, IGameMapList);
|
|
|
|
if Assigned(mbMenu.SelectedItem) and (not mbMenu.SelectedItem.Enabled) then
|
|
mbMenu.SelectFirst;
|
|
end;
|
|
|
|
|
|
procedure TMainForm.SetActiveGame(const Value: TCustomGame);
|
|
begin
|
|
if Value <> FActiveGame then
|
|
begin
|
|
FActiveGame := Value;
|
|
ActiveGameChanged;
|
|
end;
|
|
end;
|
|
|
|
|
|
procedure TMainForm.mbMenuCollapsing(Sender: TObject; Group: TX2MenuBarGroup; var Allowed: Boolean);
|
|
begin
|
|
Allowed := False;
|
|
end;
|
|
|
|
|
|
procedure TMainForm.mbMenuSelectedChanged(Sender: TObject; Item: TX2CustomMenuBarItem);
|
|
begin
|
|
pcMain.ActivePageIndex := Item.Tag;
|
|
end;
|
|
|
|
|
|
procedure TMainForm.llLinkClick(Sender: TObject; const Link: string; LinkType: TSysLinkType);
|
|
begin
|
|
ShellExecute(0, 'open', PChar(Link), nil, nil, SW_SHOWNORMAL);
|
|
end;
|
|
|
|
|
|
procedure TMainForm.SpinEditChange(Sender: TObject);
|
|
begin
|
|
TBindings.Notify(Sender, 'Value');
|
|
end;
|
|
|
|
|
|
procedure TMainForm.EditChange(Sender: TObject);
|
|
begin
|
|
TBindings.Notify(Sender, 'Text');
|
|
end;
|
|
|
|
|
|
procedure TMainForm.actGameAddExecute(Sender: TObject);
|
|
var
|
|
game: TCustomGame;
|
|
|
|
begin
|
|
if TGameForm.Insert(Self, game) then
|
|
begin
|
|
//
|
|
end;
|
|
end;
|
|
|
|
|
|
procedure TMainForm.actGameRemoveExecute(Sender: TObject);
|
|
begin
|
|
//
|
|
end;
|
|
|
|
|
|
{ TINIHintWindow }
|
|
function TINIHintWindow.CalcHintRect(MaxWidth: Integer; const AHint: string; AData: Pointer): TRect;
|
|
var
|
|
section: string;
|
|
key: string;
|
|
sectionRect: TRect;
|
|
|
|
begin
|
|
if GetINIHint(AHint, section, key) then
|
|
begin
|
|
Canvas.Font.Style := [fsBold];
|
|
try
|
|
sectionRect := inherited CalcHintRect(MaxWidth, section, AData);
|
|
finally
|
|
Canvas.Font.Style := [];
|
|
end;
|
|
|
|
Result := inherited CalcHintRect(MaxWidth, key, AData);
|
|
|
|
Result.Right := Max(Result.Right, sectionRect.Right);
|
|
Inc(Result.Bottom, RectHeight(sectionRect));
|
|
end else
|
|
Result := inherited CalcHintRect(MaxWidth, AHint, AData);
|
|
end;
|
|
|
|
|
|
procedure TINIHintWindow.Paint;
|
|
var
|
|
section: string;
|
|
key: string;
|
|
textRect: TRect;
|
|
clipRect: TRect;
|
|
elementColor: TColor;
|
|
elementDetails: TThemedElementDetails;
|
|
gradientStart: TColor;
|
|
gradientEnd: TColor;
|
|
textColor: TColor;
|
|
|
|
begin
|
|
if GetINIHint(Caption, section, key) then
|
|
begin
|
|
textRect := ClientRect;
|
|
textColor := Screen.HintFont.Color;
|
|
|
|
if StyleServices.Enabled then
|
|
begin
|
|
clipRect := textRect;
|
|
InflateRect(textRect, 4, 4);
|
|
if TOSVersion.Check(6) and StyleServices.IsSystemStyle then
|
|
begin
|
|
// Paint Windows gradient background
|
|
StyleServices.DrawElement(Canvas.Handle, StyleServices.GetElementDetails(tttStandardNormal), textRect, clipRect);
|
|
end else
|
|
begin
|
|
elementDetails := StyleServices.GetElementDetails(thHintNormal);
|
|
if StyleServices.GetElementColor(elementDetails, ecGradientColor1, elementColor) and (elementColor <> clNone) then
|
|
gradientStart := elementColor
|
|
else
|
|
gradientStart := clInfoBk;
|
|
if StyleServices.GetElementColor(elementDetails, ecGradientColor2, elementColor) and (elementColor <> clNone) then
|
|
gradientEnd := elementColor
|
|
else
|
|
gradientEnd := clInfoBk;
|
|
if StyleServices.GetElementColor(elementDetails, ecTextColor, elementColor) and (elementColor <> clNone) then
|
|
textColor := elementColor
|
|
else
|
|
textColor := Screen.HintFont.Color;
|
|
GradientFillCanvas(Canvas, gradientStart, gradientEnd, textRect, gdVertical);
|
|
end;
|
|
|
|
textRect := clipRect;
|
|
end;
|
|
|
|
Inc(textRect.Left, 2);
|
|
Inc(textRect.Top, 2);
|
|
|
|
Canvas.Font.Color := textColor;
|
|
Canvas.Font.Style := [fsBold];
|
|
try
|
|
DrawText(Canvas.Handle, section, -1, textRect, DT_LEFT or DT_NOPREFIX or DT_WORDBREAK or DrawTextBiDiModeFlagsReadingOnly);
|
|
Inc(textRect.Top, Canvas.TextHeight(section) + 2);
|
|
finally
|
|
Canvas.Font.Style := [];
|
|
end;
|
|
|
|
DrawText(Canvas.Handle, key, -1, textRect, DT_LEFT or DT_NOPREFIX or DT_WORDBREAK or DrawTextBiDiModeFlagsReadingOnly);
|
|
end else
|
|
inherited Paint;
|
|
end;
|
|
|
|
|
|
function TINIHintWindow.IsINIHint(const AHint: string): Boolean;
|
|
begin
|
|
Result := AnsiStartsText(INIHintPrefix, AHint);
|
|
end;
|
|
|
|
|
|
function TINIHintWindow.GetINIHint(const AHint: string; out ASection, AKey: string): Boolean;
|
|
var
|
|
hint: string;
|
|
separatorPos: Integer;
|
|
|
|
begin
|
|
Result := IsINIHint(AHint);
|
|
if Result then
|
|
begin
|
|
hint := Copy(AHint, Succ(Length(INIHintPrefix)), MaxInt);
|
|
ASection := '';
|
|
AKey := hint;
|
|
|
|
separatorPos := Pos(INIHintSeparator, hint);
|
|
if separatorPos > 0 then
|
|
begin
|
|
ASection := hint;
|
|
SetLength(ASection, Pred(separatorPos));
|
|
Delete(AKey, 1, Pred(separatorPos) + Length(INIHintSeparator));
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
|
|
initialization
|
|
HintWindowClass := TINIHintWindow;
|
|
|
|
end.
|