autosavedesk.pas

常用数学计算工具

unit AutoSaveDesk;
{ TAutoSaveDesk是帮助保存窗体上的各个控件的大小,位置,
  以及标题，Index,Checked等属性;并复现之.
  //Public
  Save方法表示保存
  Load方法表示调出
  //Published
   AutoSaveFileName 保存的文件名;
   DefaultDir       给出当前的程序路径;
   RootComponent    根控件,一般为Form;
   AddComponent     将控件名称加入ExComs;
   AddClass         将控件类名称加入ExClass;
   ExComsOK         True表示ExComs是不许保存的控件名,False表示ExComs是要保存的控件名;
   ExComs           允许或不允许保存的控件名;
   ExClassesOK      True表示ExClass是不许保存的控件类名,False表示ExClass是要保存的控件类名;
   ExClasses        允许或不允许保存的控件类名; 当ExClasses和ExComs都满足的控件才会被保存
}
interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls,ComCtrls, CheckLst, buttons, Menus, extctrls;

type
  TVclState=Record    //2000.9.25
   AName,Text:String;
   BoundsRect:TRect;
   Cursor:Integer;
   Color:TColor;
   Index:Integer;
   Checked:Boolean;
  end;
  TVclState2=Record    //2000.9.26
   ANameLen:Integer;
   AName:PChar;
   TextLen:Integer;
   Text:PChar;
  end;

  TAutoSaveDesk = class(TComponent)
  private
    { Private declarations }
   fASF,
   fDefaultDir:String;
   fRoot:TComponent;
   fExComsOK,fExClassOK:Boolean;
   fExComs,fExClass:TStrings;
   fLCom:TComponent;
  protected
    { Protected declarations }
   procedure SetASF(ASF:String);
   procedure SaveAll(Component:TComponent;Stream:TStream);

   procedure SetCom(Obj:TComponent);
   procedure SetClass(Obj:TComponent);
   procedure SetExComs(Strings:TStrings);
   procedure SetExClass(Strings:TStrings);
  public
    { Public declarations }
   constructor Create(AOwner:TComponent);  override;
   destructor  Destroy; override;
   procedure   Save;
   procedure   Load;
  published
    { Published declarations }
   property AutoSaveFileName:String Read fASF write SetASF;
   property DefaultDir:String read fDefaultDir write fDefaultDir;
   property RootComponent:TComponent Read fRoot write fRoot;
   property AddComponent:TComponent read fLCom write SetCom;
   property AddClass:TComponent read fLCom write SetClass;
   property ExComsOK:Boolean read fExComsOK write fEXComsOK default True;
   property ExComs:TStrings read fExComs write SetExcoms;
   property ExClassesOK:Boolean read fExClassOK write fExClassOK default True;
   property ExClasses:TStrings read fExClass write SetExClass;
  end;

procedure Register;

implementation

procedure Register;
begin
  RegisterComponents('System', [TAutoSaveDesk]);
end;

constructor TAutoSaveDesk.Create;
begin
 inherited;
 fDefaultDir:=ExtractFilePath(ParamStr(0));
 if fDefaultDir[Length(fDefaultDir)]<>'\'
    then fDefaultDir:=fDefaultDir+'\';
 fASF:='AutoSave.Desk';
 fRoot:=AOwner;
 fExComsOK:=True;
 fExComs:=TStringList.Create;
 fExClassOK:=True;
 fExClass:=TStringList.Create;
end;
destructor TAutoSaveDesk.Destroy;
begin
 if fExComs<>nil then fExComs.Free;
 if fExClass<>nil then fExClass.Free;
 inherited;
end;
procedure TAutoSaveDesk.SetASF;
begin
 fASF:=ASF;
end;

function  GetVSSize(VS:TVclState):Integer;
begin
 Result:=SizeOf(Integer)+Length(VS.AName)+1;
 Result:=Result+SizeOf(Integer)+Length(VS.Text)+1;
 Result:=Result+SizeOf(VS.BoundsRect)+SizeOf(Integer)
         +SizeOf(TColor)+SizeOf(Integer)+SizeOf(Boolean);
end;
procedure SaveVS(VS:TVclState; Stream:TStream);
var
 VS2:TVclState2;
