LCL: dialogs: create a generic solution for dialog copy to clipboard.

git-svn-id: trunk@52308 -

lcl/dialogs.pp

@@ -25,7 +25,7 @@ uses
   Types, typinfo, Classes, SysUtils, LMessages,
   LResources, LCLIntf, InterfaceBase, LCLStrConsts, LCLType, LCLProc, Forms,
   Controls, Themes, GraphType, Graphics, Buttons, ButtonPanel, StdCtrls,
-  ExtCtrls, LCLClasses, ClipBrd,
+  ExtCtrls, LCLClasses, ClipBrd, Menus,
   // LazUtils
   FileUtil, LazFileUtils;
 
@@ -535,6 +535,17 @@ function DefaultMessageBox(Text, Caption: PChar; Flags: Longint) : Integer;// wi
 function InputBox(const ACaption, APrompt, ADefault : String) : String;
 function PasswordBox(const ACaption, APrompt : String) : String;
 
+type
+  TCustomCopyToClipboardDialog = class(TForm)
+  protected
+    procedure DoCreate; override;
+  public
+    function GetMessageText: string; virtual; abstract;
+  end;
+
+procedure RegisterDialogForCopyToClipboard(const ADlg: TCustomForm);
+procedure DialogCopyToClipboard(Self, Sender: TObject; var Key: Word; Shift: TShiftState);
+
 const
   cInputQueryEditSizePixels: integer = 260; // Edit size in pixels
   cInputQueryEditSizePercents: integer = 25; // Edit size in % of monitor width
@@ -753,6 +764,14 @@ begin
   FCopies:=1;
 end;
 
+{ TCustomCopyToClipboardDialog }
+
+procedure TCustomCopyToClipboardDialog.DoCreate;
+begin
+  inherited DoCreate;
+
+  RegisterDialogForCopyToClipboard(Self);
+end;
 
 initialization
   Forms.MessageBoxFunction := @DefaultMessageBox;

lcl/include/messagedialogs.inc

@@ -178,8 +178,8 @@ begin
   Result:=MessageDlg(aCaption, aMsg, DlgType, Buttons, 0);
 end;
 
-function MessageDlgPos(const aMsg: String; DlgType: TMsgDlgType;
-  Buttons: TMsgDlgButtons; Helpctx : Longint; X,Y : Integer): TModalResult;
+function MessageDlgPos(const aMsg: string; DlgType: TMsgDlgType;
+  Buttons: TMsgDlgButtons; HelpCtx: Longint; X, Y: Integer): TModalResult;
 var
   DefaultIndex,
   CancelValue,
@@ -231,6 +231,55 @@ begin
   InputQuery(ACaption, APrompt, True, Result);
 end;
 
+procedure DialogCopyToClipboard(Self, Sender: TObject; var Key: Word;
+  Shift: TShiftState);
+var
+  S: string;
+  Dlg: TCustomForm;
+  Cnt, LastCnt: TControl;
+begin
+  if not ((Key=VK_C) and (Shift = [ssModifier])) then
+    Exit;
+
+  Dlg := Self as TCustomForm;
+
+  S := Format('[%s]', [Dlg.Caption]) + sLineBreak;
+  LastCnt := nil;
+
+  if Dlg is TCustomCopyToClipboardDialog then
+    S := S + sLineBreak + TCustomCopyToClipboardDialog(Dlg).GetMessageText + sLineBreak;
+
+  for Cnt in Dlg.GetEnumeratorControls do
+  begin
+    if (Cnt is TCustomLabel) then
+    begin
+      S := S + sLineBreak + Cnt.Caption + sLineBreak;
+      LastCnt := nil;
+    end else
+    begin
+      if (LastCnt=nil) or (LastCnt.Top > Cnt.Top) then
+        S := S + sLineBreak+sLineBreak
+      else
+        S := S + ' ';
+
+      S := S + Format('[%s]', [StripHotKey(Cnt.Caption)]);
+      LastCnt := Cnt;
+    end;
+  end;
+
+  Clipboard.AsText := TrimRight(S);
+end;
+
+procedure RegisterDialogForCopyToClipboard(const ADlg: TCustomForm);
+var
+  Mtd: TMethod;
+begin
+  ADlg.KeyPreview := True;
+  Mtd.Code := @DialogCopyToClipboard;
+  Mtd.Data := ADlg;
+  ADlg.AddHandlerOnKeyDown(TKeyEvent(Mtd));
+end;
+
 function SelectDirectory(const Caption, InitialDirectory: string;
   out Directory: string): boolean;
 begin

lcl/include/promptdialog.inc

@@ -13,12 +13,10 @@ type
 
   { TPromptDialog }
 
-  TPromptDialog = class(TForm)
+  TPromptDialog = class(TCustomCopyToClipboardDialog)
   private
     FCancelKind: TBitBtnKind;
     function CreateButtons(AVerticalLayout: Boolean; ASpacing: Integer): Integer;
-  protected
-    procedure KeyDown(var Key: Word; Shift: TShiftState); override;
   public
     IsSmallDevice: Boolean;
   
@@ -38,6 +36,7 @@ type
     constructor CreateMessageDialog(const ACaption, aMsg: string;
       DialogType: Longint; TheButtons: PLongint; ButtonCount, DefaultIndex : Longint);
     destructor Destroy; override;
+    function GetMessageText: string; override;
   end;
 
 
@@ -91,16 +90,6 @@ begin
     DefaultButton.Default := True;
 end;
 
-procedure TPromptDialog.KeyDown(var Key: Word; Shift: TShiftState);
-begin
-  inherited KeyDown(Key, Shift);
-  if (Shift = [ssModifier]) and (Key = VK_C) then
-  begin
-    Key := 0;
-    ClipBoard.AsText := MSG;
-  end;
-end;
-
 procedure TPromptDialog.Paint;
 var
   UseMaskHandle: HBitmap;
@@ -130,7 +119,6 @@ var
   curKind: TBitBtnKind;
 begin
   inherited CreateNew(nil, 1);
-  KeyPreview := True; //needed for capturing Ctrl+C in KeyDown
   IsSmallDevice := (Screen.Width <= 300);
 
   AutoScroll := False;
@@ -217,6 +205,11 @@ begin
   inherited destroy;
 end;
 
+function TPromptDialog.GetMessageText: string;
+begin
+  Result := MSG;
+end;
+
 procedure TPromptDialog.LayoutDialog;
 const
   cBtnCalcWidth  = 50;
@@ -544,7 +537,7 @@ type
 
   { TQuestionDlg }
 
-  TQuestionDlg = class(TForm)
+  TQuestionDlg = class(TCustomCopyToClipboardDialog)
   private
     FButtons: TList;
     FBitmap: TCustomBitmap;
@@ -563,6 +556,7 @@ type
     procedure Paint; override;
     procedure LayoutDialog;
     function ShowModal: TModalResult; override;
+    function GetMessageText: string; override;
   end;
 
 { TQuestionDlg }
@@ -863,6 +857,11 @@ begin
   inherited Destroy;
 end;
 
+function TQuestionDlg.GetMessageText: string;
+begin
+  Result := MessageTxt;
+end;
+
 procedure TQuestionDlg.KeyDown(var Key: Word; Shift: TShiftState);
 begin
   if (Key = VK_ESCAPE) and (CancelControl = nil) then