Toon posts:

[DELPHI6] SHBrowseForFolder Api vraagje

Pagina: 1
Acties:

Verwijderd

Topicstarter
Hey

het is me gelukt om via SHBrowseForFolder api een dialogje op te roepen om directory's te selecteren nu alles werkt perfect maar in het dialogje krijg ik ook netwerk,cdroms enzo te zien terwijl ik graag alleen fixed drives zou willen zien. Is er een manier om dit te bekomen ?
Indien niet is er dan een manier om de ok button grayed out te maken als er geen fixed disk is aangeduid ? (waarschijnlijk met die callback maar weet ni goed wat ik in die functie moet zetten) liefst van all zou ik alleen fixed disks willen zien in die dialog

  • mulder
  • Registratie: Augustus 2001
  • Laatst online: 06-09 22:14

mulder

ik spuug op het trottoir

Ik denk het niet
Maar als je toch al met API werkt is het niet moeilijk zelf zo'n schermpje te maken.

oogjes open, snaveltjes dicht


Verwijderd

Topicstarter
ben er niet zo goed in :)
die kleine functietjes lukken wel maar vraag me ni zoiets zelf te maken gelijk hier bvb heb geen idee hoe ik da zou moete doen. Nocthans heb het al gezien in programma's dus er moet wel een manier zijn maar ja hoe ? :)

Verwijderd

Oke, beetje brakke code, maar werkt..
code:
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
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
unit Unit1;

interface

uses
  Windows, Forms, Controls, StdCtrls, Classes;

type
  TForm1 = class(TForm)
    Button1: TButton;
    ListBox1: TListBox;
    procedure Button1Click(Sender: TObject);
  private
    FDialogHandle: Integer;
  public
    procedure DirectoryChange(const NewDir: string);
  end;

var
  Form1: TForm1;

implementation

uses
  SysUtils, ShlObj, ActiveX;

{$R *.dfm}

function lpfnBrowseProc(Wnd: HWND; uMsg: UINT; lParam, lpData: LPARAM): Integer
  stdcall;
var
  S: string;
begin
  Result := 0;
  with TObject(lpData) as TForm1 do
  begin
    case uMsg of
    BFFM_INITIALIZED:
      FDialogHandle := Wnd;
    BFFM_SELCHANGED:
      begin
        S := '';
        try
        if Pointer(lParam) <> nil then
        begin
          SetLength(S, MAX_PATH);
          if SHGetPathFromIDList(PItemIDList(lParam), PChar(S)) then
            SetLength(S, StrLen(PChar(S)));
        end;
        DirectoryChange(S);
        except
        end;
      end;
    end;
  end;
end;

procedure TForm1.Button1Click(Sender: TObject);
const
  BIF_RETURNFSANCESTORS = $0008;
var
  BrowseInfo: TBrowseInfo;
  pidl: PItemIDList;
begin
  FDialogHandle := 0;

  ZeroMemory(@BrowseInfo, SizeOf(BrowseInfo));

  with BrowseInfo do
  begin
    ulFlags := BIF_RETURNFSANCESTORS + BIF_DONTGOBELOWDOMAIN;
    hwndOwner := Handle;
    SHGetSpecialFolderLocation(Handle, CSIDL_DRIVES, pidlRoot);
    lpszTitle := nil;
    lpfn := @lpfnBrowseProc;
    lParam := LongInt(Self);
    iImage := 0;
  end;

  try
    CoInitialize(nil);
    pidl := SHBrowseForFolder(BrowseInfo);
    if pidl <> nil then
    begin
    try
      CoTaskMemFree(pidl);
      CoTaskMemFree(BrowseInfo.pidlRoot);
    except
    end;
    end;
    CoUninitialize;
  except
  end;
  FDialogHandle := 0;
end;

procedure TForm1.DirectoryChange(const NewDir: string);
begin
  ListBox1.Items.Add(NewDir);
  if FDialogHandle <> 0 then
  begin
    { Simpele check :) }
    if (NewDir > '') and (NewDir[1] = 'D') then
    SendMessage(FDialogHandle, BFFM_ENABLEOK, 0, LPARAM(False))
    else
    SendMessage(FDialogHandle, BFFM_ENABLEOK, 0, LPARAM(True));
  end;
end;

end.

Code voornamelijk gekopieerd uit de Jedi VCL, maar die code was een beetje brak.

Verwijderd

Topicstarter
Bedankt !!!

dermee heb ik die ok button kunne disablen beetje debiel cdroms enzo te tonen ook al kun je ze ni gebruiken ;(


maar hier is de code voor de callback functie incase someone needs it

function browsefolderCallback(hwnd: HWND; uMsg: UINT; lParam, lpData: LPARAM):
Integer; stdcall;
var
path : array[0..MAX_PATH] of Char;
begin
case umsg of
BFFM_SELCHANGED:
begin
if SHGetPathFromIDList(Pointer(lParam), Path) then
if getdrivetype(pchar(extractfiledrive(path)))= DRIVE_FIXED then
sendmessage(hwnd, BFFM_ENABLEOK,0,1) //ok enabled
else
sendmessage(hwnd, BFFM_ENABLEOK,1,0); //ok disabled
end;
end;
Result := 0;
end;

moest iemand een precieze code kunne versiere voor alleen fixed disks in het dialogje te krijge let me know

normaal als je root kunt gelijk stellen aan die drives (die PITEMIDLIST) maar hoe maak je zo eentje ?

Verwijderd

Kijk daarvoor dan naar de functie SelectDirectory in FileCtrl..

Kun je wel maar 1 root folder invullen.

  • mulder
  • Registratie: Augustus 2001
  • Laatst online: 06-09 22:14

mulder

ik spuug op het trottoir

Je kunt de GetDriveType api ook nog gebruiken om te bepalen welke drives wat zijn, in dit voorbeeld is D: een CD-Rom, en dat is niet echt betrouwbaar.

oogjes open, snaveltjes dicht

Pagina: 1