reportcontrol.pas

delphi编程控件

  // Calc CellRect & TextRect here
  // 如果CELL的大小或者文本框的大小改变，自动的置窗口的失效区

  If FCellsList.Count <= 0 Then
    Begin
      // 计算CELL的矩形
      FCellRect.left := FCellLeft;
      FCellRect.top := CellTop;
      FCellRect.right := FCellRect.left + FCellWidth;
      FCellRect.bottom := FCellRect.top + OwnerLineHeight;

      // 计算文本框的矩形
      TempRect := FCellRect;

      TempRect.left := TempRect.Left + FLeftMargin + 1;
      TempRect.top := TempRect.top + FTopLineWidth + 1;
      TempRect.right := TempRect.right - FLeftMargin - 1;
      TempRect.bottom := TempRect.top + FMinCellHeight - 2 - FTopLineWidth - FBottomLineWidth;

      Case FVertAlign Of
        TEXT_ALIGN_VCENTER :
          Begin
            TempRect.Top := TempRect.Top + trunc((OwnerLineHeight - FMinCellHeight) / 2 + 0.5);
            TempRect.Bottom := TempRect.Bottom + trunc((OwnerLineHeight - FMinCellHeight) / 2 + 0.5);
          End;
        TEXT_ALIGN_BOTTOM :
          Begin
            TempRect.Top := TempRect.Top + OwnerLineHeight - FMinCellHeight;
            TempRect.Bottom := TempRect.Bottom + OwnerLineHeight - FMinCellHeight;
          End;
      End;

      FTextRect := TempRect;
    End
  Else
    Begin
      TotalHeight := OwnerLineHeight;

      For I := 0 To FCellsList.Count - 1 Do
        TotalHeight := TotalHeight + TReportCell(FCellsList[I]).OwnerLineHeight;

      FCellRect.left := FCellLeft;
      FCellRect.top := CellTop;
      FCellRect.right := FCellRect.left + FCellWidth;
      FCellRect.bottom := FCellRect.top + TotalHeight;

      // 计算文本框的矩形
      TempRect := FCellRect;

      TempRect.left := TempRect.Left + FLeftMargin + 1;
      TempRect.top := TempRect.top + FTopLineWidth + 1;
      TempRect.right := TempRect.right - FLeftMargin;
      TempRect.bottom := TempRect.top + FRequiredCellHeight - 2 - FTopLineWidth - FBottomLineWidth;

      Case FVertAlign Of
        TEXT_ALIGN_VCENTER :
          Begin
            TempRect.Top := TempRect.Top + trunc((FCellRect.Bottom - FCellRect.Top - FRequiredCellHeight) / 2 + 0.5);
            TempRect.Bottom := TempRect.Bottom + trunc((FCellRect.Bottom - FCellRect.Top - FRequiredCellHeight) / 2 + 0.5);
          End;
        TEXT_ALIGN_BOTTOM :
          Begin
            TempRect.Top := TempRect.Top + FCellRect.Bottom - FCellRect.Top - FRequiredCellHeight;
            TempRect.Bottom := TempRect.Bottom + FCellRect.Bottom - FCellRect.Top - FRequiredCellHeight;
          End;
      End;

      FTextRect := TempRect;
    End;
End;

Procedure TReportCell.PaintCell(hPaintDC : HDC; bPrint : Boolean);
Var
  SaveDCIndex : Integer;
  hTempBrush : HBRUSH;
  TempLogBrush : TLOGBRUSH;
  hGrayPen, hPrevPen, hTempPen : HPEN;
  bDelete : Boolean;
  Format : UINT;
  hTextFont, hPrevFont : HFONT;
  TempRect : TRect;
Begin
  If FOwnerCell <> Nil Then
    Exit;

  SaveDCIndex := SaveDC(hPaintDC);

  SetBkMode(hPaintDC, TRANSPARENT);

  // 绘制底色
  TempRect := FCellRect;
  TempRect.Top := TempRect.Top + 1;
  TempRect.Right := TempRect.Right + 1;
  If FBackGroundColor <> RGB(255, 255, 255) Then
    Begin
      TempLogBrush.lbStyle := BS_SOLID;
      TempLogBrush.lbColor := FBackGroundColor;
      hTempBrush := CreateBrushIndirect(TempLogBrush);
      FillRect(hPaintDC, TempRect, hTempBrush);
      DeleteObject(hTempBrush);
    End;

  // 绘制边框
  hGrayPen := CreatePen(BS_SOLID, 1, RGB(192, 192, 192));

  // 左边线
  If Not bPrint And (FLeftLine Or (FCellIndex = 0)) Then
    Begin
      bDelete := False;
      hTempPen := hGrayPen;
      If FLeftLine Then
        Begin
          hTempPen := CreatePen(PS_SOLID, FLeftLineWidth, RGB(0, 0, 0));
          bDelete := True;
        End;

      hPrevPen := SelectObject(hPaintDc, hTempPen);

      MoveToEx(hPaintDc, FCellRect.left, FCellRect.top, Nil);
      LineTo(hPaintDC, FCellRect.left, FCellRect.bottom);

      SelectObject(hPaintDc, hPrevPen);

      If bDelete Then
        DeleteObject(hTempPen);
    End
  Else
    Begin
      If FLeftLine Then
        Begin
          hTempPen := CreatePen(PS_SOLID, FLeftLineWidth, RGB(0, 0, 0));
          hPrevPen := SelectObject(hPaintDc, hTempPen);

          MoveToEx(hPaintDc, FCellRect.left, FCellRect.top, Nil);
          LineTo(hPaintDC, FCellRect.left, FCellRect.bottom);

          SelectObject(hPaintDc, hPrevPen);
          DeleteObject(hTempPen);
        End;
    End;

  // 上边线
  If Not bPrint And (FTopLine Or (OwnerLine.Index = 0)) Then
    Begin
      bDelete := False;
      hTempPen := hGrayPen;

      If FTopLine Then
        Begin
          hTempPen := CreatePen(PS_SOLID, FTopLineWidth, RGB(0, 0, 0));
          bDelete := True;
        End;

      hPrevPen := SelectObject(hPaintDC, hTempPen);

      MoveToEx(hPaintDc, FCellRect.left, FCellRect.top, Nil);
      LineTo(hPaintDc, FCellRect.right, FCellRect.top);

      SelectObject(hPaintDc, hPrevPen);

      If bDelete Then
        DeleteObject(hTempPen);
    End
  Else
    Begin
      If FTopLine Then
        Begin
          hTempPen := CreatePen(PS_SOLID, FTopLineWidth, RGB(0, 0, 0));
          hPrevPen := SelectObject(hPaintDc, hTempPen);

          MoveToEx(hPaintDc, FCellRect.left, FCellRect.top, Nil);
          LineTo(hPaintDc, FCellRect.right, FCellRect.top);

          SelectObject(hPaintDc, hPrevPen);
          DeleteObject(hTempPen);
        End;
    End;


  // 右边线
  If Not bPrint Then
    Begin
      bDelete := False;
      hTempPen := hGrayPen;

      If FRightLine Then
        Begin
          hTempPen := CreatePen(PS_SOLID, FRightLineWidth, RGB(0, 0, 0));
          bDelete := True;
        End;

      hPrevPen := SelectObject(hPaintDc, hTempPen);

      MoveToEx(hPaintDc, FCellRect.right, FCellRect.top, Nil);
      LineTo(hPaintDC, FCellRect.right, FCellRect.bottom);

      SelectObject(hPaintDc, hPrevPen);

      If bDelete Then
        DeleteObject(hTempPen);
    End
  Else
    Begin
      If FRightLine Then
        Begin
          hTempPen := CreatePen(PS_SOLID, FRightLineWidth, RGB(0, 0, 0));
          hPrevPen := SelectObject(hPaintDc, hTempPen);

          MoveToEx(hPaintDc, FCellRect.right, FCellRect.top, Nil);
          LineTo(hPaintDC, FCellRect.right, FCellRect.bottom);

          SelectObject(hPaintDc, hPrevPen);
          DeleteObject(hTempPen);
        End;
    End;


  // 下边线
  If Not bPrint Then
    Begin
      bDelete := False;
      hTempPen := hGrayPen;

      If FBottomLine Then
        Begin
          hTempPen := CreatePen(PS_SOLID, FBottomLineWidth, RGB(0, 0, 0));
          bDelete := True;
        End;

      hPrevPen := SelectObject(hPaintDc, hTempPen);

      MoveToEx(hPaintDc, FCellRect.left, FCellRect.bottom, Nil);
      LineTo(hPaintDc, FCellRect.right, FCellRect.bottom);

      SelectObject(hPaintDc, hPrevPen);

      If bDelete Then
        DeleteObject(hTempPen);
    End
  Else
    Begin
      If FBottomLine Then
        Begin
          hTempPen := CreatePen(PS_SOLID, FBottomLineWidth, RGB(0, 0, 0));
          hPrevPen := SelectObject(hPaintDc, hTempPen);

          MoveToEx(hPaintDc, FCellRect.left, FCellRect.bottom, Nil);
          LineTo(hPaintDc, FCellRect.right, FCellRect.bottom);

          SelectObject(hPaintDc, hPrevPen);
          DeleteObject(hTempPen);
        End;
    End;


  DeleteObject(hGrayPen);

  hTempPen := CreatePen(PS_SOLID, 1, RGB(0, 0, 0));
  hPrevPen := SelectObject(hPaintDc, hTempPen);

  // 绘制斜线
  If FDiagonal > 0 Then
    Begin
      If ((FDiagonal And LINE_LEFT1) > 0) Then
        Begin
          MoveToEx(hPaintDC, FCellRect.left + 1, FCellRect.top + 1, Nil);
          LineTo(hPaintDC, FCellRect.right - 1, FCellRect.bottom - 1);
        End;

      If ((FDiagonal And LINE_LEFT2) > 0) Then
        Begin
          MoveToEx(hPaintDC, FCellRect.left + 1, FCellRect.top + 1, Nil);
          LineTo(hPaintDC, FCellRect.right - 1, trunc((FCellRect.bottom + FCellRect.top) / 2 + 0.5));
        End;

      If ((FDiagonal And LINE_LEFT3) > 0) Then
        Begin
          MoveToEx(hPaintDC, FCellRect.left + 1, FCellRect.top + 1, Nil);
          LineTo(hPaintDC, trunc((FCellRect.right + FCellRect.left) / 2 + 0.5), FCellRect.bottom - 1);
        End;

      If ((FDiagonal And LINE_RIGHT1) > 0) Then
        Begin
          MoveToEx(hPaintDC, FCellRect.right - 1, FCellRect.top + 1, Nil);
          LineTo(hPaintDC, FCellRect.left + 1, FCellRect.bottom - 1);
        End;

      If ((FDiagonal And LINE_RIGHT2) > 0) Then
        Begin
          MoveToEx(hPaintDC, FCellRect.right - 1, FCellRect.top + 1, Nil);
          LineTo(hPaintDC, FCellRect.left + 1, trunc((FCellRect.bottom + FCellRect.top) / 2 + 0.5));
        End;

      If ((FDiagonal And LINE_RIGHT3) > 0) Then
        Begin
          MoveToEx(hPaintDC, FCellRect.right - 1, FCellRect.top + 1, Nil);
          LineTo(hPaintDC, trunc((FCellRect.right + FCellRect.left) / 2 + 0.5), FCellRect.bottom - 1);
        End;

    End;

  SelectObject(hPaintDC, hPrevPen);
  DeleteObject(hTempPen);

  // 绘制文字
  If Length(FCellText) > 0 Then
    Begin
      Windows.SetTextColor(hPaintDC, FTextColor);
      Format := DT_EDITCONTROL Or DT_WORDBREAK;
      Case FHorzAlign Of
        TEXT_ALIGN_LEFT :
          Format := Format Or DT_LEFT;
        TEXT_ALIGN_CENTER :
          Format := Format Or DT_CENTER;
        TEXT_ALIGN_RIGHT :
          Format := Format Or DT_RIGHT;
      Else
        Format := Format Or DT_LEFT;
      End;

      hTextFont := CreateFontIndirect(FLogFont);
      hPrevFont := SelectObject(hPaintDC, hTextFont);
      TempRect := FTextRect;
      DrawText(hPaintDC, PChar(FCellText), Length(FCellText), TempRect, Format);
      SelectObject(hPaintDC, hPrevFont);
      DeleteObject(hTextFont);
    End;

  RestoreDC(hPaintDC, SaveDCIndex);
