sstoreutils.pas

Alpha Controls 界面控件包

unit sStoreUtils;
{$I sDefs.inc}

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  ToolWin, ComCtrls, ExtCtrls, ActnList, StdCtrls, jpeg,
  sConst, Menus, sPanel, inifiles, acUtils, registry, sEdit,
{$IFNDEF ALITE}
  sCurrencyEdit, sComboBox, sPageControl, sComboEdit, sMemo, sRadioButton,
{$ENDIF}
  {$IFDEF USEDB}db, dbgrids, {$ENDIF} sCheckBox, sGraphUtils, buttons;

//<<<<<<<<<<<<<<<<<<<<< Work with Windows system and ini <<<<<<<<<<<<<<
function ReadRegString(Key : HKEY; Section, Named : string):string;
procedure WriteRegString(Section, Named, Value : string);
function ReadIniInteger(Section, Named: string; Value : integer; FileName: string): integer; overload;
function ReadIniInteger(Section, Named: string; Value : integer; r: TMemIniFile): integer; overload;
function ReadIniString(Section, Named, FileName: string):string; overload;
function ReadIniString(Section, Named: string; r: TMemIniFile):string; overload;
procedure ReadIniStrings(Value : TStrings; Section, Named, FileName: string); overload;
procedure ReadIniStrings(Value : TStrings; Section, Named: string; r: TMemIniFile); overload;

procedure WriteIniStr(Section, Named, Value, FileName:string); overload;
procedure WriteIniStr(Section, Named, Value:string; IniFile : TMemIniFile); overload;
procedure WriteIniStrings(Section, Named, FileName : string; Value : TStrings); overload;
procedure WriteIniStrings(Section, Named : string; Value : TStrings; IniFile : TMemIniFile); overload;
procedure WriteIniFont(Section, Named : string; Value : TFont; IniFile : TMemIniFile); overload;
procedure ReadIniFont(Section, Named : string; Value : TFont; IniFile : TMemIniFile); overload;


//procedure RestoreCaptions(Form: TForm; IniFileName: string);
//>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>

procedure SaveFormPlacement(Form: TForm; IniFileName: string);
procedure RestoreFormPlacement(Form: TForm; IniFileName: string);

implementation

uses sStyleSimply;

const
  aWindowStates : array [0..2] of TWindowState = (wsNormal, wsMinimized, wsMaximized);

function ReadIniString(Section, Named, FileName: string):string;
var
  r : TIniFile;
  s : string;
begin
//  s:='';
  r := TIniFile.Create(FileName);
  try
    s := r.ReadString(Section,Named,'');
  finally
    r.Free;
  end;
  Result := s;
end;

function ReadIniString(Section, Named: string; r: TMemIniFile) : string;
var
  s : string;
begin
  try
    s := r.ReadString(Section, Named, '');
  finally
  end;
  Result := s;
end;

procedure ReadIniStrings(Value : TStrings; Section, Named, FileName: string); overload;
var
  r : TMemIniFile;
begin
  r := TMemIniFile.Create(FileName);
  try
    ReadIniStrings(Value, Section, Named, r);
  finally
    r.Free;
  end;
end;

procedure ReadIniStrings(Value : TStrings; Section, Named: string; r: TMemIniFile); overload;
var
  i, c : integer;
begin
  c := ReadIniInteger(Section, Named + 'Count', 0, r);
  if c = 0 then Exit;
  Value.Clear;
  for i := 0 to c - 1 do begin
    Value.Add(ReadIniString(Section, Named + 'Item' + IntToStr(i), r));
  end;
end;

function ReadIniInteger(Section, Named: string; Value : integer; FileName: string): integer;
var
  r: TIniFile;
  s: string;
begin
  Result := -1;
  r := TIniFile.Create(FileName);
  try
    s := r.ReadString(Section,Named, '');
  finally
    r.Free;
  end;
  try
    if s = '' then Result := Value else Result := StrToInt(s);
  except
  end;
end;

function ReadIniInteger(Section, Named: string; Value : integer; r: TMemIniFile): integer; overload;
var
  s: string;
begin
  Result := -1;
  if Assigned(r) then begin
    s := r.ReadString(Section,Named, '');
    try
      if s = '' then Result := Value else Result := StrToInt(s);
    except
    end;
  end;
end;

function ReadRegString(Key:HKEY; Section, Named:string):string;
var
  r : TRegIniFile;
