adfaxcvt.pas

Async Professional 4.04

{*********************************************************}
{*                   ADFAXCVT.PAS 4.04                   *}
{*      Copyright (C) TurboPower Software 1996-2002      *}
{*                 All rights reserved.                  *}
{*********************************************************}    

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

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

unit AdFaxCvt;
  {-Delphi fax converter components}

interface

uses
  WinTypes,
  WinProcs,
  Dialogs,
  SysUtils,
  Classes,
  Graphics,
  Printers,
  Messages,
  ShellAPI,
  Forms,
  Registry,
  IniFiles,
  OoMisc,
  AwFaxCvt,
  AdExcept;

resourcestring
  ApdEcStrNoClipboard = 'Clipboard format not supported';
  ApdEcStrBadFaxFmt   = 'Bad fax format';
  ApdEcStrInvalidPage = 'Invalid page';

type
  TFaxInputDocumentType = (idNone, idText, idTextEx, idTiff, idPcx,
                           idDcx, idBmp, idBitmap, idUser, idShell);

  TFaxCvtOptions    = ( coDoubleWidth, coHalfHeight, coCenterImage,
                        coYield, coYieldOften);
  TFaxCvtOptionsSet = Set of TFaxCvtOptions;

  TFaxResolution = (frNormal, frHigh);
  TFaxWidth      = (fwNormal, fwWide);

  TFaxFont = (ffStandard, ffSmall);

  TFaxStatusEvent = procedure (F : TObject; Starting, Ending : Boolean;
                              PagesConverted, LinesConverted : Integer;
                              BytesConverted, BytesToConvert : LongInt;
                              var Abort : Boolean) of object;

  TFaxOutputLineEvent = procedure(F : TObject; Data : PByteArray; Len : Integer;
                                  EndOfPage, MorePages : Boolean) of object;

  TFaxOpenFileEvent  = procedure(F : TObject; FName : String) of object;
  TFaxCloseFileEvent = procedure(F : TObject) of object;
  TFaxReadLineEvent  = procedure(F : TObject; Data : PByteArray; var Len : Integer;
                                 var EndOfPage, MorePages : Boolean) of object;

const
  afcDefInputDocumentType = idNone;
  afcDefFaxCvtOptions     = [coDoubleWidth, coCenterImage, coYield];
  afcDefResolution        = frNormal;
  afcDefFaxCvtWidth       = fwNormal;
  afcDefTopMargin         = 0;
  afcDefLeftMargin        = 50;
  afcDefLinesPerPage      = 60;
  afcDefFaxTabStop        = 4;
  afcDefFontFile          = 'APFAX.FNT';
  afcDefFontType          = ffStandard;

  { 1 minute per page timeout for shell convert }
  afcDefPrintTimeout      : Integer = 60 * 18;

type
  {component for converting data to APF format}
  TApdCustomFaxConverter = class(TApdBaseComponent)
  protected
    {.Z+}
    FInputDocumentType : TFaxInputDocumentType;
    FOptions           : TFaxCvtOptionsSet;
    FResolution        : TFaxResolution;
    FWidth             : TFaxWidth;
    FTopMargin         : Cardinal;
    FLeftMargin        : Cardinal;
    FLinesPerPage      : Cardinal;
    FTabStop           : Cardinal;
    FEnhFont           : TFont;
    FFontType          : TFaxFont;
    FFontFile          : String;
    FDocumentFile      : String;
    FOutFileName       : String;
    FDefUserExtension  : String;
    FStationID         : String;
    FStatus            : TFaxStatusEvent;
    FOutputLine        : TFaxOutputLineEvent;
    FOpenUserFile      : TFaxOpenFileEvent;
    FCloseUserFile     : TFaxCloseFileEvent;
    FReadUserLine      : TFaxReadLineEvent;
    LastDocType        : TFaxInputDocumentType;
    Data               : PAbsFaxCvt;
    FileOpen           : Boolean;
    PrnCallbackHandle  : HWND;
    FWaitingForShell   : Boolean;
    FResetShellTimer   : Boolean;                                        {!!.01}
    FShellPageCount    : Integer;                                        {!!.01}
    FPadPage           : Boolean;                                        {!!.04}

    procedure CreateData;
      {-Create PAbsFaxCvt record for API layer}
    procedure DestroyData;
      {-Destroy PAbsFaxCvt record for API layer}
    procedure SetCvtOptions(const NewOpts : TFaxCvtOptionsSet);
      {-Set fax converter options}
    procedure SetDocumentFile(const NewFile : String);
      {-Set document file name}
    procedure SetEnhFont(Value: TFont);
      {-Set font for use with the extended text converter}
    procedure ConvertToResolution(const FileName : string;
      NewRes : TFaxResolution);
      {-Converts the FileName to a new resolution, used by the public methods}
    procedure ChangeDefPrinter(UseFax : Boolean);
      {-Change the Default Printer}
    procedure ConvertShell(const FileName : string);
      {-Convert the Shell to APF by sending to Fax Printer using printto or}
      {print changes default printer (ChangeDefPrinter) to send to Fax printer}
    procedure PrnCallback(var Msg: TMessage);
      {-Message handler for printer driver messages}
    procedure SetPadPage(const Value: Boolean);                          {!!.04}
      {-Sets the PadPage flag to pad a text conversion to full-page length}
    {.Z-}

  public
    constructor Create(Owner : TComponent); override;
    destructor Destroy; override;

    {conversion parameters}
    property InputDocumentType : TFaxInputDocumentType
      read FInputDocumentType write FInputDocumentType default afcDefInputDocumentType;
    property Options : TFaxCvtOptionsSet
      read FOptions write SetCvtOptions default afcDefFaxCvtOptions;
    property Resolution : TFaxResolution
      read FResolution write FResolution default afcDefResolution;
    property Width : TFaxWidth
      read FWidth write FWidth default afcDefFaxCvtWidth;
    property TopMargin : Cardinal
      read FTopMargin write FTopMargin default afcDefTopMargin;
    property LeftMargin : Cardinal
      read FLeftMargin write FLeftMargin default afcDefLeftMargin;
    property LinesPerPage : Cardinal
      read FLinesPerPage write FLinesPerPage default afcDefLinesPerPage;
    property TabStop : Cardinal
      read FTabStop write FTabStop default afcDefFaxTabStop;
    property FontFile : String
      read FFontFile write FFontFile;
    property FontType : TFaxFont
      read FFontType write FFontType;
    property EnhFont : TFont
      read FEnhFont write SetEnhFont;
    property DocumentFile : String
      read FDocumentFile write SetDocumentFile;
    property OutFileName : String
      read FOutFileName write FOutFileName;
    property DefUserExtension : String
      read FDefUserExtension write FDefUserExtension;
    property StationID : String
      read FStationID write FStationID;
    property PadPage : Boolean                                           {!!.04}
      read FPadPage write SetPadPage;                                    {!!.04}

    {events}
    property OnStatus : TFaxStatusEvent
      read FStatus write FStatus;
    property OnOutputLine : TFaxOutputLineEvent
      read FOutputLine write FOutputLine;
    property OnOpenUserFile : TFaxOpenFileEvent
      read FOpenUserFile write FOpenUserFile;
    property OnCloseUserFile : TFaxCloseFileEvent
      read FCloseUserFile write FCloseUserFile;
    property OnReadUserLine : TFaxReadLineEvent
      read FReadUserLine write FReadUserLine;

    {methods}
    procedure ConvertToFile;
      {-Convert the input file into an APF file}
    procedure Convert;
      {-Convert the input file, calling user event for output}
    procedure ConvertBitmapToFile(const Bmp : TBitmap);
      {-Convert a memory bitmap to a file - re-implemented}

    procedure ConvertToHighRes(const FileName : string);
      {-Convert the fax file to high-resolution}
    procedure ConvertToLowRes(const FileName : string);
      {-Convert the fax file to low-resolution}
    procedure OpenFile;
      {-Open the input file}
    procedure CloseFile;
      {-Close the input file}
    procedure GetRasterLine(var Buffer; var BufLen : Integer; var EndOfPage, MorePages : Boolean);
      {-Read a raster line from the input file}
    procedure CompressRasterLine(var Buffer, OutputData; var OutLen : Integer);
      {-Compress a line of raster data into a fax line}
    procedure MakeEndOfPage(var Buffer; var BufLen : Integer);
      {-Put an end of page code into buffer}

    {.Z+}
    {to be overriden}
    procedure Status(const Starting, Ending : Boolean;
                     const PagesConverted, LinesConverted : Integer;
                     const BytesToRead, BytesRead : LongInt;
                     var Abort : Boolean); virtual;
      {-Display conversion status}
    procedure OutputLine(var Data; Len : Integer; EndOfPage, MorePages : Boolean); virtual;
      {-Output a compressed data line}
    procedure OpenUserFile(const FName : String); virtual;
      {-For opening documents of type idUser}
    procedure CloseUserFile; virtual;
      {-For closing documents of type idUser}
    procedure ReadUserLine(var Data; var Len : Integer; var EndOfPage, MorePages : Boolean);
      {-For reading raster lines from documents of type idUser}
    {.Z-}
  end;

  TApdFaxConverter = class(TApdCustomFaxConverter)
  published
    property InputDocumentType;
    property Options;
    property Resolution;
    property Width;
    property TopMargin;
    property LeftMargin;
    property LinesPerPage;
    property TabStop;
    property EnhFont;
    property FontFile;
    property FontType;
    property DocumentFile;
    property OutFileName;
    property DefUserExtension;
    property OnStatus;
    property OnOutputLine;
    property OnOpenUserFile;
    property OnCloseUserFile;
    property OnReadUserLine;
  end;

  TUnpackerOptions    = (uoYield, uoAbort);
  TUnpackerOptionsSet = Set of TUnpackerOptions;

  TAutoScaleMode = (asNone, asDoubleHeight, asHalfWidth);

