Mehrsprachingkeit

[wschrabi]

Hallo,
ich habe eine UNIT mit zug. DFM und möchte nun alle CAPTIONs der Objekte mit Objektnamen in eine Liste haben.
so Zb:

Delphi-Quellcode:

Form1.Label1.Caption:='LabelText1_deutsch';
Form1.Button1.Caption := ' ButtoneText1';

Ziel ist eine maschinelle Übersetzung der Strings des Prg zu ermöglichen. Dh. ich mach dann eine Routine wo die Strings durch
capstr[1,Sprache]:='LabelText1_deutsch'; ersetzt werden und dann kann ich je nach Sprache-INdex die Captions multisprachig schalten.

Weiß wer wie man so was macht? Hat jemand das Problem der Mehrsparchigkeit schon mal gehabt?
DANKE
WS

[zeras]

Der Ansatz ist gut, nur scheitert es dann an den Dialogen, die vom jeweiligen OS in der Sprache des Computers zur Verfügung gestellt werden.
Du darfst dann aber nicht nur Captions, sondern auch Text suchen.
Ich nutze tsilang, wobei dies nicht kostenlos ist.

[Sailor]

Delphi-Quellcode:

  PROCEDURE GetComponentCaptions(frm:TForm);
   VAR
    texts: TStringList;
     comp: TComponent;
     capt: String;
        i: Integer;

   BEGIN
    texts := TStringList.Create;
    TRY
     WITH texts
      DO BEGIN
          Duplicates := dupIgnore;
          Sorted := True;
          FOR i:=0 TO frm.ComponentCount-1
           DO BEGIN
               comp := frm.Components[i];
               capt := comp.Caption;
               IF (comp.Name <> '')
                 AND
                  (capt <> '')
                THEN Add(comp.Name+'='+capt)
              END;
          SaveToFile(CaptionFileName)
         END;
    FINALLY
     texts.Free
    END
   END;

Du mußt dann nur über alle Forms iterieren, Dialoge müssen geöffnet sein. Die Beschriftungen der Buttons in den Dialogen kann auch geändert werden, bis auf wenige Ausnahmen.

Ach so, beim Setzen der Sprache dann genau umgekehrt verfahren:
Finde comp.Name
Setze die Caption

[himitsu]

Von GNU-gettext gibt es für Delphi mehrere Implementierungen. (auch in den JEDI ist was drin)

Und dann gibt es auch
http://docwiki.embarcadero.com/RADSt...ger_in_the_IDE
http://docwiki.embarcadero.com/RADSt...s_to_a_Project

[wschrabi]

Tausend DANK! Sailer super! Genau so wollte ich es. SUPER!

[wschrabi]

Zitat von Sailor:

  PROCEDURE GetComponentCaptions(frm:TForm); Du mußt dann nur über alle Forms iterieren, Dialoge müssen geöffnet sein. Die Beschriftungen der Buttons in den Dialogen kann auch geändert werden, bis auf wenige Ausnahmen.

Ach so, beim Setzen der Sprache dann genau umgekehrt verfahren:
Finde comp.Name
Setze die Caption

Frage: Ich möchte die Files *.dfm einlesen wie kann ich da die frm:TFORM machen?
wie kann man das abändern, dass er die Files (*.dfm) in einer Listbox interiert. Die Listbox mit den *.dfm hab ich ja.

oder: wie kann ich eine Liste aller TForms erhalten von einem fremden DelphiPRoject?
Edit: hab das hier gefunden: https://stackoverflow.com/questions/...of-my-software

Mein ansatz ist:

Delphi-Quellcode:

unit Unit1MergeMe;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, system.IOUtils, StdCtrls ;

