Windows XP åbn/gem standarddialogbokse med Delphi 4 Standard

Prøv det her: er freeware
Web: http://www.tmssoftware.com

winxp.zip : component files for Delphi 3,4,5,6 & C++Builder 3,4,5

Brug den her i stedet for. Den er magen til den fra win2k / XP

unit Win2000Dialogs;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, CommDlg;

type
  TWin2000OpenDialog = class(TOpenDialog)
  protected
    FShowPlacesBar: Boolean; // shows the left bar
    FInterceptor: Pointer; // pointer to intercepting function
    function IsWin2000: Boolean; // are we on Windows2000 or WinME?
  public
    constructor Create(AOwner: TComponent); override;
    function Execute: Boolean; override;
  published
    property ShowPlacesBar: Boolean read FShowPlacesBar write FShowPlacesBar;
  end;

  TWin2000SaveDialog = class(TWin2000OpenDialog)
  public
    constructor Create(AOwner: TComponent); override;
    function Execute: Boolean; override;
  end;

type
  TOpenFileNameEx = packed record
    lStructSize: DWORD;
    hWndOwner: HWND;
    hInstance: HINST;
    lpstrFilter: PAnsiChar;
    lpstrCustomFilter: PAnsiChar;
    nMaxCustFilter: DWORD;
    nFilterIndex: DWORD;
    lpstrFile: PAnsiChar;
    nMaxFile: DWORD;
    lpstrFileTitle: PAnsiChar;
    nMaxFileTitle: DWORD;
    lpstrInitialDir: PAnsiChar;
    lpstrTitle: PAnsiChar;
    Flags: DWORD;
    nFileOffset: Word;
    nFileExtension: Word;
    lpstrDefExt: PAnsiChar;
    lCustData: LPARAM;
    lpfnHook: function(Wnd: HWND; Msg: UINT; wParam: WPARAM; lParam: LPARAM): UINT stdcall;
    lpTemplateName: PAnsiChar;
    pvReserved: Pointer;
    dwReserved: DWORD;
    FlagsEx: DWORD;
  end;

const
  OFN_EX_NOPLACESBAR = 1;

function GetOpenFileNameEx(var OpenFile: TOpenFilenameEx): Bool; stdcall;
function GetSaveFileNameEx(var OpenFile: TOpenFilenameEx): Bool; stdcall;

implementation

function GetOpenFileNameEx; external 'comdlg32.dll' name 'GetOpenFileNameA';
function GetSaveFileNameEx; external 'comdlg32.dll' name 'GetSaveFileNameA';

var
  CurInstanceShowPlacesBar: Boolean;

function OpenInterceptor(var DialogData: TOpenFileName): Bool; stdcall;
var
  DialogDataEx: TOpenFileNameEx;
begin
  Move(DialogData, DialogDataEx, sizeof(DialogData));

  if CurInstanceShowPlacesBar then
    DialogDataEx.FlagsEx := 0
  else
    DialogDataEx.FlagsEx := OFN_EX_NOPLACESBAR;

  DialogDataEx.lStructSize := sizeof(TOpenFileNameEx); // size of new structure
  Result := GetOpenFileNameEx(DialogDataEx);
end;

function SaveInterceptor(var DialogData: TOpenFileName): Bool; stdcall;
var
  DialogDataEx: TOpenFileNameEx;
begin
  Move(DialogData, DialogDataEx, sizeof(DialogData));

  if CurInstanceShowPlacesBar then
    DialogDataEx.FlagsEx := 0
  else
    DialogDataEx.FlagsEx := 1;

  DialogDataEx.lStructSize := sizeof(TOpenFileNameEx); // size of new structure
  Result := GetSaveFileNameEx(DialogDataEx);
end;

{ TWin2000OpenDialog }

constructor TWin2000OpenDialog.Create(AOwner: TComponent);
begin
  inherited;
  FShowPlacesBar := True;
  FInterceptor := @OpenInterceptor;
end;

