adfaxcvt.pas

测试用例

    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;
    property HorizMult : Cardinal
      read FHorizMult write SetHorizMult default afcDefHorizMult;
    property HorizDiv : Cardinal
      read FHorizDiv write SetHorizDiv default afcDefHorizDiv;
    property VertMult : Cardinal
      read FVertMult write SetVertMult default afcDefVertMult;
    property VertDiv : Cardinal
      read FVertDiv write SetVertDiv default afcDefVertDiv;
    property AutoScaleMode : TAutoScaleMode
      read FAutoScaleMode write FAutoScaleMode;
    property InFileName : String
      read FInFileName write SetInFileName;
    property OutFileName : String
      read FOutFileName write FOutFileName;
    property NumPages : Cardinal
      read GetNumPages;
    property FaxResolution : TFaxResolution
      read GetFaxResolution;
    property FaxWidth : TFaxWidth
      read GetFaxWidth;

    {events}
    property OnOutputLine : TUnpackOutputLineEvent
      read FOutputLine write FOutputLine;
    property OnStatus : TUnpackStatusEvent
      read FStatus write FStatus;

    {class functions}
    class function IsAnAPFFile(const FName : String) : Boolean;
  end;

  TApdFaxUnpacker = class(TApdCustomFaxUnpacker)
  published
    property Options;
    property WhitespaceCompression;
    property WhitespaceFrom;
    property WhitespaceTo;
    property Scaling;
    property HorizMult;
    property HorizDiv;
    property VertMult;
    property VertDiv;
    property AutoScaleMode;
    property InFileName;
    property OutFileName;

    property OnOutputLine;
    property OnStatus;
  end;

  EApdAPFGraphicError = class (Exception);

  TApdAPFGraphic = class (TGraphic)
    private
      FCurrentPage : Integer;
      FPages       : TList;
      FFromAPF     : TApdCustomFaxUnpacker;
      FToAPF       : TApdCustomFaxConverter;

    protected
      procedure Draw (ACanvas : TCanvas; const Rect : TRect); override;
      procedure FreeImages;
      function GetEmpty : Boolean; override;
      function GetHeight : Integer; override;
      function GetNumPages : Integer;
      function GetPage (x : Integer) : TBitmap;
      function GetWidth : Integer; override;
      procedure SetCurrentPage (v : Integer);
      procedure SetHeight (v : Integer); override;
      procedure SetPage (x : Integer; v : TBitmap);
      procedure SetWidth (v : Integer); override;

    public
      constructor Create; override;
      destructor Destroy; override;

      procedure Assign (Source : TPersistent); override;
      procedure AssignTo (Dest : TPersistent); override;
      procedure LoadFromClipboardFormat (AFormat : Word; AData : THandle;
                                         APalette : HPALETTE); override;
      procedure LoadFromFile (const Filename : string); override;
      procedure LoadFromStream (Stream: TStream); override;
      procedure SaveToClipboardFormat (var AFormat : Word; var AData : THandle;
                                       var APalette : HPALETTE); override;
      procedure SaveToStream (Stream : TStream); override;
      procedure SaveToFile (const Filename : string); override;

      property Page[x : Integer] : TBitmap read GetPage write SetPage; 

    published
      property CurrentPage : Integer read FCurrentPage write SetCurrentPage;
      property NumPages : Integer read GetNumPages;

  end;
  
implementation

