Просмотр исходного кода

Add sign tool command help icon.

Martijn Laan 1 год назад
Родитель
Сommit
672cb36ba5

+ 11 - 0
Projects/Src/IDE.InputQueryMemoForm.dfm

@@ -13,6 +13,7 @@ object InputQueryMemoForm: TInputQueryMemoForm
   Font.Name = 'MS Sans Serif'
   Font.Name = 'MS Sans Serif'
   Font.Style = []
   Font.Style = []
   Position = poScreenCenter
   Position = poScreenCenter
+  OnAfterMonitorDpiChanged = FormAfterMonitorDpiChanged
   OnCreate = FormCreate
   OnCreate = FormCreate
   DesignSize = (
   DesignSize = (
     582
     582
@@ -26,6 +27,16 @@ object InputQueryMemoForm: TInputQueryMemoForm
     Caption = '...'
     Caption = '...'
     FocusControl = ValueControl
     FocusControl = ValueControl
   end
   end
+  object DocImage: TImage
+    Left = 8
+    Top = 115
+    Width = 16
+    Height = 16
+    Cursor = crHandPoint
+    Anchors = [akLeft, akBottom]
+    AutoSize = True
+    Transparent = True
+  end
   object OKButton: TButton
   object OKButton: TButton
     Left = 421
     Left = 421
     Top = 111
     Top = 111

+ 39 - 5
Projects/Src/IDE.InputQueryMemoForm.pas

@@ -14,7 +14,7 @@ unit IDE.InputQueryMemoForm;
 interface
 interface
 
 
 uses
 uses
-  Classes, Controls, StdCtrls, UIStateForm;
+  Classes, Controls, StdCtrls, UIStateForm, Vcl.ExtCtrls;
 
 
 type
 type
   TInputQueryMemoForm = class(TUIStateForm)
   TInputQueryMemoForm = class(TUIStateForm)
@@ -22,40 +22,48 @@ type
     CancelButton: TButton;
     CancelButton: TButton;
     PromptLabel: TLabel;
     PromptLabel: TLabel;
     ValueControl: TMemo;
     ValueControl: TMemo;
+    DocImage: TImage;
     procedure FormCreate(Sender: TObject);
     procedure FormCreate(Sender: TObject);
     procedure ValueControlKeyPress(Sender: TObject; var Key: Char);
     procedure ValueControlKeyPress(Sender: TObject; var Key: Char);
     procedure ValueControlChange(Sender: TObject);
     procedure ValueControlChange(Sender: TObject);
     procedure ValueControlKeyDown(Sender: TObject; var Key: Word;
     procedure ValueControlKeyDown(Sender: TObject; var Key: Word;
       Shift: TShiftState);
       Shift: TShiftState);
+    procedure FormAfterMonitorDpiChanged(Sender: TObject; OldDPI,
+      NewDPI: Integer);
   private
   private
     FSingleLine: Boolean;
     FSingleLine: Boolean;
     function GetValue: String;
     function GetValue: String;
     procedure SetPrompt(const APrompt: String);
     procedure SetPrompt(const APrompt: String);
     procedure SetValue(const AValue: String);
     procedure SetValue(const AValue: String);
+    procedure UpdateImages;
+    procedure SetDocImageClick(const Value: TNotifyEvent);
   public
   public
-    property SingleLine: Boolean write FSingleLine;
+    property DocImageClick: TNotifyEvent write SetDocImageClick;
     property Prompt: String write SetPrompt;
     property Prompt: String write SetPrompt;
+    property SingleLine: Boolean write FSingleLine;
     property Value: String read GetValue write SetValue;
     property Value: String read GetValue write SetValue;
   end;
   end;
 
 
 function InputQueryMemo(const ACaption, APrompt: String; var AValue: String;
 function InputQueryMemo(const ACaption, APrompt: String; var AValue: String;
-  const ASingleLine: Boolean = False): Boolean;
+  const ASingleLine: Boolean = False; const ADocImageClick: TNotifyEvent = nil): Boolean;
 
 
 implementation
 implementation
 
 
 uses
 uses
-  Windows, Messages, IDE.HelperFunc, Forms;
+  Windows, Messages, Forms, Graphics, ComCtrls,
+  IDE.HelperFunc, IDE.ImagesModule, IDE.MainForm;
 
 
 {$R *.DFM}
 {$R *.DFM}
 
 
 function InputQueryMemo(const ACaption, APrompt: String; var AValue: String;
 function InputQueryMemo(const ACaption, APrompt: String; var AValue: String;
-  const ASingleLine: Boolean): Boolean;
+  const ASingleLine: Boolean; const ADocImageClick: TNotifyEvent): Boolean;
 begin
 begin
   with TInputQueryMemoForm.Create(Application) do try
   with TInputQueryMemoForm.Create(Application) do try
     Caption := ACaption;
     Caption := ACaption;
     Prompt := APrompt;
     Prompt := APrompt;
     Value := AValue;
     Value := AValue;
     SingleLine := ASingleLine;
     SingleLine := ASingleLine;
+    DocImageClick := ADocImageClick;
     if ShowModal = mrOk then begin
     if ShowModal = mrOk then begin
       AValue := Value;
       AValue := Value;
       Result := True;
       Result := True;
@@ -69,6 +77,13 @@ end;
 procedure TInputQueryMemoForm.FormCreate(Sender: TObject);
 procedure TInputQueryMemoForm.FormCreate(Sender: TObject);
 begin
 begin
   InitFormFont(Self);
   InitFormFont(Self);
+  UpdateImages;
+end;
+
+procedure TInputQueryMemoForm.FormAfterMonitorDpiChanged(Sender: TObject;
+  OldDPI, NewDPI: Integer);
+begin
+  UpdateImages;
 end;
 end;
 
 
 function TInputQueryMemoForm.GetValue: String;
 function TInputQueryMemoForm.GetValue: String;
@@ -76,6 +91,12 @@ begin
   Result := ValueControl.Text;
   Result := ValueControl.Text;
 end;
 end;
 
 
+procedure TInputQueryMemoForm.SetDocImageClick(const Value: TNotifyEvent);
+begin
+  DocImage.OnClick := Value;
+  DocImage.Visible := Assigned(DocImage.OnClick);
+end;
+
 procedure TInputQueryMemoForm.SetPrompt(const APrompt: String);
 procedure TInputQueryMemoForm.SetPrompt(const APrompt: String);
 begin
 begin
   PromptLabel.Caption := APrompt;
   PromptLabel.Caption := APrompt;
@@ -117,4 +138,17 @@ begin
     Key := #0;
     Key := #0;
 end;
 end;
 
 
+procedure TInputQueryMemoForm.UpdateImages;
+
+  function GetImage(const Button: TToolButton; const WH: Integer): TWICImage;
+  begin
+    Result := ImagesModule.LightToolBarImageCollection.GetSourceImage(Button.ImageIndex, WH, WH)
+  end;
+
+begin
+ { After a DPI change the button's Width and Height isn't yet updated, so calculate it ourselves }
+  var WH := MulDiv(16, CurrentPPI, 96);
+  DocImage.Picture.Graphic:= GetImage(MainForm.HelpButton, WH);
+end;
+
 end.
 end.

+ 10 - 2
Projects/Src/IDE.SignToolsForm.pas

@@ -31,6 +31,7 @@ type
     procedure EditButtonClick(Sender: TObject);
     procedure EditButtonClick(Sender: TObject);
   private
   private
     FSignTools: TStringList;
     FSignTools: TStringList;
+    procedure CommandDocImageClick(Sender: TObject);
     procedure UpdateSignTools;
     procedure UpdateSignTools;
     procedure UpdateSignToolsButtons;
     procedure UpdateSignToolsButtons;
     procedure SetSignTools(SignTools: TStringList);
     procedure SetSignTools(SignTools: TStringList);
@@ -47,7 +48,8 @@ implementation
 
 
 uses
 uses
   Windows, Messages, SysUtils, Dialogs,
   Windows, Messages, SysUtils, Dialogs,
-  Shared.CommonFunc.Vcl, IDE.InputQueryMemoForm, IDE.HelperFunc;
+  Shared.CommonFunc.Vcl, IDE.InputQueryMemoForm, IDE.HelperFunc,
+  IDE.HtmlHelpFunc;
 
 
 {$R *.DFM}
 {$R *.DFM}
 
 
@@ -87,6 +89,12 @@ begin
   SendMessage(Handle, WM_SETICON, ICON_BIG, 0);
   SendMessage(Handle, WM_SETICON, ICON_BIG, 0);
 end;
 end;
 
 
+procedure TSignToolsForm.CommandDocImageClick(Sender: TObject);
+begin
+  if Assigned(HtmlHelp) then
+    HtmlHelp(GetDesktopWindow, PChar(GetHelpFile), HH_DISPLAY_TOPIC, Cardinal(PChar('topic_setup_signtool.htm')));
+end;
+
 procedure TSignToolsForm.CreateParams(var Params: TCreateParams);
 procedure TSignToolsForm.CreateParams(var Params: TCreateParams);
 begin
 begin
   inherited CreateParams(Params);
   inherited CreateParams(Params);
@@ -118,7 +126,7 @@ begin
       end;
       end;
     end;
     end;
 
 
-    if InputQueryMemo(Caption, 'Command of the Sign Tool:', SignToolCommand, True) then begin
+    if InputQueryMemo(Caption, 'Command of the Sign Tool:', SignToolCommand, True, CommandDocImageClick) then begin
       if SignToolCommand = '' then begin
       if SignToolCommand = '' then begin
         AppMessageBox(PChar('Invalid command.'), PChar(Caption), MB_OK or MB_ICONSTOP);
         AppMessageBox(PChar('Invalid command.'), PChar(Caption), MB_OK or MB_ICONSTOP);
         Exit;
         Exit;