全部代码是:
unit FormStore;
interface
uses PropRW, dbtables, menus,db,extctrls,
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs;
type
TFormStore = class(TComponent)
private
{ Private declarations }
FStoredProps :TStrings;
FStorePropValues :string;
FPopupMenu :TPopupMenu;
FDatabaseName :string;
FQryStorage :TQuery;
FSaveFormCreate: TNotifyEvent;
FSaveWindowProc: TWndMethod;
FBeforeSave: TNotifyEvent;
procedure LoadPropValues(Reader: TReader);
procedure StorePropValues(Writer: TWriter);
procedure SetStoredProps(Value: TStrings);
procedure SetEvents;
procedure FormCreate(Sender: TObject);
procedure FormWindowProc(var Message: TMessage);
function GetForm: TCustomForm;
procedure OnMenuSaveClick(Sender: TObject);
procedure OnMenuClearClick(Sender: TObject);
function GetHasSaved() :Boolean;
protected
procedure Loaded;
override;
procedure DefineProperties(Filer: TFiler);
override;
{ Protected declarations }
public
{ Public declarations }
constructor Create(AOwner: TComponent);
override;
destructor Destroy;
override;
procedure SaveFormPlacement;
procedure ClearFormPlacement;
procedure RestoreFormPlacement;
property HasSaved :Boolean read GetHasSaved;
published
{ Published declarations }
property StoredProps: TStrings read FStoredProps write SetStoredProps;
property DatabaseName: string read FDatabaseName write FDatabaseName;
property BeforeSave :TNotifyEvent read FBeforeSave write FBeforeSave;
end;
var lCanStoreForm :Boolean = True;
procedure Register;
implementation
procedure Register;
begin
RegisterComponents('SelfControl', [TFormStore]);
end;
constructor TFormStore.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
FStoredProps :=TStringList.Create;
FPopupMenu :=nil;
FQryStorage :=nil;
FDatabaseName :='';
end;
destructor TFormStore.Destroy;
begin
FStoredProps.Free;
if Assigned(FPopupMenu) then
FPopupMenu.Free;
if Assigned(FQryStorage) then
FQryStorage.Free;
inherited Destroy;
end;
procedure TFormStore.FormWindowProc(var Message: TMessage);
begin
if Message.Msg =WM_SYSCOMMAND then
case Message.WParam of
30007: OnMenuSaveClick(nil);
30008: OnMenuClearClick(nil);
end;
if Assigned(FSaveWindowProc) then
FSaveWindowProc(Message);
end;
procedure TFormStore.SetEvents;
begin
if Owner is TCustomForm then
begin
with TForm(Owner)do
begin
FSaveFormCreate := OnCreate;
OnCreate := FormCreate;
end;
end;
end;
procedure TFormStore.LoadPropValues(Reader: TReader);
begin
FStorePropValues :=Reader.ReadString;
// if Reader.ReadBoolean then
// MyCompProperty := Reader.ReadComponent(nil);
end;
procedure TFormStore.StorePropValues(Writer: TWriter);
var i :Integer;
ts,sCompName,sPropName :string;
tsStream :TStringStream;
toWriter :TPropWriter;
begin
tsStream :=TStringStream.Create('');
try
toWriter :=TPropWriter.Create(tsStream, 4096);
try
for i :=0 to FStoredProps.Count -1do
begin
ts :=FStoredProps;
sCompName :=Copy(ts, 1, Pos('.', ts)-1);
sPropName :=Copy(ts, Pos('.', ts)+1, 2000);
toWriter.WritePropAll(GetForm().FindComponent(sCompName), sPropName);
end;
toWriter.WriteListend;
finally
toWriter.Free;
end;
tsStream.Seek(0, soFrombegin
ning);
FStorePropValues :=tsStream.DataString;
finally
tsStream.Free;
end;
Writer.WriteString(FStorePropValues);
end;
procedure TFormStore.DefineProperties(Filer: TFiler);
begin
inherited;
{ allow base classes to define properties }
//Filer.DefineProperty('PropValues', LoadPropValues, StorePropValues, True);
end;
procedure TFormStore.SaveFormPlacement;
var oStream :TBlobStream;
oWriter :TPropWriter;
i : Integer;
ts,sCompName,sPropName :string;
oFieldStorage :TBlobField;
begin
if not lCanStoreForm then
Exit;
//无权限用户禁止修改设置
with FQryStoragedo
begin
Close;
Open;
if IsEmpty then
begin
Append;
FQryStorage.FieldByName('FormClass').AsString :=GetForm().ClassName;
FQryStorage.FieldByName('CzyCode').AsString :='mazhen';
Post;
Edit;
end
else
Edit;
end;
oFieldStorage :=(FQryStorage.FieldByName('FormStorage') as TBlobField);
oFieldStorage.Clear;
oStream :=TBlobStream.Create(oFieldStorage, bmReadWrite);
try
oWriter :=TPropWriter.Create(oStream, 4096);
try
oStream.Seek(0, soFrombegin
ning);
//oWriter.WriteInteger(FStoredProps.Count);
for i :=0 to FStoredProps.Count -1do
begin
ts :=FStoredProps;
sCompName :=Copy(ts, 1, Pos('.', ts)-1);
sPropName :=Copy(ts, Pos('.', ts)+1, 2000);
oWriter.WritePropAll(GetForm().FindComponent(sCompName), sPropName);
end;
oWriter.WriteListend;
finally
oWriter.Free;
end;
finally
oStream.Free;
end;
//FQryStorage.FieldByName('PropCount').AsInteger :=FStoredProps.Count;
FQryStorage.Post;
end;
procedure TFormStore.RestoreFormPlacement;
var oStream :TBlobStream;
oReader :TPropReader;
oFieldStorage :TBlobField;
begin
with FQryStoragedo
begin
Close;
Open;
end;
if FQryStorage.IsEmpty then
Exit;
oFieldStorage :=(FQryStorage.FieldByName('FormStorage') as TBlobField);
if oFieldStorage.IsNull then
Exit;
oStream :=TBlobStream.Create(oFieldStorage, bmRead);
try
oReader :=TPropReader.Create(oStream, oStream.Size);
try
oStream.Seek(0, soFrombegin
ning);
oReader.ReadProps(Self.Owner, 0);
//,FQryStorage.FieldByName('PropCount').AsInteger);
finally
oReader.Free;
end;
finally
oStream.Free;
end;
end;
procedure TFormStore.Loaded;
var
Loading: Boolean;
begin
Loading := csLoading in ComponentState;
inherited Loaded;
if not (csDesigning in ComponentState) then
begin
if Loading then
SetEvents;
end;
end;
function TFormStore.GetForm: TCustomForm;
begin
Result := (Owner as TCustomForm);
end;
function TFormStore.GetHasSaved: Boolean;
begin
Result := not(FQryStorage.IsEmpty);
end;
procedure TFormStore.SetStoredProps(Value: TStrings);
begin
FStoredProps.Assign(Value);
end;
procedure TFormStore.FormCreate(Sender: TObject);
var hSysMenu :HMENU;
begin
hSysMenu :=GetSystemMenu(GetForm().Handle, False);
AppendMenu(hSysMenu,MF_SEPARATOR, 0,nil);
AppendMenu(hSysMenu,MF_STRING,30007, '保存当前窗口设置(&B)');
if not lCanStoreForm then
//无权限用户禁止修改设置
EnableMenuItem(hSysMenu,30007,MF_GRAYED);
AppendMenu(hSysMenu,MF_STRING,30008, '清除当前窗口设置(&Q)');
with GetForm()do
begin
FSaveWindowProc :=WindowProc;
WindowProc :=FormWindowProc;
end;
FQryStorage :=TQuery.Create(Self);
FQryStorage.DatabaseName :=FDatabaseName;
FQryStorage.SQL.SetText(PChar(
Format('SELECT * FROM S_FormStorage WHERE FormClass = ''%s''',
[GetForm().ClassName]) ));
FQryStorage.RequestLive :=True;
try
RestoreFormPlacement;
if FQryStorage.IsEmpty then
EnableMenuItem(hSysMenu,30008,MF_GRAYED);
except
Application.MessageBox('窗口设置错误! 请清除当前窗口设置'
,'系统错误', MB_ICONERROR);
end;
if Assigned(FSaveFormCreate) then
FSaveFormCreate(Sender);
end;
procedure TFormStore.OnMenuSaveClick(Sender: TObject);
begin
if Assigned(FBeforeSave) then
FBeforeSave(Self);
SaveFormPlacement();
end;
procedure TFormStore.OnMenuClearClick(Sender: TObject);
begin
ClearFormPlacement;
end;
procedure TFormStore.ClearFormPlacement;
begin
with FQryStoragedo
begin
Close;
Open;
end;
if not FQryStorage.IsEmpty then
FQryStorage.Delete;
end;
end.
