Vista OpenFileDialog

[Bernhard Geyer]

Zitat von Willie1:

Borland hat vergessen diese Option ein zu bauen

Borland hat seit Jahren nix mehr mit Delphi zu tun.

Zitat von Willie1:

des SwissDelphi Forum direkt comdlg32.dll angezapt.

Sinnvoll ist gleich die WideString-Version der entsprechenden API-Funktion zu verwenden.

[DeddyH]

Ich habe das mal schnell umgeschrieben und in eine Unit gepackt, falls jemand Fehler entdeckt, korrigiere man mich bitte.

Delphi-Quellcode:

unit uCustomFileDialog;

interface

uses Windows;

function OpenSaveFileDialog(ParentHandle: THandle; const DefExt, Filter, InitialDir,
  Title: string; var FileName: string; IsOpenDialog: Boolean): Boolean;

implementation
uses ShlObj, SysUtils;

type
  POpenFilenameA = ^TOpenFilenameA;
  tagOFNA = packed record
    lStructSize: DWORD;
    hWndOwner: HWND;
    hInstance: HINST;
    lpstrFilter: PAnsiChar;
    lpstrCustomFilter: PChar;
    nMaxCustFilter: DWORD;
    nFilterIndex: DWORD;
    lpstrFile: PAnsiChar;
    nMaxFile: DWORD;
    lpstrFileTitle: PAnsiChar;
    nMaxFileTitle: DWORD;
    lpstrInitialDir: PAnsiChar;
    lpstrTitle: PAnsiChar;
    Flags: DWORD;
    nFileOffset: Word;
    nFileExtension: Word;
    lpstrDefExt: PAnsiChar;
    lCustData: LPARAM;
    lpfnHook: function(Wnd: HWND; Msg: UINT; ParamW: WPARAM; ParamL: LPARAM): UINT stdcall;
    lpTemplateName: PAnsiChar;
  end;
  TOpenFilenameA = tagOFNA;

  POpenFilenameW = ^TOpenFilenameW;
  tagOFNW = packed record
    lStructSize: DWORD;
    hWndOwner: HWND;
    hInstance: HINST;
    lpstrFilter: PWideChar;
    lpstrCustomFilter: PChar;
    nMaxCustFilter: DWORD;
    nFilterIndex: DWORD;
    lpstrFile: PWideChar;
    nMaxFile: DWORD;
    lpstrFileTitle: PWideChar;
    nMaxFileTitle: DWORD;
    lpstrInitialDir: PWideChar;
    lpstrTitle: PWideChar;
    Flags: DWORD;
    nFileOffset: Word;
    nFileExtension: Word;
    lpstrDefExt: PWideChar;
    lCustData: LPARAM;
    lpfnHook: function(Wnd: HWND; Msg: UINT; ParamW: WPARAM; ParamL: LPARAM): UINT stdcall;
    lpTemplateName: PWideChar;
  end;
  TOpenFilenameW = tagOFNW;

  TOpenFilename = {$IFDEF UNICODE}TOpenFilenameW{$ELSE}TOpenFilenameA{$ENDIF};

function GetOpenFileName(var OpenFile: TOpenFilename): Bool; stdcall; external 'comdlg32.dll'  name {$IFDEF UNICODE}'GetOpenFileNameW'{$ELSE}'GetOpenFileNameA'{$ENDIF};
function GetSaveFileName(var OpenFile: TOpenFilename): Bool; stdcall; external 'comdlg32.dll'  name {$IFDEF UNICODE}'GetSaveFileNameW'{$ELSE}'GetSaveFileNameA'{$ENDIF};

const
  OFN_DONTADDTORECENT = $02000000;
  OFN_FILEMUSTEXIST = $00001000;
  OFN_HIDEREADONLY = $00000004;
  OFN_PATHMUSTEXIST = $00000800;

function CharReplace(const Source: string; oldChar, newChar: Char): string;
var
  i: Integer;
begin
  Result := Source;
  for i := 1 to Length(Result) do
    if Result[i] = oldChar then
      Result[i] := newChar
end;

function OpenSaveFileDialog(ParentHandle: THandle; const DefExt, Filter, InitialDir, Title: string; var FileName: string; IsOpenDialog: Boolean): Boolean;
var
  ofn: TOpenFileName;
  szFile: array[0..MAX_PATH] of Char;
