ChivalryServerLauncher/source/view/Forms.Main.pas
Mark van Renswoude 9c720f5922 Added: Inno Setup script
Changed: MapList now uses JSON format, preview filename parameter added
Changed: cleaned up preview folder, no more duplicates
Changed: version number now uses XE2's auto generated date numbers
2014-08-02 12:15:14 +00:00

1201 lines
32 KiB
ObjectPascal

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;
pmnLaunchSep1: TMenuItem;
actOpenConfigFolder: TAction;
pmnLaunchOpenConfigFolder: TMenuItem;
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);
procedure actOpenConfigFolderExecute(Sender: TObject);
private type
TBindingExpressionList = TList<TBindingExpression>;
TPageMenuDictionary = TDictionary<TTabSheet, TX2MenuBarItem>;
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.DateUtils,
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);
function GetVersionDate: TDateTime;
begin
Result := EncodeDate(2000, 1, 1) + Pred(App.Version.Release);
end;
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 := Format('%s v%d.%d - %s',
[App.Version.Strings.ProductName,
App.Version.Major,
App.Version.Minor,
FormatDateTime('yyyy.mm.dd', GetVersionDate)]);
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<TGameMap>;
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<TGameMap>.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].PreviewName)
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.actOpenConfigFolderExecute(Sender: TObject);
begin
if not Assigned(ActiveGame) then
exit;
ShellExecute(Self.Handle, 'explore', PChar(ActiveGame.GetConfigPath), nil, nil, SW_SHOWNORMAL);
end;
procedure TMainForm.actMapAddExecute(Sender: TObject);
var
gameMapList: IGameMapList;
maps: TList<TGameMap>;
map: TGameMap;
node: PVirtualNode;
begin
if not Supports(ActiveGame, IGameMapList, gameMapList) then
exit;
maps := TList<TGameMap>.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.