4programmers.net 4p Forum Delphi i Pascal Wywołanie okna PrintDlgEx na 64bit Windows w lazarusie

Wywołanie okna PrintDlgEx na 64bit Windows w lazarusie

Wywołanie okna PrintDlgEx na 64bit Windows w lazarusie
srobert1000
srobert1000
  • Rejestracja: dni
  • Ostatnio: dni
0

Podany poniżej kod działa gdy program jest skompilowany pod windows 10 32bit, natomiast przy kompilacji pod 64bit zwraca komunikat E_INVALIDARG.

Kopiuj
unit Unit1;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, Forms, Controls, Graphics, Dialogs, StdCtrls, windows;

const
  PD_ALLPAGES = $00000000;
  PD_SELECTION = $00000001;
  PD_PAGENUMS = $00000002;
  PD_NOSELECTION = $00000004;
  PD_NOPAGENUMS = $00000008;
  PD_COLLATE = $00000010;
  PD_PRINTTOFILE = $00000020;
  PD_PRINTSETUP = $00000040;
  PD_NOWARNING = $00000080;
  PD_RETURNDC = $00000100;
  PD_RETURNIC = $00000200;
  PD_RETURNDEFAULT = $00000400;
  PD_SHOWHELP = $00000800;
  PD_ENABLEPRINTHOOK = $00001000;
  PD_ENABLESETUPHOOK = $00002000;
  PD_ENABLEPRINTTEMPLATE = $00004000;
  PD_ENABLESETUPTEMPLATE = $00008000;
  PD_ENABLEPRINTTEMPLATEHANDLE = $00010000;
  PD_ENABLESETUPTEMPLATEHANDLE = $00020000;
  PD_USEDEVMODECOPIES = $00040000;
  PD_USEDEVMODECOPIESANDCOLLATE = $00040000;
  PD_DISABLEPRINTTOFILE = $00080000;
  PD_HIDEPRINTTOFILE = $00100000;
  PD_NONETWORKBUTTON = $00200000;
  PD_CURRENTPAGE = $00400000;
  PD_NOCURRENTPAGE = $00800000;
  PD_EXCLUSIONFLAGS = $01000000;
  PD_USELARGETEMPLATE = $10000000;

  START_PAGE_GENERAL = $ffffffff;

  PD_RESULT_CANCEL = 0;
  PD_RESULT_PRINT = 1;
  PD_RESULT_APPLY = 2;


type
  tagPDEXW = packed record
    lStructSize : DWORD;
    hWndOwner : HWND;
    hDevMode : HGLOBAL;
    hDevNames : HGLOBAL;
    hDC : HDC;
    Flags : DWORD;
    Flags2 : DWORD;
    ExclusionFlags : DWORD;
    nPageRanges : DWORD;
    nMaxPageRanges : DWORD;
    lpPageRanges : Pointer;
    nMinPage : DWORD;
    nMaxPage : DWORD;
    nCopies : DWORD;
    hInstance : HWND;
    lpPrintTemplateName : PWideChar;
    lpCallback : Pointer;
    nPropertyPages : DWORD;
    lphPropertyPages : PtrUInt;
    nStartPage : DWORD;
    dwResultAction : DWORD;
  end;

  TPrintDlgEx = tagPDEXW;
  PPrintDlgEx = ^TPrintDlgEx;

  tagPRINTPAGERANGE = packed record
    nFromPage, nToPage : DWord;
  end;

  TPageRange = tagPRINTPAGERANGE;

type TPrintDlgExFunc = function (lppd : PPrintDlgEx): DWORD; stdcall;

type

  { TForm1 }

  TForm1 = class(TForm)
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
  private

  public

  end;

var
  Form1: TForm1;

implementation

{$R *.lfm}

{ TForm1 }

procedure TForm1.Button1Click(Sender: TObject);
var hComDlg32 : THandle;
    PrintDlgEx : TPrintDlgExFunc;
    PrintDlgExResult : integer;
    pdex : TPrintDlgEx;
    PageRangeArray : array[1..3] of TPageRange;