begin
  Result := '';
  r := TRegIniFile.Create('');
  r.RootKey := Key;
  try
    Result := r.ReadString(Section, Named, '');
  finally
    r.Free;
  end;
end;

procedure WriteRegString(Section, Named, Value : string);
var
  r : TRegIniFile;
begin
  r := TRegIniFile.Create('');
  r.RootKey := HKEY_CURRENT_USER;
  try
    r.CreateKey(Section);
    r.WriteString(Section, Named, Value);
  finally
    r.Free;
  end;
end;

procedure WriteIniStr(Section, Named, Value, FileName : string); overload;
var
  r : TIniFile;
begin
  r := TIniFile.Create(FileName);
  try
    if r <> nil then r.WriteString(Section, Named, Value);
  finally
    r.Free;
  end;
end;

procedure WriteIniStr(Section, Named, Value:string; IniFile : TMemIniFile);
begin
  try
    IniFile.WriteString(Section, Named, Value);
  finally
  end;
end;

procedure WriteIniStrings(Section, Named, FileName : string; Value : TStrings); overload;
var
  r : TMemIniFile;
begin
  r := TMemIniFile.Create(FileName);
  try
    if r <> nil then WriteIniStrings(Section, Named, Value, r);
  finally
    r.Free;
  end;
end;

procedure WriteIniStrings(Section, Named : string; Value : TStrings; IniFile : TMemIniFile); overload;
var
  i : integer;
begin
  WriteIniStr(Section, Named + 'Count', IntToStr(Value.Count), IniFile);
  for i := 0 to Value.Count - 1 do begin
    WriteIniStr(Section, Named + 'Item' + IntToStr(i), Value[i], IniFile);
  end;
end;

procedure WriteIniFont(Section, Named :string; Value : TFont; IniFile : TMemIniFile); overload;
begin
  WriteIniStr(Section, Named + '_Color', IntToStr(Value.Color), IniFile);
  WriteIniStr(Section, Named + '_Name', Value.Name, IniFile);
  WriteIniStr(Section, Named + '_Size', IntToStr(Value.Size), IniFile);
  WriteIniStr(Section, Named + '_Bold', IntToStr(integer(fsBold in Value.Style)), IniFile);
  WriteIniStr(Section, Named + '_Italic', IntToStr(integer(fsItalic in Value.Style)), IniFile);
  WriteIniStr(Section, Named + '_Underline', IntToStr(integer(fsUnderline in Value.Style)), IniFile);
  WriteIniStr(Section, Named + '_StrikeOut', IntToStr(integer(fsStrikeOut in Value.Style)), IniFile);
end;

procedure ReadIniFont(Section, Named : string; Value : TFont; IniFile : TMemIniFile); overload;
begin
  Value.Color := ReadIniInteger(Section, Named + '_Color', 0, IniFile);
  Value.Name := ReadIniString(Section, Named + '_Name', IniFile);
  Value.Size := ReadIniInteger(Section, Named + '_Size', 8, IniFile);
  if ReadIniInteger(Section, Named + '_Bold', 0, IniFile) = 1 then Value.Style := Value.Style + [fsBold];
  if ReadIniInteger(Section, Named + '_Italic', 0, IniFile) = 1 then Value.Style := Value.Style + [fsItalic];
  if ReadIniInteger(Section, Named + '_Underline', 0, IniFile) = 1 then Value.Style := Value.Style + [fsUnderline];
  if ReadIniInteger(Section, Named + '_StrikeOut', 0, IniFile) = 1 then Value.Style := Value.Style + [fsStrikeOut];
end;

