AW: Formular Position speichern
Liste der Anhänge anzeigen (Anzahl: 1)
Vielleicht ist FormPersist für Dich geeignet.
Von hier: http://www.torry.net/vcl/forms/savers/FormPersist.zip Getestet mit WIN8.1, XE7 Im Anhang EXE.
Delphi-Quellcode:
unit Unit1;
interface uses Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics, Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.ExtCtrls, FormPersist; type TForm1 = class(TForm) Panel1: TPanel; Panel2: TPanel; Panel3: TPanel; procedure FormCreate(Sender: TObject); procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean); private { Private-Deklarationen } public { Public-Deklarationen } end; var Form1: TForm1; implementation {$R *.dfm} procedure TForm1.FormCloseQuery(Sender: TObject; var CanClose: Boolean); begin // // SaveForms(); SaveAllForms; end; procedure TForm1.FormCreate(Sender: TObject); begin // // LoadForms(); LoadAllForms; end; end. //----------------------------------------------------------------- //(c) Alex Mitev, alexmi@abv.bg, February 2005 //You can use this unit freely, but please let me know if you make any improvements in it. // a conditional symbol for saving the settigns file in text format, without archiving //{$DEFINE DEBUG} unit FormPersist; interface uses System.Classes, System.SysUtils, Vcl.Forms, System.ZLib, System.TypInfo, Winapi.Windows, Vcl.Dialogs; type TSectionFile = class(TObject) private FSections: TStringList; function AddSection(const Section: string): TStrings; public constructor Create; destructor Destroy; override; procedure Clear; function SectionExists(const Section: string): Boolean; procedure ReadSection(const Section: string; Strings: TStrings); overload; function ReadSection(const Section: string): String; overload; procedure EraseSection(const Section: string); procedure WriteSection(const Section: string; Strings: TStrings); overload; procedure WriteSection(const Section: string; const Str: String); overload; function ReadSections(Strings: TStrings): Boolean; procedure GetStrings(List: TStrings); procedure SetStrings(List: TStrings); procedure LoadFromFile(const FileName: string); procedure LoadFromStream(Stream: TStream); procedure SaveToFile(const FileName: string); procedure SaveToStream(Stream: TStream); end; { Loads all forms' settigns, specified by the AForms parameter. The best place put this function is before Application.Run in the project file or in the form's OnCreate() method Avoid calling this procedure mulpiple times in a for loop, because for each call the settings file is decompressed and read in memory. Instead, create an array of TForm, fill it with data and then call the procedure. } procedure LoadForms(AForms: array of TForm); { Saves all forms' settigns, specified by the AForms parameter. The best place put this function is after Application.Run in the project file or in the form's OnDestroy() method Avoid calling this procedure mulpiple times in a for loop, because for each call the settings file is decompressed and then compressed again. Instead, create an array of TForm, fill it with data and then call the procedure. } procedure SaveForms(AForms: array of TForm); // the same as LoadForms, but loads all screen forms procedure LoadAllForms; // the same as SaveForms, but saves all screen forms procedure SaveAllForms; implementation type { The original idea for this class was taken from the class AsInheritedReader in the Demos\RichEdit demo (which shows how to reload a form from a resource at run-time), but was developed further. Now the only common thing between the two classes is the ReadPrefix() procedure. } TFormSettingsReader = class(TReader) private procedure ErrorEvent(Reader: TReader; const Message: string; var Handled: Boolean); public constructor Create(Stream: TStream; BufSize: Integer); procedure ReadPrefix(var Flags: TFilerFlags; var AChildPos: Integer); override; end; TFormSettingsWriter = class(TWriter) public procedure DefineBinaryProperty(const Name: string; ReadData, WriteData: TStreamProc; HasData: Boolean); override; end; { TFormSettingsReader } constructor TFormSettingsReader.Create(Stream: TStream; BufSize: Integer); begin inherited; OnError := ErrorEvent; end; procedure TFormSettingsReader.ErrorEvent(Reader: TReader; const Message: string; var Handled: Boolean); begin { EClassNotFound is raised if a class name that has not been linked into the current application is encountered when reading a component from a stream, i.e. the user has deleted all components from a given class since the last save EReadError is raised if a property can't be read while creating a form, i.e. the user has deleted a component (and thus its associated published field) since the last save } if (ExceptObject is EClassNotFound) or (ExceptObject is EReadError) then Handled := True; end; procedure TFormSettingsReader.ReadPrefix(var Flags: TFilerFlags; var AChildPos: Integer); begin inherited ReadPrefix(Flags, AChildPos); // when Flags contains ffInherited, TReader.ReadComponent will find // the existing component instead of creating a new one Include(Flags, ffInherited); end; { TFormSettingsWriter } procedure TFormSettingsWriter.DefineBinaryProperty(const Name: string; ReadData, WriteData: TStreamProc; HasData: Boolean); begin // Don't save binary properties. // If you want to enable saving of binary properties, call // inherited; // This will have a very negative impact on the size of the settigns file. end; procedure PatchIsDefaultPropertyValue; type T3Bytes = array[0..2] of Byte; T4Bytes = array[0..3] of Byte; // there is no standart type with size 3 bytes that we can use to compare // 3 bytes, wo we write a custom function function Compare3Bytes(const Val1, Val2: T3Bytes): Boolean; begin Result := (Val1[0] = Val2[0]) and (Val1[1] = Val2[1]) and (Val1[2] = Val2[2]); end; const EndOfFunc: T4Bytes = ( $5D, // pop ebp $C2,$08,$00 // ret $0008 ); // The release and debug versions of Classes.pas compile to different machine code, // so we need 2 different patches depending on which version of Classes.pas // the program is linked in ReleaseBytes: T3Bytes = ( $8B,$C3, // mov eax, ebx $5B // pop ebx ); ReleasePatch: T3Bytes = ( $33,$C0, // xor eax, eax $5B // pop ebx ); DebugBytes: T3Bytes = ( $8A,$45,$E3 // mov al, [ebp-$1d] ); DebugPatch: T3Bytes = ( $33,$C0, // xor eax, eax $90 // nop ); var PBytes, PPatch: Pointer; WrittenBytes: SIZE_T; //Cardinal; begin PBytes := @System.Classes.IsDefaultPropertyValue; while Integer(PBytes^) <> Integer(EndOfFunc) do Integer(PBytes) := Integer(PBytes) + 1; Integer(PBytes) := Integer(PBytes) - 5; PPatch := nil; if Compare3Bytes(T3Bytes(PBytes^), ReleaseBytes) then // the program is linked to the release version of Classes.pas PPatch := @ReleasePatch else if Compare3Bytes(T3Bytes(PBytes^), DebugBytes) then // the program is linked to the debug version of Classes.pas PPatch := @DebugPatch; if PPatch <> nil then WriteProcessMemory(GetCurrentProcess, PBytes, PPatch, SizeOf(T3Bytes), WrittenBytes); end; // A general procedure for compressing a stream procedure CompressStream(ASource, ATarget: TStream); begin with TCompressionStream.Create(clDefault, ATarget) do try CopyFrom(ASource, ASource.Size); finally Free; end; end; // A general procedure for decompressing a stream procedure DecompressStream(ASource, ATarget: TStream); var Buf: array[0..1023] of Byte; nRead: Integer; begin with TDecompressionStream.Create(ASource) do try // ATarget.CopyFrom(DecompStream, 0) won't work, because CopyFrom requests the // size of the stream when the Count parameter is 0, and TDecompressionStream // doesn't support requesting the size of thå stream repeat nRead := Read(Buf, 1024); ATarget.Write(Buf, nRead); until nRead = 0; finally Free; end; end; function LoadSettingsFile(ASectionFile: TSectionFile): Boolean; var msCompFile, msDecompFile: TMemoryStream; SettingsFileName: String; begin Result := False; msCompFile := TMemoryStream.Create; msDecompFile := TMemoryStream.Create; try SettingsFileName := ChangeFileExt(Application.ExeName, '.ini'); if FileExists(SettingsFileName) then begin msCompFile.LoadFromFile(SettingsFileName); msCompFile.Position := 0; DecompressStream(msCompFile, msDecompFile); msDecompFile.Position := 0; ASectionFile.LoadFromStream(msDecompFile); Result := True; end; except {$IFDEF DEBUG} on E: EZlibError do //ECompressionError do try msCompFile.Position := 0; ASectionFile.LoadFromStream(msCompFile); Result := True; except end; {$ENDIF} end; msCompFile.Free; msDecompFile.Free; end; function SaveSettingsFile(ASectionFile: TSectionFile): Boolean; var msCompFile, msDecompFile: TMemoryStream; SettingsFileName: String; begin Result := False; msCompFile := TMemoryStream.Create; msDecompFile := TMemoryStream.Create; try SettingsFileName := ChangeFileExt(Application.ExeName, '.ini'); ASectionFile.SaveToStream(msDecompFile); msDecompFile.Position := 0; {$IFNDEF DEBUG} CompressStream(msDecompFile, msCompFile); {$ELSE} msCompFile.CopyFrom(msDecompFile, 0); {$ENDIF} msCompFile.Position := 0; msCompFile.SaveToFile(SettingsFileName); Result := True; except end; msCompFile.Free; msDecompFile.Free; end; procedure LoadForms(AForms: array of TForm); procedure LoadFormFromStream(AForm: TForm; AStream: TStream); var OrigName: String; begin with TFormSettingsReader.Create(AStream, 4096) do try OrigName := AForm.Name; AForm := ReadRootComponent(AForm) as TForm; // By default, the streaming system changes the name of the form, // because a form with the same name already exists. // It is safe to restore the original name after the streaming process is done. AForm.Name := OrigName; finally Free; end; end; var SectionFile: TSectionFile; msBinary, msText: TMemoryStream; Strings: TStringList; I: Integer; begin SectionFile := TSectionFile.Create; msBinary := TMemoryStream.Create; msText := TMemoryStream.Create; Strings := TStringList.Create; try if not LoadSettingsFile(SectionFile) then Exit; for I := Low(AForms) to High(AForms) do begin SectionFile.ReadSection(AForms[I].Name, Strings); if Strings.Count > 0 then begin msText.Position := 0; Strings.SaveToStream(msText); msText.Position := 0; msBinary.Position := 0; ObjectTextToBinary(msText, msBinary); msBinary.Position := 0; LoadFormFromStream(AForms[I], msBinary); end; end; finally SectionFile.Free; msBinary.Free; msText.Free; Strings.Free; end; end; procedure SaveForms(AForms: array of TForm); procedure SaveFormToStream(AForm: TForm; AStream: TStream); begin with TFormSettingsWriter.Create(AStream, 4096) do try WriteDescendent(AForm, nil); finally Free; end; end; var SectionFile: TSectionFile; msBinary, msText: TMemoryStream; Strings: TStringList; I: Integer; begin SectionFile := TSectionFile.Create; msBinary := TMemoryStream.Create; msText := TMemoryStream.Create; Strings := TStringList.Create; try LoadSettingsFile(SectionFile); for I := Low(AForms) to High(AForms) do begin msBinary.Position := 0; SaveFormToStream(AForms[I], msBinary); msBinary.Position := 0; msText.Position := 0; ObjectBinaryToText(msBinary, msText); msText.Position := 0; Strings.LoadFromStream(msText); SectionFile.WriteSection(AForms[I].Name, Strings); end; SaveSettingsFile(SectionFile); finally SectionFile.Free; msBinary.Free; msText.Free; Strings.Free; end; end; procedure LoadAllForms; var FormsArr: array of TForm; I: Integer; begin SetLength(FormsArr, Screen.FormCount); for I := 0 to Screen.FormCount - 1 do FormsArr[I] := Screen.Forms[I]; LoadForms(FormsArr); end; procedure SaveAllForms; var FormsArr: array of TForm; I: Integer; begin SetLength(FormsArr, Screen.FormCount); for I := 0 to Screen.FormCount - 1 do FormsArr[I] := Screen.Forms[I]; SaveForms(FormsArr); end; { TSectionFile } constructor TSectionFile.Create; begin inherited; FSections := TStringList.Create; end; destructor TSectionFile.Destroy; begin if FSections <> nil then Clear; FSections.Free; inherited; end; function TSectionFile.AddSection(const Section: string): TStrings; begin Result := TStringList.Create; try FSections.AddObject(Section, Result); except Result.Free; raise; end; end; procedure TSectionFile.Clear; var I: Integer; begin for I := 0 to FSections.Count - 1 do TObject(FSections.Objects[I]).Free; FSections.Clear; end; function TSectionFile.SectionExists(const Section: string): Boolean; begin // if the section name exists, then the section is non-empty Result := FSections.IndexOf(Section) >= 0; end; procedure TSectionFile.ReadSection(const Section: string; Strings: TStrings); var I: Integer; begin Strings.Clear; I := FSections.IndexOf(Section); if I >= 0 then Strings.Assign(TStrings(FSections.Objects[I])); end; function TSectionFile.ReadSection(const Section: string): String; var Strings: TStringList; begin Strings := TStringList.Create; try ReadSection(Section, Strings); if Strings.Count > 0 then Result := Strings[0] else Result := ''; finally Strings.Free; end; end; procedure TSectionFile.WriteSection(const Section: string; Strings: TStrings); var I: Integer; Str: TStrings; begin if Assigned(Strings) and (Strings.Count > 0) then begin I := FSections.IndexOf(Section); if I >= 0 then Str := TStrings(FSections.Objects[I]) else Str := AddSection(Section); Str.Assign(Strings); end else EraseSection(Section); end; procedure TSectionFile.WriteSection(const Section: string; const Str: String); var Strings: TStringList; begin Strings := nil; try if Str <> '' then begin Strings := TStringList.Create; Strings.Append(Str); end; WriteSection(Section, Strings); finally if Assigned(Strings) then Strings.Free; end; end; function TSectionFile.ReadSections(Strings: TStrings): Boolean; begin Strings.Assign(FSections); Result := Strings.Count > 0; end; procedure TSectionFile.EraseSection(const Section: string); var I: Integer; begin I := FSections.IndexOf(Section); if I >= 0 then begin TStrings(FSections.Objects[I]).Free; FSections.Delete(I); end; end; procedure TSectionFile.GetStrings(List: TStrings); var I, J: Integer; Strings: TStrings; begin List.BeginUpdate; try for I := 0 to FSections.Count - 1 do begin List.Add('[' + FSections[I] + ']'); Strings := TStrings(FSections.Objects[I]); for J := 0 to Strings.Count - 1 do List.Add(Strings[J]); end; finally List.EndUpdate; end; end; procedure TSectionFile.SetStrings(List: TStrings); var I: Integer; S: string; Strings: TStrings; begin Clear; Strings := nil; for I := 0 to List.Count - 1 do begin S := List[I]; // the line is not a cooment if (S <> '') and (S[1] <> ';') then if (S[1] = '[') and (S[Length(S)] = ']') then // a section begin Delete(S, 1, 1); SetLength(S, Length(S)-1); Strings := AddSection(Trim(S)); end else if Strings <> nil then Strings.Add(S); end; end; procedure TSectionFile.LoadFromFile(const FileName: string); var Strings: TStringList; begin Strings := TStringList.Create; try Strings.LoadFromFile(FileName); SetStrings(Strings); finally Strings.Free; end; end; procedure TSectionFile.LoadFromStream(Stream: TStream); var Strings: TStringList; begin Strings := TStringList.Create; try Strings.LoadFromStream(Stream); SetStrings(Strings); finally Strings.Free; end; end; procedure TSectionFile.SaveToFile(const FileName: string); var Strings: TStringList; begin Strings := TStringList.Create; try GetStrings(Strings); Strings.SaveToFile(FileName); finally Strings.Free; end; end; procedure TSectionFile.SaveToStream(Stream: TStream); var Strings: TStringList; begin Strings := TStringList.Create; try GetStrings(Strings); Strings.SaveToStream(Stream); finally Strings.Free; end; end; initialization PatchIsDefaultPropertyValue; end. |
AW: Formular Position speichern
Nimm doch einfach die Jedi-Komponente TJvFormStorage (Zu finden in der Gruppe JV Persistence).
Oder musst du das zwingend in der Datenbank speichern? |
AW: Formular Position speichern
Also, ich weiß ja nicht, was ihr hier für Klimmzüge veranstaltet. 500 Zeilen Code? :shock:
Delphi-Quellcode:
Die Routine zum laden habe ich mir mal gespart. In OnClose der Formulare dann:
unit Unit6;
interface uses Windows, SysUtils, IniFiles; type TFoobar = class(TObject) private FFormName: AnsiString; FLeft: Integer; FTop: Integer; FWidth: Integer; FHeight: Integer; public constructor Create(FormName: AnsiString; Left, Top, Width, Height: Integer); procedure SaveSizePos; end; implementation { TFoobar } constructor TFoobar.Create(FormName: AnsiString; Left, Top, Width, Height: Integer); begin inherited Create; FFormName := FormName; Fleft := Left; FTop := Top; FWidth := Width; FHeight := Height; end; procedure TFoobar.SaveSizePos; var Ini: TIniFile; begin Ini := TIniFile.Create('Z:\test.ini'); try Ini.WriteInteger(FFormName, 'left', Fleft); Ini.WriteInteger(FFormName, 'top', FTop); Ini.WriteInteger(FFormName, 'width', FWidth); Ini.WriteInteger(FFormName, 'height', FHeight); finally Ini.Free; end; end; end.
Delphi-Quellcode:
Sieht dann so aus:
procedure TForm5.FormClose(Sender: TObject; var Action: TCloseAction);
var SizePos: TFoobar; begin SizePos := TFoobar.Create(Self.Name, Self.Left, Self.Top, Self.Width, Self.Height); try SizePos.SaveSizePos; finally SizePos.Free; end; end;
Code:
[Form5]
left=98 top=327 width=349 height=280 [Form1] left=879 top=206 width=651 height=338 |
AW: Formular Position speichern
So wie ich den OP verstanden habe, geht es nicht darum, dass ein Form seine eigene Position speichern und lesen kann, sondern es liegt in einer DB eine Liste von Formnamen mit zugehörigen Positionen vor und nur diese Forms sollen erzeugt und angezeigt werden.
Man braucht also eine irgendwie geartete Zuordnung FormName -> FormKlasse um eine Instanz der entsprechenden Klasse zu erzeugen. Vorschläge dazu wurden in #8 und #10 gemacht. Wenn die Form dann erst einmal erzeugt ist, kann sie sich die Position ja wieder selbst aus der DB oder sonst woher auslesen. |
AW: Formular Position speichern
@Luckie:
Wie ich es sehe, geht es Ihm nicht primär darum, die Position zu lesen und zu speichern. Vielmehr speichert er beim Verlassen des Programms die Positionen UND den Namen der Fenster. Anhand des Namen soll nun beim Starten die entsprechenden Forms instanziert werden, um alle Fenster, die er vor beenden des Programms offen hatte, wieder zu öffnen. EDIT: da war bcvs wohl schneller. |
AW: Formular Position speichern
Die Anzahl der Zeilen ist doch nicht entscheidend (auch wenn einige hier im Forum das meinen), solange es DRY ist und die geforderte Aufgabe löst.
Wird die Aufgabe damit nicht gelöst, dann ist auch eine Zeile Code schon zu viel. |
AW: Formular Position speichern
Ok, es sollen also automatisch die Formulare geöffnet werden, die beim letzten mal geöffnet waren?
Beim Start der Anwendung: wenn in Ini Section FormA existiert, dann FormA.Show wenn in Ini Section FormB existiert, dann FormB.Show @Sir Rufo: Das mag sein. Aber ich küsse lieber. ;) -> KISS Prinzip. Und damit ich mich nicht wiederhole, habe ich den Code in eine Klasse ausgelagert. |
AW: Formular Position speichern
|
AW: Formular Position speichern
Bei mir hat sich folgende Vorgehensweise bestens bewährt:
In meinen Datenbanken gibt es gewöhnlich eine Tabelle BENUTZER, die für Single-User-Anwendungen nur einen Datensatz enthält, bei Multi-User-Anwendungen für jeden registrierten Benutzer einen weiteren Datensatz. Dort steht dann z.B. in den Spalten MAIN_LEFT, MAIN_TOP, MAIN_WIDTH, MAIN_HEIGHT, MAIN_MAX, wo das Fenster mit welcher Größe positioniert werden und ob es maximiert angezeigt werden soll. Jedes Formular, dessen Fensterparameter gespeichert werden sollen, erhält zwei private Methoden: Einstellungen_Lesen und Einstellungen_Speichern, die beim OnShow bzw. beim OnClose aufgerufen werden. Darin steht dann folgender Code:
Delphi-Quellcode:
Eine Kennzeichnung der Spalten für die verschiedenen Formulare benötigst du im Grunde nur deswwegen, damit du dich selbst nicht unnötig in Verwirrung stürzt. Dafür kannst du ja den Namen des Formulars verwenden, gefolgt von einem Unterstrich und den jeweiligen Bezeichnungen für Left, Top usw. Jedes Formular richtet sich dann beim Erscheinen vollkommen selbständig aus und speichert seine Parameter beim Schließen ebenso automatisch, so daß du dich nicht weiter darum kümmern mußt. Diese Methoden mußt du nur einmal schreiben und kannst sie dann einfach in das neue Formular kopieren, wobei du natürlich die Spaltenbezeichner anpassen mußt. Wenn du das eine Weile so gehandhabt hast, machst du das praktisch im Schlaf und hast das sozusagen in Nullkommanix erledigt.
Procedure TFormMain.Einstellungen_Lesen;
begin Self.Left := DatMod.Qset_Benutzer.FieldByName('MAIN_LEFT').AsInteger; Self.Top := DatMod.Qset_Benutzer.FieldByName('MAIN_TOP').AsInteger; Self.Width := DatMod.Qset_Benutzer.FieldByName('MAIN_WIDTH').AsInteger; Self.Height := DatMod.Qset_Benutzer.FieldByName('MAIN_HEIGHT').AsInteger; IF DatMod.Qset_Benutzer.FieldByName('MAIN_MAX').AsBoolean THEN Self.WindowState := wsMaximized ELSE Self.WindowState := wsNormal; end; Procedure TFormMain.Einstellungen_Speichern; Var Maxi : Boolean; begin Maxi := Self.WindowState = wsMaximized; Self.WindowState := wsNormal; DatMod.Qset_Benutzer.Edit; DatMod.Qset_Benutzer.FieldByName('MAIN_LEFT').AsInteger := Self.Left; DatMod.Qset_Benutzer.FieldByName('MAIN_TOP').AsInteger := Self.Top; DatMod.Qset_Benutzer.FieldByName('MAIN_WIDTH').AsInteger := Self.Width; DatMod.Qset_Benutzer.FieldByName('MAIN_HEIGHT').AsInteger := Self.Height; DatMod.Qset_Benutzer.FieldByName('MAIN_MAX').AsBoolean := Maxi; DatMod.Qset_Benutzer.Post; end; Eine weitere Tabelle verwende ich z.B. für Spaltenbreiten von Grids, die ebenfalls für jeden Benutzer gesondert abgespeichert werden. Sonstige Einstellungen wie Farben usw. werden ebenfalls in der Benutzertabelle gespeichert, die bei umfangreichen Anwendungen auch mal um die 100 Spalten beherbergt. Diese Vorgehensweise hat sich im Laufe der Jahre so weit entwickelt, daß ich damit vollkommen zufrieden bin und mich weder um Registry-Einträge noch um User-Verzeichnisse kümmern muß. |
AW: Formular Position speichern
Es Fehlt dann nur noch die Überprüfung ob der Monitor noch existiert...
Besonders Interessant, wenn der User per Datensicherung die Daten auf einen anderen PC/Laptop übertragen will... Sollten die Daten 1. Computernamen bezogen gespeichert werden und bei laden getestet werden ob es die Top/Left Positions auf dem aktuellen Computer gibt... Mavarik |
Alle Zeitangaben in WEZ +1. Es ist jetzt 16:31 Uhr. |
Powered by vBulletin® Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
LinkBacks Enabled by vBSEO © 2011, Crawlability, Inc.
Delphi-PRAXiS (c) 2002 - 2023 by Daniel R. Wolf, 2024 by Thomas Breitkreuz