jvqbrowsefolder.pas

East make Tray Icon in delphi

  Result := nil;

  if ASpecialDirectory = fdNoSpecialFolder then
    Exit;

  GetCSIDLLocation(ASpecialDirectory, CSIDL, Path);

  if CSIDL <> 0 then
  begin
    { MSDN: The calling application is responsible for freeing this pointer }
    { SHGetSpecialFolderLocation is shell v4.7 or later}
    if Failed(SHGetSpecialFolderLocation(0, CSIDL, Result)) then
      Result := nil;
  end
  else
    Result := CreateIDListFromPath(Path);
end;

function IDListToPath(IDList: PItemIDList): string;
var
  IDesktopFolder: IShellFolder;
  StrRet: TStrRet;
begin
  { Similar to SHGetPathFromIDList }
  if Succeeded(SHGetDesktopFolder(IDesktopFolder)) and
    Succeeded(IDesktopFolder.GetDisplayNameOf(IDList, SHGDN_NORMAL or SHGDN_FORPARSING, StrRet)) then

    { Result may be a GUID; Don't know whether these GUIDs are portable. Microsoft
      does recommend to return strings 'that are as close to the display names
      as possible'. But in this case display names aren't usable }
    Result := StrRetToString(IDList, StrRet)
  else
    Result := '';

  (* These GUID's seem pretty portable, you can enter them at RootDirectoryPath
     or Directory, ie the "::{GUID}" part (only tested on Windows XP).

    ::{00020D75-0000-0000-C000-000000000046} - Inbox
    ::{20D04FE0-3AEA-1069-A2D8-08002B30309D} - CSIDL_DRIVES
    ::{208D2C60-3AEA-1069-A2D7-08002B30309D} - CSIDL_NETWORK, CSIDL_NETHOOD
    ::{21EC2020-3AEA-1069-A2DD-08002B30309D} - CSIDL_CONTROLS
    ::{2227A280-3AEA-1069-A2DE-08002B30309D} - CSIDL_PRINTERS, CSIDL_PRINTHOOD
    ::{450D8FBA-AD25-11D0-98A8-0800361B1103} - CSIDL_PERSONAL
    ::{645FF040-5081-101B-9F08-00AA002F954E} - CSIDL_BITBUCKET
    ::{7007ACC7-3202-11D1-AAD2-00805FC1270E} - CSIDL_CONNECTIONS
    ::{871C5380-42A0-1069-A2EA-08002B30309D} - CSIDL_INTERNET
    ::{D6277990-4C6A-11CF-8D87-00AA0060F5BF} - Scheduled Tasks
  *)
end;

function CSIDLToPath(const ASpecialDirectory: TFromDirectory): string;
var
  CSIDL: Cardinal;
  IDList: PItemIDList;
  ShellMalloc: IMalloc;
begin
  if ASpecialDirectory = fdNoSpecialFolder then
  begin
    Result := '';
    Exit;
  end;

  GetCSIDLLocation(ASpecialDirectory, CSIDL, Result);

  if CSIDL = 0 then
    Exit;

  { SHGetSpecialFolderLocation is shell v4.7 or later}
  if Succeeded(SHGetSpecialFolderLocation(0, CSIDL, IDList)) then
  try
    Result := IDListToPath(IDList);
  finally
    if Succeeded(SHGetMalloc(ShellMalloc)) then
      ShellMalloc.Free(IDList);
  end
  else
    Result := '';
end;

procedure SetDialogPos(AParentHandle, AWndHandle: THandle;
  Position: TJvFolderPos);
var
  R, SR: TRect;
begin
  if GetClientRect(AWndHandle, R) then
  begin
    //R.Right := R.Left + AWidth;
    //R.Bottom := R.Top + AHeight;
    SystemParametersInfo(SPI_GETWORKAREA, 0, @SR, 0);
    case Position of
      fpScreenCenter:
        begin
          R.Left := ((SR.Right - SR.Left - (R.Right - R.Left)) div 2);
          R.Top := (SR.Bottom - SR.Top - (R.Bottom - R.Top)) div 2;
        end;
      fpFormCenter:
        begin
          GetWindowRect(AParentHandle, SR);
          R.Left := SR.Left + ((SR.Right - SR.Left - (R.Right - R.Left)) div 2);
          R.Top := SR.Top + (SR.Bottom - SR.Top - (R.Bottom - R.Top)) div 2;
        end;
      fpTopLeft:
        begin
          R.Left := SR.Left;
          R.Top := SR.Top;
        end;
      fpTopRight:
        begin
          R.Top := SR.Top;
          R.Left := SR.Right - (R.Right - R.Left) -
            GetSystemMetrics(SM_CXFIXEDFRAME);
        end;
      fpBottomLeft:
        begin
          R.Top := SR.Bottom - (R.Bottom - R.Top) -
            GetSystemMetrics(SM_CYCAPTION) -
            -GetSystemMetrics(SM_CYFIXEDFRAME);
          R.Left := SR.Left;
        end;
      fpBottomRight:
        begin
          R.Top := SR.Bottom - (R.Bottom - R.Top) -
            GetSystemMetrics(SM_CYCAPTION) -
            GetSystemMetrics(SM_CYFIXEDFRAME);
          R.Left := SR.Right - (R.Right - R.Left) -
            GetSystemMetrics(SM_CXFIXEDFRAME);
        end;
      fpDefault:
        Exit;
    end;
    SetWindowPos(AWndHandle, 0, R.Left, R.Top, 0, 0,
      SWP_NOACTIVATE or SWP_NOSIZE or SWP_NOZORDER);
  end;