begin
 VS2.ANameLen:=Length(VS.AName)+1;
 Stream.Write(VS2.ANameLen,SizeOf(VS2.ANameLen));
 GetMem(VS2.AName,VS2.ANameLen);
 StrPCopy(VS2.AName,VS.AName);
 Stream.Write(VS2.AName^,VS2.ANameLen);

 VS2.TextLen:=Length(VS.Text)+1;
 Stream.Write(VS2.TextLen,SizeOf(VS2.TextLen));
 GetMem(VS2.Text,VS2.TextLen);
 StrPCopy(VS2.Text,VS.Text);
 Stream.Write(VS2.Text^,VS2.TextLen);

 Stream.Write(VS.BoundsRect,SizeOf(VS.BoundsRect));
 Stream.Write(VS.Cursor,SizeOf( VS.Cursor));
 Stream.Write(VS.Color,SizeOf(TColor));
 Stream.Write(Vs.Index,SizeOf(Integer));
 Stream.Write(VS.Checked,SizeOf(Boolean));
end;
procedure LoadVS(Var VS:TVclState; Stream:TStream);
var
 VS2:TVclState2;
begin
 Stream.Read(VS2.ANameLen,SizeOf(VS2.ANameLen));
 GetMem(VS2.AName,VS2.ANameLen);
 Stream.Read(VS2.AName^,VS2.ANameLen);
 VS.AName:=StrPas(VS2.AName);

 Stream.Read(VS2.TextLen,SizeOf(VS2.TextLen));
 GetMem(VS2.Text,VS2.TextLen);
 Stream.Read(VS2.Text^,VS2.TextLen);
 VS.Text:=StrPas(VS2.Text);

 Stream.Read(VS.BoundsRect,SizeOf(VS.BoundsRect));
 Stream.Read(VS.Cursor,SizeOf( VS.Cursor));
 Stream.Read(VS.Color,SizeOf(TColor));
 Stream.Read(VS.Index,SizeOf(Integer));
 Stream.Read(VS.Checked,SizeOf(Boolean));
end;
procedure GetBound(Component:TComponent; var BoundsRect:TRect);
begin
 if (Component is TForm) then begin
  if TForm(Component).WindowState=wsMaximized
     then TForm(Component).WindowState:=wsNormal;
  BoundsRect:=TControl(Component).BoundsRect;
 end else if (Component is TToolButton) then begin
 //None
 end else if (Component is TControl) then begin
  BoundsRect:=TControl(Component).BoundsRect;
 end else begin
 end;
end;
procedure SetBound(Component:TComponent; BoundsRect:TRect);
begin
 if Component is TForm then begin
     TControl(Component).BoundsRect:=BoundsRect;
 end else if (Component is TToolButton) then begin
 //none
 end else if (Component is TControl) then begin
  TControl(Component).BoundsRect:=BoundsRect;
 end else begin
 end;
end;
procedure GetText(Component:TComponent; var Text:String);
var
 Len:Integer;
begin
  if (Component is TCustomForm)or(Component is TButtonControl) then begin
  Len := TControl(Component).GetTextLen;
  SetString(Text, PChar(nil), Len);
  TControl(Component).GetTextBuf(PChar(Text),Len+1);
 end else if (Component is TCustomEdit) then begin
  Text:=TEdit(Component).Text;
 end else if (Component is TLabel) then begin
  Text:=TLabel(Component).Caption;
 end else if (Component is TCustomPanel) then begin
  Text:=TPanel(Component).Caption;
 end;
end;
procedure SetText(Component:TComponent; Text:String);
begin
 if (Component is TCustomForm)or(Component is TButtonControl)then begin
  TControl(Component).SetTextBuf(PChar(Text));
 end else if (Component is TCustomEdit) then begin
  TEdit(Component).Text:=Text;
 end else if (Component is TLabel) then begin
  TLabel(Component).Caption:=Text;
 end else if (Component is TCustomPanel) then begin
  TPanel(Component).Caption:=Text;
 end;
end;

procedure GetColor(Component:TComponent; var Color:TColor);
begin
 if (Component is TCustomEdit) then begin
  Color:=TEdit(Component).Font.Color;
 end else if (Component is TCustomLabel) then begin
  Color:=TLabel(Component).Font.Color;
 end;
end;
procedure SetColor(Component:TComponent; Color:TColor);
begin
 if (Component is TCustomEdit) then begin
  TEdit(Component).Font.Color:=Color;
 end else if (Component is TCustomLabel) then begin
  TLabel(Component).Font.Color:=Color;
 end;
