⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 apputils.pas

📁 RX Library contains a large number of components, objects and routines for Borland Delphi with full
💻 PAS
📖 第 1 页 / 共 2 页
字号:
{*******************************************************}
{                                                       }
{         Delphi VCL Extensions (RX)                    }
{                                                       }
{         Copyright (c) 1995, 1996 AO ROSNO             }
{         Copyright (c) 1997, 1998 Master-Bank          }
{                                                       }
{*******************************************************}

unit AppUtils;

interface

{$I RX.INC}

uses Windows, Registry, RTLConsts, Classes, Controls, Forms, IniFiles, Grids, VCLUtils;

function GetDefaultSection(Component: TComponent): string;
procedure GetDefaultIniData(Control: TControl; var IniFileName,
  Section: string {$IFDEF WIN32}; UseRegistry: Boolean {$ENDIF});
function GetDefaultIniName: string;

type
  TOnGetDefaultIniName = function: string;

const
  OnGetDefaultIniName: TOnGetDefaultIniName = nil;

{$IFDEF WIN32}
var
  DefCompanyName: string = '';
  RegUseAppTitle: Boolean = False;

function GetDefaultIniRegKey: string;
{$ENDIF}

function FindForm(FormClass: TFormClass): TForm;
function FindShowForm(FormClass: TFormClass; const Caption: string): TForm;
function ShowDialog(FormClass: TFormClass): Boolean;
function InstantiateForm(FormClass: TFormClass; var Reference): TForm;

{$IFDEF WIN32}
procedure SaveFormPlacement(Form: TForm; const IniFileName: string;
  UseRegistry: Boolean);
procedure RestoreFormPlacement(Form: TForm; const IniFileName: string;
  UseRegistry: Boolean);
procedure WriteFormPlacementReg(Form: TForm; IniFile: TRegIniFile;
  const Section: string);
procedure ReadFormPlacementReg(Form: TForm; IniFile: TRegIniFile;
  const Section: string; LoadState, LoadPosition: Boolean);
procedure SaveMDIChildrenReg(MainForm: TForm; IniFile: TRegIniFile);
procedure RestoreMDIChildrenReg(MainForm: TForm; IniFile: TRegIniFile);
procedure RestoreGridLayoutReg(Grid: TCustomGrid; IniFile: TRegIniFile);
procedure SaveGridLayoutReg(Grid: TCustomGrid; IniFile: TRegIniFile);
{$ELSE}
procedure SaveFormPlacement(Form: TForm; const IniFileName: string);
procedure RestoreFormPlacement(Form: TForm; const IniFileName: string);
{$ENDIF WIN32}

procedure WriteFormPlacement(Form: TForm; IniFile: TIniFile;
  const Section: string);
procedure ReadFormPlacement(Form: TForm; IniFile: TIniFile;
  const Section: string; LoadState, LoadPosition: Boolean);
procedure SaveMDIChildren(MainForm: TForm; IniFile: TIniFile);
procedure RestoreMDIChildren(MainForm: TForm; IniFile: TIniFile);
procedure RestoreGridLayout(Grid: TCustomGrid; IniFile: TIniFile);
procedure SaveGridLayout(Grid: TCustomGrid; IniFile: TIniFile);

function GetUniqueFileNameInDir(const Path, FileNameMask: string): string;

function StrToIniStr(const Str: string): string;
function IniStrToStr(const Str: string): string;

function IniReadString(IniFile: TObject; const Section, Ident,
  Default: string): string;
procedure IniWriteString(IniFile: TObject; const Section, Ident,
  Value: string);
function IniReadInteger(IniFile: TObject; const Section, Ident: string;
  Default: Longint): Longint;
procedure IniWriteInteger(IniFile: TObject; const Section, Ident: string;
  Value: Longint);
function IniReadBool(IniFile: TObject; const Section, Ident: string;
  Default: Boolean): Boolean;
procedure IniWriteBool(IniFile: TObject; const Section, Ident: string;
  Value: Boolean);
procedure IniReadSections(IniFile: TObject; Strings: TStrings);
procedure IniEraseSection(IniFile: TObject; const Section: string);
procedure IniDeleteKey(IniFile: TObject; const Section, Ident: string);

{$IFDEF WIN32}
procedure AppBroadcast(Msg, wParam: Longint; lParam: Longint);
{$ELSE}
procedure AppBroadcast(Msg, wParam: Word; lParam: Longint);
{$ENDIF WIN32}

procedure AppTaskbarIcons(AppOnly: Boolean);

{ Internal using utilities }

procedure InternalSaveGridLayout(Grid: TCustomGrid; IniFile: TObject;
  const Section: string);
procedure InternalRestoreGridLayout(Grid: TCustomGrid; IniFile: TObject;
  const Section: string);
procedure InternalSaveMDIChildren(MainForm: TForm; IniFile: TObject);
procedure InternalRestoreMDIChildren(MainForm: TForm; IniFile: TObject);

implementation