function TWin2000OpenDialog.Execute: Boolean;
begin
  if IsWin2000 then
  begin
    CurInstanceShowPlacesBar := FShowPlacesBar;
    Result := DoExecute(FInterceptor);
  end
  else
    Result := inherited Execute;
end;

function TWin2000OpenDialog.IsWin2000: Boolean;
var
  OSVersionInfo : TOSVersionInfo;
begin
  Result := False;
  OSVersionInfo.dwOSVersionInfoSize := SizeOf(TOSVersionInfo);

  if not GetVersionEx(OSVersionInfo) then
    exit;

  Result :=
    ((OSVersionInfo.dwPlatformId = VER_PLATFORM_WIN32_NT) and (OSVersionInfo.dwMajorVersion >= 5)) //Windows 2000
  or
    ((OSVersionInfo.dwPlatformId = VER_PLATFORM_WIN32_WINDOWS) and (OSVersionInfo.dwMajorVersion >= 4) and (OSVersionInfo.dwMinorVersion >= 90)); //Windows ME
(*
  if (OSVersionInfo.dwPlatformId = VER_PLATFORM_WIN32_NT) and (OSVersionInfo.dwMajorVersion >= 5) then // Detect Windows 2000
    Result := True
  else if ((OSVersionInfo.dwPlatformId = VER_PLATFORM_WIN32_WINDOWS) and (OSVersionInfo.dwMajorVersion >= 4) and (OSVersionInfo.dwMinorVersion >= 90)) then // Detect Windows ME
    Result := True;
  *)
end;

{ TWin2000SaveDialog }

constructor TWin2000SaveDialog.Create(AOwner: TComponent);
begin
  inherited;
  FInterceptor := @SaveInterceptor;
end;

function TWin2000SaveDialog.Execute: Boolean;
begin
  if IsWin2000 then
    Result := inherited Execute // TWin2000OpenDialog has the functionality
  else
    Result := DoExecute(@GetSaveFileName); // can't call inherited because it will call opendialogs DoExecute
end;

end.

Det ser meget spændende ud.

Stone -> Den komponent du har fundet ser ud til at gøre, så hele WinXP-themes bliver understøttet (jeg har ikke prøvet komponenten endnu). Men: Virker det også i dialogboksene?

Jens Borrisholt -> Det ser meget spændende ud :-)

Jeg kigger på det.

Jens -> http://www.ebruger.dk/img/dote/athlon-pascal_Dialogbokse.JPG
Som du kan se er der lidt skønhedsfejl i dit løsningsfoslag...

Stone -> Jeg kigger på dit forslag nu :-)

Jeg har nu prøvet Stones løsning, og den retter heldigvis op på den lille skønhedsfejl :-)
Den kan dog ikke stå på ejne ben, så en kombination af jeres løsninger bliver den  endelige løsning :-)

Stone -> Det er ellers en simpel komponent, det eneste den gør er jo at tilføje lidt xml i programmets resourcer! Men det er åbenbart på den måde MS har valgt at gøre det.

Og nu er der også næsten fuld understøttelse af WindowsXP-themes. Det er en fed sidegevinst (selvom jeg normalt bruger Win2K-look, og ikke det der plastik) :-)

Dog mangler jeg fuld undestøttelse af Cleartype-visning (skrifttypeudjævning), men det spørgsmål hører vist hjemme i et nyt spørgsmål...

athlon-pascal:
Jo det virker i dialogboksene.

Det som er et lille minus er at det ikke virker i dbdatedit, her må man selv indsætte et billede, men så har man ikke mouseover effekt - som i dbcombobox.

stone

Stone -> Se http://www.ebruger.dk/img/dote/athlon-pascal_Dialogbokse.JPG . Den øverste er med Jens' komponent alene, den nederste er ned både din og Jens' komponenter.  Hvis jeg kun bruger din komponent, så er der ikke det der panel med genvejs-placeringer-halløj til venstre.
Det er derfor jeg fordelte pointene som jeg gjorde :-)

ok fair...

stone