awfaxcvt.pas

测试用例

(***** BEGIN LICENSE BLOCK *****
 * Version: MPL 1.1
 *
 * The contents of this file are subject to the Mozilla Public License Version
 * 1.1 (the "License"); you may not use this file except in compliance with
 * the License. You may obtain a copy of the License at
 * http://www.mozilla.org/MPL/
 *
 * Software distributed under the License is distributed on an "AS IS" basis,
 * WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License
 * for the specific language governing rights and limitations under the
 * License.
 *
 * The Original Code is TurboPower Async Professional
 *
 * The Initial Developer of the Original Code is
 * TurboPower Software
 *
 * Portions created by the Initial Developer are Copyright (C) 1991-2002
 * the Initial Developer. All Rights Reserved.
 *
 * Contributor(s):
 *
 * ***** END LICENSE BLOCK ***** *)

{*********************************************************}
{*                   AWFAXCVT.PAS 4.06                   *}
{*********************************************************}
{* Low-level fax conversion/unpacking utilities          *}
{*********************************************************}

{
  Used by the TApdFaxUnpacker and TApdFaxConverter (AdFaxCvt.pas), and
  by the printer drivers.
}

{Global defines potentially affecting this unit}
{$I AWDEFINE.INC}

{Options required for this unit}
{$V-,I-,B-,X+,G+,O-}

{$IFNDEF PrnDrv}
{$J+,H+}
{$ENDIF}

{$IFNDEF PRNDRV}
  {$DEFINE BindFaxFont}
{$ENDIF}

unit AwFaxCvt;
  {-Fax conversion}

interface

uses
  {-------RTL}
  {$IFNDEF Prndrv}
  Graphics,
  Classes,
  Controls,
  Forms,
  {$ENDIF}
  WinTypes,
  WinProcs,
  SysUtils,
  Messages,
  {-------APW}
  OoMisc;

{--Abstract converter functions--}

procedure acInitFaxConverter(var Cvt : PAbsFaxCvt; Data : Pointer;
                            CB : TGetLineCallback; OpenFile : TOpenFileCallback;
                            CloseFile : TCloseFileCallback; DefaultExt : PChar);
  {-Initialize a fax converter engine}

procedure acDoneFaxConverter(var Cvt : PAbsFaxCvt);
  {-Destroy a fax converter engine}

procedure acSetOtherData(Cvt : PAbsFaxCvt; OtherData : Pointer);
  {-Set other data pointer}

procedure acOptionsOn(Cvt : PAbsFaxCvt; OptionFlags : Word);
  {-Activate multiple fax converter options}

procedure acOptionsOff(Cvt : PAbsFaxCvt; OptionFlags : Word);
  {-Deactivate multiple options}

function acOptionsAreOn(Cvt : PAbsFaxCvt; OptionFlags : Word) : Bool;
  {-Return TRUE if all specified options are on}

procedure acSetMargins(Cvt : PAbsFaxCvt; Left, Top : Cardinal);
  {-Set left and top margins for converter}

procedure acSetResolutionMode(Cvt : PAbsFaxCvt; HiRes : Bool);
  {-Select standard or high resolution mode}

procedure acSetResolutionWidth(Cvt : PAbsFaxCvt; RW : Cardinal);
  {-Select standard (1728 pixels) or wide (2048 pixels) width}

procedure acSetStationID(Cvt : PAbsFaxCvt; ID : PChar);
  {-Set the station ID of the converter}

procedure acSetStatusCallback(Cvt : PAbsFaxCvt; CB : TCvtStatusCallback);
  {-Set the procedure called for conversion status}

procedure acSetStatusWnd(Cvt : PAbsFaxCvt; HWindow : TApdHwnd);
  {-Set the handle of the window that receives status messages}

function acOpenFile(Cvt : PAbsFaxCvt; FileName : PChar) : Integer;
  {-Open a converter input file}

procedure acCloseFile(Cvt : PAbsFaxCvt);
  {-Close a converter input file}

function acGetRasterLine(Cvt : PAbsFaxCvt; var Data; var Len : Integer;
                         var EndOfPage, MorePages : Bool) : Integer;
  {-Read a raster line from an input file}

function acCreateOutputFile(Cvt : PAbsFaxCvt) : Integer;
  {-Create an APF file}

function acCloseOutputFile(Cvt : PAbsFaxCvt) : Integer;
  {-Close an APF file}

