adfaxcvt.pas

Async Professional 4.04

  finally
    if DefPrnChanged then                                                {!!.01}
      ChangeDefPrinter(False);                                           {!!.01}
    Status(False, True, FShellPageCount, 0, 0, 0, DummyBool);            {!!.01}
  end;                                                                   {!!.01}
end;

procedure TApdCustomFaxConverter.PrnCallback(var Msg: TMessage);
var
 DummyBool : Boolean;
begin
  with Msg do begin
    case Msg of                                                          {!!.01}
      apw_EndDoc  : FWaitingForShell := False;                           {!!.01}
      apw_EndPage :
        begin
          FResetShellTimer := True;                                      {!!.01}
          { generate a status event }                                    {!!.01}
          inc(FShellPageCount);                                          {!!.01}
          Status(False, False, FShellPageCount, 0, 0, 0, DummyBool);     {!!.01}
        end;

    else                                                                 {!!.01}
      Result := DefWindowProc(PrnCallbackHandle, Msg, wParam, lParam);
    end;                                                                 {!!.01}
  end;
end;

procedure TApdCustomFaxConverter.SetPadPage(const Value: Boolean);       {!!.04}
begin
  FPadPage := Value;
  if Assigned(Data) then
    Data.PadPage := FPadPage;
end;