end;
procedure GetIndex(Component:TComponent; Var Index:Integer);
begin
 if (Component is TComboBox) then begin
  Index:=TComboBox(Component).ItemIndex;
 end else if (Component is TListBox) then begin
  Index:=TListBox(Component).ItemIndex;
 end else if (Component is TCheckListBox) then begin
  Index:=TCheckListBox(Component).ItemIndex;
 end else if (Component is TPageControl) then begin
  Index:=TPageControl(Component).ActivePageIndex;
 end else if (Component is TTabControl) then begin
  Index:=TTabControl(Component).TabIndex;
 end else if (Component is TTrackBar) then begin
  Index:=TTrackBar(Component).Position;
 end else if (Component is TProgressBar) then begin
  Index:=TProgressBar(Component).Position;
 end else if (Component is TScrollBar) then begin
  Index:=TScrollBar(Component).Position;
 end else if (Component is TScrollBox) then begin
  Index:=TScrollBox(Component).VertScrollBar.Position;
 end else begin
  Index:=Component.Tag;
 end;
end;
procedure SetIndex(Component:TComponent; Index:Integer);
begin
 if (Component is TComboBox) then begin
  if TComboBox(Component).ItemIndex<>Index then begin
   TComboBox(Component).ItemIndex:=Index;
   if Assigned(TComboBox(Component).OnChange) then
      TComboBox(Component).OnChange(Component);
  end;
  TComboBox(Component).ItemIndex:=Index;
 end else if (Component is TListBox) then begin
  TListBox(Component).ItemIndex:=Index;
 end else if (Component is TCheckListBox) then begin
  TCheckListBox(Component).ItemIndex:=Index;
 end else if (Component is TPageControl) then begin
  TPageControl(Component).ActivePageIndex:=Index;
 end else if (Component is TTabControl) then begin
  TTabControl(Component).TabIndex:=Index;
 end else if (Component is TTrackBar) then begin
  TTrackBar(Component).Position:=Index;
 end else if (Component is TProgressBar) then begin
  TProgressBar(Component).Position:=Index;
 end else if (Component is TScrollBar) then begin
  TScrollBar(Component).Position:=Index;
 end else if (Component is TScrollBox) then begin
  TScrollBox(Component).VertScrollBar.Position:=Index;
 end else begin
  Component.Tag:=Index;
 end;
end; 

procedure GetChecked(Component:TComponent; Var Checked:Boolean);
begin
 if (Component is TCheckBox) then begin
  Checked:=TCheckBox(Component).Checked;
 end else if (Component is TRadioButton) then begin
  Checked:=TRadioButton(Component).Checked;
 end else if (Component is TMenuItem) then begin
  Checked:=TMenuItem(Component).Checked
 end else if (Component is TSpeedButton) then begin
  Checked:=TSpeedButton(Component).Down;
 end else if (Component is TToolButton) then begin
  Checked:=TToolButton(Component).Down;
 end else if (Component is TControl) then begin
  Checked:=TControl(Component).visible;
 end;
end;
procedure SetChecked(Component:TComponent; Checked:Boolean);
begin
 if (Component is TCheckBox) then begin
  if Assigned(TCheckBox(Component).OnClick) and
   (Checked<>TCheckBox(Component).Checked) then //模拟单击事件
    begin
     TCheckBox(Component).Checked:=Checked; //需要预先准备Checked
     TCheckBox(Component).OnClick(TCheckBox(Component));
    end;
  TCheckBox(Component).Checked:=Checked;
 end else if (Component is TRadioButton) then begin
  if Assigned(TCheckBox(Component).OnClick) and
   (TRadioButton(Component).Checked<>Checked) then //模拟单击事件
    begin
     TCheckBox(Component).Checked:=Checked;
     TRadioButton(Component).OnClick(TRadioButton(Component));
    end;
  TRadioButton(Component).Checked:=Checked;
 end else if (Component is TMenuItem) then begin
   if Assigned(TMenuItem(Component).OnClick)and
     (Checked<>TMenuItem(Component).Checked) then //模拟单击事件
      TMenuItem(Component).OnClick(Component);
   TMenuItem(Component).Checked:=Checked;
 end else if (Component is TSpeedButton) then begin
  if Assigned(TSpeedButton(Component).OnClick)and
     (Checked<>TSpeedButton(Component).Down) then begin//模拟单击事件
     TSpeedButton(Component).Down:=Checked;
     TSpeedButton(Component).OnClick(Component);
    end;
  TSpeedButton(Component).Down:=Checked;
 end else if (Component is TToolButton) then begin
  if Assigned(TToolButton(Component).OnClick)and
     (Checked<>TToolButton(Component).Down) then begin //模拟单击事件
      TToolButton(Component).Down:=Checked;   
      TToolButton(Component).OnClick(Component);
     end;
  TToolButton(Component).Down:=Checked;
 end else if (Component is TControl) then begin
  TControl(Component).Visible:=Checked;
 end;