begin
  hComDlg32 := LoadLibrary('comdlg32.dll');
  if hComDlg32 <> 0 then
  begin
    Pointer(PrintDlgEx) := GetProcAddress(hComDlg32,'PrintDlgExW');
    if Assigned(PrintDlgEx) then
    begin
      ZeroMemory(@pdex, sizeof(pdex));
      pdex.lStructSize := sizeof(pdex);
      pdex.hWndOwner := Handle;
      pdex.Flags := PD_ALLPAGES  {or PD_NOSELECTION or PD_NOCURRENTPAGE};
      pdex.nPageRanges := 1;
      pdex.nMaxPageRanges := 3;
      PageRangeArray[1].nFromPage := 1;
      PageRangeArray[1].nToPage := 10;
      pdex.lpPageRanges := @PageRangeArray[1];
      pdex.nMinPage := 1;
      pdex.nMaxPage := 10;
      pdex.nCopies := 1;
      pdex.nStartPage := START_PAGE_GENERAL;

      PrintDlgExResult := PrintDlgEx(@pdex);
      case PrintDlgExResult of
        E_OUTOFMEMORY: showMessage('E_OUTOFMEMORY');
        E_INVALIDARG: showMessage('E_INVALIDARG');
        E_POINTER: showMessage('E_POINTER');
        E_HANDLE: showMessage('E_HANDLE');
        E_FAIL: showMessage('E_FAIL');
        S_OK: begin
                case pdex.dwResultAction of
                  PD_RESULT_CANCEL: ShowMessage('Cancel');
                  PD_RESULT_PRINT: ShowMessage('Print');
                  PD_RESULT_APPLY: ShowMessage('Applay');
                end;
              end;
      end;
    end;
    FreeLibrary(hComDlg32);
  end;
end;

end.

Jak zrobić aby ten kod działał nie tylko na win32, ale także na win64.

Udostępnij
Komentuj
kAzek
KA
  • Rejestracja: dni
  • Ostatnio: dni
  • Lokalizacja: Gorlice
3

Przede wszystkim wywalić packed z tagPDEXW = packed record i prawie już powinno działać (przynajmniej w Delphi)
Inne sugestie:

Kopiuj
  PPageRange = ^TPageRange; //<-- dodać
  
  tagPDEXW = record
    lStructSize : DWORD;
    hWndOwner : HWND;
    hDevMode : HGLOBAL;
    hDevNames : HGLOBAL;
    hDC : HDC;
    Flags : DWORD;
    Flags2 : DWORD;
    ExclusionFlags : DWORD;
    nPageRanges : DWORD;
    nMaxPageRanges : DWORD;
    lpPageRanges : Pointer; //<-- zmienić na PPageRange 
    nMinPage : DWORD;
    nMaxPage : DWORD;
    nCopies : DWORD;
    hInstance : HWND;
    lpPrintTemplateName : PWideChar;
    lpCallback : Pointer;
    nPropertyPages : DWORD;
    lphPropertyPages : PtrUInt; //<-- nie wiem to FP odpowiednik UIntPtr? Jeżeli tak to OK
    nStartPage : DWORD;
    dwResultAction : DWORD;
  end;

Druga potrzebna zmiana to typ zmiennej PrintDlgExResult : integer; zmienić na PrintDlgExResult : NativeInt; jeżeli w FP jest coś takiego, bo jak się okazało Integer to może być za mało w aplikacji 64bit (w Delphi rzucało wyjątkiem ERangeError ale tylko jak apka miała zwrócić błąd czyli w tym przypadku przed wywaleniem, tego packed).

Udostępnij
Komentuj
flowCRANE
flowCRANE
  • Rejestracja: dni
  • Ostatnio: dni
  • Lokalizacja: Tuchów
  • Postów: 12269
3

Spróbuj z taką deklaracją struktur:

Kopiuj
type
  tagPDEXW = record
    lStructSize:         DWORD;
    hWndOwner:           HWND;
    hDevMode:            HGLOBAL;
    hDevNames:           HGLOBAL;
    hDC:                 HDC;
    Flags:               DWORD;
    Flags2:              DWORD;
    ExclusionFlags:      DWORD;
    nPageRanges:         DWORD;
    nMaxPageRanges:      DWORD;
    lpPageRanges:        Pointer;
    nMinPage:            DWORD;
    nMaxPage:            DWORD;
    nCopies:             DWORD;
    hInstance:           HINST;
    lpPrintTemplateName: LPCWSTR;
    lpCallback:          Pointer;
    nPropertyPages:      DWORD;
    lphPropertyPages:    Pointer;
    nStartPage:          DWORD;
    dwResultAction:      DWORD;
  end;

