Formular Position speichern

[Perlsau]

Zitat von Sugar:

Ich speichere den Namen (und weitere Daten) des Formulares in einer Tabelle. Das Feld in dem der Name des Formulares steht ist ein VarChar, also String. Nun muss ich beim Öffnn der Formulare dieses String in ein TForm (o.ä.) umwandeln um dann Width, Top etc zuzuweisen. Ich scheitere aber daran, den ausgelesenen String in ein TForm umzuwandeln. Kann mir jemand helfen?

Mir ist ebenfalls nicht so recht klar, was dein eigentliches Problem ist. Meinst du wirklich das Property Name, wenn du davon schreibst, den Namen des Formulars speichern und lesen zu wollen? Oder meinst du – was weitaus wahrscheinlicher wäre – das Property Caption, das den Text enthält, der in der Titelleiste eines Formulars angezeigt wird? Wie oben schon festgestellt wurde, ist der Name eines Formulars beim dessen Erzeugung bereits bekannt. Andernfalls könntest du das Formular gar nicht erst erzeugen. Irgendwo hast du da offenbar was vollkommen falsch verstanden, aber was das sein könnte, entzieht sich meiner Kenntnis.

[hathor]

http://www.torry.net/pages.php?id=96

[Sugar]

Hallo Forum,

habe ich mich wirklich so unverständlich ausgedrückt? Entschuldigung.

Also, mal weiter ausgeholt:

Ich erweitere eine ältere interne Anwendung über die unsere User sich schon immer beschwert haben, weil die Fensterpositionen nicht gespeichert werden und man nicht die Möglichkeit hat sich auf den Bildschirmen zurecht gerückten Formulare, dessen Größe und Position zu "merken". Hintergrund: Kommt ein Anruf in der Zentrale an zeigt das Hauptformular den Stammsatz des Anrufers an, soweit erkennbar.

Der User muss dann weitere Fenster "manuell" öffnen um bspw. Historie, Rechnungen etc. im Blick zu haben.

Ich möchte nun, dass der User sich seine drei, vier Fenster öffnen und auf den Bildschirmen platzieren kann UND diese "Ansicht" als Szenario speichern. Öffnet der User dann das Programm, lese ich in der Datenbank was er als Szenario gespeichert hat und öffne und platziere diese Fenster. So die Idee...

Ich dachte mir nun, ich speichere in einer Tabelle den Usernamen, den Namen der Form (Ja, die Eigenschaft NAME),Top, Height, Width, left und ein bit ob das Fenster beim Start sichtbar sein soll.

Was ich nun nicht weiß wie man es umsetzt ist: Ich hole mir den Namen der Form als String, nur wie wandele ich diesen String um, so dass ich damit die Form mit diesem Namen anzeigen kann?

Kurzes "Nebenproblem" noch dazu: Gibt es eine Möglichkeit alle offenen Formulare der Anwendung zu ermitteln?

Also, nochmal Sorry für die vielleicht verwirrende Anfrage. Ich hoffe es ist nun klarer was ich vorhabe.

Danke für die bisherige Hilfe

Gruß
Sugar

[edit]ps. @hathor: Dein Link ist nicht verfügbar

[edit2]:

Zu dem Ermitteln der offenen Formulare habe ich etwas gefunden:

Delphi-Quellcode:

For i:=0 to Screen.FormCount-1 do
   begin
    Screen.Forms[i].Name

Wenn in Name etwas steht ist es eine geöffnete Form meiner App.

[bcvs]

Zitat von Sugar:

Was ich nun nicht weiß wie man es umsetzt ist: Ich hole mir den Namen der Form als String, nur wie wandele ich diesen String um, so dass ich damit die Form mit diesem Namen anzeigen kann?

Schreib dir halt eine Funktion, die abhängig vom Namen die richtige Form erzeugt und anzeigt. z.B. ganz einfach so

Delphi-Quellcode:

if FormName='MyForm' then
begin
  MyForm:=TMyForm.Create(Application);
  MyForm.Show;
end;

[Sugar]

@bcvs

Ich dachte halt es geht eleganter. So muss ich bei jeder neu hinzukommenden Form auch die Abfrage anpassen... das wollte ich umgehen

[Lemmy]

Zitat von Sugar:

@bcvs

Ich dachte halt es geht eleganter. So muss ich bei jeder neu hinzukommenden Form auch die Abfrage anpassen... das wollte ich umgehen

dann nimm eine TClassLIst (aus contnrs) und fülle die beim Programmstart mit allen relevanten Formularen

Delphi-Quellcode:

Liste := TClassList;
Liste.Add(TFormXYZ);
-...

wenn Du nun ein bestimmtes Formular suchst:

Delphi-Quellcode:

function FOrmErzeugen(AFormularName: String): TForm;
var
  FormClass: TFormClass;
  idxForm: Integer;
begin
  FormClass := nil;
  for idxForm := 0 to Liste.Count -1 do
  begin
    if Liste.Item[idxForm].ClassName = AFormularName then
      FormClass := Liste.Item[idxForm]
  end;
  if Assigned(FOrmClass) then
    result := FormClass.Create(Application)
  else
    ....

Und wenn dir das ständige Durchlaufen der ClassList zu langsam ist, dann sortiere die Liste nach den Namen, dann kannst Du schneller suchen....

Nachtrag: Wenn Du ein aktuelleres Delphi hast, kannst Du hier auch mit einer generischen Liste arbeiten....

[hathor]

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, [e-mail], 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.

[Jasocul]

Nimm doch einfach die Jedi-Komponente TJvFormStorage (Zu finden in der Gruppe JV Persistence).
Oder musst du das zwingend in der Datenbank speichern?