begin
  Result := False;
  FillChar(ofn, SizeOf(TOpenFileName), 0);
  with ofn do
  begin
    lStructSize := SizeOf(TOpenFileName);
    hwndOwner := ParentHandle;
    lpstrFile := szFile;
    nMaxFile := SizeOf(szFile);
    if (Title <> '') then
      lpstrTitle := PChar(Title);
    if (InitialDir <> '') then
      lpstrInitialDir := PChar(InitialDir);
    StrPCopy(lpstrFile, FileName);
    lpstrFilter := PChar(CharReplace(Filter, '|', #0)+#0#0);
    if DefExt <> '' then
      lpstrDefExt := PChar(DefExt);
  end;
  if IsOpenDialog then
  begin
    if GetOpenFileName(ofn) then
    begin
      Result := True;
      FileName := StrPas(szFile);
    end;
  end
  else
  begin
    if GetSaveFileName(ofn) then
    begin
      Result := True;
      FileName := StrPas(szFile);
    end;
  end
end;

end.

[Willie1]

vielen Dank für den Code.
Ich kann es leider nicht testen, weil plötzlich der Norton-Virenwächter Alarm schlägt und keine Exe-Datei mehr durchlässt!! (Auch ein leeres Formular nicht.)

Willie

[EWeiss]

Wo kann ich das Flag für Unicode setzen ?
Hab mit deinem OpenFileDialog riesen Speicherleck

gruss

[Bernhard Geyer]

Zitat von EWeiss:

Wo kann ich das Flag für Unicode setzen ?

Welche Flag?

Zitat von EWeiss:

Hab mit deinem OpenFileDialog riesen Speicherleck

Zeig mal etwas Quellcode.

[EWeiss]

Zitat von Bernhard Geyer:

Zitat von EWeiss:

Wo kann ich das Flag für Unicode setzen ?

Welche Flag?

Zitat von EWeiss:

Hab mit deinem OpenFileDialog riesen Speicherleck

Zeig mal etwas Quellcode.

Der Quellcode ist hier
http://www.delphipraxis.net/1085053-post10.html

EDIT:
Noch ein Bild angehangen.

gruss

[EWeiss]

irgenwie verträgt sich das nicht!

function OpenSaveFileDialog(ParentHandle: THandle; const DefExt, Filter, InitialDir, Title: string; var FileName: string; IsOpenDialog: Boolean): Boolean;
mit
TOpenFilename = {$IFDEF UNICODE}TOpenFilenameW{$ELSE}TOpenFilenameA{$ENDIF};
wenn der FileName als string ausgelegt ist.
Deshalb meine Frage nach dem Flag..
Funktioniert nur mit FileName als WideString!

trotzdem bekomme ich dann nach dem beenden wieder jedemenge Speicherlecks.
34x dieser Block.

Zitat:

--------------------------------2011/5/1 21:20:11--------------------------------
Ein Speicherblock hat Speicher verloren. Die Größe ist: 20

This block was allocated by thread 0x6B8, and the stack trace (return addresses) at the time was:
40317E
406A6E
42C794
42C629
42C174
423017
42302C
428027
431890
74EE62FA [Unknown function at gapfnScSendMessage]
74EE6D3A [Unknown function at GetThreadDesktop]

Der Block wird momentan für eine Objektklasse benutzt Unbekannt

The allocation number is: 1638

Aktueller Speicherauszug von 256 Bytes, beginnend ab Zeigeradresse 7EEAF7D0:
0C 00 00 00 FC 6B B5 03 50 65 F7 7E 80 80 80 80 3E 5B 76 A8 80 80 80 80 00 00 00 00 30 F7 EA 7E
00 00 00 00 00 00 00 00 38 A6 40 00 00 00 00 00 6C 06 00 00 7E 31 40 00 6E 6A 40 00 94 C7 42 00
29 C6 42 00 74 C1 42 00 17 30 42 00 2C 30 42 00 27 80 42 00 90 18 43 00 FA 62 EE 74 3A 6D EE 74
B8 06 00 00 9A 31 40 00 89 53 40 00 64 64 40 00 FB C5 42 00 74 C1 42 00 17 30 42 00 2C 30 42 00
27 80 42 00 90 18 43 00 FA 62 EE 74 3A 6D EE 74 B8 06 00 00 10 00 00 00 E4 04 01 00 67 A5 89 57
0E 00 00 00 2C D2 AC 03 10 F9 EA 7E 80 80 80 80 98 5A 76 A8 80 80 80 80 00 00 00 00 30 F7 EA 7E
00 00 00 00 00 00 00 00 38 A6 40 00 00 00 00 00 6F 06 00 00 7E 31 40 00 6E 6A 40 00 94 C7 42 00
29 C6 42 00 74 C1 42 00 17 30 42 00 2C 30 42 00 27 80 42 00 90 18 43 00 FA 62 EE 74 3A 6D EE 74
. . . . ü k µ . P e ÷ ~ € € € € > [ v ¨ € € € € . . . . 0 ÷ ê ~
. . . . . . . . 8 ¦ @ . . . . . l . . . ~ 1 @ . n j @ . ” Ç B .
) Æ B . t Á B . . 0 B . , 0 B . ' € B . � . C . ú b î t : m î t
¸ . . . š 1 @ . ‰ S @ . d d @ . û Å B . t Á B . . 0 B . , 0 B .
' € B . � . C . ú b î t : m î t ¸ . . . . . . . ä . . . g ¥ ‰ W
. . . . , Ò ¬ . . ù ê ~ € € € € ˜ Z v ¨ € € € € . . . . 0 ÷ ê ~
. . . . . . . . 8 ¦ @ . . . . . o . . . ~ 1 @ . n j @ . ” Ç B .
) Æ B . t Á B . . 0 B . , 0 B . ' € B . � . C . ú b î t : m î t

grrr das selbe problem mit dem OpenFileDialog von turboPascal.


gruss