Add context menu on various labels of about dialog, so the user can easily copy application version and others. Closes #82

This commit is contained in:
Ansgar Becker
2018-01-20 17:29:07 +01:00
parent ee27ccdec7
commit 5a3dde10b8
2 changed files with 32 additions and 1 deletions

View File

@ -33,6 +33,7 @@ object AboutBox: TAboutBox
Font.Name = 'Tahoma'
Font.Style = [fsBold]
ParentFont = False
PopupMenu = popupLabels
Transparent = True
IsControl = True
end
@ -42,6 +43,7 @@ object AboutBox: TAboutBox
Width = 64
Height = 13
Caption = 'lblAppVersion'
PopupMenu = popupLabels
Transparent = True
IsControl = True
end
@ -51,6 +53,7 @@ object AboutBox: TAboutBox
Width = 72
Height = 13
Caption = 'lblAppCompiled'
PopupMenu = popupLabels
Transparent = True
end
object lblAppWebpage: TLabel
@ -66,6 +69,7 @@ object AboutBox: TAboutBox
Font.Name = 'Tahoma'
Font.Style = []
ParentFont = False
PopupMenu = popupLabels
Transparent = True
OnClick = OpenURL
OnMouseMove = MouseOver
@ -1390,6 +1394,7 @@ object AboutBox: TAboutBox
Font.Style = []
ParentColor = False
ParentFont = False
PopupMenu = popupLabels
OnClick = lblCreditsClick
OnMouseMove = MouseOver
end
@ -1434,4 +1439,14 @@ object AboutBox: TAboutBox
TabOrder = 2
OnClick = btnDonatedOKClick
end
object popupLabels: TPopupMenu
Images = MainForm.ImageListMain
Left = 32
Top = 144
object menuCopyLabel: TMenuItem
Caption = 'Copy'
ImageIndex = 3
OnClick = menuCopyLabelClick
end
end
end

View File

@ -8,7 +8,7 @@ interface
uses
Windows, Classes, Graphics, Forms, Controls, StdCtrls, ExtCtrls, SysUtils, ComCtrls, pngimage, gnugettext,
Dialogs, SynRegExpr;
Dialogs, SynRegExpr, Vcl.Menus, ClipBrd;
type
TAboutBox = class(TForm)
@ -24,6 +24,8 @@ type
editDonated: TEdit;
btnDonatedOK: TButton;
lblCredits: TLabel;
popupLabels: TPopupMenu;
menuCopyLabel: TMenuItem;
procedure OpenURL(Sender: TObject);
procedure MouseOver(Sender: TObject; Shift: TShiftState; X, Y: Integer);
procedure FormShow(Sender: TObject);
@ -31,6 +33,7 @@ type
procedure editDonatedExit(Sender: TObject);
procedure btnDonatedOKClick(Sender: TObject);
procedure lblCreditsClick(Sender: TObject);
procedure menuCopyLabelClick(Sender: TObject);
private
{ Private declarations }
public
@ -90,6 +93,19 @@ begin
end;
procedure TAboutBox.menuCopyLabelClick(Sender: TObject);
var
LabelComp: TComponent;
begin
// Copy label caption
if Sender is TMenuItem then begin
LabelComp := TPopupMenu(TMenuItem(Sender).GetParentMenu).PopupComponent;
if LabelComp is TLabel then begin
Clipboard.AsText := TLabel(LabelComp).Caption;
end;
end;
end;
procedure TAboutBox.editDonatedEnter(Sender: TObject);
begin
btnDonatedOK.Default := True;