jvbrowsefolder.pas

East make Tray Icon in delphi

  BrowseInfo.hwndOwner := FOwnerWindow;
  BrowseInfo.pszDisplayName := dspName;
  BrowseInfo.lpfn := TFNBFFCallBack(@lpfnBrowseProc);
  BrowseInfo.lParam := Longint(Self);

  if (FStatusText = '') or not (odNewDialogStyle in FUsedOptions) then
    BrowseInfo.lpszTitle := Pointer(FTitle)
  else
  if FTitle = '' then
    BrowseInfo.lpszTitle := PChar(FStatusText)
  else
    BrowseInfo.lpszTitle := PChar(FTitle + Cr + FStatusText);

  if FRootDirectory = fdNoSpecialFolder then
    BrowseInfo.pidlRoot := CreateIDListFromPath(FRootDirectoryPath)
  else
    BrowseInfo.pidlRoot := CreateIDListFromCSIDL(FRootDirectory);

  try
    if odNewDialogStyle in FUsedOptions then
      CoInitialize(nil);
    try
      ActiveWindow := GetActiveWindow;
      WindowList := DisableTaskWindows(0);
      try
        if not PidlFree(FPidl) then
        begin
          Assert(False);    // FPidl comes from shell, so PidlFree should never fail
          FPidl := nil;     // in case building without assertions, need to ensure FPidl is nil
        end;
        FPidl := SHBrowseForFolder(BrowseInfo);
      finally
        EnableTaskWindows(WindowList);
        SetActiveWindow(ActiveWindow);
      end;

      Result := FPidl <> nil;
      if Result then
      begin
        FDisplayName := BrowseInfo.pszDisplayName;
        FDirectory := IDListToPath(FPidl);
      end;

      PidlFree(BrowseInfo.pidlRoot);
    finally
      FDialogWindow := 0;
      FOwnerWindow := 0;
      if odNewDialogStyle in FUsedOptions then
        CoUninitialize;
    end;
  except
  end;
end;

function TJvBrowseForFolderDialog.GetEnumFlags(psf: IShellFolder;
  pidlFolder: PItemIDList; const phWnd: HWND;
  var pgrfFlags: DWORD): HResult;
var
  Flags: TJvBrowsableObjectClasses;
  Obj: TJvBrowsableObjectClass;
begin
  { (rb) Don't know for sure if pgrfFlags is initialized }
  Flags := [];
  for Obj := Low(TJvBrowsableObjectClass) to High(TJvBrowsableObjectClass) do
    if pgrfFlags and CBrowseObjectClasses[Obj] = CBrowseObjectClasses[Obj] then
      Include(Flags, Obj);

  { This seems not to work ?? : }
  //if psf.GetDisplayNameOf(pidlFolder, SHGDN_NORMAL or SHGDN_FORPARSING, StrRet) <> S_OK then
  //  Exit;
  try
    if DoGetEnumFlags(IDListToPath(pidlFolder), Flags) then
      Result := S_OK
    else
      Result := S_FALSE;
  except
    Result := E_UNEXPECTED;
  end;

  pgrfFlags := 0;
  for Obj := Low(TJvBrowsableObjectClass) to High(TJvBrowsableObjectClass) do
    if Obj in Flags then
      Inc(pgrfFlags, CBrowseObjectClasses[Obj]);
end;

function TJvBrowseForFolderDialog.GetOwnerWindow: HWND;
var
  F: TCustomForm;
begin
  // (Ralf Kaiser) Owner maybe a TDataModule
  if Owner is TControl then
    F := GetParentForm(TControl(Owner))
  else
    F := nil;
  if F <> nil then
    {$IFDEF VCL}
    Result := F.Handle
    {$ENDIF VCL}
    {$IFDEF VisualCLX}
    Result := QWidget_winId(F.Handle)
    {$ENDIF VisualCLX}
  else
  if Owner is TWinControl then
    {$IFDEF VCL}
    Result := (Owner as TWinControl).Handle
    {$ENDIF VCL}
    {$IFDEF VisualCLX}
    Result := QWidget_winId((Owner as TWinControl).Handle)
    {$ENDIF VisualCLX}
  else
  if (Screen <> nil) and (Screen.ActiveCustomForm <> nil) then
    {$IFDEF VCL}
    Result := Screen.ActiveCustomForm.Handle
    {$ENDIF VCL}
    {$IFDEF VisualCLX}
    Result := QWidget_winId(Screen.ActiveCustomForm.Handle)
    {$ENDIF VisualCLX}
  else
    Result := GetForegroundWindow;
end;

function TJvBrowseForFolderDialog.GetRootDirectoryPath: string;
begin
  if FRootDirectory = fdNoSpecialFolder then
    Result := FRootDirectoryPath
  else
    Result := CSIDLToPath(FRootDirectory);
end;

procedure TJvBrowseForFolderDialog.HookDialog;
begin
  if FDialogWindow <> 0 then
    FDefWndProc := Pointer(SetWindowLong(FDialogWindow, GWL_WNDPROC,
      Longint(FObjectInstance)));
end;

function TJvBrowseForFolderDialog.IsRootDirectoryPathStored: Boolean;
begin
  Result := (RootDirectory = fdNoSpecialFolder) and (FRootDirectoryPath > '');
end;

procedure TJvBrowseForFolderDialog.MainWndProc(var Msg: TMessage);
begin
  try
    Dispatch(Msg);
  except
    Application.HandleException(Self);
  end;
end;

procedure TJvBrowseForFolderDialog.SetExpanded(const APath: string);
begin
  if FDialogWindow <> 0 then
    { Implicit conversion }
    SetExpandedW(APath);
end;

procedure TJvBrowseForFolderDialog.SetExpanded(IDList: PItemIDList);
begin
  if FDialogWindow <> 0 then
    SendMessage(FDialogWindow, BFFM_SETEXPANDED, WPARAM(False), LPARAM(IDList));
end;

procedure TJvBrowseForFolderDialog.SetExpandedW(const APath: WideString);
begin
  if FDialogWindow <> 0 then
    SendMessage(FDialogWindow, BFFM_SETEXPANDED, WPARAM(True), LPARAM(PWideChar(APath)));
end;

procedure TJvBrowseForFolderDialog.SetOKEnabled(const Value: Boolean);
begin
  if FDialogWindow <> 0 then
    SendMessage(FDialogWindow, BFFM_ENABLEOK, 0, LPARAM(Value));
end;

procedure TJvBrowseForFolderDialog.SetOKText(const AText: string);
begin
  if FDialogWindow <> 0 then
    { Implicit conversion }
    SetOKTextW(AText);
end;

procedure TJvBrowseForFolderDialog.SetOKTextW(const AText: WideString);
begin
  if FDialogWindow <> 0 then
    SendMessage(FDialogWindow, BFFM_SETOKTEXT, 0, LPARAM(PWideChar(AText)));
end;

procedure TJvBrowseForFolderDialog.SetOptions(const Value: TOptionsDir);
var
  AddedOptions, RemovedOptions: TOptionsDir;
begin
  if FOptions = Value then
    Exit;

  AddedOptions := Value - (FOptions * Value);
  RemovedOptions := FOptions - (FOptions * Value);

  FOptions := Value;

  { Force correct options }
  if odIncludeUrls in AddedOptions then
    FOptions := FOptions + [odEditBox, odNewDialogStyle, odIncludeFiles];
  if odShareable in AddedOptions then
    FOptions := FOptions + [odNewDialogStyle];
  if odUsageHint in AddedOptions then
    FOptions := FOptions + [odNewDialogStyle] - [odEditBox];
  if odValidate in AddedOptions then
    FOptions := FOptions + [odEditBox];
  if odEditBox in AddedOptions then
    FOptions := FOptions - [odUsageHint];

  if odEditBox in RemovedOptions then
    FOptions := FOptions - [odIncludeUrls, odValidate];
  if odNewDialogStyle in RemovedOptions then
    FOptions := FOptions - [odIncludeUrls, odShareable, odUsageHint];
  if odIncludeFiles in RemovedOptions then
    FOptions := FOptions - [odIncludeUrls];

  { Last check }
  if odEditBox in FOptions then
    FOptions := FOptions - [odUsageHint]
  else
    FOptions := FOptions - [odIncludeUrls, odValidate];
  if odUsageHint in FOptions then
    FOptions := FOptions - [odValidate, odEditBox];
end;

procedure TJvBrowseForFolderDialog.SetRootDirectory(
  const Value: TFromDirectory);
begin
  if (Value = fdNoSpecialFolder) and (FRootDirectory <> fdNoSpecialFolder) then
    FRootDirectoryPath := GetRootDirectoryPath;

  FRootDirectory := Value;
end;

procedure TJvBrowseForFolderDialog.SetRootDirectoryPath(
  const Value: string);
begin
  FRootDirectory := fdNoSpecialFolder;
  FRootDirectoryPath := Value;
end;

procedure TJvBrowseForFolderDialog.SetSelection(const APath: string);
begin
  if FDialogWindow <> 0 then
    SendMessage(FDialogWindow, BFFM_SETSELECTION, WPARAM(True), LPARAM(Pointer(APath)));
end;

procedure TJvBrowseForFolderDialog.SetSelection(IDList: PItemIDList);
begin
  if FDialogWindow <> 0 then
    SendMessage(FDialogWindow, BFFM_SETSELECTION, WPARAM(False), LPARAM(IDList));
end;

procedure TJvBrowseForFolderDialog.SetStatusText(const AText: string);
begin
  if FDialogWindow <> 0 then
    SendMessage(FDialogWindow, BFFM_SETSTATUSTEXT, 0, LPARAM(Pointer(AText)));
end;

procedure TJvBrowseForFolderDialog.SetStatusTextW(const AText: WideString);
begin
  if FDialogWindow <> 0 then
    SendMessage(FDialogWindow, BFFM_SETSTATUSTEXTW, 0, LPARAM(PWideChar(AText)));
end;

function TJvBrowseForFolderDialog.ShouldShow(psf: IShellFolder; pidlFolder,
  pidlItem: PItemIDList): HResult;
var
  StrRet: TStrRet;
begin
  psf.GetDisplayNameOf(pidlItem, SHGDN_NORMAL or SHGDN_FORPARSING, StrRet);

  try
    if DoShouldShow(StrRetToString(pidlItem, StrRet)) then
      Result := S_OK
    else
      Result := S_FALSE;
  except
    Result := E_UNEXPECTED;
  end;
end;

procedure TJvBrowseForFolderDialog.UpdateStatusText(AText: string);
const
  cStatusLabel = $3743;
var
  WindowRect, ItemRect: TRect;
  ItemHandle: THandle;
  LCanvas: TCanvas;
begin
  if [odStatusAvailable, odNewDialogStyle] * FUsedOptions <> [odStatusAvailable] then
    Exit;

  if StatusText <> '' then
    AText := StatusText
  else
  begin
    ItemHandle := GetDlgItem(FDialogWindow, cStatusLabel);
    if ItemHandle <> 0 then
    begin
      GetWindowRect(FDialogWindow, WindowRect);
      GetWindowRect(ItemHandle, ItemRect);
      if Application.MainForm <> nil then
        LCanvas := Application.MainForm.Canvas
      else
      begin
        LCanvas := TCanvas.Create;
        LCanvas.Handle := GetDC(HWND_DESKTOP);
      end;
      AText := MinimizeFileName(AText, LCanvas,
        (WindowRect.Right - WindowRect.Left) - (ItemRect.Left - WindowRect.Left) * 2 - 8);
      if Application.MainForm = nil then
        LCanvas.Free;
    end;
  end;

  SetStatusText(AText);
end;

procedure TJvBrowseForFolderDialog.WMShowWindow(var Msg: TMessage);
begin
  { If the dialog isn't resized, we won't get a WM_SIZE message. Thus we
    respond to the WM_SHOWWINDOW message }

  if not FPositionSet then
    SetDialogPos(FOwnerWindow, FDialogWindow, Position);
  FPositionSet := True;

  inherited;
end;

procedure TJvBrowseForFolderDialog.WMSize(var Msg: TWMSize);
var
  BtnSize: TRect;
  WindowSize: TRect;
begin
  inherited;

  if FHelpButtonHandle <> 0 then
  begin
    GetWindowRect(FHelpButtonHandle, BtnSize);
    GetWindowRect(FDialogWindow, WindowSize);
    ScreenToClient(FDialogWindow, BtnSize.TopLeft);
    ScreenToClient(FDialogWindow, BtnSize.BottomRight);

    SetWindowPos(FHelpButtonHandle, 0, BtnSize.Left,
      WindowSize.Bottom - WindowSize.Top - FHelpButtonHeightDelta,
      BtnSize.Right - BtnSize.Left, BtnSize.Bottom - BtnSize.Top,
      SWP_NOZORDER + SWP_NOACTIVATE);
  end;
end;

{$IFDEF UNITVERSIONING}
initialization
  RegisterUnitVersion(HInstance, UnitVersioning);

finalization
  UnregisterUnitVersion(HInstance);
{$ENDIF UNITVERSIONING}

end.