ChivalryServerLauncher/source/view/Forms.Main.pas

948 lines
25 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.Imaging.pngimage,
Vcl.ImgList,
Vcl.Mask,
Vcl.Menus,
Vcl.StdCtrls,
Vcl.ToolWin,
Winapi.ActiveX,
JvExControls,
JvExMask,
JvGradient,
JvGroupHeader,
JvSpin,
VirtualTrees,
X2CLGraphicList,
X2CLMenuBar,
X2CLmusikCubeMenuBarPainter,
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;
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 actCloseExecute(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 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 actMapAddExecute(Sender: TObject);
procedure actMapRemoveExecute(Sender: TObject);
procedure actMapUpExecute(Sender: TObject);
procedure actMapDownExecute(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 EnablePageActions;
procedure ActiveGameChanged;
procedure ClearUIBindings;
procedure Bind(const APropertyName: string; ADestObject: TObject; const ADestPropertyName: string);
procedure BindGameNetwork;
procedure BindGameName;
procedure UpdateMenu;
procedure UpdateGameList;
procedure UpdateMapList;
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: TPageMenuMap read FPageMenuMap;
property UIBindings: TBindingExpressionList read FUIBindings;
end;
implementation
uses
System.Bindings.Helper,
System.Math,
System.StrUtils,
System.SysUtils,
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.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;
// #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;
var
gameMapList: IGameMapList;
begin
if Supports(ActiveGame, IGameMapList, gameMapList) then
vstMapList.RootNodeCount := gameMapList.GetMapList.Count
else
vstMapList.Clear;
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.GetMapList[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;
newNode: PVirtualNode;
selectedMaps: TList<TGameMap>;
map: TGameMap;
begin
if (ATargetIndex < 0) or (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.GetMapList[sourceIndex]);
gameMapList.GetMapList.Insert(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.GetMapList[sourceIndex]);
gameMapList.GetMapList.Move(sourceIndex, newIndex);
end;
end;
vstMapList.ClearSelection;
vstMapList.IterateSubtree(nil,
procedure(Sender: TBaseVirtualTree; Node: PVirtualNode; Data: Pointer; var Abort: Boolean)
begin
if selectedMaps.Contains(gameMapList.GetMapList[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;
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;
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.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
gameMapList: IGameMapList;
map: TGameMap;
begin
if not Supports(ActiveGame, IGameMapList, gameMapList) then
exit;
map := gameMapList.GetMapList[Node^.Index];
case Column of
MapColumnName:
CellText := map.DisplayName;
MapColumnCategory:
CellText := map.Category;
end;
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.actMapAddExecute(Sender: TObject);
var
gameMapList: IGameMapList;
map: TGameMap;
node: PVirtualNode;
begin
if not Supports(ActiveGame, IGameMapList, gameMapList) then
exit;
if TMapForm.Insert(Self, gameMapList, map) then
begin
gameMapList.GetMapList.Add(map);
UpdateMapList;
node := FindMapNode(map);
if Assigned(node) then
begin
vstMapList.ClearSelection;
vstMapList.FocusedNode := node;
vstMapList.Selected[node] := True;
end;
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.GetMapList.Delete(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.