FPC: 3.0.0
Laz: 1.6
Moin,
ein Menüpunkt aus einem TMainMenü soll ein neues Formular erzeugen, anzeigen und löschen.
Der Ausruf beinhaltet :
Code: Alles auswählen
procedure TMainForm.MainMenu_InfoClick(Sender: TObject);
procedure TMainForm.MainMenu_InfoClick(Sender: TObject);
begin
Copyright_Window:=TCopyright_Window.Create(Nil);
Copyright_Window.show;
FreeAndNil(Copyright_Window);
end;
Code: Alles auswählen
unit copyright;
{$mode delphi}
interface
uses
Classes, SysUtils, FileUtil,
LCLIntf, LCLType, LMessages, Messages, Variants, Graphics, Controls, Forms,
Dialogs, StdCtrls, ExtCtrls, ComCtrls, Buttons,
// Um die Versionsinformation auszulesen
// Quelle: http://www.lazarusforum.de/viewtopic.php?f=10&t=4085
vinfo, versiontypes;
type
{ TCopyright_Window }
TCopyright_Window = class(TForm)
BitBtn2: TBitBtn;
BitBtn3: TBitBtn;
Bt_Close: TButton;
Memo1: TMemo;
procedure BitBtn2Click(Sender: TObject);
procedure BitBtn3Click(Sender: TObject);
procedure Bt_CloseClick(Sender: TObject);
// procedure Button1Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
private
{ private declarations }
public
{ public declarations }
end;
var
Copyright_Window: TCopyright_Window;
implementation
{$R *.lfm}
{ TCopyright_Window }
function ProductVersionToString(PV: TFileProductVersion): String;
begin
Result := Format('%d.%d.%d.%d', [PV[0],PV[1],PV[2],PV[3]])
end;
procedure TCopyright_Window.FormCreate(Sender: TObject);
var
Info: TVersionInfo;
begin
Info := TVersionInfo.Create;
Info.Load(HINSTANCE);
//ShowMessage(ProductVersionToString(Info.FixedInfo.FileVersion));
Memo1.Text :=Application.title+' '+ProductVersionToString(Info.FixedInfo.FileVersion); //+#13+#10+produktversion+#13+#10+dateiversion;
Memo1.Text := Memo1.Text+#13+#10+#13+#10+'Softwarenutzungs-und Überlassungsvertrag';
Memo1.Text := Memo1.Text+#13+#10+#13+#10+'- Diese Software darf kostenlos und unverändert weitergeben werden'
+#13+#10+'und auf beliebig vielen Computern (auch gleichzeitig) genutzt werden.';
Memo1.Text := Memo1.Text+#13+#10+#13+#10+'- Die Software bleibt Eigentum von Heiko Rompel.';
Memo1.Text := Memo1.Text+#13+#10+#13+#10+'- Auf Grund der unbekannten Anzahl der verschiedenen Computersysteme'
+#13+#10+'kann ich nur garantieren, das die Software auf einem Speichermedium Platz belegt. ';
Memo1.Text := Memo1.Text+#13+#10+#13+#10+'- Ich kann nicht garantieren, das die Software auf jedem Computer läuft'
+#13+#10+'und dort auch keine Schäden verursacht.';
Memo1.Text := Memo1.Text+#13+#10+#13+#10+'Wenn Sie mit obigen Punkten nicht einverstanden sind,'
+#13+#10+'so löschen Sie dieses Programm auf Ihrem Computer.';
Memo1.Text := Memo1.Text+#13+#10+#13+#10+'Homepage: http://www.rompelsoft.de';
Memo1.Text := Memo1.Text+#13+#10+'Kontakt : info@rompelsoft.de';
end;
{
procedure TCopyright_Window.Button1Click(Sender: TObject);
// Um die Versionsinformation auszulesen
// Quelle: http://www.lazarusforum.de/viewtopic.php?f=10&t=4085
function ProductVersionToString(PV: TFileProductVersion): String;
begin
Result := Format('%d.%d.%d.%d', [PV[0],PV[1],PV[2],PV[3]])
end;
var
Info: TVersionInfo;
begin
Info := TVersionInfo.Create;
Info.Load(HINSTANCE);
ShowMessage(ProductVersionToString(Info.FixedInfo.FileVersion));
ShowMessage(ProductVersionToString(Info.FixedInfo.ProductVersion));
Info.Free;
end;
}
procedure TCopyright_Window.Bt_CloseClick(Sender: TObject);
begin
close
end;
procedure TCopyright_Window.BitBtn2Click(Sender: TObject);
// Internetseite aufrufen
begin
OpenUrl('http://www.rompelsoft.de');
end;
procedure TCopyright_Window.BitBtn3Click(Sender: TObject);
// E-Mail versenden
var
Info: TVersionInfo;
begin
Info := TVersionInfo.Create;
Info.Load(HINSTANCE);
OpenURL('mailto:info@rompelsoft.de?subject=Nutzeranfrage '+Application.title+' '+ProductVersionToString(Info.FixedInfo.FileVersion)); //&body=Hello World');
end;
end.
Danach bekomme ich dann noch ein Assembler-Fenster.Projekt project1 hat Exception-Klasse >>EResNotFound<< ausgelöst mit der Meldung:
Resource "1" not found
Bei Adress 472032
Warum funktioniert das nicht (mehr)?
Gruß Heiko