opendlgfavadapter.pas

East make Tray Icon in delphi

      Style := csDropDownList;
      Sorted := True;
      OnClick := FavoriteComboBoxClick;
      Parent := FFavoritePanel;
    end;
    with TStaticText.Create(FFavoritePanel) do
    begin
      AutoSize := False;
      SetBounds(6, 0, 100, 14);
      Caption := RsFavorites;
      FocusControl := FFavoriteComboBox;
      Parent := FFavoritePanel;
    end;
    FAddButton := TButton.Create(FFavoritePanel);
    with FAddButton do
    begin
      SetBounds(333, 14, 75, 23);
      Caption := RsAdd;
      OnClick := AddButtonClick;
      Parent := FFavoritePanel;
    end;
  end;
end;

//--------------------------------------------------------------------------------------------------

destructor TFavOpenDialog.Destroy;
begin
  UnhookDialogs;
  FreeObjectInstance(FParentWndInstance);
  FreeObjectInstance(FWndInstance);
  FreeAndNil(FFavoritePanel);
  FreeAndNil(FFavoriteFolders);
  FreeAndNil(FHooks);
  inherited Destroy;
end;

//--------------------------------------------------------------------------------------------------

procedure TFavOpenDialog.DialogFolderChange;
var
  Path: string;
begin
  Path := CurrentFolder;
  with FFavoriteComboBox do
  begin
    ItemIndex := Items.IndexOf(Path);
    DeleteMode := (ItemIndex <> -1);
  end;
end;

//--------------------------------------------------------------------------------------------------

procedure TFavOpenDialog.DialogShow;
var
  PreviewRect: TRect;
begin
  FParentWnd := GetParent(FHandle);
  if IsOpenPictDialog then
    DoShow
  else  
  begin
    GetClientRect(FHandle, PreviewRect);
    PreviewRect.Top := PreviewRect.Bottom - 43;
    FFavoritePanel.BoundsRect := PreviewRect;
    FFavoritePanel.ParentWindow := FHandle;
    if IsWin2k or IsWinXP then
      FOldParentWndInstance := Pointer(SetWindowLong(FParentWnd, GWL_WNDPROC, Longint(FParentWndInstance)));
    AdjustControlPos;
    try
      DoShow;
    finally
      FFavoriteComboBox.Items.Assign(FavoriteFolders);
    end;
  end;  
end;

//--------------------------------------------------------------------------------------------------

procedure TFavOpenDialog.DoClose;
begin
  if Assigned(FOnClose) then
    FOnClose(Self);
end;

//--------------------------------------------------------------------------------------------------

procedure TFavOpenDialog.DoShow;
begin
  if Assigned(FOnShow) then
    FOnShow(Self);
end;

//--------------------------------------------------------------------------------------------------

procedure TFavOpenDialog.FavoriteComboBoxClick(Sender: TObject);
begin
  with FFavoriteComboBox do
    if ItemIndex <> - 1 then
      CurrentFolder := FFavoriteComboBox.Items[ItemIndex];
end;

//--------------------------------------------------------------------------------------------------

function TFavOpenDialog.GetCurrentFolder: string;
var
  Path: array[0..MAX_PATH] of Char;
begin
  SetString(Result, Path, SendMessage(FParentWnd, CDM_GETFOLDERPATH, SizeOf(Path), Integer(@Path)));
  StrResetLength(Result);
end;

//--------------------------------------------------------------------------------------------------

function TFavOpenDialog.GetFileNameEditWnd: HWND;
begin
  Result := GetDlgItem(FParentWnd, edt1);
  if Result = 0 then
    Result := GetDlgItem(FParentWnd, cmb13);
end;

//--------------------------------------------------------------------------------------------------

procedure TFavOpenDialog.HookDialogs;
var
  Pe: TJclPeImage;
  I: Integer;

  procedure HookImportsForModule(ModuleBase: Pointer);
  const
    comdlg32 = 'comdlg32.dll';
  begin
    if ModuleBase <> nil then
    begin
      FHooks.HookImport(ModuleBase, comdlg32, 'GetOpenFileNameA', @NewGetOpenFileName, @OldGetOpenFileName);
      FHooks.HookImport(ModuleBase, comdlg32, 'GetSaveFileNameA', @NewGetSaveFileName, @OldGetSaveFileName);
    end;
  end;