end;

function lpfnBrowseProc(Wnd: HWND; uMsg: UINT; lParam, lpData: LPARAM): Integer; stdcall;
begin
  Result := 0;

  with TJvBrowseForFolderDialog(lpData) do
  begin
    FDialogWindow := Wnd;
    case uMsg of
      BFFM_INITIALIZED:
        DoInitialized;
      BFFM_SELCHANGED:
        DoSelChanged(PItemIDList(lParam));
      BFFM_IUNKNOWN:
        DoIUnknown(IUnknown(lParam));
      BFFM_VALIDATEFAILEDA:
        Result := DoValidateFailed(PChar(lParam));
      BFFM_VALIDATEFAILEDW:
        Result := DoValidateFailedW(PWideChar(lParam));
    end;
  end;
end;

//=== { TJvBrowseForFolderDialog } ===========================================

constructor TJvBrowseForFolderDialog.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FOptions := [odStatusAvailable, odNewDialogStyle];
  FPosition := fpScreenCenter; // ahuser: changed from fpDefault - I think no one wants the dialog in the right bottom corner
  FRootDirectory := fdNoSpecialFolder;
  FObjectInstance := JvMakeObjectInstance(MainWndProc);
end;

destructor TJvBrowseForFolderDialog.Destroy;
begin
  PidlFree(FPidl);
  JvFreeObjectInstance(FObjectInstance);
  inherited Destroy;
end;

procedure TJvBrowseForFolderDialog.DefaultHandler(var Msg);
begin
  if FDialogWindow <> 0 then
    with TMessage(Msg) do
      Result := CallWindowProc(FDefWndProc, FDialogWindow, Msg, WParam, LParam)
  else
    inherited DefaultHandler(Msg);
end;

function TJvBrowseForFolderDialog.DoGetEnumFlags(const AFolder: string;
  var Flags: TJvBrowsableObjectClasses): Boolean;
begin
  { (rb) Always return True? }
  Result := True;
  if Assigned(FOnGetEnumFlags) then
    FOnGetEnumFlags(Self, AFolder, Flags);
end;

procedure TJvBrowseForFolderDialog.DoInitialized;
const
  SBtn = 'BUTTON';
  HelpButtonId = $FFFF;
var
  BtnHandle, BtnFont: THandle;
  BtnSize, WindowSize: TRect;
