opensource/HeidiSQL
1
0
Fork 0
mirror of https://github.com/HeidiSQL/HeidiSQL.git synced 2025-08-06 18:24:26 +08:00
Code Issues Packages Projects Releases Wiki Activity

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

Browse Source
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
Download Patch File Download Diff File Expand all files Collapse all files

15
source/about.dfm
View File

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

18
source/about.pas
View File

@ -8,7 +8,7 @@ interface
uses uses
Windows, Classes, Graphics, Forms, Controls, StdCtrls, ExtCtrls, SysUtils, ComCtrls, pngimage, gnugettext, Windows, Classes, Graphics, Forms, Controls, StdCtrls, ExtCtrls, SysUtils, ComCtrls, pngimage, gnugettext,
Dialogs, SynRegExpr; Dialogs, SynRegExpr, Vcl.Menus, ClipBrd;
type type
TAboutBox = class(TForm) TAboutBox = class(TForm)
@ -24,6 +24,8 @@ type
editDonated: TEdit; editDonated: TEdit;
btnDonatedOK: TButton; btnDonatedOK: TButton;
lblCredits: TLabel; lblCredits: TLabel;
popupLabels: TPopupMenu;
menuCopyLabel: TMenuItem;
procedure OpenURL(Sender: TObject); procedure OpenURL(Sender: TObject);
procedure MouseOver(Sender: TObject; Shift: TShiftState; X, Y: Integer); procedure MouseOver(Sender: TObject; Shift: TShiftState; X, Y: Integer);
procedure FormShow(Sender: TObject); procedure FormShow(Sender: TObject);
@ -31,6 +33,7 @@ type
procedure editDonatedExit(Sender: TObject); procedure editDonatedExit(Sender: TObject);
procedure btnDonatedOKClick(Sender: TObject); procedure btnDonatedOKClick(Sender: TObject);
procedure lblCreditsClick(Sender: TObject); procedure lblCreditsClick(Sender: TObject);
procedure menuCopyLabelClick(Sender: TObject);
private private
{ Private declarations } { Private declarations }
public public
@ -90,6 +93,19 @@ begin
end; 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); procedure TAboutBox.editDonatedEnter(Sender: TObject);
begin begin
btnDonatedOK.Default := True; btnDonatedOK.Default := True;