mirror of
https://github.com/HeidiSQL/HeidiSQL.git
synced 2025-08-06 18:24:26 +08:00
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:
@ -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
|
||||
|
@ -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;
|
||||
|
Reference in New Issue
Block a user