unit Forms.Main; interface uses System.Bindings.Expression, System.Classes, System.Generics.Collections, Vcl.ActnList, Vcl.ComCtrls, Vcl.Controls, Vcl.ExtCtrls, Vcl.Forms, Vcl.Imaging.pngimage, Vcl.ImgList, Vcl.Mask, Vcl.Menus, Vcl.StdCtrls, Vcl.ToolWin, JvExControls, JvExMask, JvGradient, JvGroupHeader, JvSpin, VirtualTrees, X2CLGraphicList, X2CLMenuBar, X2CLmusikCubeMenuBarPainter, Game.Base, Game.Intf; type TMainForm = class(TForm) actGameAdd: TAction; actGameRemove: TAction; actMapAdd: TAction; actMapDown: TAction; actMapRemove: TAction; actMapUp: TAction; alMain: TActionList; btnClose: TButton; btnLaunch: TButton; btnSave: TButton; bvlButtons: TBevel; edtMessageOfTheDay: TEdit; edtServerName: TEdit; gbPorts: TGroupBox; gbServerName: TGroupBox; gcMenu: TX2GraphicContainer; gcMenuAbout: TX2GraphicContainerItem; gcMenuGames: TX2GraphicContainerItem; gcMenuMaplist: TX2GraphicContainerItem; gcMenuNetwork: TX2GraphicContainerItem; gcMenuSettings: TX2GraphicContainerItem; gcToolbar: TX2GraphicContainer; gcToolbaradd: TX2GraphicContainerItem; gcToolbardown: TX2GraphicContainerItem; gcToolbarremove: TX2GraphicContainerItem; gcToolbarup: TX2GraphicContainerItem; glMenu: TX2GraphicList; glToolbar: TX2GraphicList; grdMenu: TJvGradient; imgGamesWarning: TImage; imgLogo: TImage; lblChivalry: TLabel; lblGamesWarning: TLabel; lblGentleface: TLabel; lblJCL: TLabel; lblMessageOfTheDay: TLabel; lblPeerPort: TLabel; lblPixelophilia: TLabel; lblQueryPort: TLabel; lblServerName: TLabel; lblServerPort: TLabel; lblSuperObject: TLabel; lblVirtualTreeview: TLabel; llChivalry: TLinkLabel; llGentleface: TLinkLabel; llGentlefaceCC: TLinkLabel; llJCL: TLinkLabel; llPixelophilia: TLinkLabel; llPixelophiliaCC: TLinkLabel; llSuperObject: TLinkLabel; llVirtualTreeview: TLinkLabel; mbMenu: TX2MenuBar; mbpMenuPainter: TX2MenuBarmusikCubePainter; pcMain: TPageControl; pmnLaunch: TPopupMenu; pmnLaunchCopyCmdLine: TMenuItem; pnlButtons: TPanel; pnlGamesWarning: TPanel; pnlLogo: TPanel; sePeerPort: TJvSpinEdit; seQueryPort: TJvSpinEdit; seServerPort: TJvSpinEdit; shpLogo: TShape; shpMenu: TShape; tbGameAdd: TToolButton; tbGameRemove: TToolButton; tbGames: TToolBar; tbMapAdd: TToolButton; tbMapDown: TToolButton; tbMapRemove: TToolButton; tbMapSep1: TToolButton; tbMapUp: TToolButton; ToolBar1: TToolBar; tsAbout: TTabSheet; tsConfiguration: TTabSheet; tsGames: TTabSheet; tsMapList: TTabSheet; tsNetwork: TTabSheet; vstGames: TVirtualStringTree; vstMapList: TVirtualStringTree; actLaunch: TAction; actCopyCmdLine: TAction; actSave: TAction; actClose: TAction; 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); procedure vstGamesGetText(Sender: TBaseVirtualTree; Node: PVirtualNode; Column: TColumnIndex; TextType: TVSTTextType; var CellText: string); procedure vstGamesFocusChanged(Sender: TBaseVirtualTree; Node: PVirtualNode; Column: TColumnIndex); procedure vstMapListGetText(Sender: TBaseVirtualTree; Node: PVirtualNode; Column: TColumnIndex; TextType: TVSTTextType; var CellText: string); procedure actMapAddExecute(Sender: TObject); procedure actCloseExecute(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 UpdateMenu; procedure UpdateGameList; procedure UpdateMapList; 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, Forms.Map, Game.Chivalry.MedievalWarfare, Game.List, Persist.GameList, Resources; 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 = '>'; GameColumnName = 0; GameColumnLocation = 1; MapColumnName = 0; MapColumnCategory = 1; {$R *.dfm} { TMainForm } procedure TMainForm.FormCreate(Sender: TObject); var lightBtnFace: TColor; pageIndex: Integer; menuGroup: TX2MenuBarGroup; menuItem: TX2MenuBarItem; userGamesFileName: string; begin FUIBindings := TBindingExpressionList.Create; FPageMenuMap := TPageMenuMap.Create(pcMain.PageCount); vstGames.NodeDataSize := SizeOf(TCustomGame); vstMapList.NodeDataSize := SizeOf(TCustomGame); { 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; { Load games } userGamesFileName := Resources.GetUserDataPath(Resources.UserGamesFileName); if FileExists(userGamesFileName) then TGameListPersist.Load(userGamesFileName, TGameList.Instance) else TGameList.Instance.AutoDetect; UpdateGameList; // #ToDo1 -oMvR: 30-6-2014: load last active game if TGameList.Instance.Count > 0 then ActiveGame := TGameList.Instance.First; { 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; vstMapList.Clear; if Assigned(ActiveGame) and (not ActiveGame.Loaded) then ActiveGame.Load; // #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 UpdateMapList; 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.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.UpdateGameList; begin vstGames.RootNodeCount := TGameList.Instance.Count; pnlGamesWarning.Visible := (TGameList.Instance.Count = 0); end; procedure TMainForm.UpdateMapList; begin if Assigned(ActiveGame) then vstMapList.RootNodeCount := (ActiveGame as IGameMapList).GetMapList.Count else vstMapList.Clear; 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 TGameList.Instance.Add(game); // #ToDo1 -oMvR: 30-6-2014: move to shared spot TGameListPersist.Save(Resources.GetUserDataPath(Resources.UserGamesFileName), TGameList.Instance); UpdateGameList; ActiveGame := game; end; end; procedure TMainForm.actGameRemoveExecute(Sender: TObject); var gameIndex: Integer; game: TCustomGame; begin if not Assigned(vstGames.FocusedNode) then exit; gameIndex := vstGames.FocusedNode^.Index; if MessageBox(Self.Handle, 'Do you want to remove the selected game?', 'Remove', MB_YESNO or MB_ICONQUESTION) = ID_YES then begin vstGames.BeginUpdate; try game := TGameList.Instance[gameIndex]; TGameList.Instance.Delete(gameIndex); if game = ActiveGame then begin if TGameList.Instance.Count > 0 then ActiveGame := TGameList.Instance.First else ActiveGame := nil; end; // #ToDo1 -oMvR: 30-6-2014: move to shared spot TGameListPersist.Save(Resources.GetUserDataPath(Resources.UserGamesFileName), TGameList.Instance); UpdateGameList; finally vstGames.EndUpdate; end; end; end; procedure TMainForm.vstGamesGetText(Sender: TBaseVirtualTree; Node: PVirtualNode; Column: TColumnIndex; TextType: TVSTTextType; var CellText: string); var game: TCustomGame; begin game := TGameList.Instance[Node^.Index]; case Column of GameColumnName: CellText := game.GameName; GameColumnLocation: CellText := game.Location; end; end; procedure TMainForm.vstGamesFocusChanged(Sender: TBaseVirtualTree; Node: PVirtualNode; Column: TColumnIndex); begin actGameRemove.Enabled := Assigned(Sender.FocusedNode); end; procedure TMainForm.vstMapListGetText(Sender: TBaseVirtualTree; Node: PVirtualNode; Column: TColumnIndex; TextType: TVSTTextType; var CellText: string); var map: TGameMap; begin if not Assigned(ActiveGame) then exit; map := (ActiveGame as IGameMapList).GetMapList[Node^.Index]; case Column of MapColumnName: CellText := map.DisplayName; MapColumnCategory: CellText := map.Category; end; end; procedure TMainForm.actMapAddExecute(Sender: TObject); var mapList: IGameMapList; map: TGameMap; begin mapList := ActiveGame as IGameMapList; if TMapForm.Insert(Self, mapList, map) then begin mapList.GetMapList.Add(map); UpdateMapList; end; end; procedure TMainForm.actCloseExecute(Sender: TObject); begin Close; 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.