reportcontrol.pas

企业智能(ERP)管理系统

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);
    try
      FillRect(hPaintDC, TempRect, hTempBrush);
    finally
      DeleteObject(hTempBrush);
    end;
  end;

  // 绘制边框
  hGrayPen := CreatePen(BS_SOLID, 1, RGB(192, 192, 192));
  try
    // 左边线
    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;
      try
        hPrevPen := SelectObject(hPaintDc, hTempPen);

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

        SelectObject(hPaintDc, hPrevPen);
      finally
        if bDelete then
          DeleteObject(hTempPen);
      end;
    end
    else
    begin
      if FLeftLine then
      begin
        hTempPen := CreatePen(PS_SOLID, FLeftLineWidth, RGB(0, 0, 0));
        try
          hPrevPen := SelectObject(hPaintDc, hTempPen);

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

          SelectObject(hPaintDc, hPrevPen);
        finally
          DeleteObject(hTempPen);
        end;
      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;
      try
        hPrevPen := SelectObject(hPaintDC, hTempPen);

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

        SelectObject(hPaintDc, hPrevPen);
      finally
        if bDelete then
          DeleteObject(hTempPen);
      end;
    end
    else
    begin
      if FTopLine then
      begin
        hTempPen := CreatePen(PS_SOLID, FTopLineWidth, RGB(0, 0, 0));
        try
          hPrevPen := SelectObject(hPaintDc, hTempPen);

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

          SelectObject(hPaintDc, hPrevPen);
        finally
          DeleteObject(hTempPen);
        end;
      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;
      try
        hPrevPen := SelectObject(hPaintDc, hTempPen);

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

        SelectObject(hPaintDc, hPrevPen);
      finally
        if bDelete then
          DeleteObject(hTempPen);
      end;
    end
    else
    begin
      if FRightLine then
      begin
        hTempPen := CreatePen(PS_SOLID, FRightLineWidth, RGB(0, 0, 0));
        try
          hPrevPen := SelectObject(hPaintDc, hTempPen);

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

          SelectObject(hPaintDc, hPrevPen);
        finally
          DeleteObject(hTempPen);
        end;
      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;
      try
        hPrevPen := SelectObject(hPaintDc, hTempPen);

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

        SelectObject(hPaintDc, hPrevPen);
      finally
        if bDelete then
          DeleteObject(hTempPen);
      end;
    end
    else
    begin
      if FBottomLine then
      begin
        hTempPen := CreatePen(PS_SOLID, FBottomLineWidth, RGB(0, 0, 0));
        try
          hPrevPen := SelectObject(hPaintDc, hTempPen);

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

          SelectObject(hPaintDc, hPrevPen);
        finally
          DeleteObject(hTempPen);
        end;
      end;
    end;
  finally
    DeleteObject(hGrayPen);
  end;

  hTempPen := CreatePen(PS_SOLID, 1, RGB(0, 0, 0));
  try
    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);
  finally
    DeleteObject(hTempPen);
  end;

  // 绘制文字
  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);
    try
      hPrevFont := SelectObject(hPaintDC, hTextFont);
      TempRect := FTextRect;
      DrawText(hPaintDC, PChar(FCellText), Length(FCellText), TempRect, Format);
      SelectObject(hPaintDC, hPrevFont);
    finally
      DeleteObject(hTextFont);
    end;
  end;

  RestoreDC(hPaintDC, SaveDCIndex);
end;

constructor TReportCell.Create;
var
  hTempDC: HDC;
  pt, ptOrg: TPoint;
begin
  FCellsList := TList.Create;
  FBmp := TBitmap.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;
  FBmp.Free;
  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;

  FDragCellHeight := Cell.FDragCellHeight;
  FMinCellHeight := Cell.FMinCellHeight;

  // border
  FLeftLine := Cell.FLeftLine;
  FLeftLineWidth := Cell.FLeftLineWidth;

  FTopLine := Cell.FTopLine;
  FTopLineWidth := Cell.FTopLineWidth;

  FRightLine := Cell.FRightLine;
  FRightLineWidth := Cell.FRightLineWidth;

  FBottomLine := Cell.FBottomLine;
  FBottomLineWidth := Cell.FBottomLineWidth;

  // 斜线
  FDiagonal := Cell.FDiagonal;

  // color
  FTextColor := Cell.FTextColor;
  FBackGroundColor := Cell.FBackGroundColor;

  // align
  FHorzAlign := Cell.FHorzAlign;
  FVertAlign := Cell.FVertAlign;

  // string
//  FCellText := Cell.FCellText;

  // font
  FLogFont := Cell.FLogFont;

  if Cell.OwnerCell <> nil then
  begin
    if bInsert then
    begin
      Cell.OwnerCell.FCellsList.Insert(
        Cell.OwnerCell.FCellsList.IndexOf(Cell),
        Self);
      FOwnerCell := Cell.OwnerCell;
    end
    else
      Cell.OwnerCell.AddOwnedCell(Self);
  end;
end;