type
  tagPRINTPAGERANGE = record
    nFromPage: DWORD;
    nToPage:   DWORD;
  end;

W razie dalszych problemów możesz wymusić wyrównanie pamięci struktur danych, tak aby było zgodne ze strukturami deklarowanymi w C (czyli tak jak to robi Win32 API). Do tego służy dyrektywa $PACKRECORDS oraz argument C:

Kopiuj
{$PACKRECORDS C}

Często można ją spotkać w nagłówkach automatycznie tłumaczonych z C na Free Pascala (jakimiś transpilerami).

Choć wątpię, aby pakowanie tych struktur miało jakiekolwiek znaczenie, skoro wszystkie ich pola są albo 32-bitowe, albo 64-bitowe. Żeby wyrównanie bajtowe było nieprawidłowe, musiałoby być zmienione w tym module na jakiekolwiek inne niż domyślne, przed deklaracjami tych struktur.

W razie gdybyś dla całego modułu potrzebował innego wyrównania niż domyślnego, ale dla struktur używanych w połączeniu z Win32 API chciał mieć to konkretne, możesz skorzystać z poniższej składni:

Kopiuj
// Zapamiętaj poprzednie wyrównanie i ustaw to dla struktur C.
{$PUSH PACKRECORDS}
{$PACKRECORDS C}

// Tu deklaracja struktur dla Win32 API.

// Przywróć poprzednie wyrównanie.
{$POP PACKRECORDS}

Jeśli masz problem z implementacją nagłówków, trzymaj się oryginalnych nazw oraz typów danych dedykowanych danemu API (tutaj: Win32 API). Po drugie, nigdy nie używaj pakowania struktur i macierzy, jeśli korzystasz z cudzego API, chyba że wyraźnie jest to napisane w dokumentacji. W przypadku Win32 API, zwykle nie używa się pakowanych struktur i macierzy, więc packed należy usunąć.

Przy okazji @kAzek wspomniał o kilku rzeczach wartych przyjrzenia się i skomentowania.

kAzek napisał(a):
Kopiuj
lpPageRanges : Pointer; //<-- zmienić na PPageRange

To nie jest zbyt istotne. Miałoby znaczenie, gdybyśmy potrzebowali konkretnego typu pointera na potrzeby jego dereferencji lub uniknięcia błędów kompilacji spowodowanych silnym typowaniem języka. A tak to typ wskaźnika jest obojętny, byle zgadzała się liczba jego poziomów (tutaj wymagany jest jednopoziomowy wskaźnik, więc typ Pointer jest prawidłowy).

Kopiuj
lphPropertyPages : PtrUInt; //<-- nie wiem to FP odpowiednik UIntPtr? Jeżeli tak to OK

To pole ma być jednopoziomowym wskaźnikiem, więc powinno być typu Pointer (w module Windows nie ma deklaracji typu LPPRINTPAGERANGE). Deklarowanie tego w formie liczby może się zemścić.

Udostępnij
Komentuj
srobert1000
srobert1000
  • Rejestracja: dni
  • Ostatnio: dni
0

Dzięki wszystkim za pomoc.

Mam jeszcze takie pytanie.

Kopiuj
const
  IID_IObjectWithSite = '{FC4801A3-2BA9-11CF-A229-00AA003D7352}';
  IID_IPrintDialogCallback = '{5852A2C3-6530-11D1-B6A3-0000F8757BF9}';

type
    IObjectWithSite = interface(IUnknown)
      [IID_IObjectWithSite]
      function SetSite(const pUnkSite: IUnknown): HResult; stdcall;
      function GetSite(const riid: TIID; out site: IUnknown): HResult; stdcall;
    end;

  type
    IPrintDialogCallback = interface(IUnknown)
      [IID_IPrintDialogCallback]
      function InitDone: HResult; stdcall;
      function SelectionChange: HResult; stdcall;
      function HandleMessage(hDlg: hWnd; uMsg: UINT; WParam: WParam; LParam:
        LParam; var pResult: lresult): HResult; stdcall;
    end;

  type
    TPrintDialogCallback = class(TInterfacedObject, IObjectWithSite, IPrintDialogCallback)
    private
      //FSite: IPrintDialogServices;
    public

      // IObjectWithSite
      function SetSite(const pUnkSite: IUnknown): HResult; stdcall;
      function GetSite(const riid: TIID; out site: IUnknown): HResult; stdcall;

      // IPrintDialogCallback
      function InitDone: HResult; stdcall;
      function SelectionChange: HResult; stdcall;
      function HandleMessage(hDlg: hWnd; uMsg: UINT; WParam: WParam; LParam:
        LParam; var pResult: lresult): HResult; stdcall;
    end;