type
  TFormFIND = class(TForm)
    ListBoxtmp: TListBox;
    Edit1: TEdit;
    Label1: TLabel;
    Button1: TButton;
    OpenDialog1: TOpenDialog;
    Button2: TButton;
    OpenDialog2: TOpenDialog;
    Button3: TButton;
   // gtPDFDocument1: TgtPDFDocument;
   // gtPDFDocumentCOVER: TgtPDFDocument;
    ListBoxEnd: TListBox;
    SaveDialog1: TSaveDialog;
    Memo1: TMemo;
    CheckBox1: TCheckBox;
    //gtPDFDocument2: TgtPDFDocument;
    CheckBox2: TCheckBox;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
  private
    { Private-Deklarationen }
      procedure MakeFileList(listboxtmp: Tlistbox; teil:array of string; Verzeichnis: string);
      procedure FindAllFiles(const FileList: tstrings;RootFolder: string; Maske: array of string; Recurse: Boolean = False);
      function GetTempDirectory: String;
      PROCEDURE GetComponentCaptions(frm:TForm; FN: string);
      
      
      
    
  public
    { Public-Deklarationen }
  end;

var
  FormFIND: TFormFIND;
  mypath: string;

implementation

{$R *.dfm}


procedure TFormFIND.Button1Click(Sender: TObject);
begin
   if opendialog1.Execute then
      begin
        edit1.Text:= Opendialog1.FileName;
      end;

end;

procedure TFormFIND.Button2Click(Sender: TObject);
begin
   if opendialog2.execute then
      begin
        makefilelist(listboxtmp,['*.dfm'],extractfilepath(opendialog2.filename));

      end;
end;


function filenameconform(fn:string):string;
begin
  fn:=stringreplace(fn,' ','_',[rfReplaceall]);
  fn:=stringreplace(fn,'.','_',[rfReplaceall]);
  fn:=stringreplace(fn,':','_',[rfReplaceall]);
  result:=fn;
end;

procedure TFormFIND.Button3Click(Sender: TObject);
var
  i: Integer;
  mymergedfn: string;
begin
listboxend.Clear;



mymergedfn:=filenameconform(datetimetostr(now));


savedialog1.filename:=format('%sGREPFORM.pas',[mypath]);
if Savedialog1.execute then
   begin
   for i := 0 to listboxtmp.Count-1 do
      begin
      mypath:=extractfilepath(listboxtmp.Items[i]);
      GetComponentCaptions(listboxtmp.Items[i],savedialog1.filename);
      
      end;
   
   
   end;
   


end;

PROCEDURE formfind.GetComponentCaptions(frm:TForm; FN: string);
   VAR
    texts: TStringList;
     comp: TComponent;
     capt: String;
        i: Integer;

   BEGIN
    texts := TStringList.Create;
    TRY
     WITH texts
      DO BEGIN
          Duplicates := dupIgnore;
          Sorted := True;
          FOR i:=0 TO frm.ComponentCount-1
           DO BEGIN
               comp := frm.Components[i];
               capt := comp.Caption;
               IF (comp.Name <> '')
                 AND
                  (capt <> '')
                THEN Add(comp.Name+'='+capt)
              END;
          SaveToFile(FN)
         END;
    FINALLY
     texts.Free
    END
   END;

   
function TFormFIND.GetTempDirectory: String;
var
  tempFolder: array[0..MAX_PATH] of Char;
begin
  //GetTempPath(MAX_PATH, @tempFolder);
  //result := StrPas(tempFolder);
  result:=TPath.GetTempPath;
end;


procedure TFormFIND.FindAllFiles(const FileList: tstrings;RootFolder: string; Maske: array of string; Recurse: Boolean = False);
var
  SR: TSearchRec;
  i : integer;
begin
  //RootFolder := IncludeTrailingPathDelimiter(RootFolder);

  if Recurse then
    if FindFirst(RootFolder + '*.*', faAnyFile, SR) = 0 then
    try
      repeat
        if SR.Attr and faDirectory = faDirectory then
            // --> ein Verzeichnis wurde gefunden
            // der Verzeichnisname steht in SR.Name
            // der vollständige Verzeichnisname (inkl. darüberliegender Pfade) ist
            // RootFolder + SR.Name
          if (SR.Name <> '.') and (SR.Name <> '..') then
            FindAllFiles(FileList, RootFolder + SR.Name, Maske, Recurse);
      until FindNext(SR) <> 0;
    finally
      FindClose(SR);
    end;
  i := 0;
  repeat
    begin
      if FindFirst(RootFolder + Maske[i], faAnyFile, SR) = 0 then
      try
        repeat
          if SR.Attr and faDirectory <> faDirectory then
          begin
            // --> eine Datei wurde gefunden
            // der Dateiname steht in SR.Name
            // der vollständige Dateiname (inkl. Pfadangabe) ist
            // RootFolder + SR.Name
            FileList.Add(RootFolder + SR.Name);
          end;
        until FindNext(SR) <> 0;
      finally
        FindClose(SR);
      end;
      i := i + 1;
    end
  until
    i = high(maske) + 1;