begin
  Pe := TJclPeImage.Create(True);
  try
    Pe.AttachLoadedModule(HInstance);
    if Pe.StatusOK then
    begin
      HookImportsForModule(Pointer(HInstance));
      for I := 0 to Pe.ImportList.UniqueLibItemCount - 1 do
        HookImportsForModule(Pointer(GetModuleHandle(PChar(Pe.ImportList.UniqueLibItems[I].FileName))));
    end;
  finally
    Pe.Free;
  end;
end;

//--------------------------------------------------------------------------------------------------

procedure TFavOpenDialog.LoadFavorites(const FileName: string);
begin
  if FileExists(FileName) then
    FavoriteFolders.LoadFromFile(FileName)
  else
    FavoriteFolders.Clear;
end;

//--------------------------------------------------------------------------------------------------

procedure TFavOpenDialog.ParentWndProc(var Message: TMessage);
begin
  with Message do
  begin
    Result := CallWindowProc(FOldParentWndInstance, FParentWnd, Msg, WParam, LParam);
    if Msg = WM_SIZE then
      AdjustControlPos;
  end;
end;

//--------------------------------------------------------------------------------------------------

procedure TFavOpenDialog.SetCurrentFolder(const Value: string);
var
  LastFocus: HWND;
  FileNameBuffer: string;
begin
  if (FParentWnd <> 0) and DirectoryExists(Value) then
  begin
    LastFocus := GetFocus;
    FileNameBuffer := GetWindowCaption(FileNameEditWnd);
    SendMessage(FParentWnd, CDM_SETCONTROLTEXT, edt1, LPARAM(PChar(Value)));
    SendMessage(GetDlgItem(FParentWnd, 1), BM_CLICK, 0, 0);
    SendMessage(FParentWnd, CDM_SETCONTROLTEXT, edt1, LPARAM(PChar(FileNameBuffer)));
    SetFocus(LastFocus);
  end;
end;

//--------------------------------------------------------------------------------------------------

procedure TFavOpenDialog.SetDeleteMode(const Value: Boolean);
begin
  if FDeleteMode <> Value then
  begin
    FDeleteMode := Value;
    if FDeleteMode then
      FAddButton.Caption := RsDelete
    else
      FAddButton.Caption := RsAdd;
    FFavoriteComboBox.Invalidate;
  end;
end;

//--------------------------------------------------------------------------------------------------

procedure TFavOpenDialog.UnhookDialogs;
var
  I: Integer;
begin
  I := 0;
  while I < FHooks.Count do
    if not FHooks[I].Unhook then
      Inc(I);
end;

//--------------------------------------------------------------------------------------------------

procedure TFavOpenDialog.WndProc(var Message: TMessage);

  procedure Default;
  begin
    with Message do
      Result := CallWindowProc(FOldWndInstance, FHandle, Msg, WParam, LParam);
  end;

begin
  if FHandle <> 0 then
  begin
    case Message.Msg of
      WM_NOTIFY:
        begin
          case (POFNotify(Message.LParam)^.hdr.code) of
            CDN_INITDONE:
              DialogShow;
            CDN_FOLDERCHANGE:
              if not IsOpenPictDialog then
                DialogFolderChange;
            CDN_FILEOK:
              if IsOpenPictDialog then
                FPictureDialogLastFolder := CurrentFolder;
          end;
          Default;
        end;
      WM_DESTROY:
        begin
          if not IsOpenPictDialog then
            FavoriteFolders.Assign(FFavoriteComboBox.Items);
          try
            DoClose;
            Default;
          finally
            if not IsOpenPictDialog then
              FFavoritePanel.ParentWindow := 0;
            FParentWnd := 0;
          end;
        end;
      WM_NCDESTROY:
        begin
          Default;
          FHandle := 0;
        end;
    else
      Default;
    end;
  end;
end;

//--------------------------------------------------------------------------------------------------

initialization

finalization
  FreeAndNil(FavOpenDialog);

// History:

// $Log: OpenDlgFavAdapter.pas,v $
// Revision 1.5  2005/02/26 17:36:01  rrossmair
// - applied Salvatore Besso's fix for truncation of Add button when using large fonts.
// - some cleaning, module header updated.
//

end.