⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 apfpdeng.pas

📁 Async Professional 4.07
💻 PAS
📖 第 1 页 / 共 4 页
字号:
                     lpClip : PRect) : Integer; export; {index 28}
function  ExtDeviceMode(hwnd : HWND; hInst : THandle; lpdmOut : PDevMode;
                        lpDevName : PStr; lpPort : PStr; lpdmIn : PDevMode;
                        lpProfile : PStr; wMode : Word) : Integer;
                        export; {index 90}
function  DeviceCapabilities(lpDevName : PStr; lpPort : PStr; wIndex : Word;
                             lpOutput : PStr; lpdm : PDevMode) : DWord;
                             export; {index 91}
function  AdvancedSetupDialog(hwnd : HWND; hInstMiniDrv : THandle;
                              lpdmIn : PDevMode; lpdmOut : PDevMode) : Longint;
                              export; {index 93}
function  DevInstall(hwnd : HWND; lpDevName : PStr; lpOldPort : PStr;
                     lpNewPort : PStr) : Integer; export; {index 94}
function  ExtDeviceModePropSheet(hwnd : HWND; hInst : THandle;
                                 lpDevName : PStr; lpPort : PStr;
                                 dwReserved : DWord;
                                 lpfnAdd : TFnAddPropSheetPage;
                                 lParam : Longint) : Integer;
                                 export; {index 95}
function  fnDump(lpdv : PDev; lpptCursor : PPoint;
                 fMode : WORD) : Integer; export; {index 100}

{-------------------------------------------------------}

implementation

uses
  AwFaxCvt;

{$R ApfPDEng.Res}   { Printer driver engine resources }

const
  { GDI escapes not defined in WinTypes.Pas }
  SetPrinterDC  = 9;
  ResetDevice   = 128;

type
  OS =
    record
      O, S : Word;    { for Seg/Ofs typecasting }
    end;

{$I PDDEBUG.INC}      {include printer driver diagnostics if enabled} 

{----------------------------------}
{ implicit imports from UniDrv.DLL }
{----------------------------------}

function  UniBitBlt(lpdv : PDev; sDestXOrg, sDestYOrg : Integer;
                    lpSrcDev : PBitmap; sSrcXOrg, sSrcYOrg : Integer;
                    sXExt, sYExt : Word; lRop3 : Longint;
                    lpPBrush : PPBrush; DrawMode : PDrawMode) : WordBool; far;
                    external 'UNIDRV' index 1;
function  UniColorInfo(lpdv : PDev; dwColorIn : DWord;
                       lpPColor : PDWord) : DWord; far;
                       external 'UNIDRV' index 2;
function  UniControl(lpdv : PDev; func : Word;
                     lpInData, lpOutData : pointer) : Integer; far;
                     external 'UNIDRV' index 3;
procedure UniDisable(lpdv : PDev); far;
                    external 'UNIDRV' index 4;
function  UniEnable(lpdv : PDev; wStyle : Word; lpDestDevType : PStr;
                    lpOutputFile : PStr; lpData : PDevMode;
                    lpCd : PCustomData) : Integer; far;
                    external 'UNIDRV' index 5;
function  UniEnumDFonts(lpdv : PDev; lpFaceName : PStr;
                        lpfnCallback : TFnEnumDFonts;
                        lpClientData : Pointer) : Integer; far;
                        external 'UNIDRV' index 6;
function  UniEnumObj(lpdv : PDev; wStyle : Word;
                     lpfnCallback : TFarProc;
                     lpClientData : Pointer) : Integer; far;
                     external 'UNIDRV' index 7;
function  UniOutput(lpdv : PDev; wStyle : Word; wCount : Word;
                    lppoints : PPoint; lpPPen : PPPen;
                    lpPBrush : PPBrush; lpDrawMode : PDrawMode;
                    lpClipRect : PRect) : Integer; far;
                    external 'UNIDRV' index 8;
function  UniPixel(lpdv : PDev; wX, wY : Integer; dwPhysColor : DWord;
                   lpDrawMode : PDrawMode) : Integer; far;
                   external 'UNIDRV' index 9;
function  UniRealizeObject(lpdv : PDev;  iStyle : Integer;
                           lpInObj : PStr; lpOutObj : PStr;
                           lpTextXForm : PTextXForm) : Integer; far;
                           external 'UNIDRV' index 10;
function  UniDeviceMode(hWnd : HWND; hInstance : THandle;
                        lpDestDevType : PStr;
                        lpOutputFile : PStr) : Integer; far;
                        external 'UNIDRV' index 13;
function  UniExtTextOut(lpdv : PDev; wDestXOrg, wDestYOrg : Integer;
                        lpClipRect : PRect; lpString : PStr;
                        nCount : Integer; lpFontInfo : PFontInfo;
                        lpDrawMode : PDrawMode; lpTextXForm : PTextXForm;
                        lpCharWidths : PInteger; lpOpaqueRect : PRect;
                        wOptions : Word) : DWord; far;
                        external 'UNIDRV' index 14;