uses SysUtils, Messages, Consts, rxStrUtils, FileUtil, Placemnt;

function GetDefaultSection(Component: TComponent): string;
var
  F: TCustomForm;
  Owner: TComponent;
begin
  if Component <> nil then begin
    if Component is TCustomForm then Result := Component.ClassName
    else begin
      Result := Component.Name;
      if Component is TControl then begin
        F := GetParentForm(TControl(Component));
        if F <> nil then Result := F.ClassName + Result
        else begin
          if TControl(Component).Parent <> nil then
            Result := TControl(Component).Parent.Name + Result;
        end;
      end
      else begin
        Owner := Component.Owner;
        if Owner is TForm then
          Result := Format('%s.%s', [Owner.ClassName, Result]);
      end;
    end;
  end
  else Result := '';
end;

function GetDefaultIniName: string;
begin
  if Assigned(OnGetDefaultIniName) then
    Result:= OnGetDefaultIniName
  else
    Result := ExtractFileName(ChangeFileExt(Application.ExeName, '.INI'));
end;

{$IFDEF WIN32}
function GetDefaultIniRegKey: string;
begin
  if RegUseAppTitle and (Application.Title <> '') then
    Result := Application.Title
  else Result := ExtractFileName(ChangeFileExt(Application.ExeName, ''));
  if DefCompanyName <> '' then
    Result := DefCompanyName + '\' + Result;
  Result := 'Software\' + Result;
end;
{$ENDIF}

procedure GetDefaultIniData(Control: TControl; var IniFileName,
  Section: string {$IFDEF WIN32}; UseRegistry: Boolean {$ENDIF});
var
  I: Integer;
begin
  IniFileName := EmptyStr;
  with Control do
    if Owner is TCustomForm then
      for I := 0 to Owner.ComponentCount - 1 do
        if (Owner.Components[I] is TFormPlacement) then begin
          IniFileName := TFormPlacement(Owner.Components[I]).IniFileName;
          Break;
        end;
  Section := GetDefaultSection(Control);
  if IniFileName = EmptyStr then
{$IFDEF WIN32}
    if UseRegistry then IniFileName := GetDefaultIniRegKey
    else
{$ENDIF}
    IniFileName := GetDefaultIniName;
end;

function FindForm(FormClass: TFormClass): TForm;
var
  I: Integer;
begin
  Result := nil;
  for I := 0 to Screen.FormCount - 1 do begin
    if Screen.Forms[I] is FormClass then begin
      Result := Screen.Forms[I];
      Break;
    end;
  end;
end;

function InternalFindShowForm(FormClass: TFormClass;
  const Caption: string; Restore: Boolean): TForm;
var
  I: Integer;
begin
  Result := nil;
  for I := 0 to Screen.FormCount - 1 do begin
    if Screen.Forms[I] is FormClass then
      if (Caption = '') or (Caption = Screen.Forms[I].Caption) then begin
        Result := Screen.Forms[I];
        Break;
      end;
  end;
  if Result = nil then begin
    Application.CreateForm(FormClass, Result);
    if Caption <> '' then Result.Caption := Caption;
  end;
  with Result do begin
    if Restore and (WindowState = wsMinimized) then WindowState := wsNormal;
    Show;
  end;
end;

function FindShowForm(FormClass: TFormClass; const Caption: string): TForm;
begin
  Result := InternalFindShowForm(FormClass, Caption, True);
end;

function ShowDialog(FormClass: TFormClass): Boolean;
var
  Dlg: TForm;
begin
  Application.CreateForm(FormClass, Dlg);
  try
    Result := Dlg.ShowModal in [mrOk, mrYes];
  finally
    Dlg.Free;
  end;
end;

function InstantiateForm(FormClass: TFormClass; var Reference): TForm;
begin
  if TForm(Reference) = nil then
    Application.CreateForm(FormClass, Reference);
  Result := TForm(Reference);
end;

function StrToIniStr(const Str: string): string;
var
{$IFDEF WIN32}
  Buffer: array[0..4095] of Char;
{$ELSE}
  Buffer: array[0..255] of Char;
{$ENDIF}
  B, S: PChar;