(*
procedure RestoreCaptions(Form: TForm; IniFileName: string);
var
  i : integer;
  s : string;
  r : TMemIniFile;
begin
  Exit;
  r := TMemIniFile.Create(IniFileName);

  s := ReadIniString('T' + Form.Name, Form.Name + '_Caption', r);
  Form.Caption := iff(s<>'', s, Form.Caption);

  for i := 0 to Form.ComponentCount-1 do begin
    s := UpperCase(Form.Components[i].ClassName);
    if Form.Components[i] is TLabel then begin // TLabel
      s := ReadIniString('T' + Form.Name, Form.Components[i].Name + '_Caption', r);
      TLabel(Form.Components[i]).Caption := iff(s<>'', s, TLabel(Form.Components[i]).Caption);
    end else
    if Form.Components[i] is TAction then begin // TAction
      s := ReadIniString('T' + Form.Name, Form.Components[i].Name + '_Caption', r);
      if s<>'' then TAction(Form.Components[i]).Caption := s;
      s := ReadIniString('T' + Form.Name, Form.Components[i].Name + '_Hint', r);
      TAction(Form.Components[i]).Hint := iff(s<>'', s, TAction(Form.Components[i]).Hint);
    end else
    if Form.Components[i] is TMenuItem then begin // TMenuItem
      if not Assigned(TMenuItem(Form.Components[i]).Action) then begin
        s := ReadIniString('T' + Form.Name, Form.Components[i].Name + '_Caption', r);
        TMenuItem(Form.Components[i]).Caption := iff(s<>'', s, TMenuItem(Form.Components[i]).Caption);
        s := ReadIniString('T' + Form.Name, Form.Components[i].Name + '_Hint', r);
        TMenuItem(Form.Components[i]).Hint := iff(s<>'', s, TMenuItem(Form.Components[i]).Hint);
      end;
    end else
{$IFDEF USEDB}
    if Form.Components[i] is TField then begin // TField
      s := ReadIniString('T' + Form.Name, Form.Components[i].Name + '_DisplayLabel', r);
      TField(Form.Components[i]).DisplayLabel := iff(s<>'', s, TField(Form.Components[i]).DisplayLabel);
    end else
{$ENDIF}
    if Form.Components[i] is TToolButton  then begin //TToolButton
      if not Assigned(TToolButton(Form.Components[i]).Action) then begin
        s := ReadIniString('T' + Form.Name, Form.Components[i].Name + '_Caption', r);
        TToolButton(Form.Components[i]).Caption := iff(s<>'', s, TToolButton(Form.Components[i]).Caption);
        s := ReadIniString('T' + Form.Name, Form.Components[i].Name + '_Hint', r);
        TToolButton(Form.Components[i]).Caption := iff(s<>'', s, TToolButton(Form.Components[i]).Hint);
      end;
    end else
    if Form.Components[i] is TTabSheet then begin // TTabSheet
      s := ReadIniString('T' + Form.Name, Form.Components[i].Name + '_Caption', r);
      TTabSheet(Form.Components[i]).Caption := iff(s<>'', s, TTabSheet(Form.Components[i]).Caption);
    end else
    if Form.Components[i] is TSpeedButton then begin // TSpeedButton
      s := ReadIniString('T' + Form.Name, Form.Components[i].Name + '_Caption', r);
      TSpeedButton(Form.Components[i]).Caption := iff(s<>'', s, TSpeedButton(Form.Components[i]).Caption);
    end;
  end;
end;
*)
procedure SaveFormPlacement(Form: TForm; IniFileName: string);
begin
  if Form.WindowState = wsNormal then begin
    WriteIniStr(Form.Name, 'Left', IntToStr(Form.Left), IniFileName);
    WriteIniStr(Form.Name, 'Top', IntToStr(Form.Top), IniFileName);
    WriteIniStr(Form.Name, 'Width', IntToStr(Form.Width), IniFileName);
    WriteIniStr(Form.Name, 'Height', IntToStr(Form.Height), IniFileName);
  end;
  WriteIniStr(Form.Name, 'State', IntToStr(ord(Form.WindowState)), IniFileName);
end;

procedure RestoreFormPlacement(Form: TForm; IniFileName: string);
var
  i : integer;
  ws : TWindowState;
begin
  i := ReadIniInteger(Form.Name, 'State', -1, IniFileName);
  if i = -1 then Exit;
  ws := aWindowStates[i];

  Form.WindowState := ws;
  if ws = wsNormal then begin
    i := ReadIniInteger(Form.Name, 'Left', -1, IniFileName);
    if i <> -1 then begin
      Form.Left := i;
    end;
    i := ReadIniInteger(Form.Name, 'Top', -1, IniFileName);
    if i <> -1 then begin
      Form.Top := i;
    end;
    i := ReadIniInteger(Form.Name, 'Width', -1, IniFileName);
    if i <> -1 then begin
      Form.Width := i;
    end;
    i := ReadIniInteger(Form.Name, 'Height', -1, IniFileName);
    if i <> -1 then begin
      Form.Height := i;
    end;
  end;
end;

end.