function  UniGetCharWidth(lpdv : PDev; lpBuffer : PInteger;
                          wFirstChar : Word; wLastChar : Word;
                          lpFontInfo : PFontInfo; lpDrawMode : PDrawMode;
                          lpFontTrans : PTextXForm) : Integer; far;
                          external 'UNIDRV' index 15;
function  UniDIBBlt(lpbmp : PBitmap; style : Word; iStart : Word;
                    sScans : Word; lpDIBits : PStr; lpBMI : PBitmapInfo;
                    lpDrawMode : PDrawMode; lpConvInfo : PStr) : Integer; far;
                    external 'UNIDRV' index 19;
function  UniSetDIBitsToDevice(lpdv : PDev; wDestXOrg, wDestYOrg : Word;
                               StartScan : Word; NumScans : Word;
                               lpCR : PRect; lpDrawMode : PDrawMode;
                               lpDIBits : PStr; lpDIBHdr : PBitmapInfoHeader;
                               lpConvInfo : PStr) : Integer; far;
                               external 'UNIDRV' index 21;
function  UniStretchDIB(lpdv : PDev; wMode : Word; DstX, DstY : Integer;
                        DstXE, DstYE : Integer; SrcX, SrcY : Integer;
                        SrcXE, SrcYE : Integer; lpBits : PStr;
                        lpDIBHdr : PBitmapInfoHeader; lpConvInfo : PStr;
                        dwRop : DWord; lpbr : PPBrush; lpdm : PDrawMode;
                        lpClip : PRect) : Integer; far;
                        external 'UNIDRV' index 28;
function  UniDeviceSelectBitmap(lpdv : PDev; lpPrevBmp : PBitmap;
                                lpBmp : PBitmap; dwFlags : DWord) : WordBool; far;
                                external 'UNIDRV' index 29;
function  UniBitmapBits(lpdv : PDev; fFlags : DWord; dwCount : DWord;
                        lpBits : PStr) : WordBool; far;
                        external 'UNIDRV' index 30;
function  UniExtDeviceMode(hwnd : HWND; hInst : THandle; lpdmOut : PDevMode;
                           lpDevName : PStr; lpPort : PStr; lpdmIn : PDevMode;
                           lpProfile : PStr; wMode : Word) : Integer; far;
                           external 'UNIDRV' index 90;
function  UniDeviceCapabilities(lpDevName : PStr; lpPort : PStr;
                                wIndex : Word; lpOutput : PStr; lpdm : PDevMode;
                                hInstMiniDrv : THandle) : DWord; far;
                                external 'UNIDRV' index 91;
function  UniAdvancedSetupDialog(hwnd : HWND; hInstMiniDrv : THandle;
                                 lpdmIn, lpdmOut : PDevMode) : Longint; far;
                                 external 'UNIDRV' index 93;
function  UniDevInstall(hwnd : HWND; lpDevName : PStr; lpOldPort : PStr;
                        lpNewPort : PStr) : Integer; far;
                        external 'UNIDRV' index 94;
function  UniExtDeviceModePropSheet(hWnd : HWND; hInst : THandle;
                                    lpDevName : PStr; lpPort : PStr;
                                    dwReserved : DWord;
                                    lpfnAdd : TFnAddPropSheetPage;
                                    lParam : Longint) : Integer; far;
                                    external 'UNIDRV' index 95;


{-------------------------------------------------------------------}
{ the following are declarations for procedures defined later       }
{-------------------------------------------------------------------}

procedure ProcessLandscapeRasterLines (lpdv : PDev);  forward;
function  CreateNewNode  (lpdv : PDev) : pointer;     forward;
procedure FreeScanNodes  (lpdv : PDev);               forward; 

{-------------------------------------------------------------------}
{ the following are the core routines in the apf fax printer driver }
{-------------------------------------------------------------------}

function Control(lpdv : PDev; func : Word;
                 lpInData, lpOutData : Pointer) : Integer;
var
  lpXPDV        : PDevExt;
  Success       : Boolean;
  sRet          : Integer;
  i             : Integer;
  di            : TDocInfo;
  SaveDataLine  : PByteArray;
  SaveTempBuf   : PByteArray;                                    

