Entwickler-Ecke
Delphi Language (Object-Pascal) / CLX - Verschiedene Prozeduren als Parameter übergeben
Mathematiker - Mi 02.01.13 23:30
Titel: Verschiedene Prozeduren als Parameter übergeben
Hallo,
ich habe die Absicht für ein größeres Objekt mit einer Vielzahl von Formularen eine einheitliche Prozedur zum Speichern von Paintboxgrafiken zu schreiben. Solange ich mich auf Standardtypen (bmp, jpg, gif, png) beschränke geht alles gut.
Nun möchte ich aber auch die Grafik als Vektorgrafik/Metafile speichern. Die Zeichenroutinen befinden sich in den jeweiligen Units und werden durch Übergabe des MetafileCanvas aufgerufen.
Mein Problem ist nun, dass ich der Speichermethode
Delphi-Quelltext
1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:
50:
51:
52:
53:
54:
55:
56:
57:
58:
59:
60:
61:
62:
63:
| procedure bildspeichernpb(pb:tpaintbox; ????? zeichenroutine(canvas:tmetafilecanvas):procedure ??????);
var datei:tfilestream;
speicherdialog:tsavedialog;
Bitmap: TBitmap;
myrect,birect:trect;
mymetafile:tmetafile;
metacanvas:tmetafilecanvas;
begin
Bitmap := TBitmap.Create;
Bitmap.Width := pb.Width;
Bitmap.Height := pb.Height;
birect.left:=0;
birect.right:=pb.width;
birect.top:=0;
birect.bottom:=pb.height;
myrect:=birect;
bitmap.canvas.CopyRect(biRect,pb.Canvas, MyRect);
speicherdialog:=TSaveDialog.Create(nil);
With speicherdialog do
begin
Title:='Abbildung speichern';
Filter:='Abbildung (*.bmp)|*.bmp|Abbildung,16 Farben (*.bmp)|*.bmp|Abbildung (*.jpg)|*.jpg|GIF-Abbildung (*.gif)|*.GIF|PNG-Grafik (*.png)|*.png|Vektorgrafik (*.wmf)|*.wmf';
Filename:='';
Filterindex:=4;
Defaultext:='gif';
InitialDir:='c:\eigene dateien';
Options:=[ofOverwritePrompt,ofHideReadOnly,ofEnableSizing];
If Execute Then
begin
if filterindex=2 then Bitmap.PixelFormat := pf4bit;
if filterindex<3 then
begin
datei:=tfilestream.create(filename,fmcreate);
bitmap.savetostream(datei);
datei.free;
end;
if filterindex=3 then savejpg(bitmap,filename,100,false);
if filterindex=4 then gifsave(bitmap,filename);
if filterindex=5 then pngsave(bitmap,filename);
if filterindex=6 then begin
MyMetafile := TMetafile.Create;
mymetafile.enhanced:=true;
mymetafile.height:=pb.height;
mymetafile.width:=pb.width;
metacanvas:=TMetafileCanvas.Create(MyMetafile, 0);
zeichenroutine (metacanvas) metacanvas.Free;
datei:=tfilestream.create(filename,fmcreate);
mymetafile.savetostream(datei);
datei.free;
mymetafile.free;
end;
end;
speicherdialog.free;
Bitmap.Free;
end; |
irgendwie die Methode zeichenroutine(canvas:tmetafilecanvas) übergeben muss.
In der EE-Suche habe ich bisher leider nichts gefunden. Vielleicht habe ich auch nur die falschen Schlagwörter gesucht.
Meine Frage ist nun, gibt es eine Möglichkeit, irgendwie die Methode beim Aufrufen der Prozedur bildspeichernpb zu übergeben.
Ein Eintrag der ganzen Units in die uses-Liste der Unit mit der Speicherprozedur geht leider nicht, da es dann zu Überkreuzungen kommt. Ich habe auch schon als Alternative erwogen, mymetafile immer vor dem Auruf der Speichermethode zu erzeugen und als Parameter zu übergeben. Da die Grafiken teilweise aufwendig sind, wäre das aber nur eine Notlösung.
Beste Grüße
Mathematiker
Gausi - Do 03.01.13 00:08
Das sollte über einen neuen Typ gehen, wenn ich das richtig verstehe:
Delphi-Quelltext
1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
| type TMyProc = procedure(aString: String);
procedure Proc1(aString: String);
begin
ShowMessage(aString);
end;
procedure runProc(aProc: TMyProc; s: String);
begin
aProc(s);
end;
procedure TForm2.Button1Click(Sender: TObject);
begin
runProc(Proc1, 'Procedure 1 ausgeführt');
end; |
Martok - Do 03.01.13 00:25
Noch erwähnenswert ist die Unterform mit "
of object".
Die braucht man, wenn man nicht eine freifliegende Funktion, sondern eine Methode übergeben möchte:
Delphi-Quelltext
1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
| type TMyProc = procedure(aString: String) of object;
type
TIrgendwas = class
procedure Proc1(aString: String);
end;
procedure TIrgendwas.Proc1(aString: String);
begin
ShowMessage(aString);
end; |
Der Rest (also Aufruf und Verwendung als Parameter/Variable) ist dann aber identisch.
Eine Deklaration, die sagen würde "mir egal ob Objekt oder nicht" gibt es leider nicht. Das hat damit zu tun, dass der generierte Code grundlegend anders aussieht. Die Entscheidung muss man dem Compiler also von Hand abnehmen ;)
jaenicke - Do 03.01.13 09:33
Der Vollständigkeit halber, bei neueren Delphiversionen (D2009+) geht es noch einfacher mit anonymen Methoden:
Delphi-Quelltext
1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
| type
TExample = reference to procedure(const AValue: string);
procedure DoSomething(const CallExampleRef: TExample);
begin
CallExampleRef('blub');
end;
DoSomething(
procedure(const AValue: string)
begin
ShowMessage(AValue);
end
); |
Blup - Do 03.01.13 10:26
Warum nicht ein fertiges TGraphic-Object übergeben?
Als konkrete Klasse könnte dann z.B. auch ein TMetafile für Vektorgrafiken verwendet werden.
bummi - Do 03.01.13 12:21
Sorry falls ich etwas off topic sein sollte.
Ich löse diese Anforderungen, wenn man es vorher nicht gleich mitberücksichtigt hat, gerne (etwas unüblich) durch das Unterschieben eines Canvas in der OnPaintroutine.
Pseudocode:
If assigned(FOutputCanvas) then c := FOutputCanvas else c := Canvas;
das ganze Painting findet dann auf c statt und ein Ausdruck oder Export beschränkt sich darauf:
FOutputCanvas zu setzen (Metafilecanvas/PrinterCanvas/was auch immer)
Invalidate aufzurufen
FOutputCanvas wieder zurückzusetzen
das Canvas könnte auch manipuliert sein bezüglich Offset/Zoom/Rotation.
Mathematiker - Do 03.01.13 16:03
Hallo,
Danke allen für die guten Tipps.
Ich habe Gausis und Martoks Hinweise getestet und es funktioniert absolut perfekt.
Damit kann ich jetzt auch noch die Übergabe der Paintbox entfernen und nur noch deren Abmessungen weitergeben, d.h.
Delphi-Quelltext
1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:
50:
51:
52:
53:
54:
55:
56:
57:
58:
| type
tmetaproc = procedure(canvas:TCanvas) of object;
...
procedure bildspeichernmeta(breite,hoehe:integer;aproc:tmetaproc);
var Bitmap: TBitmap;
f:tfilestream;
sd:tsavedialog;
mymetafile:tmetafile;
canvas:tmetafilecanvas;
begin
sd:=TSaveDialog.Create(nil);
With sd do
begin
Title:='Abbildung speichern';
Filter:='Abbildung (*.bmp)|*.bmp|Abbildung,16 Farben (*.bmp)|*.bmp|Abbildung (*.jpg)|*.jpg|GIF-Abbildung (*.gif)|*.GIF|PNG-Grafik (*.png)|*.png|Vektorgrafik (*.wmf)|*.wmf';
Filename:='';
Filterindex:=4;
Defaultext:='gif';
InitialDir:='c:\eigene dateien';
Options:=[ofOverwritePrompt,ofHideReadOnly,ofEnableSizing];
If Execute Then
begin
if filterindex<>6 then
begin
Bitmap := TBitmap.Create;
Bitmap.Width := breite;
Bitmap.Height := hoehe;
aproc(bitmap.canvas);
if filterindex=2 then Bitmap.PixelFormat := pf4bit;
if filterindex<3 then
begin
f:=tfilestream.create(filename,fmcreate);
bitmap.savetostream(f);
f.free;
end;
if filterindex=3 then savejpg(bitmap,filename,100,false);
if filterindex=4 then gifsave(bitmap,filename);
if filterindex=5 then pngsave(bitmap,filename);
bitmap.free;
end
else
begin
MyMetafile := TMetafile.Create;
mymetafile.enhanced:=true;
mymetafile.height:=hoehe;
mymetafile.width:=breite;
canvas:=TMetafileCanvas.Create(MyMetafile, 0);
aproc(canvas);
canvas.Free;
f:=tfilestream.create(filename,fmcreate);
mymetafile.savetostream(f);
f.free;
mymetafile.free;
end;
end;
end;
sd.free;
end; |
Das ist genau das, was ich gesucht habe.
Damit ergeben sich auch weitere Möglichkeiten. Zum Beispiel kann ich das Kopieren in die Zwischenablage und das Drucken der Grafiken auf ähnliche Art jeweils in einer Routine zusammenfassen.
Beste Grüße
Mathematiker
WasWeißDennIch - Fr 04.01.13 13:06
Damit das richtig rund wird, sollten aber zumindest noch Ressourcen-Schutzblöcke verwendet werden. Die If-Abfragen könnte man durch case ersetzen. Und was machst Du, wenn als Methodenzeiger nil übergeben wurde?
Entwickler-Ecke.de based on phpBB
Copyright 2002 - 2011 by Tino Teuber, Copyright 2011 - 2025 by Christian Stelzmann Alle Rechte vorbehalten.
Alle Beiträge stammen von dritten Personen und dürfen geltendes Recht nicht verletzen.
Entwickler-Ecke und die zugehörigen Webseiten distanzieren sich ausdrücklich von Fremdinhalten jeglicher Art!