IDE.HelperFunc.pas 25 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801
  1. unit IDE.HelperFunc;
  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. Additional Compiler IDE functions
  8. }
  9. interface
  10. uses
  11. Windows,
  12. Classes, Forms, Dialogs, Menus, Controls, StdCtrls, Graphics,
  13. ScintEdit, IDE.IDEScintEdit, ModernColors;
  14. type
  15. TAddLinesPrefix = (alpNone, alpTimestamp, alpCountdown);
  16. TKeyMappingType = (kmtDelphi, kmtVisualStudio);
  17. procedure InitFormFont(Form: TForm);
  18. procedure SetControlWindowTheme(const WinControl: TWinControl; const Dark: Boolean);
  19. procedure InitFormThemeInit(const Theme: TTheme);
  20. function InitFormTheme(const Form: TForm): Boolean;
  21. function InitFormThemeGetBkColor(const WindowColor: Boolean): TColor;
  22. function InitFormThemeIsDark: Boolean;
  23. function GetDisplayFilename(const Filename: String): String;
  24. function GetFileTitle(const Filename: String): String;
  25. function GetCleanFileNameOfFile(const Filename: String): String;
  26. function GetLastWriteTimeOfFile(const Filename: String;
  27. LastWriteTime: PFileTime): Boolean;
  28. procedure AddFileToRecentDocs(const Filename: String);
  29. function GenerateGuid: String;
  30. function ISPPInstalled: Boolean;
  31. function IsISPPBuiltins(const Filename: String): Boolean;
  32. function WindowsVersionAtLeast(const AMajor, AMinor: Byte; const ABuild: Word = 0): Boolean;
  33. function IsWindows10: Boolean;
  34. function IsWindows11: Boolean;
  35. function GetDefaultThemeType: TThemeType;
  36. function GetDefaultKeyMappingType: TKeyMappingType;
  37. function GetDefaultMemoKeyMappingType: TIDEScintKeyMappingType;
  38. procedure LaunchFileOrURL(const AFilename: String; const AParameters: String = '');
  39. procedure OpenDonateSite;
  40. procedure OpenMailingListSite;
  41. procedure LoadKnownIncludedAndHiddenFiles(const AFilename: String; const IncludedFiles, HiddenFiles: TStringList);
  42. procedure SaveKnownIncludedAndHiddenFiles(const AFilename: String; const IncludedFiles, HiddenFiles: TStringList);
  43. procedure DeleteKnownIncludedAndHiddenFiles(const AFilename: String);
  44. procedure LoadBreakPointLines(const AFilename: String; const BreakPointLines: TStringList);
  45. procedure SaveBreakPointLines(const AFilename: String; const BreakPointLines: TStringList);
  46. procedure DeleteBreakPointLines(const AFilename: String);
  47. function NewShortCutToText(const ShortCut: TShortCut): String;
  48. procedure SetFakeShortCutText(const MenuItem: TMenuItem; const S: String);
  49. procedure SetFakeShortCut(const MenuItem: TMenuItem; const Key: Word;
  50. const Shift: TShiftState); overload;
  51. procedure SetFakeShortCut(const MenuItem: TMenuItem; const ShortCut: TShortCut); overload;
  52. procedure SaveTextToFile(const Filename: String;
  53. const S: String; const SaveEncoding: TSaveEncoding);
  54. procedure AddLines(const ListBox: TListBox; const S: String; const AObject: TObject; const LineBreaks: Boolean; const Prefix: TAddLinesPrefix; const PrefixParam: Cardinal);
  55. procedure SetLowPriority(ALowPriority: Boolean; var SavePriorityClass: DWORD);
  56. procedure SetHelpFileDark(const Dark: Boolean);
  57. function GetHelpFile: String;
  58. function FindOptionsToSearchOptions(const FindOptions: TFindOptions;
  59. const RegEx: Boolean): TScintFindOptions; overload;
  60. function FindOptionsToSearchOptions(const MatchCase: Boolean;
  61. const RegEx: Boolean): TScintFindOptions; overload;
  62. function RegExToReplaceMode(const RegEx: Boolean): TScintReplaceMode;
  63. function GetSourcePath(const AFilename: String): String;
  64. function ReadScriptLines(const ALines: TStringList; const ReadFromFile: Boolean;
  65. const ReadFromFileFilename: String; const NotReadFromFileMemo: TScintEdit): Integer;
  66. function CreateBitmapInfo(const Width, Height, BitCount: Integer): TBitmapInfo;
  67. function GetPreferredMemoFont: String;
  68. function DoubleAmp(const S: String): String;
  69. implementation
  70. uses
  71. ActiveX, ShlObj, ShellApi, CommDlg, SysUtils, IOUtils, StrUtils, ExtCtrls,
  72. Messages, Consts, NetEncoding,
  73. ECDSA, SHA256, Shared.CommonFunc, Shared.CommonFunc.Vcl, PathFunc, Shared.FileClass, NewUxTheme, NewNotebook,
  74. IDE.MainForm, IDE.Messages, Shared.ConfigIniFile;
  75. procedure InitFormFont(Form: TForm);
  76. begin
  77. var Metrics: TNonClientMetrics;
  78. var FontName: String;
  79. Metrics.cbSize := SizeOf(Metrics);
  80. if SystemParametersInfo(SPI_GETNONCLIENTMETRICS, SizeOf(Metrics),
  81. @Metrics, 0) then
  82. FontName := Metrics.lfMessageFont.lfFaceName;
  83. { Only allow fonts that we know will fit the text correctly }
  84. if not SameText(FontName, 'Microsoft Sans Serif') and
  85. not SameText(FontName, 'Segoe UI') then
  86. FontName := 'Tahoma';
  87. var FontSize: Integer;
  88. if SameText(FontName, 'Segoe UI') then
  89. FontSize := 9
  90. else
  91. FontSize := 8;
  92. Form.Font.Name := FontName;
  93. Form.Font.Size := FontSize;
  94. end;
  95. procedure SetControlWindowTheme(const WinControl: TWinControl; const Dark: Boolean);
  96. { Can be used for memos and listboxes to switch them to (or from) a native dark scrollbar }
  97. begin
  98. if UseThemes then begin
  99. WinControl.StyleName := 'Windows';
  100. if Dark then
  101. SetWindowTheme(WinControl.Handle, 'DarkMode_Explorer', nil)
  102. else
  103. SetWindowTheme(WinControl.Handle, nil, nil);
  104. end;
  105. end;
  106. var
  107. FormTheme: TTheme;
  108. procedure InitFormThemeInit(const Theme: TTheme);
  109. begin
  110. FormTheme := Theme;
  111. end;
  112. function InitFormTheme(const Form: TForm): Boolean;
  113. {$IF CompilerVersion >= 36.0}
  114. procedure HideGroupBoxFrames(const ParentControl: TWinControl);
  115. begin
  116. for var I := 0 to ParentControl.ControlCount-1 do begin
  117. const Control = ParentControl.Controls[I];
  118. if Control is TGroupBox then
  119. (Control as TGroupBox).ShowFrame := False;
  120. if Control is TWinControl then
  121. HideGroupBoxFrames(Control as TWinControl);
  122. end;
  123. end;
  124. {$ENDIF}
  125. { Assumes forms other then MainForm call this function only once during creation, and assumes they
  126. don't need any styling if the theme is non dark. Always styles MainForm. Returns True if it did
  127. style, False otherwise. }
  128. begin
  129. Result := (Form = MainForm) or FormTheme.Dark;
  130. if Result then begin
  131. Form.Color := InitFormThemeGetBkColor(Form = MainForm); { Prevents some flicker, but not all }
  132. SetDarkTitleBar(Form, FormTheme.Dark);
  133. end;
  134. {$IF CompilerVersion >= 36.0}
  135. HideGroupBoxFrames(Form);
  136. {$ENDIF}
  137. end;
  138. function InitFormThemeGetBkColor(const WindowColor: Boolean): TColor;
  139. begin
  140. if WindowColor then begin
  141. Result := FormTheme.Colors[tcBack]; { This is white if not dark mode }
  142. if Result = clWhite then
  143. Result := GetSysColor(COLOR_WINDOW); { For high contrast themes }
  144. end else
  145. Result := FormTheme.Colors[tcToolBack]; { This is gray/btnface if not dark mode }
  146. end;
  147. function InitFormThemeIsDark: Boolean;
  148. begin
  149. Result := FormTheme.Dark;
  150. end;
  151. function GetDisplayFilename(const Filename: String): String;
  152. var
  153. Buf: array[0..MAX_PATH-1] of Char;
  154. begin
  155. if CommDlg.GetFileTitle(PChar(Filename), Buf, SizeOf(Buf) div SizeOf(Buf[0])) = 0 then
  156. Result := Buf
  157. else
  158. Result := Filename;
  159. end;
  160. function GetFileTitle(const Filename: String): String;
  161. begin
  162. if Filename = '' then
  163. Result := 'Untitled'
  164. else
  165. Result := Filename;
  166. end;
  167. function GetCleanFileNameOfFile(const Filename: String): String;
  168. begin
  169. var Files := TDirectory.GetFiles(PathExtractDir(Filename), PathExtractName(Filename));
  170. if Length(Files) = 1 then
  171. Result := Files[0]
  172. else
  173. Result := Filename;
  174. end;
  175. function GetLastWriteTimeOfFile(const Filename: String;
  176. LastWriteTime: PFileTime): Boolean;
  177. var
  178. H: THandle;
  179. begin
  180. H := CreateFile(PChar(Filename), 0, FILE_SHARE_READ or FILE_SHARE_WRITE,
  181. nil, OPEN_EXISTING, 0, 0);
  182. if H <> INVALID_HANDLE_VALUE then begin
  183. Result := GetFileTime(H, nil, nil, LastWriteTime);
  184. CloseHandle(H);
  185. end
  186. else
  187. Result := False;
  188. end;
  189. procedure AddFileToRecentDocs(const Filename: String);
  190. { Notifies the shell that a document has been opened. This will
  191. add the file to the Recent section of the app's Jump List.
  192. It is only necessary to call this function when the shell is unaware that
  193. a file is being opened. Files opened through Explorer or common dialogs get
  194. added to the Jump List automatically. }
  195. begin
  196. SHAddToRecentDocs(SHARD_PATHW, PChar(Filename));
  197. end;
  198. function GenerateGuid: String;
  199. var
  200. Guid: TGUID;
  201. P: PWideChar;
  202. begin
  203. if CoCreateGuid(Guid) <> S_OK then
  204. raise Exception.Create('CoCreateGuid failed');
  205. if StringFromCLSID(Guid, P) <> S_OK then
  206. raise Exception.Create('StringFromCLSID failed');
  207. try
  208. Result := P;
  209. finally
  210. CoTaskMemFree(P);
  211. end;
  212. end;
  213. function ISPPInstalled: Boolean;
  214. begin
  215. Result := NewFileExists(PathExtractPath(NewParamStr(0)) + 'ISPP.dll');
  216. end;
  217. function IsISPPBuiltins(const Filename: String): Boolean;
  218. begin
  219. Result := PathCompare(PathExtractName(Filename), 'ISPPBuiltins.iss') = 0;
  220. end;
  221. var
  222. WindowsVersion: Cardinal;
  223. function WindowsVersionAtLeast(const AMajor, AMinor: Byte; const ABuild: Word): Boolean;
  224. begin
  225. Result := WindowsVersion >= Cardinal((AMajor shl 24) or (AMinor shl 16) or ABuild);
  226. end;
  227. function IsWindows10: Boolean;
  228. begin
  229. Result := WindowsVersionAtLeast(10, 0);
  230. end;
  231. function IsWindows11: Boolean;
  232. begin
  233. Result := WindowsVersionAtLeast(10, 0, 22000);
  234. end;
  235. function GetDefaultThemeType: TThemeType;
  236. begin
  237. if DarkModeActive then
  238. Result := ttModernDark
  239. else
  240. Result := ttModernLight;
  241. end;
  242. function GetDefaultKeyMappingType: TKeyMappingType;
  243. begin
  244. Result := kmtDelphi;
  245. end;
  246. function GetDefaultMemoKeyMappingType: TIDEScintKeyMappingType;
  247. begin
  248. Result := kmtDefault;
  249. end;
  250. procedure LaunchFileOrURL(const AFilename: String; const AParameters: String = '');
  251. begin
  252. { SEE_MASK_FLAG_NO_UI isn't used, so error dialogs are possible }
  253. const OwnerWnd = GetOwnerWndForMessageBox;
  254. const WindowList = DisableTaskWindows(OwnerWnd);
  255. try
  256. const Dir = GetSystemDir;
  257. var Info: TShellExecuteInfo;
  258. FillChar(Info, SizeOf(Info), 0);
  259. Info.cbSize := SizeOf(Info);
  260. Info.fMask := SEE_MASK_NOASYNC;
  261. Info.Wnd := OwnerWnd;
  262. Info.lpVerb := 'open';
  263. Info.lpFile := PChar(AFilename);
  264. Info.lpParameters := PChar(AParameters);
  265. Info.lpDirectory := PChar(Dir);
  266. Info.nShow := SW_SHOWNORMAL;
  267. ShellExecuteEx(@Info);
  268. finally
  269. EnableTaskWindows(WindowList);
  270. end;
  271. end;
  272. procedure OpenDonateSite;
  273. begin
  274. LaunchFileOrURL('https://jrsoftware.org/isdonate.php');
  275. end;
  276. procedure OpenMailingListSite;
  277. begin
  278. LaunchFileOrURL('https://jrsoftware.org/ismail.php');
  279. end;
  280. procedure LoadConfigIniList(const AIni: TConfigIniFile; const ASection, AIdent: String;
  281. const AList: TStringList; const ADelimiter: Char);
  282. begin
  283. if ASection = '' then
  284. raise Exception.Create('ASection must be set');
  285. var OldDelimiter := AList.Delimiter;
  286. AList.Delimiter := ADelimiter;
  287. try
  288. AList.DelimitedText := AIni.ReadString(ASection, AIdent, '');
  289. finally
  290. AList.Delimiter := OldDelimiter;
  291. end;
  292. end;
  293. procedure DeleteConfigIniList(const AIni: TConfigIniFile; const ASection, AIdent: String);
  294. begin
  295. if ASection = '' then
  296. raise Exception.Create('ASection must be set');
  297. AIni.DeleteKey(ASection, AIdent);
  298. end;
  299. procedure SaveConfigIniList(const AIni: TConfigIniFile; const ASection, AIdent: String;
  300. const AList: TStringList; const ADelimiter: Char);
  301. begin
  302. if AList.Count = 0 then begin
  303. DeleteConfigIniList(AIni, ASection, AIdent);
  304. Exit;
  305. end;
  306. if ASection = '' then
  307. raise Exception.Create('ASection must be set');
  308. var OldDelimiter := AList.Delimiter;
  309. AList.Delimiter := ADelimiter;
  310. try
  311. AIni.WriteString(ASection, AIdent, AList.DelimitedText);
  312. finally
  313. AList.Delimiter := OldDelimiter;
  314. end;
  315. end;
  316. procedure LoadKnownIncludedAndHiddenFiles(const AFilename: String; const IncludedFiles, HiddenFiles: TStringList);
  317. begin
  318. var Ini := TConfigIniFile.Create;
  319. try
  320. LoadConfigIniList(Ini, 'IncludedFilesHistory', AFilename, IncludedFiles, '*');
  321. LoadConfigIniList(Ini, 'HiddenFilesHistory', AFilename, HiddenFiles, '*');
  322. finally
  323. Ini.Free;
  324. end;
  325. end;
  326. procedure SaveKnownIncludedAndHiddenFiles(const AFilename: String; const IncludedFiles, HiddenFiles: TStringList);
  327. begin
  328. var Ini := TConfigIniFile.Create;
  329. try
  330. SaveConfigIniList(Ini, 'IncludedFilesHistory', AFilename, IncludedFiles, '*');
  331. SaveConfigIniList(Ini, 'HiddenFilesHistory', AFilename, HiddenFiles, '*');
  332. finally
  333. Ini.Free;
  334. end;
  335. end;
  336. procedure DeleteKnownIncludedAndHiddenFiles(const AFilename: String);
  337. begin
  338. var Ini := TConfigIniFile.Create;
  339. try
  340. DeleteConfigIniList(Ini, 'IncludedFilesHistory', AFilename);
  341. DeleteConfigIniList(Ini, 'HiddenFilesHistory', AFilename);
  342. finally
  343. Ini.Free;
  344. end;
  345. end;
  346. procedure LoadBreakPointLines(const AFilename: String; const BreakPointLines: TStringList);
  347. begin
  348. var Ini := TConfigIniFile.Create;
  349. try
  350. LoadConfigIniList(Ini, 'BreakPointLines', AFilename, BreakPointLines, ',');
  351. finally
  352. Ini.Free;
  353. end;
  354. end;
  355. procedure SaveBreakPointLines(const AFilename: String; const BreakPointLines: TStringList);
  356. begin
  357. var Ini := TConfigIniFile.Create;
  358. try
  359. SaveConfigIniList(Ini, 'BreakPointLines', AFilename, BreakPointLines, ',');
  360. finally
  361. Ini.Free;
  362. end;
  363. end;
  364. procedure DeleteBreakPointLines(const AFilename: String);
  365. begin
  366. var Ini := TConfigIniFile.Create;
  367. try
  368. DeleteConfigIniList(Ini, 'BreakPointLines', AFilename);
  369. finally
  370. Ini.Free;
  371. end;
  372. end;
  373. function NewShortCutToText(const ShortCut: TShortCut): String;
  374. { This function is better than Delphi's ShortCutToText function because it works
  375. for dead keys. A dead key is a key which waits for the user to press another
  376. key so it can be combined. For example `+e=è. Pressing space after a dead key
  377. produces the dead key char itself. For example `+space=`. }
  378. const
  379. { List of chars ShortCutToText knows about and doesn't rely on Win32's
  380. GetKeyNameText for, taken from Vcl.Menus.pas }
  381. OKKeys = [$08, $09, $0D, $1B, $20..$28, $2D..$2E, $30..$39, $41..$5A, $70..$87];
  382. begin
  383. Result := '';
  384. var Key := LoByte(Word(ShortCut));
  385. if not (Key in OKKeys) then begin
  386. { ShortCutToText will use Win32's GetKeyNameText for this key and if it's
  387. a dead key this gives long names like 'ACCENT CIRCONFLEXE' instead of a
  388. short name like '^'. Long names are not what we want so handle these dead
  389. keys ourselves and use ToUnicode instead of GetKeyNameText to find the
  390. short name. For non-dead keys we always call ShortCutToText even if
  391. ToUnicode might work as well. }
  392. var ScanCode := MapVirtualKey(Key, MAPVK_VK_TO_VSC);
  393. if ScanCode <> 0 then begin
  394. var KeyboardState: TKeyboardState;
  395. GetKeyboardState(KeyboardState);
  396. const TempSize = 64; { Same as Vcl.Touch.Keyboard.pas }
  397. var TempStr: String;
  398. SetLength(TempStr, TempSize);
  399. ZeroMemory(@TempStr[1], TempSize * SizeOf(Char));
  400. var Size := ToUnicode(Key, ScanCode, KeyboardState, @TempStr[1], TempSize, 0);
  401. if Size = -1 then begin
  402. { This was a dead key, now stored in TempStr. Add space to get the dead
  403. key char itself. }
  404. ScanCode := MapVirtualKey(VK_SPACE, MAPVK_VK_TO_VSC);
  405. if ScanCode <> 0 then begin
  406. Size := ToUnicode(VK_SPACE, ScanCode, KeyboardState, @TempStr[1], TempSize, 0);
  407. if Size = 1 then begin
  408. var Name := TempStr[1];
  409. if ShortCut and scShift <> 0 then Result := Result + SmkcShift;
  410. if ShortCut and scCtrl <> 0 then Result := Result + SmkcCtrl;
  411. if ShortCut and scAlt <> 0 then Result := Result + SmkcAlt;
  412. Result := Result + Name;
  413. end;
  414. end;
  415. end;
  416. end else begin
  417. { This virtual key has no scan code meaning it's impossible to enter with
  418. the current keyboard layout (for example French AZERTY + VK_OEM_MINUS).
  419. We can just exit because calling ShortCutToText is pointless. }
  420. Exit;
  421. end;
  422. end;
  423. if Result = '' then
  424. Result := ShortCutToText(ShortCut);
  425. { Example CompForm test code:
  426. SetFakeShortCut(HDonate, ShortCut(VK_OEM_1, []));
  427. SetFakeShortCut(HShortcutsDoc, ShortCut(VK_OEM_PLUS, []));
  428. SetFakeShortCut(HDoc, ShortCut(VK_OEM_COMMA, []));
  429. SetFakeShortCut(HExamples, ShortCut(VK_OEM_MINUS, []));
  430. SetFakeShortCut(HFaq, ShortCut(VK_OEM_PERIOD, []));
  431. SetFakeShortCut(HMailingList, ShortCut(VK_OEM_2, []));
  432. SetFakeShortCut(HWhatsNew, ShortCut(VK_OEM_3, []));
  433. SetFakeShortCut(HWebsite, ShortCut(VK_OEM_4, []));
  434. SetFakeShortCut(HISPPDoc, ShortCut(VK_OEM_5, []));
  435. SetFakeShortCut(HAbout, ShortCut(VK_OEM_6, []));
  436. SetFakeShortCut(TAddRemovePrograms, ShortCut(VK_OEM_7, []));
  437. Without our dead key handling this produces for example:
  438. -US International + VK_OEM_3: "GRAVE"
  439. -French AZERTY + VK_OEM_7: "ACCENT CIRCONFLEXE"
  440. To add a keyboard layout follow the instructions at
  441. https://www.thewindowsclub.com/add-or-remove-keyboard-layout-in-windows-11
  442. and then switch to the language using the task bar's language bar.
  443. Also see https://code.visualstudio.com/docs/getstarted/keybindings#_keyboard-layouts }
  444. end;
  445. procedure SetFakeShortCutText(const MenuItem: TMenuItem; const S: String);
  446. begin
  447. var Caption := MenuItem.Caption;
  448. var P := Pos(#9, Caption);
  449. if P <> 0 then
  450. Delete(Caption, P, MaxInt);
  451. if S <> '' then
  452. MenuItem.Caption := Caption + #9 + S
  453. else
  454. MenuItem.Caption := Caption;
  455. end;
  456. procedure SetFakeShortCut(const MenuItem: TMenuItem; const Key: Word;
  457. const Shift: TShiftState);
  458. begin
  459. SetFakeShortCut(MenuItem, ShortCut(Key, Shift));
  460. end;
  461. procedure SetFakeShortCut(const MenuItem: TMenuItem; const ShortCut: TShortCut);
  462. begin
  463. SetFakeShortCutText(MenuItem, NewShortCutToText(ShortCut));
  464. end;
  465. procedure SaveTextToFile(const Filename: String;
  466. const S: String; const SaveEncoding: TSaveEncoding);
  467. var
  468. AnsiMode: Boolean;
  469. AnsiStr: AnsiString;
  470. F: TTextFileWriter;
  471. begin
  472. AnsiMode := False;
  473. if SaveEncoding = seAuto then begin
  474. AnsiStr := AnsiString(S);
  475. if S = String(AnsiStr) then
  476. AnsiMode := True;
  477. end;
  478. F := TTextFileWriter.Create(Filename, fdCreateAlways, faWrite, fsNone);
  479. try
  480. if AnsiMode then
  481. F.WriteAnsi(AnsiStr)
  482. else begin
  483. F.UTF8WithoutBOM := SaveEncoding <> seUTF8WithBOM;
  484. F.Write(S);
  485. end;
  486. finally
  487. F.Free;
  488. end;
  489. end;
  490. procedure AddLines(const ListBox: TListBox; const S: String; const AObject: TObject; const LineBreaks: Boolean; const Prefix: TAddLinesPrefix; const PrefixParam: Cardinal);
  491. var
  492. ST: TSystemTime;
  493. LineNumber: Cardinal;
  494. procedure AddLine(S: String);
  495. var
  496. TimestampPrefixTab: Boolean;
  497. DC: HDC;
  498. Size: TSize;
  499. begin
  500. TimestampPrefixTab := False;
  501. case Prefix of
  502. alpTimestamp:
  503. begin
  504. if LineNumber = 0 then begin
  505. { Don't forget about ListBox's DrawItem if you change the format of the following timestamp. }
  506. Insert(Format('[%.2u%s%.2u%s%.2u%s%.3u] ', [ST.wHour, FormatSettings.TimeSeparator,
  507. ST.wMinute, FormatSettings.TimeSeparator, ST.wSecond, FormatSettings.DecimalSeparator,
  508. ST.wMilliseconds]), S, 1);
  509. end else begin
  510. Insert(#9, S, 1); { Not actually painted - just for Ctrl+C }
  511. TimestampPrefixTab := True;
  512. end;
  513. end;
  514. alpCountdown:
  515. begin
  516. Insert(Format('[%.2d] ', [PrefixParam-LineNumber]), S, 1);
  517. end;
  518. end;
  519. try
  520. ListBox.TopIndex := ListBox.Items.AddObject(S, AObject);
  521. except
  522. on EOutOfResources do begin
  523. ListBox.Clear;
  524. SendMessage(ListBox.Handle, LB_SETHORIZONTALEXTENT, 0, 0);
  525. ListBox.Items.Add(SCompilerStatusReset);
  526. ListBox.TopIndex := ListBox.Items.AddObject(S, AObject);
  527. end;
  528. end;
  529. DC := GetDC(0);
  530. try
  531. SelectObject(DC, ListBox.Font.Handle);
  532. if TimestampPrefixTab then
  533. GetTextExtentPoint(DC, PChar(S)+1, Length(S)-1, Size)
  534. else
  535. GetTextExtentPoint(DC, PChar(S), Length(S), Size);
  536. finally
  537. ReleaseDC(0, DC);
  538. end;
  539. Inc(Size.cx, 5);
  540. if TimestampPrefixTab then
  541. Inc(Size.cx, PrefixParam);
  542. if Size.cx > SendMessage(ListBox.Handle, LB_GETHORIZONTALEXTENT, 0, 0) then
  543. SendMessage(ListBox.Handle, LB_SETHORIZONTALEXTENT, Size.cx, 0);
  544. Inc(LineNumber);
  545. end;
  546. var
  547. LineStart, I: Integer;
  548. LastWasCR: Boolean;
  549. begin
  550. GetLocalTime(ST);
  551. if LineBreaks then begin
  552. LineNumber := 0;
  553. LineStart := 1;
  554. LastWasCR := False;
  555. { Call AddLine for each line. CR, LF, and CRLF line breaks are supported. }
  556. for I := 1 to Length(S) do begin
  557. if S[I] = #13 then begin
  558. AddLine(Copy(S, LineStart, I - LineStart));
  559. LineStart := I + 1;
  560. LastWasCR := True;
  561. end
  562. else begin
  563. if S[I] = #10 then begin
  564. if not LastWasCR then
  565. AddLine(Copy(S, LineStart, I - LineStart));
  566. LineStart := I + 1;
  567. end;
  568. LastWasCR := False;
  569. end;
  570. end;
  571. AddLine(Copy(S, LineStart, Maxint));
  572. end else
  573. AddLine(S);
  574. end;
  575. procedure SetLowPriority(ALowPriority: Boolean; var SavePriorityClass: DWORD);
  576. begin
  577. if ALowPriority then begin
  578. { Save current priority and change to 'low' }
  579. if SavePriorityClass = 0 then
  580. SavePriorityClass := GetPriorityClass(GetCurrentProcess);
  581. SetPriorityClass(GetCurrentProcess, IDLE_PRIORITY_CLASS);
  582. end
  583. else begin
  584. { Restore original priority }
  585. if SavePriorityClass <> 0 then begin
  586. SetPriorityClass(GetCurrentProcess, SavePriorityClass);
  587. SavePriorityClass := 0;
  588. end;
  589. end;
  590. end;
  591. var
  592. HelpFileDark: Boolean;
  593. procedure SetHelpFileDark(const Dark: Boolean);
  594. begin
  595. HelpFileDark := Dark;
  596. end;
  597. function GetHelpFile: String;
  598. begin
  599. Result := Format('%sisetup%s.chm', [PathExtractPath(NewParamStr(0)) {$IFDEF DEBUG} + '..\..\Files\' {$ENDIF}, IfThen(HelpFileDark, '-dark', '')]);
  600. end;
  601. function FindOptionsToSearchOptions(const FindOptions: TFindOptions;
  602. const RegEx: Boolean): TScintFindOptions;
  603. begin
  604. Result := [];
  605. if frMatchCase in FindOptions then
  606. Include(Result, sfoMatchCase);
  607. if frWholeWord in FindOptions then
  608. Include(Result, sfoWholeWord);
  609. if RegEx then
  610. Include(Result, sfoRegEx);
  611. end;
  612. function FindOptionsToSearchOptions(const MatchCase: Boolean;
  613. const RegEx: Boolean): TScintFindOptions; overload;
  614. begin
  615. Result := [];
  616. if MatchCase then
  617. Include(Result, sfoMatchCase);
  618. if RegEx then
  619. Include(Result, sfoRegEx);
  620. end;
  621. function RegExToReplaceMode(const RegEx: Boolean): TScintReplaceMode;
  622. begin
  623. if RegEx then
  624. Result := srmRegEx
  625. else
  626. Result := srmMinimal;
  627. end;
  628. function GetSourcePath(const AFilename: String): String;
  629. begin
  630. if AFilename <> '' then
  631. Result := PathExtractPath(AFilename)
  632. else begin
  633. { If the script was not saved, default to My Documents }
  634. Result := GetShellFolderPath(CSIDL_PERSONAL);
  635. if Result = '' then
  636. raise Exception.Create('GetShellFolderPath failed');
  637. end;
  638. end;
  639. function ReadScriptLines(const ALines: TStringList; const ReadFromFile: Boolean;
  640. const ReadFromFileFilename: String; const NotReadFromFileMemo: TScintEdit): Integer;
  641. function ContainsNullChar(const S: String): Boolean;
  642. var
  643. I: Integer;
  644. begin
  645. Result := False;
  646. for I := 1 to Length(S) do
  647. if S[I] = #0 then begin
  648. Result := True;
  649. Break;
  650. end;
  651. end;
  652. var
  653. F: TTextFileReader;
  654. I: Integer;
  655. begin
  656. if ReadFromFile then begin
  657. F := TTextFileReader.Create(ReadFromFileFilename, fdOpenExisting, faRead, fsRead);
  658. try
  659. while not F.Eof do
  660. ALines.Add(F.ReadLine);
  661. finally
  662. F.Free;
  663. end;
  664. end
  665. else begin
  666. ALines.Capacity := NotReadFromFileMemo.Lines.Count;
  667. ALines.Assign(NotReadFromFileMemo.Lines);
  668. end;
  669. { Check for null characters }
  670. for I := 0 to ALines.Count-1 do begin
  671. if ContainsNullChar(ALines[I]) then begin
  672. Result := I;
  673. Exit;
  674. end;
  675. end;
  676. Result := -1;
  677. end;
  678. function CreateBitmapInfo(const Width, Height, BitCount: Integer): TBitmapInfo;
  679. begin
  680. ZeroMemory(@Result, SizeOf(Result));
  681. Result.bmiHeader.biSize := SizeOf(Result.bmiHeader);
  682. Result.bmiHeader.biWidth := Width;
  683. Result.bmiHeader.biHeight := Height;
  684. Result.bmiHeader.biPlanes := 1;
  685. Result.bmiHeader.biBitCount := BitCount;
  686. Result.bmiHeader.biCompression := BI_RGB;
  687. end;
  688. var
  689. PreferredMemoFont: String;
  690. function GetPreferredMemoFont: String;
  691. begin
  692. Result := PreferredMemoFont;
  693. end;
  694. function DoubleAmp(const S: String): String;
  695. var
  696. I: Integer;
  697. begin
  698. Result := S;
  699. I := 1;
  700. while I <= Length(Result) do begin
  701. if Result[I] = '&' then begin
  702. Inc(I);
  703. Insert('&', Result, I);
  704. Inc(I);
  705. end
  706. else
  707. Inc(I, PathCharLength(S, I));
  708. end;
  709. end;
  710. initialization
  711. var OSVersionInfo: TOSVersionInfo;
  712. OSVersionInfo.dwOSVersionInfoSize := SizeOf(OSVersionInfo);
  713. GetVersionEx(OSVersionInfo);
  714. WindowsVersion := (Byte(OSVersionInfo.dwMajorVersion) shl 24) or (Byte(OSVersionInfo.dwMinorVersion) shl 16) or Word(OSVersionInfo.dwBuildNumber);
  715. PreferredMemoFont := 'Consolas';
  716. if not FontExists(PreferredMemoFont) then
  717. PreferredMemoFont := 'Courier New';
  718. end.