IDE.InputQueryMemoForm.pas 4.5 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155
  1. unit IDE.InputQueryMemoForm;
  2. {
  3. Inno Setup
  4. Copyright (C) 1997-2025 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, ExtCtrls, BitmapButton;
  13. type
  14. TInputQueryMemoForm = class(TUIStateForm)
  15. OKButton: TButton;
  16. CancelButton: TButton;
  17. PromptLabel: TLabel;
  18. ValueControl: TMemo;
  19. DocBitBtn: TBitmapButton;
  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 SetDocBitBtnClick(const Value: TNotifyEvent);
  34. public
  35. property DocBitBtnClick: TNotifyEvent write SetDocBitBtnClick;
  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 ADocBitBtnClick: 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 ADocBitBtnClick: TNotifyEvent): Boolean;
  49. begin
  50. with TInputQueryMemoForm.Create(Application) do try
  51. Caption := ACaption;
  52. Prompt := APrompt;
  53. Value := AValue;
  54. SingleLine := ASingleLine;
  55. DocBitBtnClick := ADocBitBtnClick;
  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. InitFormTheme(Self);
  69. UpdateImages;
  70. end;
  71. procedure TInputQueryMemoForm.FormAfterMonitorDpiChanged(Sender: TObject;
  72. OldDPI, NewDPI: Integer);
  73. begin
  74. UpdateImages;
  75. end;
  76. function TInputQueryMemoForm.GetValue: String;
  77. begin
  78. Result := ValueControl.Text;
  79. end;
  80. procedure TInputQueryMemoForm.SetDocBitBtnClick(const Value: TNotifyEvent);
  81. begin
  82. DocBitBtn.OnClick := Value;
  83. DocBitBtn.Visible := Assigned(DocBitBtn.OnClick);
  84. end;
  85. procedure TInputQueryMemoForm.SetPrompt(const APrompt: String);
  86. begin
  87. PromptLabel.Caption := APrompt;
  88. var MoveX := PromptLabel.Left + PromptLabel.Width + CancelButton.Left - (OkButton.Left + OkButton.Width) - ValueControl.Left;
  89. ValueControl.Left := ValueControl.Left + MoveX;
  90. ValueControl.Width := ValueControl.Width - MoveX;
  91. end;
  92. procedure TInputQueryMemoForm.SetValue(const AValue: String);
  93. begin
  94. ValueControl.Text := AValue;
  95. ValueControl.SelectAll;
  96. end;
  97. procedure TInputQueryMemoForm.ValueControlChange(Sender: TObject);
  98. begin
  99. { We don't allow Enter to be added but it could still be pasted so must check.
  100. Checking with Lines.Count doesn't work, for example if one pastes 3 lines and
  101. then removes two it still returns 3 for Lines.Count. }
  102. if FSingleLine then begin
  103. var Text := ValueControl.Text;
  104. OKButton.Enabled := Pos(#10, Text) = 0;
  105. end else
  106. OKButton.Enabled := True;
  107. end;
  108. procedure TInputQueryMemoForm.ValueControlKeyDown(Sender: TObject;
  109. var Key: Word; Shift: TShiftState);
  110. begin
  111. if Key = VK_ESCAPE then
  112. CancelButton.Click;
  113. end;
  114. procedure TInputQueryMemoForm.ValueControlKeyPress(Sender: TObject;
  115. var Key: Char);
  116. begin
  117. { #10 = Ctrl+Enter, #13 = Enter or Shift+Enter }
  118. if FSingleLine and ((Key = #10) or (Key = #13)) then
  119. Key := #0;
  120. end;
  121. procedure TInputQueryMemoForm.UpdateImages;
  122. function GetImage(const Button: TToolButton; const WH: Integer): TWICImage;
  123. begin
  124. Result := ImagesModule.LightToolBarImageCollection.GetSourceImage(Button.ImageIndex, WH, WH)
  125. end;
  126. begin
  127. { After a DPI change the button's Width and Height isn't yet updated, so calculate it ourselves }
  128. var WH := MulDiv(16, CurrentPPI, 96);
  129. DocBitBtn.Bitmap.Assign(GetImage(MainForm.HelpButton, WH));
  130. end;
  131. end.