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; TPageMenuMap = TDictionary; 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.