procedure acInitDataLine(Cvt : PAbsFaxCvt);
  {-Initialize the converter's line buffer}

function acAddData(Cvt : PAbsFaxCvt; var Buffer; Len : Cardinal; DoInc : Bool) : Integer;
  {-Add a block of data to the output file}

function acAddLine(Cvt : PAbsFaxCvt; var Buffer; Len : Cardinal) : Integer;
  {-Add a line of image data to the file}

procedure acCompressRasterLine(Cvt : PAbsFaxCvt; var Buffer);
  {-compress a raster line of bits into runlength codes}

procedure acMakeEndOfPage(Cvt : PAbsFaxCvt; var Buffer; var Len : Integer);
  {-Encode end-of-page data into Buffer}

function acOutToFileCallback(Cvt : PAbsFaxCvt; var Data; Len : Integer;
                             EndOfPage, MorePages : Bool) : Integer;
  {-Output a compressed raster line to an APF file}

function acConvertToFile(Cvt : PAbsFaxCvt; FileName, DestFile : PChar) : Integer;
  {-Convert an image to a fax file}

function acConvert(Cvt : PAbsFaxCvt; FileName : PChar;
                   OutCallback : TPutLineCallback) : Integer;
  {-Convert an input file, sending data to OutHandle or to OutCallback}

{$IFNDEF PRNDRV}                                                 
{--Text converter functions--}

procedure fcInitTextConverter(var Cvt : PAbsFaxCvt);
  {-Initialize a text-to-fax converter}

procedure fcDoneTextConverter(var Cvt : PAbsFaxCvt);
  {-Destroy a text-to-fax converter}

procedure fcInitTextExConverter(var Cvt : PAbsFaxCvt);  
  {-Initialize an extended text-to-fax converter}

procedure fcDoneTextExConverter(var Cvt : PAbsFaxCvt); 
  {-Destroy an extended text-to-fax converter}

procedure fcSetTabStop(Cvt : PAbsFaxCvt; TabStop : Cardinal);
  {-Set the number of spaces equivalent to a tab character}

function fcLoadFont(Cvt : PAbsFaxCvt; FileName : PChar;
                    FontHandle : Cardinal; HiRes : Bool) : Integer;
  {-Load selected font from APFAX.FNT or memory}

function fcSetFont(Cvt : PAbsFaxCvt; Font : TFont; HiRes : Boolean) : Integer;  
  {-Set font for extended text converter}

procedure fcSetLinesPerPage(Cvt : PAbsFaxCvt; LineCount : Cardinal);
  {-Set the number of text lines per page}

function fcOpenFile(Cvt : PAbsFaxCvt; FileName : PChar) : Integer;
  {-Open a text file for input}

procedure fcCloseFile(Cvt : PAbsFaxCvt);
  {-Close text file}

procedure fcRasterizeText(Cvt : PAbsFaxCvt; St : PChar; Row : Cardinal; var Data);
  {-Turn a row in a string into a raster line}

function fcGetTextRasterLine( Cvt : PAbsFaxCvt; var Data; var Len : Integer;
                              var EndOfPage, MorePages : Bool) : Integer;
  {-Callback to convert one row of a string into a raster line}

{--TIFF converter functions--}

procedure tcInitTiffConverter(var Cvt : PAbsFaxCvt);
  {-Initialize a TIFF-to-fax converter}

procedure tcDoneTiffConverter(var Cvt : PAbsFaxCvt);
  {-Destroy a TIFF converter}

function tcOpenFile(Cvt : PAbsFaxCvt; FileName : PChar) : Integer;
  {-Open a TIFF file for input}

procedure tcCloseFile(Cvt : PAbsFaxCvt);
  {-Close TIFF file}

function tcGetTiffRasterLine( Cvt : PAbsFaxCvt; var Data; var Len : Integer;
                              var EndOfPage, MorePages : Bool) : Integer;
  {-Callback to read a row of TIFF raster data}

{--PCX converter functions--}

procedure pcInitPcxConverter(var Cvt : PAbsFaxCvt);
  {-Initialize a PCX-to-fax converter}

procedure pcDonePcxConverter(var Cvt : PAbsFaxCvt);
  {-Destroy a PCX-to-fax converter}

function pcOpenFile(Cvt : PAbsFaxCvt; FileName : PChar) : Integer;
  {-Open a PCX file for input}

procedure pcCloseFile(Cvt : PAbsFaxCvt);
  {-Close PCX file}

function pcGetPcxRasterLine(Cvt : PAbsFaxCvt; var Data; var Len : Integer;
                            var EndOfPage, MorePages : Bool) : Integer;
  {-Callback to read a row of PCX raster data}

{--DCX converter functions--}

procedure dcInitDcxConverter(var Cvt : PAbsFaxCvt);
  {-Initialize a DCX-to-fax converter}

procedure dcDoneDcxConverter(var Cvt : PAbsFaxCvt);
  {-Destroy a PCX-to-fax converter}

function dcOpenFile(Cvt : PAbsFaxCvt; FileName : PChar) : Integer;
  {-Open a DCX file for input}

procedure dcCloseFile(Cvt : PAbsFaxCvt);
  {-Close DCX file}

function dcGetDcxRasterLine(Cvt : PAbsFaxCvt; var Data; var Len : Integer;
                            var EndOfPage, MorePages : Bool) : Integer;
  {-Callback to read a row of DCX raster data}

{--BMP converter functions--}

procedure bcInitBmpConverter(var Cvt : PAbsFaxCvt);
  {-Initialize a BMP-to-fax converter}

procedure bcDoneBmpConverter(var Cvt : PabsFaxCvt);
  {-Destroy a BMP-to-fax converter}

function bcOpenFile(Cvt : PAbsFaxCvt; FileName : PChar) : Integer;
  {-Open a BMP file for input}

procedure bcCloseFile(Cvt : PAbsFaxCvt);
  {-Close BMP file}

function bcGetBmpRasterLine(Cvt : PAbsFaxCvt; var Data; var Len : Integer;
                            var EndOfPage, MorePages : Bool) : Integer;
  {-Callback to read a row of BMP raster data}

procedure bcInitBitmapConverter(var Cvt : PAbsFaxCvt);
  {-Initialize a bitmap-to-fax converter}

procedure bcDoneBitmapConverter(var Cvt : PAbsFaxCvt);
  {-Destroy a bitmap-to-fax converter}

function bcSetInputBitmap(var Cvt : PAbsFaxCvt; Bitmap : HBitmap) : Integer;
  {-Set bitmap that will be converted}

function bcOpenBitmap(Cvt : PAbsFaxCvt; FileName : PChar) : Integer;
  {-Open bitmap "file"}

procedure bcCloseBitmap(Cvt : PAbsFaxCvt);
  {-Close bitmap "file"}

function bcGetBitmapRasterLine(Cvt : PAbsFaxCvt; var Data; var Len : Integer;
                               var EndOfPage, MorePages : Bool) : Integer;
  {-Read a raster line from a bitmap}

{--Basic fax unpacker--}


function upInitFaxUnpacker( var Unpack : PUnpackFax; Data : Pointer;
                            CB : TUnpackLineCallback) : Integer;
  {-Initialize a fax unpacker}

procedure upDoneFaxUnpacker(var Unpack : PUnpackFax);
  {-Destroy a fax unpacker}

procedure upOptionsOn(Unpack : PUnpackFax; OptionFlags : Word);
  {-Turn on one or more unpacker options}

procedure upOptionsOff(Unpack : PUnpackFax; OptionFlags : Word);
  {-Turn off one or more unpacker options}

function upOptionsAreOn(Unpack : PUnpackFax; OptionFlags : Word) : Bool;
  {-Return True if all specified options are on}

procedure upSetStatusCallback(Unpack : PUnpackFax; Callback : TUnpackStatusCallback);
  {-Set up a routine to be called to report unpack status}

function upSetWhitespaceCompression(Unpack : PUnpackFax; FromLines, ToLines : Cardinal) : Integer;

  {-Set the whitespace compression option.}

procedure upSetScaling(Unpack : PUnpackFax; HMult, HDiv, VMult, VDiv : Cardinal);
  {-Set horizontal and vertical scaling factors}

function upGetFaxHeader(Unpack : PUnpackFax; FName : PChar; var FH : TFaxHeaderRec) : Integer;
  {-Return header for fax FName}

function upGetPageHeader(Unpack : PUnpackFax; FName : PChar; Page : Cardinal; var PH : TPageHeaderRec) : Integer;

  {-Return header for Page in fax FName}

function upUnpackPage(Unpack : PUnpackFax; FName : PChar; Page : Cardinal) : Integer;
  {-Unpack page number Page, calling the put line callback for each raster line}

function upUnpackFile(Unpack : PUnpackFax; FName : PChar) : Integer;
  {-Unpack all pages in a fax file}

function upUnpackPageToBitmap(Unpack : PUnpackFax; FName : PChar; Page : Cardinal;
                              var Bmp : TMemoryBitmapDesc; Invert : Bool) : Integer;

  {-Unpack a page of fax into a memory bitmap}

function upUnpackFileToBitmap(Unpack : PUnpackFax; FName : PChar; var Bmp : TMemoryBitmapDesc;
                              Invert : Bool) : Integer;

  {-Unpack a fax into a memory bitmap}

function upUnpackFileToBuffer(Unpack : PUnpackFax; FName : PChar) : Integer;

  {-Unpack a fax into a memory bitmap}

function upUnpackPageToBuffer(Unpack : PUnpackFax; FName : PChar; Page : Cardinal; UnpackingFile : Boolean) : Integer;

  {-Unpack a page of fax into a memory bitmap}

function upPutMemoryBitmapLine(Unpack : PUnpackFax; plFlags : Word; var Data; Len, PageNum : Cardinal) : Integer;

  {-Callback to output a raster line to an in-memory bitmap}

{--Output to image file routines--}

function upUnpackPageToPcx(Unpack : PUnpackFax; FName, OutName : PChar; Page : Cardinal) : Integer;

  {-Unpack one page of an APF file to a PCX file}

function upUnpackFileToPcx(Unpack : PUnpackFax; FName, OutName : PChar) : Integer;

  {-Unpack an APF file to a PCX file}

function upUnpackPageToDcx(Unpack : PUnpackFax; FName, OutName : PChar; Page : Cardinal) : Integer;

  {-Unpack one page of an APF file to a DCX file}

function upUnpackFileToDcx(Unpack : PUnpackFax; FName, OutName : PChar) : Integer;

  {-Unpack an APF file to a DCX file}

function upUnpackPageToTiff(Unpack : PUnpackFax; FName, OutName : PChar; Page : Cardinal) : Integer;

  {-Unpack one page of an APF file to a TIF file}

function upUnpackFileToTiff(Unpack : PUnpackFax; FName, OutName : PChar) : Integer;

  {-Unpack an APF file to a TIF file}

function upUnpackPageToBmp(Unpack : PUnpackFax; FName, OutName : PChar; Page : Cardinal) : Integer;

  {-Unpack one page of an APF file to a BMP file}

function upUnpackFileToBmp(Unpack : PUnpackFax; FName, OutName : PChar) : Integer;

  {-Unpack an APF file to a BMP file}

{--misc--}
function awIsAnAPFFile(FName : PChar) : Bool;
  {-Return TRUE if the file FName is a valid APF file}

{$ENDIF}

implementation


{$IFDEF BindFaxFont}
{$IFDEF Win32}
{$R AWFAXCVT.R32}
{$ELSE}
{$R AWFAXCVT.R16}
{$ENDIF}
{$ENDIF}

const
  {General}
  DefUpdateInterval          = 16;          {Lines per status call}
  DefFontFile                = 'APFAX.FNT'; {Default font file name}
  FaxFileExt                 = 'APF';       {Fax file extension}
  DefLeftMargin              = 50;          {Default left margin of 1/4 inch}
  DefTopMargin               = 0;           {Default top margin of zero}
  DefFaxTabStop              = 4;           {Default tab stops}

  {Default fax conversion options}
  DefFaxCvtOptions = fcYield + fcDoubleWidth + fcCenterImage;

  {No bad options}
  BadFaxCvtOptions = 0;

  ReadBufferSize = 8192;        {Max size of file read buffer}
  LinePadSize    = 2;           {Assure this many nulls per line}
  MaxFontBytes   = 24576;       {Maximum bytes for a font}
  LineBufSize    = 512;         {Size of unpacker's line buffer}

  {End of line bit codes for fax images}
  EOLRec     : TCodeRec = (Code : $0001; Sig : 12);
  LongEOLRec : TCodeRec = (Code : $0001; Sig : 16);

  {$IFDEF BindFaxFont}
  {font resource data}
  AwFontResourceType = 'AWFAXFONT';
  AwFontResourceName = 'FAXFONT';
  {$ENDIF}

  {TIFF tag values}
  SubfileType         = 255;
  ImageWidth          = 256;
  ImageLength         = 257;
  BitsPerSample       = 258;
  Compression         = 259;
  PhotometricInterp   = 262;
  StripOffsets        = 273;
  RowsPerStrip        = 278;
  StripByteCounts     = 279;

  {TIFF tag integer types}
  tiffByte            = 1;
  tiffASCII           = 2;
  tiffShort           = 3;
  tiffLong            = 4;
  tiffRational        = 5;

  {TIFF compression values}
  compNone = $0001;
  compHuff = $0002;
  compFAX3 = $0003;
  compFAX4 = $0004;
  compWRDL = $8003;
  compMPNT = $8005;

  {For decoding white runs}
  WhiteTable : TTermCodeArray = (
    (Code : $0035; Sig : 8),
    (Code : $0007; Sig : 6),
    (Code : $0007; Sig : 4),
    (Code : $0008; Sig : 4),
    (Code : $000B; Sig : 4),
    (Code : $000C; Sig : 4),
    (Code : $000E; Sig : 4),
    (Code : $000F; Sig : 4),
    (Code : $0013; Sig : 5),
    (Code : $0014; Sig : 5),
    (Code : $0007; Sig : 5),
    (Code : $0008; Sig : 5),
    (Code : $0008; Sig : 6),
    (Code : $0003; Sig : 6),
    (Code : $0034; Sig : 6),