Apputils.pas
上传用户:hylc_2004
上传日期:2014-01-23
资源大小:46800k
文件大小:26k
源码类别:

Delphi控件源码

开发平台:

Delphi

  1. {*******************************************************}
  2. {                                                       }
  3. {         Delphi VCL Extensions (RX)                    }
  4. {                                                       }
  5. {         Copyright (c) 1995, 1996 AO ROSNO             }
  6. {         Copyright (c) 1997, 1998 Master-Bank          }
  7. {                                                       }
  8. {*******************************************************}
  9. unit AppUtils;
  10. interface
  11. {$I RX.INC}
  12. uses Windows, Registry, RTLConsts, Classes, Controls, Forms, IniFiles, Grids, VCLUtils;
  13. function GetDefaultSection(Component: TComponent): string;
  14. procedure GetDefaultIniData(Control: TControl; var IniFileName,
  15.   Section: string {$IFDEF WIN32}; UseRegistry: Boolean {$ENDIF});
  16. function GetDefaultIniName: string;
  17. type
  18.   TOnGetDefaultIniName = function: string;
  19. const
  20.   OnGetDefaultIniName: TOnGetDefaultIniName = nil;
  21. {$IFDEF WIN32}
  22. var
  23.   DefCompanyName: string = '';
  24.   RegUseAppTitle: Boolean = False;
  25. function GetDefaultIniRegKey: string;
  26. {$ENDIF}
  27. function FindForm(FormClass: TFormClass): TForm;
  28. function FindShowForm(FormClass: TFormClass; const Caption: string): TForm;
  29. function ShowDialog(FormClass: TFormClass): Boolean;
  30. function InstantiateForm(FormClass: TFormClass; var Reference): TForm;
  31. {$IFDEF WIN32}
  32. procedure SaveFormPlacement(Form: TForm; const IniFileName: string;
  33.   UseRegistry: Boolean);
  34. procedure RestoreFormPlacement(Form: TForm; const IniFileName: string;
  35.   UseRegistry: Boolean);
  36. procedure WriteFormPlacementReg(Form: TForm; IniFile: TRegIniFile;
  37.   const Section: string);
  38. procedure ReadFormPlacementReg(Form: TForm; IniFile: TRegIniFile;
  39.   const Section: string; LoadState, LoadPosition: Boolean);
  40. procedure SaveMDIChildrenReg(MainForm: TForm; IniFile: TRegIniFile);
  41. procedure RestoreMDIChildrenReg(MainForm: TForm; IniFile: TRegIniFile);
  42. procedure RestoreGridLayoutReg(Grid: TCustomGrid; IniFile: TRegIniFile);
  43. procedure SaveGridLayoutReg(Grid: TCustomGrid; IniFile: TRegIniFile);
  44. {$ELSE}
  45. procedure SaveFormPlacement(Form: TForm; const IniFileName: string);
  46. procedure RestoreFormPlacement(Form: TForm; const IniFileName: string);
  47. {$ENDIF WIN32}
  48. procedure WriteFormPlacement(Form: TForm; IniFile: TIniFile;
  49.   const Section: string);
  50. procedure ReadFormPlacement(Form: TForm; IniFile: TIniFile;
  51.   const Section: string; LoadState, LoadPosition: Boolean);
  52. procedure SaveMDIChildren(MainForm: TForm; IniFile: TIniFile);
  53. procedure RestoreMDIChildren(MainForm: TForm; IniFile: TIniFile);
  54. procedure RestoreGridLayout(Grid: TCustomGrid; IniFile: TIniFile);
  55. procedure SaveGridLayout(Grid: TCustomGrid; IniFile: TIniFile);
  56. function GetUniqueFileNameInDir(const Path, FileNameMask: string): string;
  57. function StrToIniStr(const Str: string): string;
  58. function IniStrToStr(const Str: string): string;
  59. function IniReadString(IniFile: TObject; const Section, Ident,
  60.   Default: string): string;
  61. procedure IniWriteString(IniFile: TObject; const Section, Ident,
  62.   Value: string);
  63. function IniReadInteger(IniFile: TObject; const Section, Ident: string;
  64.   Default: Longint): Longint;
  65. procedure IniWriteInteger(IniFile: TObject; const Section, Ident: string;
  66.   Value: Longint);
  67. function IniReadBool(IniFile: TObject; const Section, Ident: string;
  68.   Default: Boolean): Boolean;
  69. procedure IniWriteBool(IniFile: TObject; const Section, Ident: string;
  70.   Value: Boolean);
  71. procedure IniReadSections(IniFile: TObject; Strings: TStrings);
  72. procedure IniEraseSection(IniFile: TObject; const Section: string);
  73. procedure IniDeleteKey(IniFile: TObject; const Section, Ident: string);
  74. {$IFDEF WIN32}
  75. procedure AppBroadcast(Msg, wParam: Longint; lParam: Longint);
  76. {$ELSE}
  77. procedure AppBroadcast(Msg, wParam: Word; lParam: Longint);
  78. {$ENDIF WIN32}
  79. procedure AppTaskbarIcons(AppOnly: Boolean);
  80. { Internal using utilities }
  81. procedure InternalSaveGridLayout(Grid: TCustomGrid; IniFile: TObject;
  82.   const Section: string);
  83. procedure InternalRestoreGridLayout(Grid: TCustomGrid; IniFile: TObject;
  84.   const Section: string);
  85. procedure InternalSaveMDIChildren(MainForm: TForm; IniFile: TObject);
  86. procedure InternalRestoreMDIChildren(MainForm: TForm; IniFile: TObject);
  87. implementation
  88. uses SysUtils, Messages, Consts, rxStrUtils, FileUtil, Placemnt;
  89. function GetDefaultSection(Component: TComponent): string;
  90. var
  91.   F: TCustomForm;
  92.   Owner: TComponent;
  93. begin
  94.   if Component <> nil then begin
  95.     if Component is TCustomForm then Result := Component.ClassName
  96.     else begin
  97.       Result := Component.Name;
  98.       if Component is TControl then begin
  99.         F := GetParentForm(TControl(Component));
  100.         if F <> nil then Result := F.ClassName + Result
  101.         else begin
  102.           if TControl(Component).Parent <> nil then
  103.             Result := TControl(Component).Parent.Name + Result;
  104.         end;
  105.       end
  106.       else begin
  107.         Owner := Component.Owner;
  108.         if Owner is TForm then
  109.           Result := Format('%s.%s', [Owner.ClassName, Result]);
  110.       end;
  111.     end;
  112.   end
  113.   else Result := '';
  114. end;
  115. function GetDefaultIniName: string;
  116. begin
  117.   if Assigned(OnGetDefaultIniName) then
  118.     Result:= OnGetDefaultIniName
  119.   else
  120.     Result := ExtractFileName(ChangeFileExt(Application.ExeName, '.INI'));
  121. end;
  122. {$IFDEF WIN32}
  123. function GetDefaultIniRegKey: string;
  124. begin
  125.   if RegUseAppTitle and (Application.Title <> '') then
  126.     Result := Application.Title
  127.   else Result := ExtractFileName(ChangeFileExt(Application.ExeName, ''));
  128.   if DefCompanyName <> '' then
  129.     Result := DefCompanyName + '' + Result;
  130.   Result := 'Software' + Result;
  131. end;
  132. {$ENDIF}
  133. procedure GetDefaultIniData(Control: TControl; var IniFileName,
  134.   Section: string {$IFDEF WIN32}; UseRegistry: Boolean {$ENDIF});
  135. var
  136.   I: Integer;
  137. begin
  138.   IniFileName := EmptyStr;
  139.   with Control do
  140.     if Owner is TCustomForm then
  141.       for I := 0 to Owner.ComponentCount - 1 do
  142.         if (Owner.Components[I] is TFormPlacement) then begin
  143.           IniFileName := TFormPlacement(Owner.Components[I]).IniFileName;
  144.           Break;
  145.         end;
  146.   Section := GetDefaultSection(Control);
  147.   if IniFileName = EmptyStr then
  148. {$IFDEF WIN32}
  149.     if UseRegistry then IniFileName := GetDefaultIniRegKey
  150.     else
  151. {$ENDIF}
  152.     IniFileName := GetDefaultIniName;
  153. end;
  154. function FindForm(FormClass: TFormClass): TForm;
  155. var
  156.   I: Integer;
  157. begin
  158.   Result := nil;
  159.   for I := 0 to Screen.FormCount - 1 do begin
  160.     if Screen.Forms[I] is FormClass then begin
  161.       Result := Screen.Forms[I];
  162.       Break;
  163.     end;
  164.   end;
  165. end;
  166. function InternalFindShowForm(FormClass: TFormClass;
  167.   const Caption: string; Restore: Boolean): TForm;
  168. var
  169.   I: Integer;
  170. begin
  171.   Result := nil;
  172.   for I := 0 to Screen.FormCount - 1 do begin
  173.     if Screen.Forms[I] is FormClass then
  174.       if (Caption = '') or (Caption = Screen.Forms[I].Caption) then begin
  175.         Result := Screen.Forms[I];
  176.         Break;
  177.       end;
  178.   end;
  179.   if Result = nil then begin
  180.     Application.CreateForm(FormClass, Result);
  181.     if Caption <> '' then Result.Caption := Caption;
  182.   end;
  183.   with Result do begin
  184.     if Restore and (WindowState = wsMinimized) then WindowState := wsNormal;
  185.     Show;
  186.   end;
  187. end;
  188. function FindShowForm(FormClass: TFormClass; const Caption: string): TForm;
  189. begin
  190.   Result := InternalFindShowForm(FormClass, Caption, True);
  191. end;
  192. function ShowDialog(FormClass: TFormClass): Boolean;
  193. var
  194.   Dlg: TForm;
  195. begin
  196.   Application.CreateForm(FormClass, Dlg);
  197.   try
  198.     Result := Dlg.ShowModal in [mrOk, mrYes];
  199.   finally
  200.     Dlg.Free;
  201.   end;
  202. end;
  203. function InstantiateForm(FormClass: TFormClass; var Reference): TForm;
  204. begin
  205.   if TForm(Reference) = nil then
  206.     Application.CreateForm(FormClass, Reference);
  207.   Result := TForm(Reference);
  208. end;
  209. function StrToIniStr(const Str: string): string;
  210. var
  211. {$IFDEF WIN32}
  212.   Buffer: array[0..4095] of Char;
  213. {$ELSE}
  214.   Buffer: array[0..255] of Char;
  215. {$ENDIF}
  216.   B, S: PChar;
  217. begin
  218.   if Length(Str) > SizeOf(Buffer) then
  219.     raise Exception.Create(ResStr(SLineTooLong));
  220. {$IFDEF WIN32}
  221.   S := PChar(Str);
  222. {$ELSE}
  223.   S := StrPAlloc(Str);
  224. {$ENDIF}
  225.   try
  226.     B := Buffer;
  227.     while S^ <> #0 do
  228.       case S^ of
  229.         #13, #10:
  230.           begin
  231.             if (S^ = #13) and (S[1] = #10) then Inc(S)
  232.             else if (S^ = #10) and (S[1] = #13) then Inc(S);
  233.             B^ := '';
  234.             Inc(B);
  235.             B^ := 'n';
  236.             Inc(B);
  237.             Inc(S);
  238.           end;
  239.       else
  240.         B^ := S^;
  241.         Inc(B);
  242.         Inc(S);
  243.       end;
  244.   finally
  245. {$IFNDEF WIN32}
  246.     StrDispose(S);
  247. {$ENDIF}
  248.   end;
  249.   B^ := #0;
  250.   Result := StrPas(Buffer);
  251. end;
  252. function IniStrToStr(const Str: string): string;
  253. var
  254. {$IFDEF WIN32}
  255.   Buffer: array[0..4095] of Char;
  256. {$ELSE}
  257.   Buffer: array[0..255] of Char;
  258. {$ENDIF}
  259.   B, S: PChar;
  260. begin
  261.   if Length(Str) > SizeOf(Buffer) then
  262.     raise Exception.Create(ResStr(SLineTooLong));
  263. {$IFDEF WIN32}
  264.   S := PChar(Str);
  265. {$ELSE}
  266.   S := StrPAlloc(Str);
  267. {$ENDIF}
  268.   try
  269.     B := Buffer;
  270.     while S^ <> #0 do
  271.       if (S[0] = '') and (S[1] = 'n') then
  272.       begin
  273.         B^ := #13;
  274.         Inc(B);
  275.         B^ := #10;
  276.         Inc(B);
  277.         Inc(S);
  278.         Inc(S);
  279.       end
  280.       else
  281.       begin
  282.         B^ := S^;
  283.         Inc(B);
  284.         Inc(S);
  285.       end;
  286.   finally
  287. {$IFNDEF WIN32}
  288.     StrDispose(S);
  289. {$ENDIF}
  290.   end;
  291.   B^ := #0;
  292.   Result := StrPas(Buffer);
  293. end;
  294. const
  295. { The following strings should not be localized }
  296.   siFlags     = 'Flags';
  297.   siShowCmd   = 'ShowCmd';
  298.   siMinMaxPos = 'MinMaxPos';
  299.   siNormPos   = 'NormPos';
  300.   siPixels    = 'PixelsPerInch';
  301.   siMDIChild  = 'MDI Children';
  302.   siListCount = 'Count';
  303.   siItem      = 'Item%d';
  304. function IniReadString(IniFile: TObject; const Section, Ident,
  305.   Default: string): string;
  306. begin
  307. {$IFDEF WIN32}
  308.   if IniFile is TRegIniFile then
  309.     Result := TRegIniFile(IniFile).ReadString(Section, Ident, Default)
  310.   else
  311. {$ENDIF}
  312.   if IniFile is TIniFile then
  313.     Result := TIniFile(IniFile).ReadString(Section, Ident, Default)
  314.   else Result := Default;
  315. end;
  316. procedure IniWriteString(IniFile: TObject; const Section, Ident,
  317.   Value: string);
  318. var
  319.   S: string;
  320. begin
  321. {$IFDEF WIN32}
  322.   if IniFile is TRegIniFile then
  323.     TRegIniFile(IniFile).WriteString(Section, Ident, Value)
  324.   else begin
  325. {$ENDIF}
  326.     S := Value;
  327.     if S <> '' then begin
  328.       if ((S[1] = '"') and (S[Length(S)] = '"')) or
  329.         ((S[1] = '''') and (S[Length(S)] = '''')) then
  330.         S := '"' + S + '"';
  331.     end;
  332.     if IniFile is TIniFile then
  333.       TIniFile(IniFile).WriteString(Section, Ident, S);
  334. {$IFDEF WIN32}
  335.   end;
  336. {$ENDIF}
  337. end;
  338. function IniReadInteger(IniFile: TObject; const Section, Ident: string;
  339.   Default: Longint): Longint;
  340. begin
  341. {$IFDEF WIN32}
  342.   if IniFile is TRegIniFile then
  343.     Result := TRegIniFile(IniFile).ReadInteger(Section, Ident, Default)
  344.   else
  345. {$ENDIF}
  346.   if IniFile is TIniFile then
  347.     Result := TIniFile(IniFile).ReadInteger(Section, Ident, Default)
  348.   else Result := Default;
  349. end;
  350. procedure IniWriteInteger(IniFile: TObject; const Section, Ident: string;
  351.   Value: Longint);
  352. begin
  353. {$IFDEF WIN32}
  354.   if IniFile is TRegIniFile then
  355.     TRegIniFile(IniFile).WriteInteger(Section, Ident, Value)
  356.   else
  357. {$ENDIF}
  358.   if IniFile is TIniFile then
  359.     TIniFile(IniFile).WriteInteger(Section, Ident, Value);
  360. end;
  361. function IniReadBool(IniFile: TObject; const Section, Ident: string;
  362.   Default: Boolean): Boolean;
  363. begin
  364. {$IFDEF WIN32}
  365.   if IniFile is TRegIniFile then
  366.     Result := TRegIniFile(IniFile).ReadBool(Section, Ident, Default)
  367.   else
  368. {$ENDIF}
  369.   if IniFile is TIniFile then
  370.     Result := TIniFile(IniFile).ReadBool(Section, Ident, Default)
  371.   else Result := Default;
  372. end;
  373. procedure IniWriteBool(IniFile: TObject; const Section, Ident: string;
  374.   Value: Boolean);
  375. begin
  376. {$IFDEF WIN32}
  377.   if IniFile is TRegIniFile then
  378.     TRegIniFile(IniFile).WriteBool(Section, Ident, Value)
  379.   else
  380. {$ENDIF}
  381.   if IniFile is TIniFile then
  382.     TIniFile(IniFile).WriteBool(Section, Ident, Value);
  383. end;
  384. procedure IniEraseSection(IniFile: TObject; const Section: string);
  385. begin
  386. {$IFDEF WIN32}
  387.   if IniFile is TRegIniFile then
  388.     TRegIniFile(IniFile).EraseSection(Section)
  389.   else
  390. {$ENDIF}
  391.   if IniFile is TIniFile then
  392.     TIniFile(IniFile).EraseSection(Section);
  393. end;
  394. procedure IniDeleteKey(IniFile: TObject; const Section, Ident: string);
  395. {$IFNDEF WIN32}
  396. var
  397.   CSection: array[0..127] of Char;
  398.   CIdent: array[0..127] of Char;
  399.   CFileName: array[0..127] of Char;
  400. {$ENDIF}
  401. begin
  402. {$IFDEF WIN32}
  403.   if IniFile is TRegIniFile then
  404.     TRegIniFile(IniFile).DeleteKey(Section, Ident)
  405.   else if IniFile is TIniFile then
  406.     TIniFile(IniFile).DeleteKey(Section, Ident);
  407. {$ELSE}
  408.   if IniFile is TIniFile then begin
  409.     WritePrivateProfileString(StrPLCopy(CSection, Section, SizeOf(CSection) - 1),
  410.       StrPLCopy(CIdent, Ident, SizeOf(CIdent) - 1), nil,
  411.       StrPLCopy(CFileName, TIniFile(IniFile).FileName, SizeOf(CFileName) - 1));
  412.   end;
  413. {$ENDIF}
  414. end;
  415. {$IFNDEF WIN32}
  416. procedure IniFileReadSections(IniFile: TIniFile; Strings: TStrings);
  417. const
  418.   BufSize = 8192;
  419. var
  420.   CFileName: array[0..127] of Char;
  421.   Buffer, P: PChar;
  422. begin
  423.   GetMem(Buffer, BufSize);
  424.   try
  425.     Strings.BeginUpdate;
  426.     try
  427.       Strings.Clear;
  428.       if GetPrivateProfileString(nil, nil, nil, Buffer, BufSize,
  429.         StrPLCopy(CFileName, IniFile.FileName, SizeOf(CFileName) - 1)) <> 0 then
  430.       begin
  431.         P := Buffer;
  432.         while P^ <> #0 do begin
  433.           Strings.Add(StrPas(P));
  434.           Inc(P, StrLen(P) + 1);
  435.         end;
  436.       end;
  437.     finally
  438.       Strings.EndUpdate;
  439.     end;
  440.   finally
  441.     FreeMem(Buffer, BufSize);
  442.   end;
  443. end;
  444. {$ENDIF}
  445. procedure IniReadSections(IniFile: TObject; Strings: TStrings);
  446. begin
  447. {$IFDEF WIN32}
  448.   if IniFile is TIniFile then
  449.     TIniFile(IniFile).ReadSections(Strings)
  450.   else if IniFile is TRegIniFile then
  451.     TRegIniFile(IniFile).ReadSections(Strings);
  452. {$ELSE}
  453.   if IniFile is TIniFile then
  454.     IniFileReadSections(TIniFile(IniFile), Strings);
  455. {$ENDIF}
  456. end;
  457. procedure InternalSaveMDIChildren(MainForm: TForm; IniFile: TObject);
  458. var
  459.   I: Integer;
  460. begin
  461.   if (MainForm = nil) or (MainForm.FormStyle <> fsMDIForm) then
  462.     raise EInvalidOperation.Create(ResStr(SNoMDIForm));
  463.   IniEraseSection(IniFile, siMDIChild);
  464.   if MainForm.MDIChildCount > 0 then begin
  465.     IniWriteInteger(IniFile, siMDIChild, siListCount,
  466.       MainForm.MDIChildCount);
  467.     for I := 0 to MainForm.MDIChildCount - 1 do
  468.       IniWriteString(IniFile, siMDIChild, Format(siItem, [I]),
  469.         MainForm.MDIChildren[I].ClassName);
  470.   end;
  471. end;
  472. procedure InternalRestoreMDIChildren(MainForm: TForm; IniFile: TObject);
  473. var
  474.   I: Integer;
  475.   Count: Integer;
  476.   FormClass: TFormClass;
  477. begin
  478.   if (MainForm = nil) or (MainForm.FormStyle <> fsMDIForm) then
  479.     raise EInvalidOperation.Create(ResStr(SNoMDIForm));
  480.   StartWait;
  481.   try
  482.     Count := IniReadInteger(IniFile, siMDIChild, siListCount, 0);
  483.     if Count > 0 then begin
  484.       for I := 0 to Count - 1 do begin
  485.         FormClass := TFormClass(GetClass(IniReadString(IniFile, siMDIChild,
  486.           Format(siItem, [Count - I - 1]), '')));
  487.         if FormClass <> nil then
  488.           InternalFindShowForm(FormClass, '', False);
  489.       end;
  490.     end;
  491.   finally
  492.     StopWait;
  493.   end;
  494. end;
  495. {$IFDEF WIN32}
  496. procedure SaveMDIChildrenReg(MainForm: TForm; IniFile: TRegIniFile);
  497. begin
  498.   InternalSaveMDIChildren(MainForm, IniFile);
  499. end;
  500. procedure RestoreMDIChildrenReg(MainForm: TForm; IniFile: TRegIniFile);
  501. begin
  502.   InternalRestoreMDIChildren(MainForm, IniFile);
  503. end;
  504. {$ENDIF WIN32}
  505. procedure SaveMDIChildren(MainForm: TForm; IniFile: TIniFile);
  506. begin
  507.   InternalSaveMDIChildren(MainForm, IniFile);
  508. end;
  509. procedure RestoreMDIChildren(MainForm: TForm; IniFile: TIniFile);
  510. begin
  511.   InternalRestoreMDIChildren(MainForm, IniFile);
  512. end;
  513. procedure InternalSaveGridLayout(Grid: TCustomGrid; IniFile: TObject;
  514.   const Section: string);
  515. var
  516.   I: Longint;
  517. begin
  518.   for I := 0 to TDrawGrid(Grid).ColCount - 1 do
  519.     IniWriteInteger(IniFile, Section, Format(siItem, [I]),
  520.       TDrawGrid(Grid).ColWidths[I]);
  521. end;
  522. procedure InternalRestoreGridLayout(Grid: TCustomGrid; IniFile: TObject;
  523.   const Section: string);
  524. var
  525.   I: Longint;
  526. begin
  527.   for I := 0 to TDrawGrid(Grid).ColCount - 1 do
  528.     TDrawGrid(Grid).ColWidths[I] := IniReadInteger(IniFile, Section,
  529.       Format(siItem, [I]), TDrawGrid(Grid).ColWidths[I]);
  530. end;
  531. {$IFDEF WIN32}
  532. procedure RestoreGridLayoutReg(Grid: TCustomGrid; IniFile: TRegIniFile);
  533. begin
  534.   InternalRestoreGridLayout(Grid, IniFile, GetDefaultSection(Grid));
  535. end;
  536. procedure SaveGridLayoutReg(Grid: TCustomGrid; IniFile: TRegIniFile);
  537. begin
  538.   InternalSaveGridLayout(Grid, IniFile, GetDefaultSection(Grid));
  539. end;
  540. {$ENDIF WIN32}
  541. procedure RestoreGridLayout(Grid: TCustomGrid; IniFile: TIniFile);
  542. begin
  543.   InternalRestoreGridLayout(Grid, IniFile, GetDefaultSection(Grid));
  544. end;
  545. procedure SaveGridLayout(Grid: TCustomGrid; IniFile: TIniFile);
  546. begin
  547.   InternalSaveGridLayout(Grid, IniFile, GetDefaultSection(Grid));
  548. end;
  549. function CrtResString: string;
  550. begin
  551.   Result := Format('(%dx%d)', [GetSystemMetrics(SM_CXSCREEN),
  552.     GetSystemMetrics(SM_CYSCREEN)]);
  553. end;
  554. function ReadPosStr(IniFile: TObject; const Section, Ident: string): string;
  555. begin
  556.   Result := IniReadString(IniFile, Section, Ident + CrtResString, '');
  557.   if Result = '' then Result := IniReadString(IniFile, Section, Ident, '');
  558. end;
  559. procedure WritePosStr(IniFile: TObject; const Section, Ident, Value: string);
  560. begin
  561.   IniWriteString(IniFile, Section, Ident + CrtResString, Value);
  562.   IniWriteString(IniFile, Section, Ident, Value);
  563. end;
  564. procedure InternalWriteFormPlacement(Form: TForm; IniFile: TObject;
  565.   const Section: string);
  566. var
  567.   Placement: TWindowPlacement;
  568. begin
  569.   Placement.Length := SizeOf(TWindowPlacement);
  570.   GetWindowPlacement(Form.Handle, @Placement);
  571.   with Placement, TForm(Form) do begin
  572.     if (Form = Application.MainForm) and IsIconic(Application.Handle) then
  573.       ShowCmd := SW_SHOWMINIMIZED;
  574.     if (FormStyle = fsMDIChild) and (WindowState = wsMinimized) then
  575.       Flags := Flags or WPF_SETMINPOSITION;
  576.     IniWriteInteger(IniFile, Section, siFlags, Flags);
  577.     IniWriteInteger(IniFile, Section, siShowCmd, ShowCmd);
  578.     IniWriteInteger(IniFile, Section, siPixels, Screen.PixelsPerInch);
  579.     WritePosStr(IniFile, Section, siMinMaxPos, Format('%d,%d,%d,%d',
  580.       [ptMinPosition.X, ptMinPosition.Y, ptMaxPosition.X, ptMaxPosition.Y]));
  581.     WritePosStr(IniFile, Section, siNormPos, Format('%d,%d,%d,%d',
  582.       [rcNormalPosition.Left, rcNormalPosition.Top, rcNormalPosition.Right,
  583.       rcNormalPosition.Bottom]));
  584.   end;
  585. end;
  586. {$IFDEF WIN32}
  587. procedure WriteFormPlacementReg(Form: TForm; IniFile: TRegIniFile;
  588.   const Section: string);
  589. begin
  590.   InternalWriteFormPlacement(Form, IniFile, Section);
  591. end;
  592. {$ENDIF WIN32}
  593. procedure WriteFormPlacement(Form: TForm; IniFile: TIniFile;
  594.   const Section: string);
  595. begin
  596.   InternalWriteFormPlacement(Form, IniFile, Section);
  597. end;
  598. {$IFDEF WIN32}
  599. procedure SaveFormPlacement(Form: TForm; const IniFileName: string;
  600.   UseRegistry: Boolean);
  601. {$ELSE}
  602. procedure SaveFormPlacement(Form: TForm; const IniFileName: string);
  603. {$ENDIF WIN32}
  604. var
  605.   IniFile: TObject;
  606. begin
  607. {$IFDEF WIN32}
  608.   if UseRegistry then IniFile := TRegIniFile.Create(IniFileName)
  609.   else IniFile := TIniFile.Create(IniFileName);
  610. {$ELSE}
  611.   IniFile := TIniFile.Create(IniFileName);
  612. {$ENDIF WIN32}
  613.   try
  614.     InternalWriteFormPlacement(Form, IniFile, Form.ClassName);
  615.   finally
  616.     IniFile.Free;
  617.   end;
  618. end;
  619. {$IFDEF WIN32}
  620.   {$HINTS OFF}
  621. {$ENDIF}
  622. type
  623. {*******************************************************}
  624. { !! ATTENTION Nasty implementation                     }
  625. {*******************************************************}
  626. {                                                       }
  627. { This class definition was copied from FORMS.PAS.      }
  628. { It is needed to access some private fields of TForm.  }
  629. {                                                       }
  630. { Any changes in the underlying classes may cause       }
  631. { errors in this implementation!                        }
  632. {                                                       }
  633. {*******************************************************}
  634.   TNastyForm = class(TScrollingWinControl)
  635.   private
  636.     FActiveControl: TWinControl;
  637.     FFocusedControl: TWinControl;
  638.     FBorderIcons: TBorderIcons;
  639.     FBorderStyle: TFormBorderStyle;
  640. {$IFDEF RX_D4}
  641.     FSizeChanging: Boolean;
  642. {$ENDIF}
  643.     FWindowState: TWindowState; { !! }
  644.   end;
  645.   THackComponent = class(TComponent);
  646. {$IFDEF WIN32}
  647.   {$HINTS ON}
  648. {$ENDIF}
  649. procedure InternalReadFormPlacement(Form: TForm; IniFile: TObject;
  650.   const Section: string; LoadState, LoadPosition: Boolean);
  651. const
  652.   Delims = [',',' '];
  653. var
  654.   PosStr: string;
  655.   Placement: TWindowPlacement;
  656.   WinState: TWindowState;
  657.   DataFound: Boolean;
  658. begin
  659.   if not (LoadState or LoadPosition) then Exit;
  660.   Placement.Length := SizeOf(TWindowPlacement);
  661.   GetWindowPlacement(Form.Handle, @Placement);
  662.   with Placement, TForm(Form) do begin
  663.     if not IsWindowVisible(Form.Handle) then
  664.       ShowCmd := SW_HIDE;
  665.     if LoadPosition then begin
  666.       DataFound := False;
  667.       Flags := IniReadInteger(IniFile, Section, siFlags, Flags);
  668.       PosStr := ReadPosStr(IniFile, Section, siMinMaxPos);
  669.       if PosStr <> '' then begin
  670.         DataFound := True;
  671.         ptMinPosition.X := StrToIntDef(ExtractWord(1, PosStr, Delims), 0);
  672.         ptMinPosition.Y := StrToIntDef(ExtractWord(2, PosStr, Delims), 0);
  673.         ptMaxPosition.X := StrToIntDef(ExtractWord(3, PosStr, Delims), 0);
  674.         ptMaxPosition.Y := StrToIntDef(ExtractWord(4, PosStr, Delims), 0);
  675.       end;
  676.       PosStr := ReadPosStr(IniFile, Section, siNormPos);
  677.       if PosStr <> '' then begin
  678.         DataFound := True;
  679.         rcNormalPosition.Left := StrToIntDef(ExtractWord(1, PosStr, Delims), Left);
  680.         rcNormalPosition.Top := StrToIntDef(ExtractWord(2, PosStr, Delims), Top);
  681.         rcNormalPosition.Right := StrToIntDef(ExtractWord(3, PosStr, Delims), Left + Width);
  682.         rcNormalPosition.Bottom := StrToIntDef(ExtractWord(4, PosStr, Delims), Top + Height);
  683.       end;
  684.       if Screen.PixelsPerInch <> IniReadInteger(IniFile, Section, siPixels,
  685.         Screen.PixelsPerInch) then DataFound := False;
  686.       if DataFound then begin
  687.         if not (BorderStyle in [bsSizeable {$IFDEF WIN32}, bsSizeToolWin {$ENDIF}]) then
  688.           rcNormalPosition := Rect(rcNormalPosition.Left, rcNormalPosition.Top,
  689.             rcNormalPosition.Left + Width, rcNormalPosition.Top + Height);
  690.         if rcNormalPosition.Right > rcNormalPosition.Left then begin
  691.           if (Position in [poScreenCenter {$IFDEF RX_D4}, poDesktopCenter {$ENDIF}]) and
  692.             not (csDesigning in ComponentState) then
  693.           begin
  694.             THackComponent(Form).SetDesigning(True);
  695.             try
  696.               Position := poDesigned;
  697.             finally
  698.               THackComponent(Form).SetDesigning(False);
  699.             end;
  700.           end;
  701.           SetWindowPlacement(Handle, @Placement);
  702.         end;
  703.       end;
  704.     end;
  705.     if LoadState then begin
  706.       WinState := wsNormal;
  707.       { default maximize MDI main form }
  708.       if ((Application.MainForm = Form) {$IFDEF RX_D4} or
  709.         (Application.MainForm = nil) {$ENDIF}) and ((FormStyle = fsMDIForm) or
  710.         ((FormStyle = fsNormal) and (Position = poDefault))) then
  711.         WinState := wsMaximized;
  712.       ShowCmd := IniReadInteger(IniFile, Section, siShowCmd, SW_HIDE);
  713.       case ShowCmd of
  714.         SW_SHOWNORMAL, SW_RESTORE, SW_SHOW:
  715.           WinState := wsNormal;
  716.         SW_MINIMIZE, SW_SHOWMINIMIZED, SW_SHOWMINNOACTIVE:
  717.           WinState := wsMinimized;
  718.         SW_MAXIMIZE: WinState := wsMaximized;
  719.       end;
  720. {$IFDEF WIN32}
  721.       if (WinState = wsMinimized) and ((Form = Application.MainForm)
  722.         {$IFDEF RX_D4} or (Application.MainForm = nil) {$ENDIF}) then
  723.       begin
  724.         TNastyForm(Form).FWindowState := wsNormal;
  725.         PostMessage(Application.Handle, WM_SYSCOMMAND, SC_MINIMIZE, 0);
  726.         Exit;
  727.       end;
  728. {$ENDIF}
  729.       if FormStyle in [fsMDIChild, fsMDIForm] then
  730.         TNastyForm(Form).FWindowState := WinState
  731.       else WindowState := WinState;
  732.     end;
  733.     Update;
  734.   end;
  735. end;
  736. {$IFDEF WIN32}
  737. procedure ReadFormPlacementReg(Form: TForm; IniFile: TRegIniFile;
  738.   const Section: string; LoadState, LoadPosition: Boolean);
  739. begin
  740.   InternalReadFormPlacement(Form, IniFile, Section, LoadState, LoadPosition);
  741. end;
  742. {$ENDIF WIN32}
  743. procedure ReadFormPlacement(Form: TForm; IniFile: TIniFile;
  744.   const Section: string; LoadState, LoadPosition: Boolean);
  745. begin
  746.   InternalReadFormPlacement(Form, IniFile, Section, LoadState, LoadPosition);
  747. end;
  748. {$IFDEF WIN32}
  749. procedure RestoreFormPlacement(Form: TForm; const IniFileName: string;
  750.   UseRegistry: Boolean);
  751. {$ELSE}
  752. procedure RestoreFormPlacement(Form: TForm; const IniFileName: string);
  753. {$ENDIF}
  754. var
  755.   IniFile: TObject;
  756. begin
  757. {$IFDEF WIN32}
  758.   if UseRegistry then begin
  759.     IniFile := TRegIniFile.Create(IniFileName);
  760.   {$IFDEF RX_D5} 
  761.     TRegIniFile(IniFile).Access := KEY_READ;
  762.   {$ENDIF}
  763.   end
  764.   else 
  765.     IniFile := TIniFile.Create(IniFileName);
  766. {$ELSE}
  767.   IniFile := TIniFile.Create(IniFileName);
  768. {$ENDIF WIN32}
  769.   try
  770.     InternalReadFormPlacement(Form, IniFile, Form.ClassName, True, True);
  771.   finally
  772.     IniFile.Free;
  773.   end;
  774. end;
  775. function GetUniqueFileNameInDir(const Path, FileNameMask: string): string;
  776. var
  777.   CurrentName: string;
  778.   I: Integer;
  779. begin
  780.   Result := '';
  781.   for I := 0 to MaxInt do begin
  782.     CurrentName := Format(FileNameMask, [I]);
  783.     if not FileExists(NormalDir(Path) + CurrentName) then begin
  784.       Result := CurrentName;
  785.       Exit;
  786.     end;
  787.   end;
  788. end;
  789. {$IFDEF WIN32}
  790. procedure AppBroadcast(Msg, wParam: Longint; lParam: Longint);
  791. {$ELSE}
  792. procedure AppBroadcast(Msg, wParam: Word; lParam: Longint);
  793. {$ENDIF WIN32}
  794. var
  795.   I: Integer;
  796. begin
  797.   for I := 0 to Screen.FormCount - 1 do
  798.     SendMessage(Screen.Forms[I].Handle, Msg, wParam, lParam);
  799. end;
  800. procedure AppTaskbarIcons(AppOnly: Boolean);
  801. var
  802.   Style: Longint;
  803. begin
  804.   Style := GetWindowLong(Application.Handle, GWL_STYLE);
  805.   if AppOnly then Style := Style or WS_CAPTION
  806.   else Style := Style and not WS_CAPTION;
  807.   SetWindowLong(Application.Handle, GWL_STYLE, Style);
  808.   if AppOnly then SwitchToWindow(Application.Handle, False);
  809. end;
  810. end.