const
  {defaults for unpacker properties}
  afcDefFaxUnpackOptions      = [uoYield];
  afcDefWhitespaceCompression = False;
  afcDefWhitespaceFrom        = 0;
  afcDefWhitespaceTo          = 0;
  afcDefScaling               = False;
  afcDefHorizMult             = 1;
  afcDefHorizDiv              = 1;
  afcDefVertMult              = 1;
  afcDefVertDiv               = 1;
  afcDefAutoScaleMode         = asDoubleHeight;

type
  TUnpackOutputLineEvent = procedure( Sender : TObject; Starting, Ending : Boolean;
                                      Data : PByteArray; Len, PageNum : Integer) of object;
  TUnpackStatusEvent = procedure( Sender : TObject; FName : String; PageNum : Integer;
                                  BytesUnpacked, BytesToUnpack : LongInt) of object;

  {component for unpacking APF files into raster lines}
  TApdCustomFaxUnpacker = class(TApdBaseComponent)
  protected
    {.Z+}
    FOptions               : TUnpackerOptionsSet;
    FWhitespaceCompression : Boolean;
    FWhitespaceFrom        : Cardinal;
    FWhitespaceTo          : Cardinal;
    FScaling               : Boolean;
    FHorizMult             : Cardinal;
    FHorizDiv              : Cardinal;
    FVertMult              : Cardinal;
    FVertDiv               : Cardinal;
    FAutoScaleMode         : TAutoScaleMode;
    FInFileName            : String;
    FOutFileName           : String;
    FOutputLine            : TUnpackOutputLineEvent;
    FStatus                : TUnpackStatusEvent;
    Data                   : PUnpackFax;
    InFileZ                : array[0..255] of Char;
    OutFileZ               : array[0..255] of Char;

    procedure CreateData;
      {-Create PUnpackFax record for API layer}
    procedure DestroyData;
      {-Destroy PUnpackFax record for API layer}
    procedure OutputLine( const Starting, Ending : Boolean;
                          const Data : PByteArray; const Len, PageNum : Cardinal); virtual;
    procedure Status( const FName : String; const PageNum : Cardinal;
                      const BytesUnpacked, BytesToUnpack : LongInt); virtual;

    {property get/set methods}
    procedure SetHorizMult(const NewHorizMult : Cardinal);
    procedure SetHorizDiv(const NewHorizDiv : Cardinal);
    procedure SetVertMult(const NewVertMult : Cardinal);
    procedure SetVertDiv(const NewVertDiv : Cardinal);
    function GetNumPages : Cardinal;
    function GetFaxResolution : TFaxResolution;
    function GetFaxWidth : TFaxWidth;
    procedure SetInFileName(const NewName : String);
    procedure SetUnpackerOptions(const NewUnpackerOptions: TUnpackerOptionsSet);

    {utility methods}
    function InFNameZ : PChar;
    function OutFNameZ : PChar;
    {.Z-}

  public
    constructor Create(AOwner : TComponent); override;
    destructor Destroy; override;

    procedure UnpackPage(const Page : Cardinal);
      {-Unpack page number Page}
    procedure UnpackFile;
      {-Unpack all pages in a fax file}
    function UnpackPageToBitmap(const Page : Cardinal) : TBitmap;
      {-Unpack a page of fax into a memory bitmap}
    function UnpackFileToBitmap : TBitmap;
      {-Unpack a fax into a memory bitmap}
    procedure UnpackPageToPcx(const Page : Cardinal);
      {-Unpack a page of a fax into a PCX file}
    procedure UnpackFileToPcx;
      {-Unpack a file to a PCX file}
    procedure UnpackPageToDcx(const Page : Cardinal);
      {-Unpack a page of a fax into a DCX file}
    procedure UnpackFileToDcx;
      {-Unpack a file to a DCX file}
    procedure UnpackPageToTiff(const Page : Cardinal);
      {-Unpack a page of a fax into a TIF file}
    procedure UnpackFileToTiff;
      {-Unpack a file to a TIF file}
    procedure UnpackPageToBmp(const Page : Cardinal);
      {-Unpack a page of a fax into a BMP file}
    procedure UnpackFileToBmp;
      {-Unpack a file to a BMP file}

    procedure ExtractPage(const Page : Cardinal);
      {-Extract a page of a fax into a new fax file}
    {properties}
    property Options : TUnpackerOptionsSet
      read FOptions write SetUnpackerOptions default afcDefFaxUnpackOptions; 
    property WhitespaceCompression : Boolean
      read FWhitespaceCompression write FWhitespaceCompression default afcDefWhitespaceCompression;
    property WhitespaceFrom : Cardinal
      read FWhitespaceFrom write FWhitespaceFrom default afcDefWhitespaceFrom;
    property WhitespaceTo : Cardinal
      read FWhitespaceTo write FWhitespaceTo default afcDefWhitespaceTo;
    property Scaling : Boolean
      read FScaling write FScaling default afcDefScaling;