IDE.InputQueryMemoForm.pas 4.5 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154
  1. unit IDE.InputQueryMemoForm;
  2. {
  3. Inno Setup
  4. Copyright (C) 1997-2020 Jordan Russell
  5. Portions by Martijn Laan
  6. For conditions of distribution and use, see LICENSE.TXT.
  7. InputQuery with a TMemo instead of a TEdit
  8. Unlike InputQuery it doesn't limit the value to 255 characters
  9. }
  10. interface
  11. uses
  12. Classes, Controls, StdCtrls, UIStateForm, Vcl.ExtCtrls;
  13. type
  14. TInputQueryMemoForm = class(TUIStateForm)
  15. OKButton: TButton;
  16. CancelButton: TButton;
  17. PromptLabel: TLabel;
  18. ValueControl: TMemo;
  19. DocImage: TImage;
  20. procedure FormCreate(Sender: TObject);
  21. procedure ValueControlKeyPress(Sender: TObject; var Key: Char);
  22. procedure ValueControlChange(Sender: TObject);
  23. procedure ValueControlKeyDown(Sender: TObject; var Key: Word;
  24. Shift: TShiftState);
  25. procedure FormAfterMonitorDpiChanged(Sender: TObject; OldDPI,
  26. NewDPI: Integer);
  27. private
  28. FSingleLine: Boolean;
  29. function GetValue: String;
  30. procedure SetPrompt(const APrompt: String);
  31. procedure SetValue(const AValue: String);
  32. procedure UpdateImages;
  33. procedure SetDocImageClick(const Value: TNotifyEvent);
  34. public
  35. property DocImageClick: TNotifyEvent write SetDocImageClick;
  36. property Prompt: String write SetPrompt;
  37. property SingleLine: Boolean write FSingleLine;
  38. property Value: String read GetValue write SetValue;
  39. end;
  40. function InputQueryMemo(const ACaption, APrompt: String; var AValue: String;
  41. const ASingleLine: Boolean = False; const ADocImageClick: TNotifyEvent = nil): Boolean;
  42. implementation
  43. uses
  44. Windows, Messages, Forms, Graphics, ComCtrls,
  45. IDE.HelperFunc, IDE.ImagesModule, IDE.MainForm;
  46. {$R *.DFM}
  47. function InputQueryMemo(const ACaption, APrompt: String; var AValue: String;
  48. const ASingleLine: Boolean; const ADocImageClick: TNotifyEvent): Boolean;
  49. begin
  50. with TInputQueryMemoForm.Create(Application) do try
  51. Caption := ACaption;
  52. Prompt := APrompt;
  53. Value := AValue;
  54. SingleLine := ASingleLine;
  55. DocImageClick := ADocImageClick;
  56. if ShowModal = mrOk then begin
  57. AValue := Value;
  58. Result := True;
  59. end else
  60. Result := False;
  61. finally
  62. Free;
  63. end;
  64. end;
  65. procedure TInputQueryMemoForm.FormCreate(Sender: TObject);
  66. begin
  67. InitFormFont(Self);
  68. UpdateImages;
  69. end;
  70. procedure TInputQueryMemoForm.FormAfterMonitorDpiChanged(Sender: TObject;
  71. OldDPI, NewDPI: Integer);
  72. begin
  73. UpdateImages;
  74. end;
  75. function TInputQueryMemoForm.GetValue: String;
  76. begin
  77. Result := ValueControl.Text;
  78. end;
  79. procedure TInputQueryMemoForm.SetDocImageClick(const Value: TNotifyEvent);
  80. begin
  81. DocImage.OnClick := Value;
  82. DocImage.Visible := Assigned(DocImage.OnClick);
  83. end;
  84. procedure TInputQueryMemoForm.SetPrompt(const APrompt: String);
  85. begin
  86. PromptLabel.Caption := APrompt;
  87. var MoveX := PromptLabel.Left + PromptLabel.Width + CancelButton.Left - (OkButton.Left + OkButton.Width) - ValueControl.Left;
  88. ValueControl.Left := ValueControl.Left + MoveX;
  89. ValueControl.Width := ValueControl.Width - MoveX;
  90. end;
  91. procedure TInputQueryMemoForm.SetValue(const AValue: String);
  92. begin
  93. ValueControl.Text := AValue;
  94. ValueControl.SelectAll;
  95. end;
  96. procedure TInputQueryMemoForm.ValueControlChange(Sender: TObject);
  97. begin
  98. { We don't allow Enter to be added but it could still be pasted so must check.
  99. Checking with Lines.Count doesn't work, for example if one pastes 3 lines and
  100. then removes two it still returns 3 for Lines.Count. }
  101. if FSingleLine then begin
  102. var Text := ValueControl.Text;
  103. OKButton.Enabled := Pos(#10, Text) = 0;
  104. end else
  105. OKButton.Enabled := True;
  106. end;
  107. procedure TInputQueryMemoForm.ValueControlKeyDown(Sender: TObject;
  108. var Key: Word; Shift: TShiftState);
  109. begin
  110. if Key = VK_ESCAPE then
  111. CancelButton.Click;
  112. end;
  113. procedure TInputQueryMemoForm.ValueControlKeyPress(Sender: TObject;
  114. var Key: Char);
  115. begin
  116. { #10 = Ctrl+Enter, #13 = Enter or Shift+Enter }
  117. if FSingleLine and ((Key = #10) or (Key = #13)) then
  118. Key := #0;
  119. end;
  120. procedure TInputQueryMemoForm.UpdateImages;
  121. function GetImage(const Button: TToolButton; const WH: Integer): TWICImage;
  122. begin
  123. Result := ImagesModule.LightToolBarImageCollection.GetSourceImage(Button.ImageIndex, WH, WH)
  124. end;
  125. begin
  126. { After a DPI change the button's Width and Height isn't yet updated, so calculate it ourselves }
  127. var WH := MulDiv(16, CurrentPPI, 96);
  128. DocImage.Picture.Graphic:= GetImage(MainForm.HelpButton, WH);
  129. end;
  130. end.