end;

procedure TAutoSaveDesk.SaveAll(Component:TComponent;Stream:TStream);
var
 i:Integer;
 VS:TVclState;
begin
//保存数据
  if ((fExComs.IndexOf(Component.Name)<>-1)xor fExComsOK)and
  ((fExClass.IndexOf(Component.ClassName)<>-1)xor fExClassOK)then begin
    VS.AName:=Component.Name;
    GetBound(Component,VS.BoundsRect);
    if (Component is TControl) then VS.Cursor:=TControl(Component).Cursor;

    GetText(Component,VS.Text);
    GetColor(Component,VS.Color);
    GetIndex(Component,VS.Index);
    GetChecked(Component,VS.Checked);

    Stream.Size:=Stream.Size+GetVSSize(Vs);
    Stream.Position:=Stream.Size-GetVSSize(Vs);
    SaveVS(VS,Stream);
   end;

 For i:=0 to Component.ComponentCount-1 do
     SaveAll(Component.Components[i],Stream);
end;
procedure TAutoSaveDesk.Save;
var
 Stream:TFileStream;
begin
 if fASF='' then exit;
 if fRoot=nil then exit;
 Stream:=nil;
 try
  Stream:=TFileStream.Create(fASF,fmCreate);
  SaveAll(fRoot,Stream);
 finally
  if Stream<>nil then Stream.Destroy;
 end;
end;
function  FindAllComponent(Root:TComponent; AName:String):TComponent;
var
 i:Integer;
begin
 Result:=Root.FindComponent(AName);
 for i:=0 to Root.ComponentCount-1 do
  begin
   if Result<>nil then exit;
   Result:=FindAllComponent(Root.Components[i],AName);
  end;
end;
procedure LoadAll(Root:TComponent; Stream:TStream);
var
 VS:TVclState;
 Component:TComponent;
begin
//读取数据
  if Root=nil then exit;
  LoadVS(VS,Stream);
  Component:=Root;
  if Component.Name=VS.AName then begin
     SetBound(Component,VS.BoundsRect);
     if (Component is TControl) then TControl(Component).Cursor:=VS.Cursor;
     SetText(Component,VS.Text);
     GetColor(Component,VS.Color);
     GetIndex(Component,VS.Index);
     GetChecked(Component,VS.Checked);
   end else Stream.Position:=0; //否则，寻找之
  Repeat
   LoadVS(VS,Stream);
   Component:=FindAllComponent(Root,VS.AName);
   if (Component<>nil)and(Component.Name=VS.AName)
    then begin //找到
     SetBound(Component,VS.BoundsRect);
     if (Component is TControl) then TControl(Component).Cursor:=VS.Cursor;
     SetText(Component,VS.Text);
     SetColor(Component,VS.Color);
     SetIndex(Component,VS.Index);
     SetChecked(Component,VS.Checked);
    end;
  until  (Stream.Position=Stream.Size);
end;
procedure TAutoSaveDesk.Load;
var
 Stream:TFileStream;
begin
 if fASF='' then exit;
 if fRoot=nil then exit;
 if not FileExists(fASF) then exit;
 Stream:=nil;
 try
  Stream:=TFileStream.Create(fASF,fmOpenRead);
  Stream.Position:=0;
  LoadAll(fRoot,Stream);
 finally
  if Stream<>nil then Stream.Destroy;
 end;
end;

procedure TAutoSaveDesk.SetCom;
begin
 if Obj=nil then begin  fLCom:=nil; exit; end;
 if fExComs.IndexOf(Obj.Name)>-1 then exit;
 fExComs.Add(Obj.Name);
end;
procedure TAutoSaveDesk.SetClass;
begin
 if Obj=nil then begin  fLCom:=nil; exit; end;
 if fExClass.IndexOf(Obj.ClassName)>-1 then exit;
 fExClass.Add(Obj.ClassName);
end;

procedure TAutoSaveDesk.SetExComs;
begin
 fExComs.Assign(Strings);
end;

procedure TAutoSaveDesk.SetExClass;
begin
 fExClass.Assign(Strings);
end;


end.