{TApdCustomFaxUnpacker}

  function UnpackCallback(Unpack : PUnpackFax; plFlags : Word; var Data; Len,
                          PageNum : Cardinal) : Integer;
  {$IFNDEF Win32} far; {$ENDIF}
  begin
    Result := ecOK;
    try
      TApdCustomFaxUnpacker(Unpack^.UserData).OutputLine(
        (plFlags and upStarting) <> 0, (plFlags and upEnding) <> 0,
        @Data, Len, PageNum);
    except
      on E : Exception do
        Result := XlatException(E);
    end;
  end;

  procedure UnpackStatusCallback(Unpack : PUnpackFax; FaxFile : PChar; PageNum : Cardinal;
                                 BytesUnpacked, BytesToUnpack : LongInt);
  {$IFNDEF Win32} far; {$ENDIF}
  begin
    TApdCustomFaxUnpacker(Unpack^.UserData).Status(
      StrPas(FaxFile), PageNum, BytesUnpacked, BytesToUnpack);
  end;

  procedure TApdCustomFaxUnpacker.CreateData;
    {-Create PUnpackFax record for API layer}
  var
    HMult : Cardinal;
    HDiv  : Cardinal;
    VMult : Cardinal;
    VDiv  : Cardinal;

  begin
    if Assigned(Data) then
      DestroyData;

    CheckException(Self, upInitFaxUnpacker(Data, Self, UnpackCallback));

    upSetStatusCallback(Data, UnpackStatusCallback);

    upOptionsOff(Data, $FFFF);
    if uoYield in FOptions then
      upOptionsOn(Data, ufYield)
    else
      upOptionsOff(Data, ufYield);
    if (FAutoScaleMode = asDoubleHeight) then
      upOptionsOn(Data, ufAutoDoubleHeight)
    else if (FAutoScaleMode = asHalfWidth) then
      upOptionsOn(Data, ufAutoHalfWidth);

    if FWhitespaceCompression then
      CheckException(Self, upSetWhitespaceCompression(Data, FWhitespaceFrom, FWhitespaceTo));

    if FScaling then begin
      if (FHorizMult = 0) then
        HMult := 1
      else
        HMult := FHorizMult;
      if (FHorizDiv = 0) then
        HDiv := 1
      else
        HDiv := FHorizDiv;
      if (FVertMult = 0) then
        VMult := 1
      else
        VMult := FVertMult;
      if (FVertDiv = 0) then
        VDiv := 1
      else
        VDiv := FVertDiv;
      upSetScaling(Data, HMult, HDiv, VMult, VDiv);
    end;
  end;

  procedure TApdCustomFaxUnpacker.DestroyData;
    {-Destroy PUnpackFax record for API layer}
  begin
    upDoneFaxUnpacker(Data);
    Data := nil;
  end;

  procedure TApdCustomFaxUnpacker.OutputLine( const Starting, Ending : Boolean;
                       const Data : PByteArray; const Len, PageNum : Cardinal);
  begin
    if Assigned(FOutputLine) then
      FOutputLine(Self, Starting, Ending, Data, Len, PageNum);
  end;

  procedure TApdCustomFaxUnpacker.Status( const FName : String; const PageNum : Cardinal;
                                          const BytesUnpacked, BytesToUnpack : LongInt);
  begin
    if Assigned(FStatus) then
      FStatus(Self, FName, PageNum, BytesUnpacked, BytesToUnpack);
  end;

  procedure TApdCustomFaxUnpacker.SetHorizMult(const NewHorizMult : Cardinal);
  begin
    if (NewHorizMult <> 0) and (FHorizMult <> NewHorizMult) then
      FHorizMult := NewHorizMult;
  end;

  procedure TApdCustomFaxUnpacker.SetHorizDiv(const NewHorizDiv : Cardinal);
  begin
    if (NewHorizDiv <> 0) and (FHorizDiv <> NewHorizDiv) then
      FHorizDiv := NewHorizDiv;
  end;

  procedure TApdCustomFaxUnpacker.SetVertMult(const NewVertMult : Cardinal);
  begin
    if (NewVertMult <> 0) and (FVertMult <> NewVertMult) then
      FVertMult := NewVertMult;
  end;

  procedure TApdCustomFaxUnpacker.SetVertDiv(const NewVertDiv : Cardinal);
  begin
    if (NewVertDiv <> 0) and (FVertDiv <> NewVertDiv) then
      FVertDiv := NewVertDiv;
  end;

  function TApdCustomFaxUnpacker.GetNumPages : Cardinal;
  var
    FH : TFaxHeaderRec;

  begin
    CreateData;
    upGetFaxHeader(Data, InFNameZ, FH);
    Result := FH.PageCount;
  end;

  function TApdCustomFaxUnpacker.GetFaxResolution : TFaxResolution;
  var
    PH : TPageHeaderRec;

  begin
    CreateData;
    CheckException(Self, upGetPageHeader(Data, InFNameZ, 1, PH));
    if ((PH.ImgFlags and ffHighRes) <> 0) then
      Result := frHigh
    else
      Result := frNormal;
  end;

  function TApdCustomFaxUnpacker.GetFaxWidth : TFaxWidth;
  var
    PH : TPageHeaderRec;

  begin
    CreateData;
    CheckException(Self, upGetPageHeader(Data, InFNameZ, 1, PH));
    if ((PH.ImgFlags and ffHighWidth) <> 0) then
      Result := fwWide
    else
      Result := fwNormal;
  end;

  procedure TApdCustomFaxUnpacker.SetInFileName(const NewName : String);
  begin
    if (UpperCase(FInFileName) <> UpperCase(NewName)) then begin
      FInFileName := NewName;
      FOutFileName := ChangeFileExt(FInFileName, '');
    end;
  end;

  procedure TApdCustomFaxUnpacker.SetUnpackerOptions(const NewUnpackerOptions: TUnpackerOptionsSet);
  begin
    if Assigned(Data) then begin                                     
      if uoYield in NewUnpackerOptions then
        upOptionsOn(Data, ufYield)
      else
        upOptionsOff(Data, ufYield);

      if uoAbort in NewUnpackerOptions then
        upOptionsOn(Data, ufAbort);
    end;

    FOptions := NewUnpackerOptions;
  end;


  function TApdCustomFaxUnpacker.InFNameZ : PChar;
  begin
    Result := StrPCopy(InFileZ, FInFileName);
  end;

  function TApdCustomFaxUnpacker.OutFNameZ : PChar;
  begin
    Result := StrPCopy(OutFileZ, FOutFileName);
  end;

  constructor TApdCustomFaxUnpacker.Create(AOwner : TComponent);
  begin
    inherited Create(AOwner);

    FOptions               := afcDefFaxUnpackOptions;
    FWhitespaceCompression := afcDefWhitespaceCompression;
    FWhitespaceFrom        := afcDefWhitespaceFrom;
    FWhitespaceTo          := afcDefWhitespaceTo;
    FScaling               := afcDefScaling;
    FHorizMult             := afcDefHorizMult;
    FHorizDiv              := afcDefHorizDiv;
    FVertMult              := afcDefVertMult;
    FVertDiv               := afcDefVertDiv;
    FAutoScaleMode         := afcDefAutoScaleMode;
    FStatus                := nil;
    FOutputLine            := nil;
    Data                   := nil;
  end;

  destructor TApdCustomFaxUnpacker.Destroy;
  begin
    if Assigned(Data) then
      DestroyData;

    inherited Destroy;
  end;

  procedure TApdCustomFaxUnpacker.UnpackPage(const Page : Cardinal);
    {-Unpack page number Page}
  begin
    CreateData;
    CheckException(Self, upUnpackPage(Data, InFNameZ, Page));
  end;

  procedure TApdCustomFaxUnpacker.UnpackFile;
    {-Unpack all pages in a fax file}
  begin
    CreateData;
    CheckException(Self, upUnpackFile(Data, InFNameZ));
  end;

  function TApdCustomFaxUnpacker.UnpackPageToBitmap(const Page : Cardinal) : TBitmap;
    {-Unpack a page of fax into a memory bitmap}
  var
    MemBmp : TMemoryBitmapDesc;

  begin
    CreateData;
    CheckException(Self, upUnpackPageToBitmap(Data, InFNameZ, Page, MemBmp, True));
    if MemBmp.Bitmap = 0 then begin                                      {!!.04}
      Result := nil;                                                     {!!.04}
      CheckException(Self, ecCantMakeBitmap);                            {!!.04}
    end else begin                                                       {!!.04}
      Result        := TBitmap.Create;
      Result.Handle := MemBmp.Bitmap;
      {if FaxResolution = frNormal then}                                 {!!.04}
      if FaxWidth = fwNormal then                                        {!!.04}
        Result.Width := StandardWidth
      else
        Result.Width := WideWidth;
    end;                                                                 {!!.04}
  end;

  function TApdCustomFaxUnpacker.UnpackFileToBitmap : TBitmap;
    {-Unpack a fax into a memory bitmap}
  var
    MemBmp : TMemoryBitmapDesc;

  begin
    CreateData;
    CheckException(Self, upUnpackFileToBitmap(Data, InFNameZ, MemBmp, True));
    if MemBmp.Bitmap = 0 then begin                                      {!!.04}
      Result := nil;                                                     {!!.04}
      CheckException(Self, ecCantMakeBitmap);                            {!!.04}
    end else begin                                                       {!!.04}
      Result        := TBitmap.Create;
      Result.Handle := MemBmp.Bitmap;
      {if FaxResolution = frNormal then}                                 {!!.04}
      if FaxWidth = fwNormal then                                        {!!.04}
        Result.Width := StandardWidth
      else
        Result.Width := WideWidth;
    end;                                                                 {!!.04}
  end;

  procedure TApdCustomFaxUnpacker.UnpackPageToPcx(const Page : Cardinal);
    {-Unpack a page of a fax into a PCX file}
  begin
    CreateData;
    CheckException(Self, upUnpackPageToPcx(Data, InFNameZ, OutFNameZ, Page));
  end;

  procedure TApdCustomFaxUnpacker.UnpackFileToPcx;
    {-Unpack a file to a PCX file}
  begin
    CreateData;
    CheckException(Self, upUnpackFileToPcx(Data, InFNameZ, OutFNameZ));
  end;

  procedure TApdCustomFaxUnpacker.UnpackPageToDcx(const Page : Cardinal);
    {-Unpack a page of a fax into a DCX file}
  begin
    CreateData;
    CheckException(Self, upUnpackPageToDcx(Data, InFNameZ, OutFNameZ, Page));
  end;

  procedure TApdCustomFaxUnpacker.UnpackFileToDcx;
    {-Unpack a file to a DCX file}
  begin
    CreateData;
    CheckException(Self, upUnpackFileToDcx(Data, InFNameZ, OutFNameZ));
  end;

  procedure TApdCustomFaxUnpacker.UnpackPageToTiff(const Page : Cardinal);
    {-Unpack a page of a fax into a TIF file}
  begin
    CreateData;
    CheckException(Self, upUnpackPageToTiff(Data, InFNameZ, OutFNameZ, Page));
  end;

  procedure TApdCustomFaxUnpacker.UnpackFileToTiff;
    {-Unpack a file to a TIF file}
  begin
    CreateData;
    CheckException(Self, upUnpackFileToTiff(Data, InFNameZ, OutFNameZ));
  end;

  procedure TApdCustomFaxUnpacker.UnpackPageToBmp(const Page : Cardinal);
    {-Unpack a page of a fax into a BMP file}
  begin
    with UnpackPageToBitmap(Page) do begin                               {!!.04}
      SaveToFile(FOutFileName);                                          {!!.04}
      Free;                                                              {!!.04}
    end;                                                                 {!!.04}
  end;

  procedure TApdCustomFaxUnpacker.UnpackFileToBmp;
    {-Unpack a file to a BMP file}
  begin
    with UnpackFileToBitmap do begin                                     {!!.04}