// Mit dem folgenden Code kann man einen TSaveDialog (TOpenDialog) um weitere Elemente
// ergänzen. Als Beispiel wird eine Combobox eingefügt, mittels der man eine Version
// auswählen kann.
// Getestet mit D4 unter XP
...
type
TForm1 = class(TForm)
Button1: TButton;
SaveDialog1: TSaveDialog;
procedure Button1Click(Sender: TObject);
procedure SaveDialog1Close(Sender: TObject);
procedure SaveDialog1Show(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
private
{ Private-Deklarationen }
public
{ Public-Deklarationen }
end;
var
Form1: TForm1;
implementation
{$R *.DFM}
var
txt: string;
idx: Integer;
p, h, l, f: THandle;
vorbelegung: TStringlist;
procedure TForm1.FormCreate(Sender: TObject);
begin
vorbelegung := TStringlist.create;
vorbelegung.add('Version 1.0');
vorbelegung.add('Version 2.0');
vorbelegung.add('Version 3.0');
end;
procedure TForm1.FormDestroy(Sender: TObject);
begin
vorbelegung.free;
end;
procedure TForm1.SaveDialog1Show(Sender: TObject);
var
hght, x: integer;
rct: TRect;
begin
p := GetParent(Savedialog1.Handle);
GetWindowRect(p, rct);
inc(rct.bottom, 35);
hght := rct.Bottom - rct.Top;
h := CreateWindow('COMBOBOX', nil, WS_CHILD or WS_VISIBLE
or CBS_DROPDOWNLIST or WS_VSCROLL,
81, hght - 68, 233, 300, p, 0, hInstance, nil);
if h <> 0 then begin
SetWindowPos(p, 0, 0, 0, rct.Right - rct.Left, hght, SWP_NOMOVE);
f := SendMessage(p, WM_GETFONT, 0, 0);
SendMessage(h, WM_SETFONT, f, 0);
for x := 0 to vorbelegung.count - 1 do
SendMessage(h, CB_ADDSTRING, 0, Integer(PChar(vorbelegung[x])));
SendMessage(h, CB_SETCURSEL, 2, 0);
l := CreateWindow('STATIC', 'Version:',
WS_VISIBLE or WS_CHILD, 9, hght - 65, 50, 25, p, 0, hInstance, nil);
if l <> 0 then SendMessage(l, WM_SETFONT, f, 0);
end;
end;
procedure TForm1.SaveDialog1Close(Sender: TObject);
var
lg: integer;
begin
if h = 0 then begin
txt := '';
exit;
end;
lg := SendMessage(h, WM_GETTEXTLENGTH, 0, 0);
setlength(txt, lg);
SendMessage(h, WM_GETTEXT, succ(lg), integer(@txt[1]));
idx := vorbelegung.indexof(txt);
DestroyWindow(h);
if l <> 0 then DestroyWindow(l);
end;
// Beispielaufruf
procedure TForm1.Button1Click(Sender: TObject);
begin
if SaveDialog1.Execute then begin
if txt = '' then begin
showmessage('Fehler beim Speichern aufgetreten');
exit;
end;
// ansonsten mach was, z.B.:
ShowMessage(txt);
// oder auch:
case idx of
0: begin
// speichere in Version 1
end;
1: begin
// speichere in Version 2
end;
else begin
// speichere in Version 3
end;
end;
end;
end;