awfaxcvt.pas

测试用例

        Code := WriteOutFile(OutFile, MainHeader, SizeOf(MainHeader));
        if (Code < ecOK) then
          goto Breakout;

        {return to original position}
        Code := SeekOutFile(OutFile, L);

      Breakout:
        UpdateMainHeader := Code;
      end;
    end;

  begin
    Code := UpdateMainHeader;
    if (Code = ecOK) then
      Code := CloseOutFile(Cvt^.OutFile);

    acCloseOutputFile := Code;
  end;

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

  label
    ErrorExit;

    function CreateOutputFile : Integer;
      {-Create the output fax file}
    begin
      with Cvt^ do begin
        if (DestFile = nil) or (DestFile^ = #0) then begin
          {create an APF file name in the source file's directory}
          JustPathNameZ(OutFileName, FileName);
          AddBackslashZ(OutFileName, OutfileName);

          {get name of output file}
          JustFileNameZ(OutFileName + StrLen(OutFileName), FileName);
          ForceExtensionZ(OutFileName, OutFileName, FaxFileExt);
          {$IFNDEF Win32}
          AnsiUpper(OutFileName);
          {$ENDIF}
        end else
          DefaultExtensionZ(OutFileName, DestFile, FaxFileExt);

        {create the output file}
        CreateOutputFile := acCreateOutputFile(Cvt);
      end;
    end;

  begin
    with Cvt^ do begin
      {create the output file}
      Code := CreateOutputFile;
      if (Code < ecOK) then
        goto ErrorExit;

      {convert the file}
      Code := acConvert(Cvt, FileName, acOutToFileCallback);
      if (Code < ecOK) then begin
        CleanupOutFile(OutFile);
        goto ErrorExit;
      end;

      {update main header of fax file and close file}
      Code := acCloseOutputFile(Cvt);
      if (Code < ecOK) then
        CleanupOutFile(OutFile);

    ErrorExit:
      acConvertToFile := Code;
    end;
  end;

  function acConvert(Cvt : PAbsFaxCvt; FileName : PChar;
                     OutCallback : TPutLineCallback) : Integer;
    {-Convert an input file, sending data to OutHandle or to OutCallback}
  const
    WhiteLine : array[1..6] of char = #$00#$80#$B2'Y'#$01#$00;
  var
    Code         : Integer;
    MorePages    : Bool;
    EndOfPage    : Bool;
    I            : Cardinal;
    Len          : Integer;
    BytesPerLine : Cardinal;
  label
    ErrorExit;

    function OutputDataLine : Integer;
    begin
      with Cvt^ do
        if (@OutCallback <> nil) then
          OutputDataLine := OutCallback(Cvt, DataLine^, ByteOfs, False, False)
        else
          OutputDataLine := ecOK;
    end;

    function DoEndOfPage : Integer;
    begin
      with Cvt^ do
        if (@OutCallback <> nil) then
          DoEndOfPage := OutCallback(Cvt, DataLine^, 0, True, MorePages)
        else
          DoEndOfPage := ecOK;
    end;

  begin
    with Cvt^ do begin
      {initialize position counter}
      CurrPage := 0;
      CurrLine := 0;

      BytesPerLine := ResWidth div 8;

      {provide an extension if the user didn't}
      DefaultExtensionZ(InFileName, FileName, DefExt);

      {show the initial status}
      Code := acConvertStatus(Cvt, csStarting);
      if (Code < ecOK) then begin
        acConvert := Code;
        Exit;
      end;

      {open the input file}
      Code := acOpenFile(Cvt, InFileName);
      if (Code < ecOK) then begin
        acConvert := Code;
        Exit;
      end;

      MorePages := True;

      while MorePages do begin
        Inc(CurrPage);
        CurrLine := 0;

        {Add top margin}
        for I := 1 to TopMargin do begin
          acInitDataLine(Cvt);
          Move(WhiteLine, DataLine^[0], 6);
          ByteOfs := 6;
          Code := OutputDataLine;
          if (Code < ecOK) then
            goto ErrorExit;
        end;

        {make initial call to GetLine function}
        FastZero(TmpBuffer^, BytesPerLine);
        Code := acGetRasterLine(Cvt, TmpBuffer^, Len, EndOfPage, MorePages);
        if (Code < ecOK) then
          goto ErrorExit;

        {read and compress raster lines until the end of the page}
        while not EndOfPage do begin
          if not HalfHeight or (HalfHeight and Odd(CurrLine)) then begin
            acCompressRasterLine(Cvt, TmpBuffer^);
            Code := OutputDataLine;
            if (Code < ecOK) then
              goto ErrorExit;
          end;

          {read the next line}
          FastZero(TmpBuffer^, BytesPerLine);
          Code := acGetRasterLine(Cvt, TmpBuffer^, Len, EndOfPage, MorePages);
          if (Code < ecOK) then
            goto ErrorExit;

          if FlagIsSet(Flags, fcYield) and FlagIsSet(Flags, fcYieldOften) and ((CurrLine and 15) = 0) then begin
            Code := ConverterYield;
            if (Code < ecOK) then
              goto ErrorExit;
          end;
        end;

        if PadPage then begin                                            {!!.04}
          {Add bottom margin}                                            {!!.04}
          for I := CurrLine to 2155 do begin                             {!!.04}
            acInitDataLine(Cvt);                                         {!!.04}
            Move(WhiteLine, DataLine^[0], 6);                            {!!.04}
            ByteOfs := 6;                                                {!!.04}
            Code := OutputDataLine;                                      {!!.04}
            if (Code < ecOK) then                                        {!!.04}
              goto ErrorExit;                                            {!!.04}
          end;                                                           {!!.04}
        end;                                                             {!!.04}

        Code := DoEndOfPage;
        if (Code < ecOK) then
          goto ErrorExit;

        {yield if the user wants it}
        if FlagIsSet(Flags, fcYield) then begin
          Code := ConverterYield;
          if (Code < ecOK) then
            goto ErrorExit;
        end;
      end;
    end;

    Code := ecOK;

  ErrorExit:
    {show final status}
    acConvertStatus(Cvt, csEnding);
    acCloseFile(Cvt);
    acConvert := Code;
  end;

{$IFNDEF PRNDRV}                                              

{Text-to-fax conversion routines}

  procedure fcInitTextConverter(var Cvt : PAbsFaxCvt);
  var
    TextCvtData : PTextFaxData;
  begin
    Cvt := nil;

    {Initialize text converter specific data}
    TextCvtData := AllocMem(SizeOf(TTextFaxData));

    TextCvtData^.ReadBuffer := AllocMem(ReadBufferSize);
    TextCvtData^.FontPtr := AllocMem(MaxFontBytes);

    TextCvtData^.TabStop := DefFaxTabStop;
    TextCvtData^.IsExtended := False;                             

    {initialize the abstract converter}
    acInitFaxConverter( Cvt, TextCvtData, fcGetTextRasterLine,
                                fcOpenFile, fcCloseFile, DefTextExt);
  end;

  procedure fcInitTextExConverter(var Cvt : PAbsFaxCvt);
    {-Initialize an extended text-to-fax converter}
  var
    TextCvtData : PTextFaxData;
  begin
    Cvt := nil;

    {Initialize text converter specific data}
    TextCvtData := AllocMem(SizeOf(TTextFaxData));

    TextCvtData^.ReadBuffer := AllocMem(ReadBufferSize);
    TextCvtData^.Bitmap := Graphics.TBitmap.Create;
    TextCvtData^.Bitmap.Monochrome := True;

    TextCvtData^.TabStop := DefFaxTabStop;
    TextCvtData^.IsExtended := True;

    TextCvtData^.ImageData := nil;
    TextCvtData^.ImageSize := 0;

    {initialize the abstract converter}
    acInitFaxConverter( Cvt, TextCvtData, fcGetTextRasterLine,
                                fcOpenFile, fcCloseFile, DefTextExt);
  end;

  procedure fcDoneTextConverter(var Cvt : PAbsFaxCvt);
    {-Destroy a text-to-fax converter}
  begin
    with PTextFaxData(Cvt^.UserData)^ do begin
      FreeMem(FontPtr, MaxFontBytes);
      FreeMem(ReadBuffer, ReadBufferSize);
    end;
    FreeMem(Cvt^.UserData, SizeOf(TTextFaxData));

    acDoneFaxConverter(Cvt);
  end;

  procedure fcDoneTextExConverter(var Cvt : PAbsFaxCvt);      
    {-Destroy an extended text-to-fax converter}
  begin
    with PTextFaxData(Cvt^.UserData)^ do begin
      FreeMem(ReadBuffer, ReadBufferSize);
      Bitmap.Free;
      FreeMem(ImageData, ImageSize);
    end;
    FreeMem(Cvt^.UserData, SizeOf(TTextFaxData));

    acDoneFaxConverter(Cvt);
  end;

  procedure fcSetTabStop(Cvt : PAbsFaxCvt; TabStop : Cardinal);
    {-Set the number of spaces equivalent to a tab character}
  begin
    if (TabStop = 0) then
      Exit;

    PTextFaxData(Cvt^.UserData)^.TabStop := TabStop;
  end;

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

  var
    ToRead    : Cardinal;
    ActRead   : Cardinal;
    SaveMode  : Integer;
    Code      : Integer;
    F         : File;
  {$ELSE}
  var
    P         : Pointer;
    ResHandle : THandle;
    MemHandle : THandle;
    Len       : Cardinal;
  {$ENDIF}
    I         : Integer;
    J         : Integer;
    Row       : Cardinal;
    NewRow    : Cardinal;
    NewBytes  : Cardinal;

  begin
    with Cvt^, PTextFaxData(Cvt^.UserData)^ do begin
    {$IFDEF BindFaxFont}
      {find resource for font}
      ResHandle := FindResource(HInstance, AwFontResourceName, AwFontResourceType);
      if (ResHandle = 0) then begin
        fcLoadFont := ecFontFileNotFound;
        Exit;
      end;

      {get handle to font data}
      MemHandle := LoadResource(HInstance, ResHandle);
      if (MemHandle = 0) then begin
        fcLoadFont := ecFontFileNotFound;
        Exit;
      end;

      {turn font handle into pointer}
      {$IFNDEF Win32}
      P := GlobalLock(MemHandle);
      {$ELSE}
      P := Pointer(MemHandle);
      {$ENDIF}

      {get data about font}
      if (FontHandle = StandardFont) then begin
        P       := GetPtr(P, Cardinal(SmallFont) * 256);
        FontRec := StandardFontRec;
      end else
        FontRec := SmallFontRec;
      Len := LongInt(FontHandle) * 256;

      {get font data}
      Move(P^, FontPtr^, Len);

      {scale up font if HiRes requested}
      if HiRes then
        with FontRec do begin
          {allocate temporary buffer for scaled up font}
          NewBytes := Bytes * 2;

          {double raster lines of font}
          for J := 255 downto 0 do begin
            NewRow := 0;
            Row    := 0;
            for I := 1 to Height do begin
              Move(FontPtr^[(Cardinal(J) * Bytes) + Row],
                FontPtr^[(Cardinal(J) * NewBytes) + NewRow], Width);
              Move(FontPtr^[(Cardinal(J) * Bytes) + Row],
                FontPtr^[(Cardinal(J) * NewBytes) + NewRow+Width], Width);
              Inc(Row, Width);
              Inc(NewRow, Width * 2);
            end;
          end;

          {adjust FontRec}
          Bytes  := NewBytes;
          Height := Height * 2;
        end;

      {$IFNDEF Win32}
      GlobalUnlock(MemHandle);
      {$ENDIF}
      FreeResource(MemHandle);

      FontLoaded := True;
      fcLoadFont := ecOK;

    end;
    {$ELSE}
      {assume failure}
      FontLoaded := False;

      {open font file}
      SaveMode := FileMode;
      FileMode := ApdShareFileRead;                                    
      Assign(F, FileName);
      Reset(F, 1);
      FileMode := SaveMode;
      Code := -IoResult;
      if (Code = ecFileNotFound) or (Code = ecPathNotFound) then
        Code := ecFontFileNotFound;
      if (Code < ecOK) then begin
        fcLoadFont := Code;
        Exit;
      end;

      {initialize font}
      FastZero(FontPtr^, MaxFontBytes);
      case FontHandle of
        SmallFont   : FontRec := SmallFontRec;
        StandardFont:
          begin
            FontRec := StandardFontRec;
            {seek past small font in file}
            Seek(F, (SmallFont * 256));
          end;
      end;
      Code := -IoResult;
      if (Code < ecOK) then
        goto Error;

      {get number of bytes to read--number of characters * bytes per char}
      ToRead := FontRec.Bytes * 256;

      {read font}
      BlockRead(F, FontPtr^, ToRead, ActRead);
      Code := -IoResult;
      if (Code < ecOK) then
        goto Error;
      if (ActRead < ToRead) then begin
        Code := ecDeviceRead;
        goto Error;
      end;

      {scale font up if HiRes requested}
      if HiRes then
        with FontRec do begin
          NewBytes := Bytes * 2;

          {double raster lines of font}
          for J := 255 downto 0 do begin
            NewRow := 0;
            Row    := 0;
            for I := 1 to Height do begin
              Move(FontPtr^[(J * Bytes) + Row], FontPtr^[(J * NewBytes) + NewRow], Width);
              Move(FontPtr^[(J * Bytes) + Row], FontPtr^[(J * NewBytes) + NewRow + Width], Width);
              Inc(Row, Width);
              Inc(NewRow, Width * 2);
            end;
          end;

          {adjust font parameters}
          Bytes  := NewBytes;
          Height := Height * 2;
        end;

      Close(F); if (IoResult = 0) then ;
      FontLoaded := True;
      fcLoadFont := ecOK;
      Exit;
    end;

  Error:
    Close(F); if (IoResult = 0) then ;
    fcLoadFont := Code;
    {$ENDIF}
  end;

  function fcSetFont(Cvt : PAbsFaxCvt; Font : TFont; HiRes : Boolean) : Integer; 
    {-Set font