begin
  { We can now change the position of the dialog - if it's not NewDialogStyle.. }
  FPositionSet := not (odNewDialogStyle in FUsedOptions);
  if FPositionSet then
    SetDialogPos(FOwnerWindow, FDialogWindow, Position);

  { ..Otherwise we have to delay the change until receive of WM_SHOWWINDOW,
    thus we need to hook the dialog; we also need to hook the dialog if there
    is a new help button on the dialog and the dialog is resizeable - ie
    NewDialogStyle }
  if not FPositionSet or ((FHelpContext <> 0) and (odNewDialogStyle in FUsedOptions)) then
    HookDialog;

  // [roko] Rx's code to insert Help button
  if FHelpContext <> 0 then
  begin
    { SomeBtnHandle is some button on the window; we need it to determine a
      useable height & width for the new help button }
    BtnHandle := FindWindowEx(FDialogWindow, 0, SBtn, nil);
    if BtnHandle <> 0 then
    begin
      GetWindowRect(BtnHandle, BtnSize);
      GetWindowRect(FDialogWindow, WindowSize);
      ScreenToClient(FDialogWindow, BtnSize.TopLeft);
      ScreenToClient(FDialogWindow, BtnSize.BottomRight);
      BtnFont := SendMessage(FDialogWindow, WM_GETFONT, 0, 0);
      { Note: BtnSize.Top = "Window.Height" - FHelpButtonHeightDelta, used in
              WM_SIZE }
      FHelpButtonHeightDelta := WindowSize.Bottom - WindowSize.Top - BtnSize.Top;
      { Remember the new buttons handle, because we need it, when the dialog
        is resized }
      FHelpButtonHandle := CreateWindow(SBtn, PChar(SHelpButton),
        WS_CHILD or WS_CLIPSIBLINGS or WS_VISIBLE or BS_PUSHBUTTON or WS_TABSTOP,
        12, BtnSize.Top, BtnSize.Right - BtnSize.Left, BtnSize.Bottom - BtnSize.Top,
        FDialogWindow, HelpButtonId, HInstance, nil);
      if BtnFont <> 0 then
        SendMessage(FHelpButtonHandle, WM_SETFONT, BtnFont, MakeLParam(1, 0));
      UpdateWindow(FDialogWindow);
    end;
  end;

  { Change directory (if possible) }
  if FDirectory <> '' then
    SetSelection(FDirectory);
  UpdateStatusText(FDirectory);

  if Assigned(FOnInit) then
    FOnInit(Self);
end;

procedure TJvBrowseForFolderDialog.DoIUnknown(const Unknown: IUnknown);
var
  FolderFilterSite: IFolderFilterSite;
begin
  if (Assigned(FOnGetEnumFlags) or Assigned(FOnShouldShow)) and
    Supports(Unknown, IID_IFolderFilterSite, FolderFilterSite) then
  begin
    FolderFilterSite.SetFilter(Self);
    FolderFilterSite := nil;
  end;
end;

procedure TJvBrowseForFolderDialog.DoSelChanged(IDList: PItemIDList);
var
  // (p3) use buff array instead of string as this works better
  Buffer: array [0..MAX_PATH] of Char;
  Path: string;
  Accept: Boolean;
  SavePidl: PItemIDList;
begin
  { Note :
    * If the location specified by the pidl parameter is not part of the file
      system, this function will fail.
    * If the pidl parameter specifies a shortcut, the pszPath will contain the
      path to the shortcut, not to the shortcut's target. (if not win XP )

    Could also use IDListToPath
  }

  if SHGetPathFromIDList(IDList, Buffer) then
    Path := Buffer
  else
    Path := '';

  SavePidl := FPidl;
  FPidl := IDList;
  try
    if Assigned(FOnAcceptChange) then
    begin
      Accept := True;
      FOnAcceptChange(Self, Path, Accept);
      SetOKEnabled(Accept);
    end;

    UpdateStatusText(Path);

    if Assigned(FOnChange) then
      FOnChange(Self, Path);
  finally
    FPidl := SavePidl;
  end;
end;

function TJvBrowseForFolderDialog.DoShouldShow(
  const AItem: string): Boolean;
begin
  if Assigned(FOnShouldShow) then
    FOnShouldShow(Self, AItem, Result)
  else
    Result := True;
end;

function TJvBrowseForFolderDialog.DoValidateFailed(
  AEditText: PChar): Integer;
var
  CanClose: Boolean;
begin
  { Return zero to allow the dialog to be dismissed or nonzero to keep
    the dialog displayed. }
  if Assigned(FOnValidateFailed) then
  begin
    CanClose := True;
    FOnValidateFailed(Self, AEditText, CanClose);
    Result := Integer(not CanClose);
  end
  else
    Result := 0; // = Integer(False)
end;

function TJvBrowseForFolderDialog.DoValidateFailedW(
  AEditText: PWideChar): Integer;
begin
  { Explicit conversion }
  Result := DoValidateFailed(PChar(string(AEditText)));
end;

function TJvBrowseForFolderDialog.Execute: Boolean;
var
  dspName: array [0..MAX_PATH] of Char;
  BrowseInfo: TBrowseInfo;
  ShellVersion: Cardinal;
  ActiveWindow: HWND;
  WindowList: Pointer;
  Option: TOptionsDirectory;
begin
  ShellVersion := GetShellVersion;
  if ShellVersion < $00040000 then
    raise EJVCLException.CreateRes(@RsEShellNotCompatible);

  FDialogWindow := 0;
  FOwnerWindow := GetOwnerWindow;
  FPositionSet := False;
  FHelpButtonHandle := 0;
  FHelpButtonHeightDelta := 0;

  Result := False;

  FillChar(BrowseInfo, SizeOf(BrowseInfo), #0);

  { FUsedOptions is a subset of FOptions; the options that actually can be
    used because of shell version limitations }