awfview.pas

测试用例

    CHeight     : Integer;
    BackBrush   : HBrush;
    OldBmp      : HBitmap;
    ScaleOldBmp : HBitmap;
    MemDC       : HDC;
    BmpDC       : HDC;
    ScaleBmp    : HBitmap;
    PR          : TRect;
    VFill       : TRect;
    HFill       : TRect;
    ISect       : TRect;
    Client      : TRect;

    procedure FillBackground;
    var
      FillR : TRect;

    begin
      {fill the background}
      FillR := PaintInfo.rcPaint;
      Inc(FillR.Right);
      Inc(FillR.Bottom);

      FillRect(PaintDC, FillR, BackBrush);
      DeleteObject(BackBrush);
    end;

    function ScaledCoordH(PT : Integer) : Integer;
    var
      M : LongInt;
      S : Integer;

    begin
      M := PT * LongInt(vHDiv);
      S := M div LongInt(vHMult);
      if ((M mod LongInt(vHMult)) <> 0) then                        
        Inc(S);
      ScaledCoordH := S;
    end;

    function ScaledCoordV(PT : Integer) : Integer;
    var
      M : LongInt;
      S : Integer;

    begin
      M := LongInt(PT) * LongInt(vVDiv);
      S := M div LongInt(vVMult);
      if ((M mod LongInt(vVMult)) <> 0) then                         
        Inc(S);
      ScaledCoordV := S;
    end;

  begin
    PR := PaintInfo.rcPaint;

    {if the rectangle is invalid, exit}
    if (PR.Left = PR.Right) or (PR.Top = PR.Bottom) then
      Exit;

    {make a brush for filling the background}
    BackBrush := CreateSolidBrush(vBGColor);

    {if we're in design mode, then just fill our background}
    if vDesigning then begin
      FillBackground;
      TextOut(PaintDC, 3, 3, vComponentName, StrLen(vComponentName));
      Exit;
    end;

    {if there's no fax loaded, or the current page is greater than}
    {the total number of pages, there's nothing to paint          }
    if (vOnPage = 0) or (vOnPage > vNumPages) or (vImage = nil) then begin
      FillBackground;
      Exit;
    end;

    {set the foreground and background colors}
    SetTextColor(PaintDC, vFGColor);
    SetBkColor(PaintDC, vBGColor);

    {create a memory DC for painting}
    MemDC  := CreateCompatibleDC(PaintDC);
    OldBmp := SelectObject(MemDC, vImage^[vOnPage].Bitmap);

    VFill := PR;
    {calculate the width of the destination rectangle}
    Width := Succ(PR.Right - PR.Left);
    if ((LongInt(vLeftOfs) + PR.Left + Width) > LongInt(vScaledWidth)) then begin
      {fill in everything outside}
      VFill.Left := vScaledWidth - vLeftOfs;
      Inc(VFill.Right);
      Inc(VFill.Bottom);
      FillRect(PaintDC, VFill, BackBrush);

      {adjust the width}
      Dec(Width, (LongInt(vLeftOfs) + PR.Left + Width) - LongInt(vScaledWidth));  
    end;

    {calculate the height of the destination rectangle}
    Height := Succ(PR.Bottom - PR.Top);
    if ((LongInt(vTopRow) + PR.Top + Height) > LongInt(vScaledHeight)) then begin 
      HFill := PR;
      {fill in everything outside}
      HFill.Top := vScaledHeight - vTopRow;
      Inc(HFill.Right);
      Inc(HFill.Bottom);

      {if the horizontal fill rectangle intersects with the}
      {vertical fill rectangle, adjust the horizontal rect}
      {accordingly}
      {$IFNDEF Win32}
      if (IntersectRect(ISect, HFill, VFill) = 0) then
      {$ELSE}
      if not IntersectRect(ISect, HFill, VFill) then
      {$ENDIF}
        {if the intersection is equal to the horizontal rect}
        {then the full rectangle should be filled, otherwise}
        {it is adjusted}
        if not EqualRect(ISect, HFill) then
          HFill.Right := Pred(VFill.Left);

      FillRect(PaintDC, HFill, BackBrush);

      {adjust the height}
      Dec(Height, (LongInt(vTopRow) + PR.Top + Height) - LongInt(vScaledHeight)); 
    end;

    SafeYield;                                                         
    if (vHMult = 1) and (vHDiv = 1) and (vVMult = 1) and (vVDiv = 1) then begin
      if vMarked then
        InvertRect(MemDC, vMarkRect);

      {paint the bitmap}
      BitBlt(PaintDC, PR.Left, PR.Top, Width, Height, MemDC,
        LongInt(vLeftOfs) + PR.Left, LongInt(vTopRow) + PR.Top, SrcCopy);       

      if vMarked then
        InvertRect(MemDC, vMarkRect);

    end else if not vMarked then
      {scale and paint the bitmap}
      StretchBlt(PaintDC, PR.Left, PR.Top, Width, Height, MemDC,
        (LongInt(vLeftOfs) + PR.Left) * LongInt(vHDiv) div LongInt(vHMult),
        (LongInt(vTopRow) + PR.Top) * LongInt(vVDiv) div LongInt(vVMult),
        LongInt(Width) * LongInt(vHDiv) div LongInt(vHMult),
        LongInt(Height) * LongInt(vVDiv) div LongInt(vVMult), SrcCopy)
    else begin
      GetClientRect(vWnd, Client);

      {calculate the width and height of the client rectangle, adjusting}
      {for the size of the scaled bitmap}
      CWidth := Client.Right - Client.Left + 1;
      if (CWidth > LongInt(vScaledWidth - vLeftOfs)) then            
        CWidth := (vScaledWidth - vLeftOfs);
      CHeight := Client.Bottom - Client.Top + 1;
      if (CHeight > LongInt(vScaledHeight - vTopRow)) then           
        CHeight := (vScaledHeight - vTopRow);

      BmpDC       := CreateCompatibleDC(PaintDC);
      ScaleBmp    := CreateCompatibleBitmap(PaintDC, CWidth, CHeight);
      ScaleOldBmp := SelectObject(BmpDC, ScaleBmp);

      SafeYield;                                                       

      {scale the bitmap}
      StretchBlt(BmpDC, 0, 0, CWidth, CHeight,
                 MemDC,
                 ScaledCoordH(vLeftOfs),
                 ScaledCoordV(vTopRow),
                 ScaledCoordH(CWidth),
                 ScaledCoordV(CHeight),
                 SrcCopy);

      {invert the marked rectangle, if necessary}
      if vMarked then
        InvertRect(BmpDC, vMarkRect);

      SafeYield;                                                       

      BitBlt(PaintDC, PR.Left, PR.Top, Width, Height, BmpDC, PR.Left,
             PR.Top, SrcCopy);

      if vMarked then
        InvertRect(BmpDC, vMarkRect);

      SelectObject(BmpDC, ScaleOldBmp);
      DeleteObject(ScaleBmp);
      DeleteDC(BmpDC);
    end;

    SafeYield;                                                         
    {clean up}
    DeleteObject(BackBrush);
    SelectObject(MemDC, OldBmp);
    DeleteDC(MemDC);
  end;

  procedure TViewer.vGetMarkClientIntersection(var R : TRect; Mark : TRect);
    {-Find the intersection of the client rect and the marked rect}
  var
    Client : TRect;

  begin
    GetClientRect(vWnd, Client);

    Inc(Client.Top, vTopRow);
    Inc(Client.Bottom, vTopRow);
    Inc(Client.Left, vLeftOfs);
    Inc(Client.Right, vLeftOfs);

    {$IFNDEF Win32}
    if (IntersectRect(R, Mark, Client) <> 0) then begin
    {$ELSE}
    if IntersectRect(R, Mark, Client) then begin
    {$ENDIF}
      Dec(R.Top, vTopRow);
      Dec(R.Bottom, vTopRow);
      Dec(R.Left, vLeftOfs);
      Dec(R.Right, vLeftOfs);
    end else
      FillChar(R, SizeOf(TRect), 0);
  end;

  procedure TViewer.vInitDragDrop(Enabled : Bool);
    {-Initialize drag and drop features}
  begin
    vDragDrop := Enabled;
    if Enabled then
      DragAcceptFiles(vWnd, True);
  end;

  function TViewer.apwViewSetFile(FName : PChar) : Integer;
    {-Set the file name of the file to view}
  var
    I         : Word;
    Code      : Integer;
    OldCursor : HCursor;
    FH        : TFaxHeaderRec;

  begin
    apwViewSetFile := ecOK;

    if (FName[0] = #0) then begin
      vFileName[0] := #0;
      vDisposeFax;
      Exit;
    end;

    {make sure the file is an APF file}
    if not ExistFileZ(FName) then begin
      apwViewSetFile := ecFileNotFound;
      Exit;
    end;

    if not awIsAnAPFFile(FName) then begin
      apwViewSetFile := ecFaxBadFormat;
      Exit;
    end;

    vDisposeFax;
    StrCopy(vFileName, FName);
    vInvalidateAll;
    UpdateWindow(vWnd);

    {get the number of pages}
    Code := upGetFaxHeader(vUnpacker, FName, FH);
    if (Code < ecOK) then begin
      apwViewSetFile := Code;
      Exit;
    end;

    {allocate the image}
    vAllocFax(FH.PageCount);

    {load each page into the bitmap}
    if vLoadWholeFax then begin
      OldCursor := SetCursor(vBusyCursor);
      for I := 1 to FH.PageCount do begin
        Code := upUnpackPageToBitmap(vUnpacker, FName, I, vImage^[I], True);
        if (Code < ecOK) then begin
          SetCursor(OldCursor);
          apwViewSetFile := Code;
          Exit;
        end;
      end;
      SetCursor(OldCursor);
    end else begin
      OldCursor := Setcursor(vBusyCursor);
      Code := upUnpackPageToBitmap(vUnpacker, FName, 1, vImage^[1], True);
      if (Code < ecOK) then begin
        SetCursor(OldCursor);
        apwViewSetFile := Code;
        Exit;
      end;
      SetCursor(OldCursor);
    end;

    vOnPage    := 1;
    vRotateDir := 0;
    vHMult     := 1;
    vHDiv      := 1;
    vVMult     := 1;
    vVDiv      := 1;
    vInitPage;

    apwViewSetFile := ecOK;
  end;

  procedure TViewer.apwViewSetFG(Color : LongInt);
    {-Set the foreground color}
  begin
    vFGColor := Color;
  end;

  procedure TViewer.apwViewSetBG(Color : LongInt);
    {-Set the background color}
  begin
    vBGColor := Color;
  end;

  procedure TViewer.apwViewSetScale(Settings : PScaleSettings);
    {-Set scaling factors}
  var
    OldHMult : Word;
    OldHDiv  : Word;
    OldVMult : Word;
    OldVDiv  : Word;

  begin
    if (Settings = nil) then
      Exit;

    OldHMult := vHMult;
    OldHDiv  := vHDiv;
    OldVMult := vVMult;
    OldVDiv  := vVDiv;

    with Settings^ do begin
      vHMult := HMult;
      vHDiv  := HDiv;
      if (vHMult = vHDiv) then begin
        vHMult := 1;
        vHDiv  := 1;
      end;

      vVMult := VMult;
      vVDiv  := VDiv;
      if (vVMult = vVDiv) then begin
        vVMult := 1;
        vVDiv  := 1;
      end;
    end;

    {only update screen if image loaded settings have changed}
    if (vImage = nil) or
       ((OldHMult = vHMult) and (OldHDiv = vHDiv) and
        (OldVMult = vVMult) and (OldVDiv = vVDiv)) then
      Exit;

    {scale the current offsets, scrollbar positions, etc.}
    if not vUpdating then
      vInitPage;
  end;

  function TViewer.apwViewSetWhitespace(FromLines, ToLines : Cardinal) : Integer;
    {-Set whitespace compression factors}
  begin
    apwViewSetWhitespace := upSetWhitespaceCompression(vUnpacker, FromLines, ToLines);
  end;

  procedure TViewer.apwViewSetScroll(HScroll, VScroll : Cardinal);
    {-Set the vertical and horizontal scroll increments}
  begin
    if (HScroll <> 0) then
      vHScrollInc := HScroll;
    if (VScroll <> 0) then
      vVScrollInc := VScroll;
  end;

  function TViewer.apwViewSelectAll : Integer;
    {-Select entire image}
  begin
    if (vImage = nil) then
      apwViewSelectAll := ecNoImageLoaded
    else begin
      if vCaptured then begin
        ReleaseCapture;
        if vOutsideEdge then
          KillTimer(vWnd, 1);
        vCaptured := False;
      end;

      apwViewSelectAll := ecOK;

      vMarked := True;
      vMarkRect.Left   := 0;
      vMarkRect.Top    := 0;
      vMarkRect.Right  := Pred(vScaledWidth);
      vMarkRect.Bottom := Pred(vScaledHeight);
      vInvalidateAll;
      UpdateWindow(vWnd);
    end;
  end;

  {$IFNDEF Win32}
  function MaxCard(C1, C2 : Cardinal) : Cardinal; assembler;
  asm
    mov   ax,C1
    mov   bx,C2
    cmp   ax,bx
    jae   @1
    mov   ax,bx
@1:
  end;

  function MinCard(C1, C2 : Cardinal) : Cardinal; assembler;
  asm
    mov   ax,C1
    mov   bx,C2
    cmp   ax,bx
    jbe   @1
    mov   ax,bx
@1:
  end;
  {$ELSE}
  function MaxCard(C1, C2 : Cardinal) : Cardinal; assembler;
  asm
    cmp   eax,edx
    jae   @1
    mov   eax,edx
@1:
  end;

  function MinCard(C1, C2 : Cardinal) : Cardinal; assembler;
  asm
    cmp   eax,edx
    jbe   @1
    mov   eax,edx                                                   
@1:
  end;
  {$ENDIF}

  function TViewer.apwViewSelect(R : PRect) : Integer;
    {-Select a portion of fax image}
  begin
    if (vImage = nil) then
      apwViewSelect := ecNoImageLoaded
    else begin
      apwViewSelect := ecOK;
      if (R = nil) then
        Exit;

      if vCaptured then begin
        ReleaseCapture;
        vCaptured := False;
      end;

      vMarked := True;

      vMarkRect        := R^;
      vMarkRect.Left   := MaxCard(0, vMarkRect.Left);
      vMarkRect.Top    := MaxCard(0, vMarkRect.Top);
      vMarkR