awfaxcvt.pas

测试用例

    SeekOutFile := Code;
    Exit;
  end;

  Seek(F^.OutFile, Posn);
  Code := -IoResult;
  if (Code < ecOK) then
    CleanupOutFile(F);
  SeekOutFile := Code;
end;

function OutFilePosn(var F : PBufferedOutputFile) : LongInt;
begin
  with F^ do
    OutFilePosn := FilePos(OutFile) + BufPos;
end;

function CloseOutFile(var F : PBufferedOutputFile) : Integer;
var
  Code : Integer;

begin
  {flush any remaining data}
  Code := FlushOutFile(F);
  if (Code < ecOK) then begin
    CloseOutFile := Code;
    Exit;
  end;

  with F^ do begin
    {close the output file}
    Close(OutFile);
    Code := -IoResult;
    if (Code < ecOK) then begin
      Erase(OutFile); if (IoResult = 0) then ;
    end;
    CloseOutFile := Code;
    FreeMem(Buffer, CvtOutBufSize);
    FreeMem(F, SizeOf(TBufferedOutputFile));
  end;
end;

{Abstract fax conversion routines}

  procedure acInitDataLine(Cvt : PAbsFaxCvt);
    {-Initialize the converter's line buffer}
  begin
    with Cvt^ do begin
      FastZero(DataLine^, MaxData);
      ByteOfs := 0;
      BitOfs  := 0;
    end;
  end;

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

    Cvt := AllocMem(SizeOf(TAbsFaxCvt));

    {initialize converter structure}
    with Cvt^ do begin
      Flags         := DefFaxCvtOptions;
      ResWidth      := StandardWidth;
      LeftMargin    := DefLeftMargin;
      TopMargin     := DefTopMargin;
      UserData      := Data;
      GetLine       := CB;
      OpenCall      := OpenFile;
      CloseCall     := CloseFile;
      InFileName[0] := #0;
      StrCopy(DefExt, DefaultExt);

      {initialize compression buffer}
      DataLine := AllocMem(MaxData);

      {initialize temporary buffer}
      TmpBuffer := AllocMem(MaxData);
    end;

    acInitDataLine(Cvt);
  end;

  procedure acDoneFaxConverter(var Cvt : PAbsFaxCvt);
    {-Destroy a fax converter engine}
  begin
    with Cvt^ do begin
      FreeMem(DataLine, MaxData);
      FreeMem(TmpBuffer, MaxData);
    end;

    FreeMem(Cvt, SizeOf(TAbsFaxCvt));
    Cvt := nil;
  end;

  procedure acSetOtherData(Cvt : PAbsFaxCvt; OtherData : Pointer);
    {-Set other data pointer}
  begin
    Cvt^.OtherData := OtherData;
  end;

  procedure acOptionsOn(Cvt : PAbsFaxCvt; OptionFlags : Word);
    {-Activate multiple fax converter options}
  begin
    with Cvt^ do
      Flags := Flags or (OptionFlags and not Cardinal(BadFaxCvtOptions));
  end;

  procedure acOptionsOff(Cvt : PAbsFaxCvt; OptionFlags : Word);
    {-Deactivate multiple options}
  begin
    with Cvt^ do
      Flags := Flags and not (OptionFlags and not BadFaxCvtOptions);
  end;

  function acOptionsAreOn(Cvt : PAbsFaxCvt; OptionFlags : Word) : Bool;
    {-Return True if all specified options are on}
  begin
    with Cvt^ do
      acOptionsAreOn := ((Flags and OptionFlags) = OptionFlags);
  end;

  procedure acSetMargins(Cvt : PAbsFaxCvt; Left, Top : Cardinal);
    {-Set left and top margins for converter}
  begin
    with Cvt^ do begin
      LeftMargin := Left;
      TopMargin  := Top;
    end;
  end;

  procedure acSetResolutionMode(Cvt : PAbsFaxCvt; HiRes : Bool);
    {-Select standard or high resolution mode}
  begin
    Cvt^.UseHighRes := HiRes;
  end;

  procedure acSetResolutionWidth(Cvt : PAbsFaxCvt; RW : Cardinal);
    {-Select standard (1728 pixels) or wide (2048 pixels) width}
  begin
    with Cvt^ do
      if (RW = rw2048) then
        ResWidth := WideWidth
      else
        ResWidth := StandardWidth;
  end;

  procedure acSetStationID(Cvt : PAbsFaxCvt; ID : PChar);
    {-Set the station ID of the converter}
  begin
    with Cvt^ do
      StrLCopy(StationID, ID, SizeOf(StationID) - 1);
  end;

  procedure acSetStatusCallback(Cvt : PAbsFaxCvt; CB : TCvtStatusCallback);
    {-Set the procedure called for conversion status}
  begin
    if (@CB <> nil) then begin
      Cvt^.StatusWnd  := 0;
      Cvt^.StatusFunc := CB;
    end;
  end;

  procedure acSetStatusWnd(Cvt : PAbsFaxCvt; HWindow : TApdHwnd);
    {-Set the handle of the window that receives status messages}
  begin
    if (HWindow <> 0) then begin
      Cvt^.StatusFunc := nil;
      Cvt^.StatusWnd  := HWindow;
    end;
  end;

  {$IFNDEF Win32}
  procedure acAddCodePrim(Cvt : PAbsFaxCvt; Code : Word; SignificantBits : Word); assembler;
    {-Lowlevel routine to add a runlength code to the line buffer}
  asm
    les   di,Cvt

    mov   ax,Code
    xor   dx,dx                            {dx:ax = extended code}
    mov   cx,TAbsFaxCvt(es:[di]).BitOfs    {cx = bit offset}
    mov   si,cx                            {save a copy of bit offset}
    jcxz  @2
@1: shl   ax,1                             {shift code for bit offset}
    rcl   dx,1
    loop  @1

@2: mov   bx,TAbsFaxCvt(es:[di]).ByteOfs   {bx = byte offset}
    add   si,SignificantBits
    mov   cx,si
    shr   cx,3
    add   TAbsFaxCvt(es:[di]).ByteOfs,cx   {update ByteOfs}
    and   si,7
    mov   TAbsFaxCvt(es:[di]).BitOfs,si    {update BitOfs}

    les   di,TAbsFaxCvt(es:[di]).DataLine
    add   di,bx
    or    es:[di],ax                       {or new bit pattern in place}
    or    es:[di+2],dl
  end;

  {$ELSE}
  procedure acAddCodePrim(Cvt : PAbsFaxCvt; Code : Word; SignificantBits : Word); assembler; register;
    {-Lowlevel routine to add a runlength code to the line buffer}
  asm
    push  esi
    push  edi
    push  ebx

    {load parameters}
    xor   ebx,ebx
    mov   bx,cx       {cx = SignificantBits}
    and   edx,$0000FFFF

    mov   ecx,TAbsFaxCvt([eax]).BitOfs
    mov   esi,ecx     {save copy of bit offset}
    or    ecx,ecx
    jz    @1

    shl   edx,cl      {shift code for bit offset}

@1: mov   edi,TAbsFaxCvt([eax]).ByteOfs
    add   esi,ebx
    mov   ecx,esi
    shr   ecx,3
    add   TAbsFaxCvt([eax]).ByteOfs,ecx
    and   esi,7
    mov   TAbsFaxCvt([eax]).BitOfs,esi

    mov   eax,TAbsFaxCvt([eax]).DataLine
    add   eax,edi
    or    [eax],dx
    shr   edx,16
    or    [eax+2],dl

    pop   ebx
    pop   edi
    pop   esi
  end;
  {$ENDIF}

  {$IFNDEF Win32}
  procedure acAddCode(Cvt : PAbsFaxCvt; RunLen : Cardinal; IsWhite : Boolean); assembler;
    {-Adds a code representing RunLen pixels of white (IsWhite=True) or black
      to the current line buffer}
  asm
    mov   ax,word ptr IsWhite                                      
    mov   bx,RunLen

    {Long run?}
    cmp   bx,64
    jb    @2

    {Long white run?}
    or    al,al
    jz    @1

    {Long white run}
    shr   bx,6
    dec   bx
    mov   si,offset WhiteMUTable
    shl   bx,2
    les   di,Cvt
    push  es
    push  di
    push  word ptr [bx+si]
    push  word ptr [bx+si+2]
    call  acAddCodePrim
    mov   bx,RunLen
    and   bx,63
    mov   si,offset WhiteTable
    jmp   @4

    {Long black run}
@1: shr   bx,6
    dec   bx
    mov   si,offset BlackMUTable
    shl   bx,2
    les   di,Cvt
    push  es
    push  di
    push  word ptr [bx+si]
    push  word ptr [bx+si+2]
    call  acAddCodePrim
    mov   bx,RunLen
    and   bx,63
    mov   si,offset BlackTable
    jmp   @4

    {Short white run?}
@2: or    al,al
    jz    @3

    {Short white run}
    mov   si,offset WhiteTable
    jmp   @4

    {Short black run}
@3: mov   si,offset BlackTable

    {Add last code}
@4: shl   bx,2
    les   di,Cvt
    push  es
    push  di
    push  word ptr [bx+si]
    push  word ptr [bx+si+2]
    call  acAddCodePrim
@5:
  end;
  {$ELSE}
  procedure acAddCode(Cvt : PAbsFaxCvt; RunLen : Cardinal; IsWhite : Boolean); assembler; register;
    {-Adds a code representing RunLen pixels of white (IsWhite=True) or black
      to the current line buffer}
  asm
    push  esi
    push  edi

    {load parameters}
    mov   edi,eax     {eax = Cvt}

    {long run?}
    cmp   edx,64
    jb    @2

    {long white run?}
    or    cl,cl
    jz    @1

    {long white run}
    push  edx
    shr   edx,6
    dec   edx
    mov   esi,offset WhiteMUTable
    mov   eax,edi
    mov   cx,word ptr [edx*4+esi+2]
    mov   dx,word ptr [edx*4+esi]
    call  acAddCodePrim
    pop   edx
    and   edx,63
    mov   esi,offset WhiteTable
    jmp   @4

    {long black run}
@1: push  edx
    shr   edx,6
    dec   edx
    mov   esi,offset BlackMUTable
    mov   eax,edi
    mov   cx,word ptr [edx*4+esi+2]
    mov   dx,word ptr [edx*4+esi]
    call  acAddCodePrim
    pop   edx
    and   edx,63
    mov   esi,offset BlackTable
    jmp   @4

    {Short white run?}
@2: or    cl,cl
    jz    @3

    {short white run}
    mov   esi,offset WhiteTable
    jmp   @4

    {short black run}
@3: mov   esi,offset BlackTable

    {add last code}
@4: mov   eax,edi
    mov   cx,word ptr [edx*4+esi+2]
    mov   dx,word ptr [edx*4+esi]
    call  acAddCodePrim

@5: pop   edi
    pop   esi
  end;
  {$ENDIF}

  procedure CountRunsAndAddCodes(Cvt : PAbsFaxCvt; var Buffer);
    {walk the pixel array, counting runlengths and adding codes to match}
  var
    SaveCvt       : PAbsFaxCvt;
    RunLen        : Integer;
    Width         : Integer;
    Margin        : Integer;
    TotalRunWidth : Integer;
    TotalRun      : Integer;
    IsWhite       : Boolean;
    PrevWhite     : Boolean;
    DblWdth       : Boolean;{D6}
    P             : PByte;
    B             : Byte;

  begin
    SaveCvt := Cvt;

    with Cvt^ do begin
      {Add margin}
      Width         := ResWidth;
      TotalRunWidth := ResWidth;
      Margin        := LeftMargin;
      TotalRun  := 0;
      P         := PByte(@Buffer);
      B         := P^;
      PrevWhite := ((B and $80) = 0);
      if PrevWhite then begin
        RunLen := Succ(Margin);
        IsWhite := True;
      end else begin
        {add margin, or a zero-runlength white code if there isn't one}
        RunLen := 1;
        acAddCode(Cvt, LeftMargin, True);
        Dec(TotalRunWidth, Margin);
        IsWhite := False;
      end;

      DblWdth := DoubleWidth;{D6}

      {$IFNDEF Win32}
      asm
        mov   dl,B
        mov   dh,$40
        mov   bl,PrevWhite             
        mov   bh,bl
        mov   cx,Width
        sub   cx,Margin

        {get NewWhite}
    @1: mov   bl,1
        test  dl,dh
        jz    @2
        dec   bl

        {update mask and get new byte if needed}
    @2: mov   al,dh
        shr   al,1
        jnz   @3
        inc   word ptr P
        les   di,P
        mov   dl,es:[di]
        mov   al,$80
    @3: mov   dh,al

        {NewWhite = PrevWhite?}
        cmp   bh,bl
        jne   @4

        {Last pixel?}
        cmp   cx,1
        jne   @5
        test  DblWdth,1{D6}
        jz    @4
        mov   ax,TotalRunWidth
        sub   ax,TotalRun
        mov   RunLen,ax
        shr   RunLen,1

        {Save registers}
    @4: push  bx
        push  cx
        push  dx

        {Add output code}
        test  DblWdth,1{D6}
        jz    @6
        shl   RunLen,1
    @6:
        {Increment TotalRun}
        mov   ax,TotalRun