End;

Constructor TReportCell.Create;
Var
  hTempDC : HDC;
  pt, ptOrg : TPoint;
Begin
  FCellsList := TList.Create;
  FLeftMargin := 5;
  FOwnerLine := Nil;
  FOwnerCell := Nil;

  FCellIndex := -1;

  FCellLeft := 0;
  FCellWidth := 0;

  FCellRect.Left := 0;
  FCellRect.Top := 0;
  FCellRect.Right := 0;
  FCellRect.Bottom := 0;

  FTextRect.Left := 0;
  FTextRect.Top := 0;
  FTextRect.Right := 0;
  FTextRect.Bottom := 0;

  FDragCellHeight := 0;
  FMinCellHeight := 0;
  FRequiredCellHeight := 0;

  // border
  FLeftLine := True;
  FLeftLineWidth := 1;

  FTopLine := True;
  FTopLineWidth := 1;

  FRightLine := True;
  FRightLineWidth := 1;

  FBottomLine := True;
  FBottomLineWidth := 1;

  // 斜线
  FDiagonal := 0;

  // color
  FTextColor := RGB(0, 0, 0);
  FBackGroundColor := RGB(255, 255, 255);

  // align
  FHorzAlign := TEXT_ALIGN_LEFT;
  FVertAlign := TEXT_ALIGN_CENTER;

  // string
  FCellText := '';

  // font
  FLogFont.lfHeight := 120;
  FLogFont.lfWidth := 0;
  FLogFont.lfEscapement := 0;
  FLogFont.lfOrientation := 0;
  FLogFont.lfWeight := 0;
  FLogFont.lfItalic := 0;
  FLogFont.lfUnderline := 0;
  FLogFont.lfStrikeOut := 0;
  FLogFont.lfCharSet := DEFAULT_CHARSET;
  FLogFont.lfOutPrecision := 0;
  FLogFont.lfClipPrecision := 0;
  FLogFont.lfQuality := 0;
  FLogFont.lfPitchAndFamily := 0;
  FLogFont.lfFaceName := '宋体';

  // Hey, I pass a invalid window's handle to you, what you return to me ?
  // Haha, is a device context of the DESKTOP WINDOW !
  hTempDC := GetDC(0);

  pt.y := GetDeviceCaps(hTempDC, LOGPIXELSY) * FLogFont.lfHeight;
  pt.y := trunc(pt.y / 720 + 0.5); // 72 points/inch, 10 decipoints/point
  DPtoLP(hTempDC, pt, 1);
  ptOrg.x := 0;
  ptOrg.y := 0;
  DPtoLP(hTempDC, ptOrg, 1);
  FLogFont.lfHeight := -abs(pt.y - ptOrg.y);
  ReleaseDC(0, hTempDC);

End;

Destructor TReportCell.Destroy;
Begin
  FCellsList.Free;
  FCellsList := Nil;

  Inherited Destroy;
End;

Function TReportCell.GetOwnerLineHeight : Integer;
Begin
  If FOwnerLine = Nil Then
    Result := 0
  Else
    Result := FOwnerLine.LineHeight;
End;

Procedure TReportCell.CopyCell(Cell : TReportCell; bInsert : Boolean);
Begin
  FLeftMargin := Cell.FLeftMargin;

  // Index
  FCellIndex := Cell.FCellIndex;

  // size & position
  FCellLeft := Cell.FCellLeft;
  FCellWidth := Cell.FCellWidth;

  FCellRect.Left := 0;
  FCellRect.Top := 0;
  FCellRect.Right := 0;
  FCellRect.Bottom := 0;

  FTextRect.Left := 0;
  FTextRect.Top := 0;
  FTextRect.Right := 0;
  FTextRect.Bottom := 0;