awfaxcvt.pas

测试用例

        add   ax,RunLen
        mov   TotalRun,ax

        les   di,Cvt
        push  es
        push  di
        push  RunLen
        push  word ptr IsWhite
        call  acAddCode

        {Restore registers}
        pop   dx
        pop   cx
        pop   bx

        {Update state}
        xor   IsWhite,1
        mov   RunLen,0
        mov   bh,bl

        {Increment RunLen and loop}
    @5: inc   RunLen
        loop  @1
      end;

      {$ELSE}

      asm
        push  edi
        push  ebx

        mov   dl,B
        mov   dh,$40
        movzx ebx,PrevWhite                                         
        mov   bh,bl
        mov   ecx,Width
        sub   ecx,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   dword ptr P
        mov   edi,P
        mov   dl,byte ptr [edi]
        mov   al,$80
    @3: mov   dh,al

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

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

        {Save registers}
    @4: push  eax
        push  edx
        push  ecx

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

        mov   eax,SaveCvt
        mov   edx,RunLen
        movzx ecx,IsWhite                                         
        call  acAddCode

        {Restore registers}
        pop   ecx
        pop   edx
        pop   eax

        {Update state}
        xor   IsWhite,1
        mov   RunLen,0
        mov   bh,bl

        {Increment RunLen and loop}
    @5: inc   RunLen
        dec   ecx
        jnz   @1

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

  procedure acCompressRasterLine(Cvt : PAbsFaxCvt; var Buffer);
    {-compress a raster line of bits into runlength codes}
  var
    Width   : Cardinal;
    P       : PByte;                                               
    IsWhite : Boolean;

  begin
    with Cvt^ do begin
      {clear used portion of previous line}
      FastZero(DataLine^, ByteOfs+1);

      ByteOfs := 0;
      BitOfs  := 0;

      {add EOL code}
      acAddCodePrim(Cvt, LongEOLRec.Code, LongEOLRec.Sig);

      {is the line all white?}
      P     := PByte(@Buffer);                                   
      Width := ResWidth;

      {$IFNDEF Win32}
      asm
        les   di,P
        xor   al,al
        mov   cx,Width
        shr   cx,3
        cld
        repe  scasb
        mov   IsWhite,True
        je    @1
        mov   IsWhite,False
    @1:
      end;
      {$ELSE}
      asm
        push  edi
        mov   edi,P
        xor   eax,eax
        mov   ecx,Width
        shr   ecx,3
        cld
        repe  scasb
        mov   IsWhite,True
        je    @1
        mov   IsWhite,False
    @1: pop   edi
      end;
      {$ENDIF}

      if IsWhite then
        {yes; add a single code for the all-white line}
        acAddCode(Cvt, Width, True)

      else
        CountRunsAndAddCodes(Cvt, Buffer);

      {Make sure there are at least LinePadSize nulls after the data}
      ByteOfs := ByteOfs + LinePadSize;
    end;
  end;

  function acConvertStatus(Cvt : PAbsFaxCvt; StatFlags : Word) : Integer;
  begin
    acConvertStatus := ecOK;

    with Cvt^ do begin
      if (StatusWnd <> 0) then begin
        if (SendMessage(StatusWnd, apw_FaxCvtStatus, StatFlags, LongInt(Cvt)) <> 0) then
          acConvertStatus := ecConvertAbort;
      end else if (@StatusFunc <> nil) then
        if StatusFunc(Cvt, StatFlags, BytesRead, BytesToRead) then
          acConvertStatus := ecConvertAbort;
    end;
  end;


  function acOpenFile(Cvt : PAbsFaxCvt; FileName : PChar) : Integer;
    {-Open a converter input file}
  begin
    with Cvt^ do
      if (@OpenCall <> nil) then
        acOpenFile := OpenCall(Cvt, FileName)
      else
        acOpenFile := ecOK;                                           
  end;

  procedure acCloseFile(Cvt : PAbsFaxCvt);
    {-Close a converter input file}
  begin
    with Cvt^ do
      if (@CloseCall <> nil) then
        CloseCall(Cvt);
  end;

  function acGetRasterLine(Cvt : PAbsFaxCvt; var Data; var Len : Integer;
                           var EndOfPage, MorePages : Bool) : Integer;
    {-Read a raster line from an input file}
  var
    Code : Integer;

  begin
    with Cvt^ do begin
      Inc(CurrLine);
      Code := GetLine(Cvt, Data, Len, EndOfPage, MorePages);
      if (Code = ecOK) then
        Code := acConvertStatus(Cvt, 0);
      acGetRasterLine := Code;
    end;
  end;

  function acAddData(Cvt : PAbsFaxCvt; var Buffer; Len : Cardinal; DoInc : Bool) : Integer;
    {-Add a block of data to the output file}
  begin
    with Cvt^ do begin
      {write the data to the file}
      acAddData := WriteOutFile(OutFile, Buffer, Len);

      {increment the length of the image data}
      if DoInc then
        Inc(PageHeader.ImgLength, Len);
    end;
  end;

  function acAddLine(Cvt : PAbsFaxCvt; var Buffer; Len : Cardinal) : Integer;
    {-Add a line of image data to the file}
  var
    Code : Integer;

  begin
    {add a length word for the data}
    Code := acAddData(Cvt, Len, SizeOf(Word), True);

    {add the data}
    if (Code = ecOK) then
      Code := acAddData(Cvt, Buffer, Len, True);
    acAddLine := Code;
  end;

  procedure acMakeEndOfPage(Cvt : PAbsFaxCvt; var Buffer; var Len : Integer);
    {-Encode end-of-page data into Buffer}
  var
    I : Cardinal;

  begin
    with Cvt^ do begin
      acInitDataLine(Cvt);
      acAddCodePrim(Cvt, LongEOLRec.Code, LongEOLRec.Sig);
      for I := 1 to 7 do                                           
        acAddCodePrim(Cvt, EOLRec.Code, EOLRec.Sig);

      Move(DataLine^, Buffer, ByteOfs);
      Len := ByteOfs;
    end;
  end;

  function acOutToFileCallback(Cvt : PAbsFaxCvt; var Data; Len : Integer;
                               EndOfPage, MorePages : Bool) : Integer;
    {-Output a compressed raster line to an APF file}
  var
    Code : Integer;
    I    : Integer;

    function UpdatePageHeader : Integer;
      {-update the current page's header}
    label
      Breakout;

    var
      Code : Integer;
      L    : LongInt;

    begin
      with Cvt^ do begin
        {save current file position for later}
        L := OutFilePosn(OutFile);

        {go to the page header}
        Code := SeekOutFile(OutFile, CurPagePos);
        if (Code < ecOK) then
          goto Breakout;

        {update the header}
        Code := WriteOutFile(Outfile, PageHeader, SizeOf(TPageHeaderRec));
        if (Code < ecOK) then
          goto Breakout;

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

      Breakout:
        UpdatePageHeader := Code;
      end;
    end;

  begin
    acOutToFileCallback := ecOK;

    with Cvt^ do begin
      if EndOfPage then begin
        {make end of page marker}
        acInitDataLine(Cvt);
        acAddCodePrim(Cvt, LongEOLRec.Code, LongEOLRec.Sig);
        for I := 1 to 7 do                                      
          acAddCodePrim(Cvt, EOLRec.Code, EOLRec.Sig);

        {add end of page to output}
        Code := acAddLine(Cvt, DataLine^, ByteOfs);
        if (Code < ecOK) then begin
          acOutToFileCallback := Code;
          Exit;
        end;

        {increment page count}
        Inc(MainHeader.PageCount);
        Code := UpdatePageHeader;
        if (Code < ecOK) then begin
          acOutToFileCallback := Code;
          Exit;
        end;
      end else if (LastPage <> CurrPage) then begin
        {create the page header}
        FastZero(PageHeader, SizeOf(PageHeader));
        with PageHeader do begin
          ImgFlags := ffLengthWords;
          if UseHighRes then
            ImgFlags := ImgFlags or ffHighRes;
          if (ResWidth = WideWidth) then
            ImgFlags := ImgFlags or ffHighWidth;
        end;

        {put the page header to the file}
        CurPagePos := OutFilePosn(OutFile);
        Code := acAddData(Cvt, PageHeader, SizeOf(PageHeader), False);
        if (Code < ecOK) then begin
          acOutToFileCallback := Code;
          Exit;
        end;

        LastPage := CurrPage;
      end;

      if not EndOfPage then
        acOutToFileCallback := acAddLine(Cvt, Data, Len);
    end;
  end;

  function ConverterYield : Integer;
    {-Yield a timeslice to other windows procedures}
  var
    Msg : TMsg;

  begin
    ConverterYield := ecOK;
    if PeekMessage(Msg, 0, 0, 0, PM_REMOVE) then
      if (Msg.Message = wm_Quit) then begin
        PostQuitMessage(Msg.wParam);
        ConverterYield := ecGotQuitMsg;
      end else begin
        TranslateMessage(Msg);
        DispatchMessage(Msg);
        ConverterYield := ecOK;
      end;
  end;

  function acCreateOutputFile(Cvt : PAbsFaxCvt) : Integer;
    {-Create an APF file}
  var
    Code : Integer;

  begin
    with Cvt^ do begin
      {initialize fax file and page headers}
      FastZero(MainHeader, SizeOf(MainHeader));
      Move(DefAPFSig, MainHeader.Signature, SizeOf(MainHeader.Signature));
      MainHeader.PageOfs := SizeOf(MainHeader);
      FastZero(PageHeader, SizeOf(PageHeader));

      {create output file}
      Code := InitOutFile(OutFile, OutFileName);
      if (Code = ecOK) then
        Code := WriteOutFile(OutFile, MainHeader, SizeOf(Mainheader));

      acCreateOutputFile := Code;
    end;
  end;

  function acCloseOutputFile(Cvt : PAbsFaxCvt) : Integer;
    {-Close an APF file}
  var
    Code : Integer;

    {$IFNDEF Win32}
    function NowAsFileDate: Longint;
    var
      Month, Day, Hour, Min, Sec, HSec: Byte;
    var
      Year: Word;
    begin
      asm
        MOV     AH,2AH
        INT     21H
        MOV     Year,CX
        MOV     Month,DH
        MOV     Day,DL
        MOV     AH,2CH
        INT     21H
        MOV     Hour,CH
        MOV     Min,CL
        MOV     Sec,DH
        MOV     HSec,DL
      end;
      LongRec(Result).Lo := (Sec shr 1) or (Min shl 5) or (Hour shl 11);
      LongRec(Result).Hi := Day or (Month shl 5) or ((Year - 1980) shl 9);
    end;
    {$ENDIF}

    function GetPackedDateTime : LongInt;
      {-Get the current date and time in BP7 packed date format}
    var
      DT : TDateTime;
    begin
      {$IFDEF Win32}
      DT     := Now;
      Result := DateTimeToFileDate(DT);
      {$ELSE}
      Result := NowAsFileDate;                                      
      {$ENDIF}
    end;

    function UpdateMainHeader : Integer;
      {-update the contents of the main header in the file}
    label
      Breakout;

    var
      Code : Integer;
      L    : LongInt;
      SLen : Cardinal;

    begin
      with Cvt^ do begin
        {refresh needed fields of MainHeader rec}
        with MainHeader do begin
          SenderID := StrPas(StationID);
          SLen     := Length(SenderID);
          if (SLen < 20) then
            FillChar(SenderID[Succ(SLen)], 20 - SLen, 32);

          FDateTime := GetPackedDateTime;
        end;

        {save current file position for later}
        L := OutFilePosn(OutFile);

        {seek to head of file}
        Code := SeekOutFile(OutFile, 0);
        if (Code < ecOK) then
          goto Breakout;

        {write the header}