begin
  if Length(Str) > SizeOf(Buffer) then
    raise Exception.Create(ResStr(SLineTooLong));
{$IFDEF WIN32}
  S := PChar(Str);
{$ELSE}
  S := StrPAlloc(Str);
{$ENDIF}
  try
    B := Buffer;
    while S^ <> #0 do
      case S^ of
        #13, #10:
          begin
            if (S^ = #13) and (S[1] = #10) then Inc(S)
            else if (S^ = #10) and (S[1] = #13) then Inc(S);
            B^ := '\';
            Inc(B);
            B^ := 'n';
            Inc(B);
            Inc(S);
          end;
      else
        B^ := S^;
        Inc(B);
        Inc(S);
      end;
  finally
{$IFNDEF WIN32}
    StrDispose(S);
{$ENDIF}
  end;
  B^ := #0;
  Result := StrPas(Buffer);
end;

function IniStrToStr(const Str: string): string;
var
{$IFDEF WIN32}
  Buffer: array[0..4095] of Char;
{$ELSE}
  Buffer: array[0..255] of Char;
{$ENDIF}
  B, S: PChar;
begin
  if Length(Str) > SizeOf(Buffer) then
    raise Exception.Create(ResStr(SLineTooLong));
{$IFDEF WIN32}
  S := PChar(Str);
{$ELSE}
  S := StrPAlloc(Str);
{$ENDIF}
  try
    B := Buffer;
    while S^ <> #0 do
      if (S[0] = '\') and (S[1] = 'n') then
      begin
        B^ := #13;
        Inc(B);
        B^ := #10;
        Inc(B);
        Inc(S);
        Inc(S);
      end
      else
      begin
        B^ := S^;
        Inc(B);
        Inc(S);
      end;
  finally
{$IFNDEF WIN32}
    StrDispose(S);
{$ENDIF}
  end;
  B^ := #0;
  Result := StrPas(Buffer);
end;

const
{ The following strings should not be localized }
  siFlags     = 'Flags';
  siShowCmd   = 'ShowCmd';
  siMinMaxPos = 'MinMaxPos';
  siNormPos   = 'NormPos';
  siPixels    = 'PixelsPerInch';
  siMDIChild  = 'MDI Children';
  siListCount = 'Count';
  siItem      = 'Item%d';

function IniReadString(IniFile: TObject; const Section, Ident,
  Default: string): string;
begin
{$IFDEF WIN32}
  if IniFile is TRegIniFile then
    Result := TRegIniFile(IniFile).ReadString(Section, Ident, Default)
  else
{$ENDIF}
  if IniFile is TIniFile then
    Result := TIniFile(IniFile).ReadString(Section, Ident, Default)
  else Result := Default;
end;

procedure IniWriteString(IniFile: TObject; const Section, Ident,
  Value: string);
var
  S: string;
begin
{$IFDEF WIN32}
  if IniFile is TRegIniFile then
    TRegIniFile(IniFile).WriteString(Section, Ident, Value)
  else begin
{$ENDIF}
    S := Value;
    if S <> '' then begin
      if ((S[1] = '"') and (S[Length(S)] = '"')) or
        ((S[1] = '''') and (S[Length(S)] = '''')) then
        S := '"' + S + '"';
    end;
    if IniFile is TIniFile then
      TIniFile(IniFile).WriteString(Section, Ident, S);
{$IFDEF WIN32}
  end;
{$ENDIF}
end;

function IniReadInteger(IniFile: TObject; const Section, Ident: string;
  Default: Longint): Longint;
begin
{$IFDEF WIN32}
  if IniFile is TRegIniFile then
    Result := TRegIniFile(IniFile).ReadInteger(Section, Ident, Default)
  else
{$ENDIF}
  if IniFile is TIniFile then
    Result := TIniFile(IniFile).ReadInteger(Section, Ident, Default)
  else Result := Default;
end;

procedure IniWriteInteger(IniFile: TObject; const Section, Ident: string;
  Value: Longint);
begin
{$IFDEF WIN32}
  if IniFile is TRegIniFile then
    TRegIniFile(IniFile).WriteInteger(Section, Ident, Value)
  else
{$ENDIF}
  if IniFile is TIniFile then
    TIniFile(IniFile).WriteInteger(Section, Ident, Value);
end;

function IniReadBool(IniFile: TObject; const Section, Ident: string;
  Default: Boolean): Boolean;
begin
{$IFDEF WIN32}
  if IniFile is TRegIniFile then
    Result := TRegIniFile(IniFile).ReadBool(Section, Ident, Default)
  else
{$ENDIF}
  if IniFile is TIniFile then
    Result := TIniFile(IniFile).ReadBool(Section, Ident, Default)
  else Result := Default;
end;

procedure IniWriteBool(IniFile: TObject; const Section, Ident: string;
  Value: Boolean);
begin
{$IFDEF WIN32}
  if IniFile is TRegIniFile then
    TRegIniFile(IniFile).WriteBool(Section, Ident, Value)
  else
{$ENDIF}
  if IniFile is TIniFile then
    TIniFile(IniFile).WriteBool(Section, Ident, Value);
end;

procedure IniEraseSection(IniFile: TObject; const Section: string);
begin
{$IFDEF WIN32}
  if IniFile is TRegIniFile then
    TRegIniFile(IniFile).EraseSection(Section)
  else
{$ENDIF}
  if IniFile is TIniFile then
    TIniFile(IniFile).EraseSection(Section);
end;

procedure IniDeleteKey(IniFile: TObject; const Section, Ident: string);
{$IFNDEF WIN32}
var
  CSection: array[0..127] of Char;
  CIdent: array[0..127] of Char;
  CFileName: array[0..127] of Char;
{$ENDIF}
begin
{$IFDEF WIN32}

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -