jvqbrowsefolder.pas

East make Tray Icon in delphi

  FUsedOptions := FOptions;
  if ShellVersion < $00060000 then
    FUsedOptions := FUsedOptions - [odNoNewButtonFolder, odUsageHint];
  if ShellVersion < $00050000 then
    FUsedOptions := FUsedOptions - [odIncludeUrls, odNewDialogStyle, odShareable];
  if ShellVersion < $00040071 then
    FUsedOptions := FUsedOptions - [odIncludeFiles, odEditBox, odValidate];

  for Option := Low(TOptionsDirectory) to High(TOptionsDirectory) do
    if Option in FUsedOptions then
      Inc(BrowseInfo.ulFlags, COptionsDirectory[Option]);

  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  
    Result := QWidget_winId(F.Handle) 
  else
  if Owner is TWinControl then  
    Result := QWidget_winId((Owner as TWinControl).Handle) 
  else
  if (Screen <> nil) and (Screen.ActiveCustomForm <> nil) then  
    Result := QWidget_winId(Screen.ActiveCustomForm.Handle) 
  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;
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);
      AText := MinimizeFileName(AText, Application.MainForm.Canvas,
        (WindowRect.Right - WindowRect.Left) - (ItemRect.Left - WindowRect.Left) * 2 - 8);
    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}
const
  UnitVersioning: TUnitVersionInfo = (
    RCSfile: '$RCSfile: JvQBrowseFolder.pas,v $';
    Revision: '$Revision: 1.6 $';
    Date: '$Date: 2004/09/07 23:11:15 $';
    LogPath: 'JVCL\run'
  );

initialization
  RegisterUnitVersion(HInstance, UnitVersioning);

finalization
  UnregisterUnitVersion(HInstance);
{$ENDIF UNITVERSIONING}

end.