end;


function ReportTime(const Name: string; const FileTime: TFileTime): string;
 var
   SystemTime, LocalTime: TSystemTime;
 begin
   if not FileTimeToSystemTime(FileTime, SystemTime) then
     RaiseLastOSError;
   if not SystemTimeToTzSpecificLocalTime(nil, SystemTime, LocalTime) then
     RaiseLastOSError;
   result:=Name + ': ' + DateTimeToStr(SystemTimeToDateTime(LocalTime));
 end;

procedure GetBuildInfo(var V1, V2, V3, V4: word);
var
  VerInfoSize, VerValueSize, Dummy: DWORD;
  VerInfo: Pointer;
  VerValue: PVSFixedFileInfo;
begin
  VerInfoSize := GetFileVersionInfoSize(PChar(ParamStr(0)), Dummy);
  if VerInfoSize > 0 then
  begin
      GetMem(VerInfo, VerInfoSize);
      try
        if GetFileVersionInfo(PChar(ParamStr(0)), 0, VerInfoSize, VerInfo) then
        begin
          VerQueryValue(VerInfo, '\', Pointer(VerValue), VerValueSize);
          with VerValue^ do
          begin
            V1 := dwFileVersionMS shr 16;
            V2 := dwFileVersionMS and $FFFF;
            V3 := dwFileVersionLS shr 16;
            V4 := dwFileVersionLS and $FFFF;
          end;
        end;
      finally
        FreeMem(VerInfo, VerInfoSize);
      end;
  end;
end;

function GetBuildInfoAsString: string;
var
  V1, V2, V3, V4: word;
begin
  GetBuildInfo(V1, V2, V3, V4);
  Result := IntToStr(V1) + '.' + IntToStr(V2) + '.' +
    IntToStr(V3) + '.' + IntToStr(V4);
end;

procedure TFormFIND.FormCreate(Sender: TObject);

var
   targetinfo: string;
   fad: TWin32FileAttributeData;
   
begin

  if not GetFileAttributesEx(PChar(Application.ExeName), GetFileExInfoStandard, @fad) then
    RaiseLastOSError;
  //ReportTime('Created', fad.ftCreationTime);
  //ReportTime('Modified', fad.ftLastWriteTime);
  //ReportTime('Accessed', fad.ftLastAccessTime);  

   {$IFDEF WIN64}
      targetinfo:=' (x64 Architecture)';
     {$ELSE}
      targetinfo:=' Architecture: 32bit';
     {$ENDIF}

   targetinfo := targetinfo + format(' %s : %s',
         [ReportTime('Created', fad.ftCreationTime),
         ReportTime('Modified', fad.ftLastWriteTime)]) ;

  FormFIND.Caption := FormFIND.Caption+' - Build: ' + GetBuildInfoAsString + targetinfo;

end;

procedure TFormFIND.MakeFileList(listboxtmp: tlistbox; teil:array of string; Verzeichnis: string);
var
  Files: TStrings;
  i: integer;
begin
  Files := TStringList.Create;
  try
  //  procedure FindAllFiles(const FileList: tstrings;RootFolder: string; Maske: array of string; Recurse: Boolean = True);

    FindAllFiles(files, Verzeichnis, teil, false);
    for i := Files.Count -1 downto 0 do
    begin
        ListBOxtmp.Items.Add(widestring(Files[i]));
        //DeleteFile(Files[i]);
    end;



  finally

    Files.Free;
  end;
end;

end.

DANKE

[wschrabi]

Also ich hab jetzt so den Ansatz:
in MainForm hab ich von DELPHIUEBESTZ-Project alle Forms in CreateForm drin und mach eine Stringlist.

Delphi-Quellcode:

procedure TFormFG.FormCreate(Sender: TObject);
begin
  MyForms := TStringList.Create;
  Application.CreateForm(TForm1, Form1); Myforms.items.add('Form1'); 
  Application.CreateForm(TForm2, Form2); Myforms.items.add('Form2'); 
  Application.CreateForm(TFrmBlatt, FrmBlatt); Myforms.items.add('FrmBlatt'); 
  Application.CreateForm(TForm4, Form4); Myforms.items.add('Form4'); 
  Application.CreateForm(TForm4TC, Form4TC); Myforms.items.add('Form4TC'); 
  Application.CreateForm(TForm5TC, Form5TC); Myforms.items.add('Form5TC'); 
  Application.CreateForm(TForm6, Form6); Myforms.items.add('Form6'); 
  Application.CreateForm(TFormindi2, Formindi2); Myforms.items.add('Formindi2'); 
  Application.CreateForm(TFormindi1, Formindi1); Myforms.items.add('Formindi1'); 
  Application.CreateForm(TForm8, Form8); Myforms.items.add('Form8'); 
  Application.CreateForm(TForm7, Form7); Myforms.items.add('Form7'); 
  Application.CreateForm(TUSBErrorForm, USBErrorForm); Myforms.items.add('USBErrorForm'); 
  Application.CreateForm(TForm9, Form9); Myforms.items.add('Form9'); 
  Application.CreateForm(TForm10, Form10); Myforms.items.add('Form10'); 
  Application.CreateForm(TMainForm, MainForm); Myforms.items.add('MainForm'); 
  Application.CreateForm(TInfoForm, InfoForm); Myforms.items.add('InfoForm'); 
  Application.CreateForm(TForm11, Form11); Myforms.items.add('Form11'); 
  Application.CreateForm(TForm4, Form4); Myforms.items.add('Form4'); 
  Application.CreateForm(TForm5, Form5); Myforms.items.add('Form5'); 
  Application.CreateForm(TForm12, Form12); Myforms.items.add('Form12'); 
  Application.CreateForm(TForm13, Form13); Myforms.items.add('Form13'); 
  Application.CreateForm(TForm111, Form111); Myforms.items.add('Form111'); 
  Application.CreateForm(TForm14, Form14); Myforms.items.add('Form14'); 
  Application.CreateForm(TFormMergeMe, FormMergeMe); Myforms.items.add('FormMergeMe'); 

end;

und dann lass ich die loop durch:

Delphi-Quellcode:

procedure TFormFIND.Button3Click(Sender: TObject);
var
  i: Integer;
  mymergedfn: string;
begin
listboxend.Clear;



mymergedfn:=filenameconform(datetimetostr(now));


savedialog1.filename:=format('%sGREPFORM.pas',[mypath]);
if Savedialog1.execute then
   begin
   for i := 0 to myforms.Count-1 do
      begin
      GetComponentCaptions(TForm(myforms[i]),savedialog1.filename);
      
      end;
   
   
   end;
   


end;

Doch leider ist der Code von oben nicht ok. Siehe Bild anbei.

So wie ich das sehe und in https://www.tek-tips.com/viewthread.cfm?qid=1025706 steht
muss man zuerst fragen ob die TComponent einen Caption hat. und dann zb TLabel(com).Caption machen.

oder? WIe kann man das machen?

Oder hier: man muss mit try machen:

Delphi-Quellcode:

procedure bla(c: TComponent)
   for i := 0 to c.ComponentsCount-1 do begin
      bla(c.Components[i])
      try
         (c.Components[i] as TControl).Caption := str
      except
      end
   end
end

DANKE

[Der schöne Günther]

Zitat von himitsu:

Von GNU-gettext gibt es für Delphi mehrere Implementierungen

Nutzen wir auch seit mehreren Jahren in unseren Delphi-Projekten. Kostet nichts, funktioniert super, und nutzt mit .po ein Standardformat. Ein Kunde hatte sich bspw. die komplette Software selbst in seine Sprache übersetzt und kein einziges mal dafür bei uns gefragt was er tun muss 😎

[wschrabi]

Habe das jetzt so gelöst:

In UnitFGMain:

Delphi-Quellcode:

uses Unit1MergeMe,
  Unit1 in '..\Unit1.dfm' {Form1},
  Unit2 in '..\Unit2.pas' {Form2},
  Unit3 in '..\Unit3.pas' {Form3},
  Unit4TC in '..\Unit4TC.pas' {Form4TC},
  Unit5TC in '..\Unit5TC.pas' {Form5TC},
  Unit6 in '..\Unit6.pas' {Form6},
  Unitindi2 in '..\Unitindi2.pas' {Formindi2},
  Unitindi1 in '..\Unitindi1.pas' {Formindi1},
  Unit8 in '..\Unit8.pas' {Form8},
  Unit7 in '..\Unit7.pas' {Form7},
  RegExpr in '..\RegExpr.pas',
  USBError in '..\USBError.pas' {USBErrorForm},
  md5 in '..\md5.pas',
  PrintFormUnit in '..\PrintFormUnit.pas' {Form9},
  Unit10 in '..\Unit10.pas' {Form10},
  DevReader in '..\HIDKomponente\HIDKomponente\DEMOS\Delphi\ReadWriteDemo\DevReader.pas' {MainForm},
  Info in '..\HIDKomponente\HIDKomponente\DEMOS\Delphi\ReadWriteDemo\Info.pas' {InfoForm},
  Unit11 in '..\Unit11.pas' {Form11},
  Unit4 in '..\Unit4.pas' {Form4},
  Unit5 in '..\Unit5.pas' {Form5},
  Unit12 in '..\Unit12.pas' {Form12},
  Unit13 in '..\Unit13.pas' {Form13},
  SetupApi in '..\HIDKomponente\HIDKomponente\SetupApi.pas',
  ModuleLoader in '..\HIDKomponente\HIDKomponente\ModuleLoader.pas',
  WinConvTypes in '..\HIDKomponente\HIDKomponente\WinConvTypes.pas',
  Unit111 in '..\SQLite\Unit111.pas' {Form111},
  Unit14 in '..\Unit14.pas' {Form14},
  UnitMergeMe in '..\UnitMergeMe.pas' {FormMergeMe},
  UnitTrans in '..\UnitTrans.pas';

{$R *.RES}

;

procedure TFormFG.Button1Click(Sender: TObject);
begin
   formfind.showmodal;
end;

procedure TFormFG.FormCreate(Sender: TObject);
begin
  MyForms := TStringList.Create;
  Application.CreateForm(TForm1, Form1); Myforms.items.add('Form1'); 
  Application.CreateForm(TForm2, Form2); Myforms.items.add('Form2'); 
  Application.CreateForm(TFrmBlatt, FrmBlatt); Myforms.items.add('FrmBlatt'); 
  Application.CreateForm(TForm4, Form4); Myforms.items.add('Form4'); 
  Application.CreateForm(TForm4TC, Form4TC); Myforms.items.add('Form4TC'); 
  Application.CreateForm(TForm5TC, Form5TC); Myforms.items.add('Form5TC'); 
  Application.CreateForm(TForm6, Form6); Myforms.items.add('Form6'); 
  Application.CreateForm(TFormindi2, Formindi2); Myforms.items.add('Formindi2'); 
  Application.CreateForm(TFormindi1, Formindi1); Myforms.items.add('Formindi1'); 
  Application.CreateForm(TForm8, Form8); Myforms.items.add('Form8'); 
  Application.CreateForm(TForm7, Form7); Myforms.items.add('Form7'); 
  Application.CreateForm(TUSBErrorForm, USBErrorForm); Myforms.items.add('USBErrorForm'); 
  Application.CreateForm(TForm9, Form9); Myforms.items.add('Form9'); 
  Application.CreateForm(TForm10, Form10); Myforms.items.add('Form10'); 
  Application.CreateForm(TMainForm, MainForm); Myforms.items.add('MainForm'); 
  Application.CreateForm(TInfoForm, InfoForm); Myforms.items.add('InfoForm'); 
  Application.CreateForm(TForm11, Form11); Myforms.items.add('Form11'); 
  Application.CreateForm(TForm4, Form4); Myforms.items.add('Form4'); 
  Application.CreateForm(TForm5, Form5); Myforms.items.add('Form5'); 
  Application.CreateForm(TForm12, Form12); Myforms.items.add('Form12'); 
  Application.CreateForm(TForm13, Form13); Myforms.items.add('Form13'); 
  Application.CreateForm(TForm111, Form111); Myforms.items.add('Form111'); 
  Application.CreateForm(TForm14, Form14); Myforms.items.add('Form14'); 
  Application.CreateForm(TFormMergeMe, FormMergeMe); Myforms.items.add('FormMergeMe'); 

end;

und im HAuptModul hier:

Delphi-Quellcode:

unit Unit1MergeMe;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, system.IOUtils, StdCtrls ;

type
  TFormFIND = class(TForm)
    ListBoxtmp: TListBox;
    Edit1: TEdit;
    Label1: TLabel;
    Button1: TButton;
    OpenDialog1: TOpenDialog;
    Button2: TButton;
    OpenDialog2: TOpenDialog;
    Button3: TButton;
   // gtPDFDocument1: TgtPDFDocument;
   // gtPDFDocumentCOVER: TgtPDFDocument;
    ListBoxEnd: TListBox;
    SaveDialog1: TSaveDialog;
    Memo1: TMemo;
    CheckBox1: TCheckBox;
    //gtPDFDocument2: TgtPDFDocument;
    CheckBox2: TCheckBox;
    procedure Button1Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
  private
    { Private-Deklarationen }
      function GetTempDirectory: String;
      PROCEDURE GetComponentCaptions(frm:TForm; FN: string);
      
      
      
    
  public
    { Public-Deklarationen }
  end;

var
  FormFIND: TFormFIND;
  mypath: string;

implementation

{$R *.dfm}

uses UnitFGMain, Typinfo;

const
CSCaption = 'Caption';

procedure TFormFIND.Button1Click(Sender: TObject);
begin
   if opendialog1.Execute then
      begin
        edit1.Text:= Opendialog1.FileName;
      end;

end;



function filenameconform(fn:string):string;
begin
  fn:=stringreplace(fn,' ','_',[rfReplaceall]);
  fn:=stringreplace(fn,'.','_',[rfReplaceall]);
  fn:=stringreplace(fn,':','_',[rfReplaceall]);
  result:=fn;
end;

procedure TFormFIND.Button3Click(Sender: TObject);
var
  i: Integer;
  mymergedfn: string;
begin
savedialog1.filename:=format('%sGREPFORM.pas',[mypath]);
if Savedialog1.execute then
   begin
   for i := 0 to myforms.Count-1 do
      begin
      GetComponentCaptions(TForm(myforms[i]),savedialog1.filename);
      end;
   end;
end;

PROCEDURE Tformfind.GetComponentCaptions(frm: TForm ; FN: string);
   VAR
    texts: TStringList;
     comp: TComponent;
     capt: String;
        i: Integer;
        

   BEGIN

    texts := TStringList.Create;
    TRY
     WITH texts
      DO BEGIN
          Duplicates := dupIgnore;
          Sorted := True;
          FOR i:=0 TO frm.ComponentCount-1
           DO 
           begin
               comp := frm.Components[i];
               if comp is TControl then
               begin
               if IsPublishedProp(Comp, CSCaption) then 
                  begin
                  capt:=GetStrProp(Comp, CSCaption);

                  IF (comp.Name <> '')
                    AND
                     (capt <> '')
                   THEN Add(comp.Name+'='+capt);

                  end;
               end;
             SaveToFile(FN)
           end;
         END;
    FINALLY
     texts.Free
    END
   END;

   
function TFormFIND.GetTempDirectory: String;
var
  tempFolder: array[0..MAX_PATH] of Char;
begin
  //GetTempPath(MAX_PATH, @tempFolder);
  //result := StrPas(tempFolder);
  result:=TPath.GetTempPath;
end;



function ReportTime(const Name: string; const FileTime: TFileTime): string;
 var
   SystemTime, LocalTime: TSystemTime;
 begin
   if not FileTimeToSystemTime(FileTime, SystemTime) then
     RaiseLastOSError;
   if not SystemTimeToTzSpecificLocalTime(nil, SystemTime, LocalTime) then
     RaiseLastOSError;
   result:=Name + ': ' + DateTimeToStr(SystemTimeToDateTime(LocalTime));
 end;

procedure GetBuildInfo(var V1, V2, V3, V4: word);
var
  VerInfoSize, VerValueSize, Dummy: DWORD;
  VerInfo: Pointer;
  VerValue: PVSFixedFileInfo;
begin
  VerInfoSize := GetFileVersionInfoSize(PChar(ParamStr(0)), Dummy);
  if VerInfoSize > 0 then
  begin
      GetMem(VerInfo, VerInfoSize);
      try
        if GetFileVersionInfo(PChar(ParamStr(0)), 0, VerInfoSize, VerInfo) then
        begin
          VerQueryValue(VerInfo, '\', Pointer(VerValue), VerValueSize);
          with VerValue^ do
          begin
            V1 := dwFileVersionMS shr 16;
            V2 := dwFileVersionMS and $FFFF;
            V3 := dwFileVersionLS shr 16;
            V4 := dwFileVersionLS and $FFFF;
          end;
        end;
      finally
        FreeMem(VerInfo, VerInfoSize);
      end;
  end;
end;

function GetBuildInfoAsString: string;
var
  V1, V2, V3, V4: word;
begin
  GetBuildInfo(V1, V2, V3, V4);
  Result := IntToStr(V1) + '.' + IntToStr(V2) + '.' +
    IntToStr(V3) + '.' + IntToStr(V4);
end;

procedure TFormFIND.FormCreate(Sender: TObject);

var
   targetinfo: string;
   fad: TWin32FileAttributeData;
   
begin

  if not GetFileAttributesEx(PChar(Application.ExeName), GetFileExInfoStandard, @fad) then
    RaiseLastOSError;
  //ReportTime('Created', fad.ftCreationTime);
  //ReportTime('Modified', fad.ftLastWriteTime);
  //ReportTime('Accessed', fad.ftLastAccessTime);  

   {$IFDEF WIN64}
      targetinfo:=' (x64 Architecture)';
     {$ELSE}
      targetinfo:=' Architecture: 32bit';
     {$ENDIF}

   targetinfo := targetinfo + format(' %s : %s',
         [ReportTime('Created', fad.ftCreationTime),
         ReportTime('Modified', fad.ftLastWriteTime)]) ;

  FormFIND.Caption := FormFIND.Caption+' - Build: ' + GetBuildInfoAsString + targetinfo;

end;


end.

[himitsu]

Zitat:

Delphi-Quellcode:

Application.CreateForm(TForm1, Form1); Myforms.items.add('Form1');
Application.CreateForm(TForm2, Form2); Myforms.items.add('Form2'); 
...

Wem fällt da was auf?
Ganz viel doppelter Code.
* Man kann CreateForm und Items.Add in eine Funktion auslagern und den Namen aus Form.Name verwenden. (kein eventueller Copy&Paste-Fehler beim Namen)
* man kann die "Registrierung" auch im Constructor/OnCreate der Forms erledigen, bzw. in einem gemeinsamen Vorfahren seiner Forms.

Da in myforms nicht der Name, sondern die Instanz beötigt wird, warum ist das keine TObjectList oder bei einer StringList kann man auch zusätzlich das Objekt speichern.
Wobei ich bei StringList.AddObject auch direkt an ein TDictionary<string,TForm> denken würde.

Und da es in Screen.Forms bereits eine Liste "aller" VCL-Forms gibt, warum nicht diese Liste benutzen?

Das GetComponentCaptions nutzt nichts von der Form, also warum ist das dann keine Class Procedure ?



TComponent.Name oder TForm(string) .... ja, die richtigen Typen sollte man immer verwenden.
Casten wen nötig, aber wenn man castet, dann auch nur zwischen kompatiblen Typen.