{TApdCustomFaxConverter}

  function StatusCallback(Cvt : PAbsFaxCvt; StatFlags : Word;
    BytesRead, BytesToRead : LongInt) : Bool; far;
  var
    Abort : Boolean;

  begin
    Abort := False;
    TApdCustomFaxConverter(Cvt^.OtherData).Status(
      (StatFlags and csStarting) <> 0, (StatFlags and csEnding) <> 0,
      Cvt^.CurrPage, Cvt^.CurrLine, Cvt^.BytesRead, Cvt^.BytesToRead, Abort);
    Result := Abort;
  end;

  function OutputCallback(Cvt : PAbsFaxCvt; var Data; Len : Integer;
                          EndOfPage, MorePages : Bool) : Integer; far;
  begin
    try
      TApdCustomFaxConverter(Cvt^.OtherData).OutputLine(
        Data, Len, EndOfPage, MorePages);
      Result := ecOK;
    except
      on E : Exception do begin
        Result := XlatException(E);
      end;
    end;
  end;

  function OpenFileCallback(Cvt : PAbsFaxCvt; FileName : PChar) : Integer; far;
  begin
    try
      TApdCustomFaxConverter(Cvt^.OtherData).OpenUserFile(StrPas(FileName));
      Result := ecOK;
    except
      on E : Exception do begin
        Result := XlatException(E);
      end;
    end;
  end;

  function ReadLineCallback(Cvt : PAbsFaxCvt; var Data; var Len : Integer;
                            var EndOfPage, MorePages : Bool) : Integer; far;
  var
    EP : Boolean;
    MP : Boolean;

  begin
    try
      TApdCustomFaxConverter(Cvt^.OtherData).ReadUserLine(Data, Len, EP, MP);
      EndOfPage := EP;
      MorePages := MP;
      Result    := ecOK;
    except
      on E : Exception do begin
        Result := XlatException(E);
      end;
    end;
  end;

  procedure CloseFileCallback(Cvt : PAbsFaxCvt); far;
  begin
    TApdCustomFaxConverter(Cvt^.OtherData).CloseUserFile;
  end;

  procedure TApdCustomFaxConverter.CreateData;
    {-Create PAbsFaxCvt record for API layer}
  const
    FontHandles : array[TFaxFont] of Cardinal = (StandardFont, SmallFont);
    ResWidths   : array[TFaxWidth] of Cardinal = (rw1728, rw2048);

  var
    Opt  : Word;
    Temp : array[0..255] of Char;

  begin
    {destroy old data, if necessary}
    if Assigned(Data) then
      DestroyData;

    LastDocType := InputDocumentType;


    {create the proper type of converter}
    case InputDocumentType of
      idText  : fcInitTextConverter(Data);
      idTextEx: fcInitTextExConverter(Data);
      idTiff  : tcInitTiffConverter(Data);
      idPcx   : pcInitPcxConverter(Data);
      idDcx   : dcInitDcxConverter(Data);
      idBmp   : bcInitBmpConverter(Data);
      idBitmap: bcInitBitmapConverter(Data);
      idUser  : acInitFaxConverter(Data, nil, ReadLineCallback,
                                          OpenFileCallback, CloseFileCallback,
                                          StrPCopy(Temp, DefUserExtension));
    end;

    {set converter options}
    acSetOtherData(Data, Self);
    Opt := 0;
    if coDoubleWidth in Options then
      Opt := Opt or fcDoubleWidth;
    if coHalfHeight in Options then
      Opt := Opt or fcHalfHeight;
    if coCenterImage in Options then
      Opt := Opt or fcCenterImage;
    if coYield in Options then
      Opt := Opt or fcYield;
    if coYieldOften in Options then
      Opt := Opt or fcYieldOften;
    acOptionsOff(Data, $FFFF);
    acOptionsOn(Data, Opt);
    acSetMargins(Data, LeftMargin, TopMargin);
    acSetResolutionMode(Data, (Resolution = frHigh));
    acSetResolutionWidth(Data, ResWidths[Width]);
    acSetStationID(Data, StrPCopy(Temp, StationID));
    acSetStatusCallback(Data, StatusCallback);

    {set text converter specific options}
    Data.PadPage := FPadPage;                                            {!!.04}
    if (InputDocumentType = idText) then begin
      fcSetTabStop(Data, TabStop);
      fcSetLinesPerPage(Data, LinesPerPage);
      CheckException(Self, fcLoadFont(Data, StrPCopy(Temp, FontFile),
        FontHandles[FontType], (Resolution = frHigh)));
    end;
    if (InputDocumentType = idTextEx) then begin
      fcSetTabStop(Data, TabStop);
      fcSetLinesPerPage(Data, LinesPerPage);
      fcSetFont(Data, FEnhFont, (Resolution = frHigh));
    end;
  end;

  procedure TApdCustomFaxConverter.DestroyData;
    {-Destroy PAbsFaxCvt record for API layer}
  begin
    case LastDocType of
      idText  : fcDoneTextConverter(Data);
      idTextEx: fcDoneTextExConverter(Data);                         
      idTiff  : tcDoneTiffConverter(Data);
      idPcx   : pcDonePcxConverter(Data);
      idDcx   : dcDoneDcxConverter(Data);
      idBmp   : bcDoneBmpConverter(Data);
      idBitmap: bcDoneBitmapConverter(Data);
      idUser  : acDoneFaxConverter(Data); 
    end;

    Data := nil;
  end;

  procedure TApdCustomFaxConverter.SetCvtOptions(const NewOpts : TFaxCvtOptionsSet);
    {-Set fax converter options}
  begin
    if (NewOpts = FOptions) then
      Exit;

    FOptions := NewOpts;
    if (coYieldOften in FOptions) and not (coYield in FOptions) then
      FOptions := FOptions + [coYield];
  end;

  procedure TApdCustomFaxConverter.SetDocumentFile(const NewFile : String);
    {-Set document file name}
  begin
    if (NewFile <> FDocumentFile) then begin
      FDocumentFile := NewFile;
      if (FDocumentFile <> '') and not (csLoading in ComponentState) then
        FOutFileName  := ChangeFileExt(FDocumentFile, '.' + DefApfExt);
    end;
  end;

  procedure TApdCustomFaxConverter.SetEnhFont(Value: TFont);
    {-Set font for use with extended text converter}
  begin
    FEnhFont.Assign(Value);
  end;                                                               

  constructor TApdCustomFaxConverter.Create(Owner : TComponent);
  begin
    inherited Create(Owner);

    {set default property values}
    FInputDocumentType := afcDefInputDocumentType;
    FOptions           := afcDefFaxCvtOptions;
    FResolution        := afcDefResolution;
    FWidth             := afcDefFaxCvtWidth;
    FTopMargin         := afcDefTopMargin;
    FLeftMargin        := afcDefLeftMargin;
    FLinesPerPage      := afcDefLinesPerPage;
    FTabStop           := afcDefFaxTabStop;
    FEnhFont           := TFont.Create;
    FFontType          := afcDefFontType;
    FFontFile          := afcDefFontFile;
    FDocumentFile      := '';
    FOutFileName       := '';
    FDefUserExtension  := '';
    FStatus            := nil;
    FOpenUserFile      := nil;
    FCloseUserFile     := nil;
    FReadUserLine      := nil;
    Data               := nil;
    FileOpen           := False;
    LastDocType        := idNone;
    FPadPage           := False;                                         {!!.04}
    { create the window handle so we can receive printer callbacks }
    PrnCallbackHandle := AllocateHWnd(PrnCallback);
  end;

  destructor TApdCustomFaxConverter.Destroy;
  begin
    FEnhFont.Free;
    if PrnCallbackHandle <> 0 then                                       {!!.02}
      DeallocateHWnd(PrnCallbackHandle);                                 {!!.02}
    inherited Destroy;

    if Assigned(Data) then
      DestroyData;
  end;

  procedure TApdCustomFaxConverter.ConvertToFile;
    {-Convert the input file into an APF file}
  var
    pFileName, pDestFile : array[0..255] of Char;

  begin
    if (InputDocumentType = idNone) or (InputDocumentType = idBitmap) then
      CheckException(Self, ecBadArgument);
    if InputDocumentType = idShell then
      ConvertShell(FDocumentFile)
    else begin
      CreateData;
      CheckException(Self, acConvertToFile(Data,
        StrPCopy(pFileName, FDocumentFile),
        StrPCopy(pDestFile, FOutFileName)));
    end;
  end;

  procedure TApdCustomFaxConverter.ConvertBitmapToFile(const Bmp : TBitmap);
    {-Convert a memory bitmap to a file}
  var
    SaveType             : TFaxInputDocumentType;
    pFileName, pDestFile : array[0..255] of Char;

  begin
    SaveType          := InputDocumentType;
    InputDocumentType := idBitmap;
    CreateData;
    try
      Data^.InBitmap := Bmp;
      CheckException(Self, bcSetInputBitmap(Data, 0));
      CheckException(Self, acConvertToFile(Data,
        StrPCopy(pFileName, FDocumentFile),