unit Forms.Main; interface uses System.Bindings.Expression, System.Classes, System.Generics.Collections, System.Types, Vcl.ActnList, Vcl.ComCtrls, Vcl.Controls, Vcl.ExtCtrls, Vcl.Forms, Vcl.Graphics, Vcl.Imaging.jpeg, Vcl.Imaging.pngimage, Vcl.ImgList, Vcl.Mask, Vcl.Menus, Vcl.StdCtrls, Vcl.ToolWin, Winapi.ActiveX, JvExControls, JvExMask, JvGradient, JvGroupHeader, JvSpin, VirtualTrees, X2CLGraphicList, X2CLMenuBar, X2CLmusikCubeMenuBarPainter, Frame.MapPreview, Game.Base, Game.Intf; type TMainForm = class(TForm) 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; tbMapList: TToolBar; tsAbout: TTabSheet; tsConfiguration: TTabSheet; tsGames: TTabSheet; tsMapList: TTabSheet; tsNetwork: TTabSheet; vstGames: TVirtualStringTree; vstMapList: TVirtualStringTree; actLaunch: TAction; actCopyCmdLine: TAction; actSave: TAction; actClose: TAction; alMapList: TActionList; alGames: TActionList; actGameAdd: TAction; actGameRemove: TAction; pnlMapListSidebar: TPanel; frmMapPreview: TMapPreviewFrame; tbGamesSep1: TToolButton; tbGameActive: TToolButton; actGameActive: TAction; gcToolbaractive: TX2GraphicContainerItem; btnMapListSave: TButton; btnMapListLoad: TButton; actMapListLoad: TAction; actMapListSave: TAction; btnRevert: TButton; actRevert: TAction; llWebsite: TLinkLabel; lblProductName: TLabel; lblCopyright: TLabel; gbPassword: TGroupBox; lblGamePassword: TLabel; edtGamePassword: TEdit; lblAdminPassword: TLabel; edtAdminPassword: TEdit; cbShowPasswords: TCheckBox; procedure FormCreate(Sender: TObject); procedure FormDestroy(Sender: TObject); procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean); 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 actCloseExecute(Sender: TObject); procedure actSaveExecute(Sender: TObject); procedure actRevertExecute(Sender: TObject); procedure actLaunchExecute(Sender: TObject); procedure actCopyCmdLineExecute(Sender: TObject); procedure actGameAddExecute(Sender: TObject); procedure actGameRemoveExecute(Sender: TObject); procedure actGameActiveExecute(Sender: TObject); procedure vstGamesGetText(Sender: TBaseVirtualTree; Node: PVirtualNode; Column: TColumnIndex; TextType: TVSTTextType; var CellText: string); procedure vstGamesPaintText(Sender: TBaseVirtualTree; const TargetCanvas: TCanvas; Node: PVirtualNode; Column: TColumnIndex; TextType: TVSTTextType); procedure vstGamesFocusChanged(Sender: TBaseVirtualTree; Node: PVirtualNode; Column: TColumnIndex); procedure vstGamesDblClick(Sender: TObject); procedure vstMapListGetText(Sender: TBaseVirtualTree; Node: PVirtualNode; Column: TColumnIndex; TextType: TVSTTextType; var CellText: string); procedure vstMapListChange(Sender: TBaseVirtualTree; Node: PVirtualNode); procedure vstMapListDragOver(Sender: TBaseVirtualTree; Source: TObject; Shift: TShiftState; State: TDragState; Pt: TPoint; Mode: TDropMode; var Effect: Integer; var Accept: Boolean); procedure vstMapListDragDrop(Sender: TBaseVirtualTree; Source: TObject; DataObject: IDataObject; Formats: TFormatArray; Shift: TShiftState; Pt: TPoint; var Effect: Integer; Mode: TDropMode); procedure vstMapListFocusChanged(Sender: TBaseVirtualTree; Node: PVirtualNode; Column: TColumnIndex); procedure actMapAddExecute(Sender: TObject); procedure actMapRemoveExecute(Sender: TObject); procedure actMapUpExecute(Sender: TObject); procedure actMapDownExecute(Sender: TObject); procedure cbShowPasswordsClick(Sender: TObject); private type TBindingExpressionList = TList; TPageMenuDictionary = TDictionary; private FActiveGame: TCustomGame; FPageMenuMap: TPageMenuDictionary; FUIBindings: TBindingExpressionList; function GetModified: Boolean; procedure SetActiveGame(const Value: TCustomGame); procedure SetModified(const Value: Boolean); protected procedure EnablePageActions; procedure ActiveGameChanged; procedure SaveActiveGame; procedure RevertActiveGame; procedure ClearUIBindings; procedure Bind(const APropertyName: string; ADestObject: TObject; const ADestPropertyName: string); procedure BindGameNetwork; procedure BindGameName; procedure BindGamePassword; procedure UpdateMenu; procedure UpdateGameList; procedure UpdateMapList; procedure SaveGameList; function FindMapNode(AMap: TGameMap): PVirtualNode; procedure HandleMapSelection(ANodes: TNodeArray; ATargetIndex: Integer; ACopy: Boolean); procedure MoveMapSelection(ANodes: TNodeArray; ATargetIndex: Integer); procedure CopyMapSelection(ANodes: TNodeArray; ATargetIndex: Integer); property ActiveGame: TCustomGame read FActiveGame write SetActiveGame; property PageMenuMap: TPageMenuDictionary read FPageMenuMap; property UIBindings: TBindingExpressionList read FUIBindings; public property Modified: Boolean read GetModified write SetModified; end; implementation uses System.Bindings.Helper, System.Math, System.StrUtils, System.SysUtils, Vcl.Clipbrd, Vcl.GraphUtil, Vcl.Themes, Winapi.ShellAPI, Winapi.Windows, X2UtApp, 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 := TPageMenuDictionary.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; lblProductName.Caption := App.Version.FormatVersion(False, True); lblCopyright.Caption := App.Version.Strings.LegalCopyright; { 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.FormCloseQuery(Sender: TObject; var CanClose: Boolean); begin if Modified then CanClose := (MessageBox(Self.Handle, 'Your changes will not be saved. Do you want to exit?', 'Close', MB_YESNO or MB_ICONQUESTION) = ID_YES); end; procedure TMainForm.EnablePageActions; const ActionListState: array[Boolean] of TActionListState = (asSuspended, asNormal); begin { Prevent shortcuts from triggering on invisible pages } alMapList.State := ActionListState[pcMain.ActivePage = tsMapList]; alGames.State := ActionListState[pcMain.ActivePage = tsGames]; end; procedure TMainForm.ActiveGameChanged; begin ClearUIBindings; vstMapList.Clear; if Assigned(ActiveGame) and (not ActiveGame.Loaded) then ActiveGame.Load; { Bind Modified property } UIBindings.Add(TBindings.CreateManagedBinding( [TBindings.CreateAssociationScope([Associate(ActiveGame, 'src')])], 'src.Modified', [TBindings.CreateAssociationScope([Associate(Self, 'dst')])], 'dst.Modified', nil, nil, [coNotifyOutput, coEvaluate])); if Supports(ActiveGame, IGameNetwork) then BindGameNetwork; if Supports(ActiveGame, IGameName) then BindGameName; if Supports(ActiveGame, IGamePassword) then BindGamePassword; if Supports(ActiveGame, IGameMapList) then UpdateMapList; UpdateMenu; end; procedure TMainForm.SaveActiveGame; begin if Assigned(ActiveGame) then ActiveGame.Save; end; procedure TMainForm.RevertActiveGame; begin if Assigned(ActiveGame) then begin ActiveGame.Load; // #ToDo2 -oMvR: 2-7-2014: This should be based on the observer pattern used by TBindings, // but I haven't figured out how that works yet. For now, manually refresh. UpdateMapList; end; 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.BindGamePassword; begin Bind('GamePassword', edtGamePassword, 'Text'); Bind('AdminPassword', edtAdminPassword, 'Text'); end; procedure TMainForm.cbShowPasswordsClick(Sender: TObject); const PasswordChar: array[Boolean] of Char = ('*', #0); begin edtGamePassword.PasswordChar := PasswordChar[cbShowPasswords.Checked]; edtAdminPassword.PasswordChar := PasswordChar[cbShowPasswords.Checked]; 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); gbPassword.Visible := Supports(ActiveGame, IGamePassword); 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; var gameMapList: IGameMapList; begin vstMapList.BeginUpdate; try if Supports(ActiveGame, IGameMapList, gameMapList) then vstMapList.RootNodeCount := gameMapList.MapCount else vstMapList.Clear; finally vstMapList.EndUpdate; end; end; procedure TMainForm.SaveGameList; begin TGameListPersist.Save(Resources.GetUserDataPath(Resources.UserGamesFileName), TGameList.Instance); UpdateGameList; end; function TMainForm.FindMapNode(AMap: TGameMap): PVirtualNode; var gameMapList: IGameMapList; begin Result := nil; if not Supports(ActiveGame, IGameMapList, gameMapList) then exit; Result := vstMapList.IterateSubtree(nil, procedure(Sender: TBaseVirtualTree; Node: PVirtualNode; Data: Pointer; var Abort: Boolean) begin Abort := (gameMapList.Map[Node^.Index] = AMap); end, nil); end; procedure TMainForm.HandleMapSelection(ANodes: TNodeArray; ATargetIndex: Integer; ACopy: Boolean); var gameMapList: IGameMapList; node: PVirtualNode; targetIndex: Integer; sourceShift: Integer; sourceIndex: Integer; newIndex: Integer; selectedMaps: TList; map: TGameMap; begin if (ATargetIndex < 0) or (Cardinal(ATargetIndex) > vstMapList.RootNodeCount) then exit; if not Supports(ActiveGame, IGameMapList, gameMapList) then exit; targetIndex := ATargetIndex; sourceShift := 0; vstMapList.BeginUpdate; try selectedMaps := TList.Create; try for node in ANodes do begin sourceIndex := node^.Index; if ACopy then begin { Copy map nodes } Inc(sourceIndex, sourceShift); map := TGameMap.Create(gameMapList.Map[sourceIndex]); gameMapList.InsertMap(targetIndex, map); selectedMaps.Add(map); Inc(targetIndex); if sourceIndex > ATargetIndex then Inc(sourceShift); end else begin { Move map nodes } if sourceIndex < ATargetIndex then Inc(sourceIndex, sourceShift); if targetIndex > sourceIndex then begin newIndex := Pred(targetIndex); Dec(sourceShift); end else begin newIndex := targetIndex; Inc(targetIndex); end; selectedMaps.Add(gameMapList.Map[sourceIndex]); gameMapList.MoveMap(sourceIndex, newIndex); end; end; vstMapList.ClearSelection; vstMapList.IterateSubtree(nil, procedure(Sender: TBaseVirtualTree; Node: PVirtualNode; Data: Pointer; var Abort: Boolean) begin if selectedMaps.Contains(gameMapList.Map[Node^.Index]) then Sender.Selected[Node] := True; end, nil); finally FreeAndNil(selectedMaps); end; finally vstMapList.EndUpdate; end; end; procedure TMainForm.MoveMapSelection(ANodes: TNodeArray; ATargetIndex: Integer); begin HandleMapSelection(ANodes, ATargetIndex, False); end; procedure TMainForm.CopyMapSelection(ANodes: TNodeArray; ATargetIndex: Integer); begin HandleMapSelection(ANodes, ATargetIndex, True); end; function TMainForm.GetModified: Boolean; begin Result := actSave.Enabled; end; procedure TMainForm.SetActiveGame(const Value: TCustomGame); begin if Value <> FActiveGame then begin FActiveGame := Value; ActiveGameChanged; end; end; procedure TMainForm.SetModified(const Value: Boolean); begin actSave.Enabled := Value; actRevert.Enabled := Value; 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; EnablePageActions; 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.actCloseExecute(Sender: TObject); begin Close; end; procedure TMainForm.actSaveExecute(Sender: TObject); begin SaveActiveGame; end; procedure TMainForm.actRevertExecute(Sender: TObject); begin if MessageBox(Self.Handle, 'Do you want to revert your changes?', 'Revert', MB_YESNO or MB_ICONQUESTION) = ID_NO then exit; RevertActiveGame; end; procedure TMainForm.actGameAddExecute(Sender: TObject); var game: TCustomGame; begin if TGameForm.Insert(Self, game) then begin TGameList.Instance.Add(game); SaveGameList; 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; SaveGameList; finally vstGames.EndUpdate; end; end; end; procedure TMainForm.actGameActiveExecute(Sender: TObject); begin if Assigned(vstGames.FocusedNode) then begin { For the sake of clarity, always save or revert changes when switching } if Modified then begin case MessageBox(Self.Handle, 'Do you want to save your changes before switching the active game?', 'Set active game', MB_YESNOCANCEL or MB_ICONQUESTION) of ID_YES: SaveActiveGame; ID_NO: RevertActiveGame; ID_CANCEL: exit; end; end; vstGames.BeginUpdate; try ActiveGame := TGameList.Instance[vstGames.FocusedNode^.Index]; vstGames.InvalidateNode(vstGames.FocusedNode); 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); actGameActive.Enabled := Assigned(Sender.FocusedNode) and (ActiveGame <> TGameList.Instance[Sender.FocusedNode^.Index]); end; procedure TMainForm.vstGamesDblClick(Sender: TObject); begin actGameActive.Execute; end; procedure TMainForm.vstMapListGetText(Sender: TBaseVirtualTree; Node: PVirtualNode; Column: TColumnIndex; TextType: TVSTTextType; var CellText: string); var gameMapList: IGameMapList; map: TGameMap; begin if not Supports(ActiveGame, IGameMapList, gameMapList) then exit; map := gameMapList.Map[Node^.Index]; case Column of MapColumnName: CellText := map.DisplayName; MapColumnCategory: CellText := map.Category; end; end; procedure TMainForm.vstGamesPaintText(Sender: TBaseVirtualTree; const TargetCanvas: TCanvas; Node: PVirtualNode; Column: TColumnIndex; TextType: TVSTTextType); begin if (Column = GameColumnName) and (TGameList.Instance[Node^.Index] = ActiveGame) then TargetCanvas.Font.Style := [fsBold]; end; procedure TMainForm.vstMapListChange(Sender: TBaseVirtualTree; Node: PVirtualNode); var hasSelection: Boolean; begin hasSelection := (Sender.SelectedCount > 0); actMapRemove.Enabled := hasSelection; actMapUp.Enabled := hasSelection; actMapDown.Enabled := hasSelection; end; procedure TMainForm.vstMapListDragOver(Sender: TBaseVirtualTree; Source: TObject; Shift: TShiftState; State: TDragState; Pt: TPoint; Mode: TDropMode; var Effect: Integer; var Accept: Boolean); begin Accept := (Source = Sender); end; procedure TMainForm.vstMapListDragDrop(Sender: TBaseVirtualTree; Source: TObject; DataObject: IDataObject; Formats: TFormatArray; Shift: TShiftState; Pt: TPoint; var Effect: Integer; Mode: TDropMode); var sourceTree: TBaseVirtualTree; selectedNodes: TNodeArray; targetIndex: Integer; lastNode: PVirtualNode; begin sourceTree := (Source as TBaseVirtualTree); targetIndex := 0; case Mode of dmNowhere: begin lastNode := Sender.GetLast; if Assigned(lastNode) then targetIndex := Succ(lastNode^.Index); end; dmAbove, dmOnNode: targetIndex := Sender.DropTargetNode^.Index; dmBelow: targetIndex := Succ(Sender.DropTargetNode^.Index); end; selectedNodes := sourceTree.GetSortedSelection(True); if Effect = DROPEFFECT_COPY then CopyMapSelection(selectedNodes, targetIndex) else MoveMapSelection(selectedNodes, targetIndex); end; procedure TMainForm.vstMapListFocusChanged(Sender: TBaseVirtualTree; Node: PVirtualNode; Column: TColumnIndex); var gameMapList: IGameMapList; begin if not Supports(ActiveGame, IGameMapList, gameMapList) then exit; if Assigned(Node) then frmMapPreview.Load(gameMapList.Map[Node^.Index].Name) else frmMapPreview.Clear; end; procedure TMainForm.actLaunchExecute(Sender: TObject); begin if not Assigned(ActiveGame) then exit; if ShellExecute(0, 'open', PChar(ActiveGame.GetExecutable), PChar(ActiveGame.GetParameters), PChar(ActiveGame.Location), SW_SHOWNORMAL) <= 32 then RaiseLastOSError; end; procedure TMainForm.actCopyCmdLineExecute(Sender: TObject); begin if not Assigned(ActiveGame) then exit; Clipboard.AsText := ActiveGame.GetCommandLine; MessageBox(Self.Handle, 'Command line has been copied to the clipboard', 'Copy', MB_OK or MB_ICONINFORMATION); end; procedure TMainForm.actMapAddExecute(Sender: TObject); var gameMapList: IGameMapList; maps: TList; map: TGameMap; node: PVirtualNode; begin if not Supports(ActiveGame, IGameMapList, gameMapList) then exit; maps := TList.Create; try if TMapForm.Insert(Self, gameMapList, maps) then begin for map in maps do gameMapList.AddMap(map); UpdateMapList; vstMapList.ClearSelection; for map in maps do begin node := FindMapNode(map); if Assigned(node) then begin vstMapList.FocusedNode := node; vstMapList.Selected[node] := True; end; end; end; finally FreeAndNil(maps); end; end; procedure TMainForm.actMapRemoveExecute(Sender: TObject); var gameMapList: IGameMapList; selectedNodes: TNodeArray; nodeIndex: Integer; begin if not Supports(ActiveGame, IGameMapList, gameMapList) then exit; if vstMapList.SelectedCount = 0 then exit; if MessageBox(Self.Handle, 'Do you want to remove the selected map(s)?', 'Remove', MB_YESNO or MB_ICONQUESTION) = ID_YES then begin vstMapList.BeginUpdate; try selectedNodes := vstMapList.GetSortedSelection(True); for nodeIndex := High(selectedNodes) downto Low(selectedNodes) do gameMapList.DeleteMap(selectedNodes[nodeIndex]^.Index); UpdateMapList; finally vstMapList.ClearSelection; vstMapList.EndUpdate; end; end; end; procedure TMainForm.actMapUpExecute(Sender: TObject); var selectedNodes: TNodeArray; targetIndex: Integer; begin selectedNodes := vstMapList.GetSortedSelection(True); if Length(selectedNodes) = 0 then exit; targetIndex := Pred(selectedNodes[0]^.Index); if targetIndex < 0 then targetIndex := 0; MoveMapSelection(selectedNodes, targetIndex); end; procedure TMainForm.actMapDownExecute(Sender: TObject); var selectedNodes: TNodeArray; targetIndex: Integer; begin selectedNodes := vstMapList.GetSortedSelection(True); if Length(selectedNodes) = 0 then exit; targetIndex := Succ(selectedNodes[High(selectedNodes)]^.Index) + 1; MoveMapSelection(selectedNodes, targetIndex); 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.