begin
  { get pointer to our private data from MiniDrv data area in PDEVICE struct }
  lpXPDV := lpdv^.lpMD;

  {$IFDEF LogControls}
  LogControl(lpdv, func, lpInData, lpOutData);
  {$ENDIF}

  case func of
    SETPRINTERDC :
      begin
        { save app's DC for QueryAbort() calls }
        if (lpXPDV <> nil) then
          lpXPDV^.hAppDC := THandle(lpInData^);
      end;

    WinTypes.STARTDOC :
      begin
        with lpXPDV^ do begin
          { see if the TApdFaxConverter is doing an idShell conversion }
          apfConverter^.StatusWnd := GetPrivateProfileInt(ApdIniSection, {!!.01}
            'ShellHandle', -1, ApdIniFileName);                          {!!.01}
          if apfConverter^.StatusWnd <> -1 then                          {!!.01}
            PostMessage(apfConverter^.StatusWnd, apw_BeginDoc, 0, 0);    {!!.01}
          if (@StartJobCallback = nil) or
            not StartJobCallback(UserInstanceData,
                                 lpInData,
                                 apfConverter^.OutFilename) then begin
            Control := SP_ERROR;
            exit;
          end;

          { open the output file }
          cvtLastError := acCreateOutputFile(apfConverter);
          if cvtLastError <> ecOk then begin
            Control := SP_ERROR;
            exit;
          end;
          inc(apfConverter^.CurrPage);

          { pass nil file to OpenJob }
          di.cbSize := sizeof(TDocInfo);
          di.lpszDocName := nil;
          di.lpszOutput := 'nul';

          { call UniDrv.DLL's Control() passing DocInfo as lpOutData }
          sRet := UniControl(lpdv, func, lpInData, @di);

          Control := sRet;
          exit;
        end;
      end;

    RESETDEVICE :
      begin
        if (lpInData = nil) then
          exit;

        { copy data from old lpdv to new }
        with PDev(lpInData)^.lpMD^ do begin
          { we don't want to use the "Move" command to copy the entire
            structure since a new converter was allocated in the Enable
            before the ResetDevice call. }
          lpXPDV^.cvtLastError        := cvtLastError;
          lpXPDV^.cvtEndPageWritten   := cvtEndPageWritten;
          lpXPDV^.cvtSomeDataWritten  := cvtSomeDataWritten;
          lpXPDV^.hAppDC              := hAppDC;
          lpXPDV^.UserInstanceData    := UserInstanceData;
          SaveDataLine                := lpXPDV^.apfConverter^.DataLine;
          SaveTempBuf                 := lpXPDV^.apfConverter^.TmpBuffer;
          Move(apfConverter^, lpXPDV^.apfConverter^, sizeof(apfConverter^));
          lpXPDV^.apfConverter^.DataLine  := SaveDataLine;
          lpXPDV^.apfConverter^.TmpBuffer := SaveTempBuf;
        end;
      end;

    NEXTBAND :
      begin
        { protect against getting end-page band after an AbortDoc }
        if not assigned(lpXPDV^.UserInstanceData) then
          { we're done as far as we are concerned }
          exit;
        {
          Call UniDrv.DLL's NextBand function.  It will either call our
          fnDump callback to process the data in the band or it will
          return an empty rectangle to us to indicate an empty band (end
          of page).
        }
        sRet := UniControl(lpdv, func, lpInData, lpOutData);

        if lpXPDV^.cvtEndPageWritten then
          lpXPDV^.cvtEndPageWritten := False;

        { check for end of page or error }
        if sRet <= 0 then begin
          { problem converting the file.  force an AbortDoc }
          lpXPDV^.cvtLastError := ecFaxGDIPrintError;
          i := Control(lpdv, WinTypes.ABORTDOC, nil, nil);
        end else if IsRectEmpty(PRect(lpOutData)^) then begin
          { end of page indicated }
          with lpXPDV^ do begin
            if apfConverter^.StatusWnd <> -1 then                        {!!.01}
              PostMessage(apfConverter^.StatusWnd, apw_EndPage, 0, 0);   {!!.01}
          end;
          with lpXPDV^, apfConverter^ do begin
            if IsLandscape then
              { rotate data and send to converter }
              ProcessLandscapeRasterLines(lpdv);                  

            { write end of page (both portrait and landscape) }
            cvtLastError := acOutToFileCallback(apfConverter, DataLine^, 0,
                                                True, True);
            cvtEndPageWritten := True;
            inc(apfConverter^.CurrPage);
          end;
        end;

        Control := sRet;
        exit;
      end;

    WinTypes.ENDDOC,
    WinTypes.ABORTDOC :
      begin
        if lpXPDV^.UserInstanceData = nil then
          { we're done as far as we are concerned }
        exit;

        with lpXPDV^ do begin
          Success := (cvtLastError = ecOk) and (func = WinTypes.ENDDOC);

          if (apfConverter <> nil) then begin
            if Success then begin
              if (not cvtEndPageWritten) and (cvtSomeDataWritten) then begin
                if IsLandscape then
                  {rotate data and send to converter}
                  ProcessLandscapeRasterLines(lpdv);

                with apfConverter^ do
                  {Tell converter it's the end of document}
                  cvtLastError := acOutToFileCallback(apfConverter,
                                                      DataLine^, 0,
                                                      True, False);
                cvtEndPageWritten := True;
              end;
            end else if IsLandscape then
              {didn't succeed -- need to free image in memory}
              FreeScanNodes(lpdv);

            cvtLastError := acCloseOutputFile(apfConverter);
          end;

          try
           if (@EndJobCallback <> nil) then
             if not EndJobCallback(UserInstanceData, Success) then begin
               Control := SP_ERROR;
               exit;
             end;
          finally
            if apfConverter^.StatusWnd <> -1 then                        {!!.01}
              PostMessage(apfConverter^.StatusWnd, apw_EndDoc, 0, 0);    {!!.01}
          end;
        end;
      end;
  end;

  { call UniDrv's Control }
  Control := UniControl(lpdv, func, lpInData, lpOutData);
end;

procedure Disable(lpdv : PDev);
var
  lpXPDV : PDevExt;

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -