// 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;



 

Zugriffe seit 6.9.2001 auf Delphi-Ecke