awfview.pas

测试用例

    sub   esi,BytesPerRow

    xor   dl,dl
    shl   ax,1
    rcr   dl,cl
    or    [esi],dl
    sub   esi,BytesPerRow

    dec   ebx             {decrement counter}
    jnz   @1              {any data left? jump if so}

    pop   edi
    pop   esi
    pop   ebx
  end;

{$ENDIF}

  function TViewer.vRotatePage(const PageNum, Direction : Cardinal) : Integer;
    {-Rotate a page}
  var
    NewWidth        : Cardinal;
    NewHeight       : Cardinal;
    NewBitmap       : HBitmap;
    BytesPerLine    : Cardinal;
    NewBytesPerLine : Cardinal;
    BmpHandle       : THandle;
    BmpPtr          : Pointer;
    NewHandle       : THandle;
    NewPtr          : Pointer;
    SrcBuf          : Pointer;
    DestBuf         : Pointer;

    function AllocTemporary(var B : TMemoryBitmapDesc) : Boolean;
    var
      Sz      : LongInt;
      BmpInfo : TBitmap;

    begin
      AllocTemporary := False;

      with B do begin
        {get information about this bitmap}
        GetObject(B.Bitmap, SizeOf(TBitmap), @BmpInfo);
        BytesPerLine := BmpInfo.bmWidthBytes;
        Sz           := LongInt(BytesPerLine) * LongInt(Height);    

        {allocate a buffer to hold the bitmap bits}
        BmpHandle := GlobalAlloc(gmem_Moveable or gmem_ZeroInit, Sz);
        if (BmpHandle = 0) then
          Exit;
        BmpPtr := GlobalLock(BmpHandle);
        if (BmpPtr = nil) then begin
          GlobalFree(BmpHandle);
          Exit;
        end;

        if (Direction = 2) then begin
          {allocate two temporary buffers for reversing bit patterns}
          SrcBuf := AllocMem(BytesPerLine);
          DestBuf := AllocMem(BytesPerLine);
        end else begin
          NewHeight := BytesPerLine * 8;
          NewWidth  := Height;

          NewBitmap := CreateBitmap(NewWidth, NewHeight, 1, 1, nil);
          GetObject(NewBitmap, SizeOf(TBitmap), @BmpInfo);
          NewBytesPerLine := BmpInfo.bmWidthBytes;

          {allocate temporary buffer to hold new bitmap}
          Sz := LongInt(NewBytesPerLine) * LongInt(NewHeight);    
          NewHandle := GlobalAlloc(gmem_Moveable or gmem_ZeroInit, Sz);
          if (NewHandle = 0) then begin
            GlobalUnlock(BmpHandle);
            GlobalFree(BmpHandle);
            Exit;
          end;
          NewPtr := GlobalLock(NewHandle);
          if (NewPtr = nil) then begin
            GlobalFree(NewHandle);
            GlobalUnlock(BmpHandle);
            GlobalFree(BmpHandle);
            Exit;
          end;
        end;

        GetBitmapBits(Bitmap, Sz, BmpPtr);
      end;

      AllocTemporary := True;
    end;

    procedure FreeTemporary;
    begin
      GlobalUnlock(BmpHandle);
      GlobalFree(BmpHandle);
      if (Direction = 2) then begin
        FreeMem(SrcBuf, BytesPerLine);
        FreeMem(DestBuf, BytesPerLine);
      end else begin
        GlobalUnlock(NewHandle);
        GlobalFree(NewHandle);
      end;
    end;

    {$IFNDEF Win32}
    procedure HugeFill(Dest : Pointer; Len : Integer; Value : Byte); assembler;
    asm
      mov   dx,Len
      les   di,Dest

  @1: or    dx,dx
      jz    @4
      xor   cx,cx
      sub   cx,di
      or    cx,cx
      jnz   @2
      mov   cx,dx
      jmp   @3

  @2: cmp   cx,dx
      jbe   @3
      mov   cx,dx

  @3: sub   dx,cx
      mov   al,Value
      mov   ah,al
      shr   cx,1
      rep   stosw
      adc   cx,cx
      rep   stosb

      or    dx,dx
      jz    @4
      mov   bx,es
      add   bx,8
      mov   es,bx
      xor   di,di
      mov   cx,dx
      shr   cx,1
      rep   stosw
      adc   cx,cx
      rep   stosb
  @4:
    end;
    {$ELSE}
    procedure HugeFill(Dest : Pointer; Len : Integer; Value : Byte);
    begin
      FillChar(Dest^, Len, Value);
    end;
    {$ENDIF}

    procedure Rotate90(var B : TMemoryBitmapDesc);
    var
      I        : LongInt;                                         
      Col      : Cardinal;
      Bit      : Cardinal;
      ActBytes : Cardinal;
      DestCol  : Pointer;

    begin
      Col      := (NewWidth - 1) div 8;
      Bit      := (NewWidth - 1) mod 8;  
      DestCol  := GetPtr(NewPtr, Col);
      ActBytes := (B.Width div 8) + Cardinal(Ord((B.Width mod 8) <> 0)); 

      {$IFOPT Q+}
      {$DEFINE QOn}
      {$ENDIF}
      {$Q-}
      for I := 0 to Pred(NewWidth) do begin 
        BitBltRot90(DestCol, GetPtr(BmpPtr, LongInt(BytesPerLine) * I), Bit, NewBytesPerLine, ActBytes);
        if (Bit = 0) then begin
          Bit := 7;
          Dec(Col);
          DestCol := GetPtr(NewPtr, Col);
        end else
          Dec(Bit);
      end;
      for I := (B.Width - (B.Width mod 8)) to Pred(NewHeight) do
        HugeFill(GetPtr(NewPtr, LongInt(NewBytesPerLine) * I), NewBytesPerLine, $FF);
      {$IFDEF QOn}
      {$Q+}
      {$ENDIF}

      B.Width  := NewWidth;
      B.Height := NewHeight;
      DeleteObject(B.Bitmap);
      B.Bitmap := NewBitmap;
      SetBitmapBits(B.Bitmap,
        LongInt(NewBytesPerLine) * LongInt(NewHeight), NewPtr);      
    end;

    procedure Rotate180(var B : TMemoryBitmapDesc);
    var
      I         : LongInt;
      J         : LongInt;
      ActBytes  : Cardinal;
      Ofs       : LongInt;
      IOfs      : LongInt;
      JOfs      : LongInt;
      Remaining : Byte;
      Mask      : Byte;

    begin
      Remaining := (B.Width mod 8);
      ActBytes  := (B.Width div 8) + Cardinal(Ord(Remaining <> 0));
      I         := 0;
      J         := Pred(B.Height);

      if (Remaining <> 0) then
        Mask := ($FF shr Remaining)
      else
        Mask := 0;                                                  

      while (I < J) do begin
        IOfs := LongInt(BytesPerLine) * I;
        JOfs := LongInt(BytesPerLine) * J;

        {$IFNDEF Win32}
        hmemcpy(SrcBuf, GetPtr(BmpPtr, IOfs), ActBytes);
        if (Remaining <> 0) then
          PByteArray(SrcBuf)^[ActBytes-1] := PByteArray(SrcBuf)^[ActBytes-1] or Mask;
        if (ActBytes <> BytesPerLine) then
          FillChar(GetPtr(SrcBuf, ActBytes)^, BytesPerLine - ActBytes, $FF);
        ReverseBits(DestBuf, SrcBuf, BytesPerLine);
        hmemcpy(SrcBuf, GetPtr(BmpPtr, JOfs), ActBytes);
        if (Remaining <> 0) then
          PByteArray(SrcBuf)^[ActBytes-1] := PByteArray(SrcBuf)^[ActBytes-1] or Mask;
        if (ActBytes <> BytesPerLine) then
          FillChar(GetPtr(SrcBuf, ActBytes)^, BytesPerLine - ActBytes, $FF);
        hmemcpy(GetPtr(BmpPtr, JOfs), DestBuf, BytesPerLine);
        ReverseBits(DestBuf, SrcBuf, BytesPerLine);
        hmemcpy(GetPtr(BmpPtr, IOfs), DestBuf, BytesPerLine);
        {$ELSE}
        Move(GetPtr(BmpPtr, IOfs)^, SrcBuf^, ActBytes);
        if (Remaining <> 0) then
          PByteArray(SrcBuf)^[ActBytes-1] := PByteArray(SrcBuf)^[ActBytes-1] or Mask;
        if (ActBytes <> BytesPerLine) then
          FillChar(GetPtr(SrcBuf, ActBytes)^, BytesPerLine - ActBytes, $FF);
        ReverseBits(DestBuf, SrcBuf, BytesPerLine);
        Move(GetPtr(BmpPtr, JOfs)^, SrcBuf^, ActBytes);
        if (Remaining <> 0) then
          PByteArray(SrcBuf)^[ActBytes-1] := PByteArray(SrcBuf)^[ActBytes-1] or Mask;
        if (ActBytes <> BytesPerLine) then
          FillChar(GetPtr(SrcBuf, ActBytes)^, BytesPerLine - ActBytes, $FF);
        Move(DestBuf^, GetPtr(BmpPtr, JOfs)^, BytesPerLine);
        ReverseBits(DestBuf, SrcBuf, BytesPerLine);
        Move(DestBuf^, GetPtr(BmpPtr, IOfs)^, BytesPerLine);
        {$ENDIF}

        Inc(I);
        Dec(J);
      end;

      {if there's a stray line, reverse it}
      if Odd(B.Height) then begin
        Ofs := LongInt(BytesPerLine) * LongInt(B.Height div 2);   

        {$IFNDEF Win32}
        hmemcpy(SrcBuf, GetPtr(BmpPtr, Ofs), BytesPerLine);
        if (Remaining <> 0) then
          PByteArray(SrcBuf)^[ActBytes-1] := PByteArray(SrcBuf)^[ActBytes-1] or Mask;
        if (ActBytes <> BytesPerLine) then
          FillChar(GetPtr(SrcBuf, ActBytes)^, BytesPerLine - ActBytes, $FF);
        ReverseBits(DestBuf, SrcBuf, BytesPerLine);
        hmemcpy(GetPtr(BmpPtr, Ofs), DestBuf, BytesPerLine);
        {$ELSE}
        Move(GetPtr(BmpPtr, Ofs)^, SrcBuf^, BytesPerLine);
        if (Remaining <> 0) then
          PByteArray(SrcBuf)^[ActBytes-1] := PByteArray(SrcBuf)^[ActBytes-1] or Mask;
        if (ActBytes <> BytesPerLine) then
          FillChar(GetPtr(SrcBuf, ActBytes)^, BytesPerLine - ActBytes, $FF);
        ReverseBits(DestBuf, SrcBuf, BytesPerLine);
        Move(DestBuf^, GetPtr(BmpPtr, Ofs)^, BytesPerLine);
        {$ENDIF}
      end;

      SetBitmapBits(B.Bitmap, LongInt(BytesPerLine) * LongInt(B.Height), BmpPtr);
    end;

    procedure Rotate270(var B : TMemoryBitmapDesc);
    var
      I        : LongInt;                                            
      Col      : Cardinal;
      Bit      : Cardinal;
      ActBytes : Cardinal;
      DestCol  : Pointer;

    begin
      Col      := 0;
      Bit      := 0;
      DestCol  := GetPtr(NewPtr, DWORD(NewBytesPerLine) * Pred(NewHeight));
      ActBytes := (B.Width div 8) + Cardinal(Ord((B.Width mod 8) <> 0));   

      {$IFOPT Q+}
      {$DEFINE QOn}
      {$ENDIF}
      {$Q-}
      for I := 0 to Pred(NewWidth) do begin
        BitBltRot270(DestCol, GetPtr(BmpPtr, LongInt(BytesPerLine) * I), Bit, NewBytesPerLine, ActBytes);
        if (Bit = 7) then begin
          Bit := 0;
          Inc(Col);
          DestCol := GetPtr(NewPtr, (DWORD(NewBytesPerLine) * Pred(NewHeight)) + Col);
        end else
          Inc(Bit);
      end;
      if (NewHeight > (B.Width - (B.Width mod 8))) then
        for I := 0 to (NewHeight - (B.Width - (B.Width mod 8))) do
          HugeFill(GetPtr(NewPtr, LongInt(NewBytesPerLine) * I), NewBytesPerLine, $FF);
      {$IFDEF QOn}
      {$Q+}
      {$ENDIF}

      B.Width  := NewWidth;
      B.Height := NewHeight;
      DeleteObject(B.Bitmap);
      B.Bitmap := NewBitmap;
      SetBitmapBits(B.Bitmap, LongInt(NewBytesPerLine) * LongInt(NewHeight), NewPtr);
    end;

  begin
    if not AllocTemporary(vImage^[PageNum]) then begin
      vRotatePage := ecOutOfMemory;
      Exit;
    end;

    vRotatePage := ecOK;

    case Direction of
      1: Rotate90(vImage^[PageNum]);
      2: Rotate180(vImage^[PageNum]);
      3: Rotate270(vImage^[PageNum]);
    end;

    FreeTemporary;
  end;

  procedure TViewer.vUpdateMarkRect(Client : TRect; X, Y : Integer);
    {-Update the mark rectangle}
  var
    NewMark : TRect;
    Total   : TRect;
    Dest    : TRect;

  begin
    if (vImage = nil) then
      Exit;
    NewMark := vMarkRect;

    {change the anchor corner's coordinate}
    case vAnchorCorner of
      1: begin NewMark.Right := X; NewMark.Bottom := Y; end;
      2: begin NewMark.Left  := X; NewMark.Bottom := Y; end;
      3: begin NewMark.Left  := X; NewMark.Top    := Y; end;
      4: begin NewMark.Right := X; NewMark.Top    := Y; end;
    end;

    {fix the rectangle}
    if (NewMark.Right < NewMark.Left) then
      ExchangeInts(NewMark.Right, NewMark.Left);
    if (NewMark.Bottom < NewMark.Top) then
      ExchangeInts(NewMark.Bottom, NewMark.Top);

    {find the new anchor corner}
    if (X = NewMark.Right) and (Y = NewMark.Bottom) then
      vAnchorCorner := 1
    else if (X = NewMark.Right) and (Y = NewMark.Top) then
      vAnchorCorner := 4
    else if (X = NewMark.Left) and (Y = NewMark.Bottom) then
      vAnchorCorner := 2
    else if (X = NewMark.Left) and (Y = NewMark.Top) then
      vAnchorCorner := 3;

    {adjust the new marked rectangle so it doesn't exceed the image maximums}
    if (NewMark.Right >= Integer(vScaledWidth)) then
      NewMark.Right := Pred(vScaledWidth);
    if (NewMark.Bottom >= Integer(vScaledHeight)) then               
      NewMark.Bottom := Pred(vScaledHeight);
    if (NewMark.Left < 0) then
      NewMark.Left := 0;
    if (NewMark.Top < 0) then
      NewMark.Top := 0;

    {find the area that needs updating}
    UnionRect(Total, NewMark, vMarkRect);
    vMarkRect := NewMark;

    vGetMarkClientIntersection(Dest, Total);
    if (Dest.Left <> Dest.Right) and (Dest.Top <> Dest.Bottom) then begin
      InvalidateRect(vWnd, @Dest, False);
      UpdateWindow(vWnd);
    end;
  end;

  procedure TViewer.vCopyToClipboard;
    {-Copy the marked bitmap to the clipboard}
  var
    W      : Word;
    H      : Word;
    B      : HBitmap;
    TempDC : HDC;
    DC1    : HDC;
    DC2    : HDC;

  begin
    if (vImage = nil) or not vMarked then
      Exit;

    {calculate width and height of clipbitmap}
    W := Succ(vMarkRect.Right - vMarkRect.Left);
    H := Succ(vMarkRect.Bottom - vMarkRect.Top);

    {create the destination monochrome bitmap}
    B := CreateBitmap(W, H, 1, 1, nil);

    {create a temporary DC compatible with the diplay}
    TempDC := GetDC(vWnd);

    {create two memory DCs for the copy of the bitmap}
    DC1 := CreateCompatibleDC(TempDC);
    ReleaseDC(vWnd, TempDC);
    DC2 := CreateCompatibleDC(DC1);

    {select the source bitmap into the source context}
    SelectObject(DC1, vImage^[vOnPage].Bitmap);

    {select the destination bitmap into the destination context}
    SelectObject(DC2, B);

    SafeYield;                                                         

    {copy the bitmap}
    if (vVMult = 1) and (vHMult = 1) and (vVDiv = 1) and (vHMult = 1) then
      BitBlt(DC2, 0, 0, W, H, DC1, vMarkRect.Left, vMarkRect.Top, SrcCopy)
    else
      StretchBlt(DC2, 0, 0, W, H, DC1,
                 (DWORD(vMarkRect.Left) * vHDiv) div vHMult,
                 (DWORD(vMarkRect.Top)  * vVDiv) div vVMult,
                 (DWORD(W) * vHDiv) div vHMult,
                 (DWORD(H) * vVDiv) div vVMult,
                 SrcCopy);

    SafeYield;                                                         

    {free resources}
    DeleteDC(DC1);
    DeleteDC(DC2);

    {put the data in the clipboard}
    if not OpenClipboard(vWnd) then exit;
    SetClipboardData(cf_Bitmap, B);
    CloseClipboard;
  end;

  procedure TViewer.vInvalidateAll;
    {-Invalidate the entire viewer window}
  begin
    InvalidateRect(vWnd, nil, True);
  end;

  procedure TViewer.vPaint(PaintDC : HDC; var PaintInfo : TPaintStruct);
    {-Paint a rectangle of image}
  var
    Width       : Integer;
    Height      : Integer;
    CWidth      : Integer;