implementation

{ TPrintDialogCallback }

{function TPrintDialogCallback.SetSite(const pUnkSite: IUnknown): HResult; stdcall;
begin
  Result := S_OK;
end;

function TPrintDialogCallback.GetSite(const riid: TIID; out site: IUnknown): HResult; stdcall;
begin
  Result := S_OK;
end;

function TPrintDialogCallback.HandleMessage(hDlg: hWnd; uMsg: UINT;
  WParam: WParam; LParam: LParam; var pResult: lresult): HResult; stdcall;
begin
  Result := S_FALSE;
end;

function TPrintDialogCallback.InitDone: HResult; stdcall;
begin
  Result := S_FALSE;
end;

function TPrintDialogCallback.SelectionChange: HResult; stdcall;
begin
  Result := S_FALSE;
end;

Jak prawidłowo zainicjować TPrintDialogCallback aby można było go przypisać do lpCallback.

Udostępnij
Komentuj
srobert1000
srobert1000
  • Rejestracja: dni
  • Ostatnio: dni
0

Mam jeszcze takie pytanie

Kopiuj
const
  IID_IObjectWithSite = '{FC4801A3-2BA9-11CF-A229-00AA003D7352}';
  IID_IPrintDialogCallback = '{5852A2C3-6530-11D1-B6A3-0000F8757BF9}';

type
    IObjectWithSite = interface(IUnknown)
      [IID_IObjectWithSite]
      function SetSite(const pUnkSite: IUnknown): HResult; stdcall;
      function GetSite(const riid: TIID; out site: IUnknown): HResult; stdcall;
    end;

  type
    IPrintDialogCallback = interface(IUnknown)
      [IID_IPrintDialogCallback]
      function InitDone: HResult; stdcall;
      function SelectionChange: HResult; stdcall;
      function HandleMessage(hDlg: hWnd; uMsg: UINT; WParam: WParam; LParam:
        LParam; var pResult: lresult): HResult; stdcall;
    end;

  type
    TPrintDialogCallback = class(TInterfacedObject, IObjectWithSite, IPrintDialogCallback)
    private
      //FSite: IPrintDialogServices;
    public

      // IObjectWithSite
      function SetSite(const pUnkSite: IUnknown): HResult; stdcall;
      function GetSite(const riid: TIID; out site: IUnknown): HResult; stdcall;

      // IPrintDialogCallback
      function InitDone: HResult; stdcall;
      function SelectionChange: HResult; stdcall;
      function HandleMessage(hDlg: hWnd; uMsg: UINT; WParam: WParam; LParam:
        LParam; var pResult: lresult): HResult; stdcall;
    end;

implementation

{ TPrintDialogCallback }

{function TPrintDialogCallback.SetSite(const pUnkSite: IUnknown): HResult; stdcall;
begin
  Result := S_OK;
end;

function TPrintDialogCallback.GetSite(const riid: TIID; out site: IUnknown): HResult; stdcall;
begin
  Result := S_OK;
end;

function TPrintDialogCallback.HandleMessage(hDlg: hWnd; uMsg: UINT;
  WParam: WParam; LParam: LParam; var pResult: lresult): HResult; stdcall;
begin
  Result := S_FALSE;
end;

function TPrintDialogCallback.InitDone: HResult; stdcall;
begin
  Result := S_FALSE;
end;

function TPrintDialogCallback.SelectionChange: HResult; stdcall;
begin
  Result := S_FALSE;
end;

Jak prawidłowo zainicjować TPrintDialogCallback aby można było go przypisać do lpCallback.

Udostępnij
Komentuj

Zarejestruj się i dołącz do największej społeczności programistów w Polsce.

Otrzymaj wsparcie, dziel się wiedzą i rozwijaj swoje umiejętności z najlepszymi.

Utwórz konto