preport.~pas

是 delphi6的函数库

Begin
  For I := 0 To FCellsList.Count - 1 Do
  Begin
    Cell := FCellsList[I];
    Cell.SetOwnerCell(Nil);
    Cell.CalcMinCellHeight;
  End;

  FCellsList.Clear;
End;

Function TReportCell.IsCellOwned(Cell: TReportCell): Boolean;
Begin
  If FCellsList.IndexOf(Cell) >= 0 Then
    Result := True
  Else
    Result := False;
End;

Procedure TReportCell.SetCellLeft(CellLeft: Integer);
Begin
  If CellLeft = FCellLeft Then
    Exit;

  FCellLeft := CellLeft;
  CalcCellRect;
End;

Procedure TReportCell.SetCellWidth(CellWidth: Integer);
Begin
  If CellWidth = FCellWidth Then Exit;

  If CellWidth > 10 Then
  Begin
    FCellWidth := CellWidth;
    CalcMinCellHeight;
    CalcCellRect;
  End Else
  Begin
    FCellWidth := 10;
    CalcMinCellHeight;
    CalcCellRect;
  End;
End;

Procedure TReportCell.SetDefineCellHeight(CellHeight: Integer);
Begin
  If CellHeight = FDefineCellHeight Then  Exit;

  If CellHeight > 18 Then
  Begin
    FDefineCellHeight := CellHeight;
    CalcMinCellHeight;
    CalcCellRect;
  End Else
  Begin
    FDefineCellHeight := 18;
    CalcMinCellHeight;
    CalcCellRect;
  End;
End;
//vip
Function TReportCell.GetCellHeight: Integer;
Begin
If FOwnerLine = Nil Then  Result := 0
  Else
     Result := FDefineCellHeight;
End;

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

Procedure TReportCell.SetLeftLine(LeftLine: Boolean);
Begin
  If LeftLine = FLeftLine Then
    Exit;

  FLeftLine := LeftLine;
  CalcMinCellHeight;
  CalcCellRect;
End;

Procedure TReportCell.SetLeftLineWidth(LeftLineWidth: Integer);
Begin
  If LeftLineWidth = FLeftLineWidth Then
    Exit;

  FLeftLineWidth := LeftLineWidth;
  CalcMinCellHeight;
  CalcCellRect;
End;

Procedure TReportCell.SetTopLine(TopLine: Boolean);
Begin
  If TopLine = FTopLine Then
    Exit;

  FTopLine := TopLine;
  CalcMinCellHeight;
  CalcCellRect;
End;

Procedure TReportCell.SetTopLineWidth(TopLineWidth: Integer);
Begin
  If TopLineWidth = FTopLineWidth Then
    Exit;

  FTopLineWidth := TopLineWidth;
  CalcMinCellHeight;
  CalcCellRect;
End;

Procedure TReportCell.SetRightLine(RightLine: Boolean);
Begin
  If RightLine = FRightLine Then Exit;

  FRightLine := RightLine;
  CalcMinCellHeight;
  CalcCellRect;
End;

Procedure TReportCell.SetRightLineWidth(RightLineWidth: Integer);
Begin
  If RightLineWidth = FRightLineWidth Then
    Exit;

  FRightLineWidth := RightLineWidth;
  CalcMinCellHeight;
  CalcCellRect;
End;

Procedure TReportCell.SetBottomLine(BottomLine: Boolean);
Begin
  If BottomLine = FBottomLine Then Exit;

  FBottomLine := BottomLine;
  CalcMinCellHeight;
  CalcCellRect;

End;

Procedure TReportCell.SetBottomLineWidth(BottomLineWidth: Integer);
Begin
  If BottomLineWidth = FBottomLineWidth Then Exit;

  FBottomLineWidth := BottomLineWidth;
  CalcMinCellHeight;
  CalcCellRect;
End;

Procedure TReportCell.SetCellText(CellText: String);
Begin
  If CellText = FCellText Then Exit;
  FCellText := CellText;
 CalcMinCellHeight;
End;
Procedure TReportCell.SetCellDef(CellDef: String);
Begin
  If CellDef = FCellDef Then  Exit;
  FCellDef := CellDef;
End;
Procedure TReportCell.SetLogFont(NewFont: TLOGFONT);
Begin
  FLogFont := NewFont;
  CalcMinCellHeight;
End;

Procedure TReportCell.SetBackGroundColor(BkColor: COLORREF);
Begin
  If BkColor = FBackGroundColor Then Exit;

  FBackGroundColor := BkColor;
End;

Procedure TReportCell.SetTextColor(TextColor: COLORREF);
Begin
  If TextColor = FTextColor Then Exit;

  FTextColor := TextColor;
End;
//计算高度
Procedure TReportCell.CalcMinCellHeight;
Var
  hTempFont, hPrevFont: HFONT;
  hTempDC: HDC;
  TempString: String;
  TempRect: TRect;
  Format: UINT;
  I: Integer;
  BottomCell, ThisCell: TReportCell;
  TotalHeight, Height, Top: Integer;
  TempSize: TSize;
Begin
  // 计算CELL的最小高度
  If FCellWidth <= FLeftMargin * 2 Then
  Begin
    FMinCellHeight := 16 + 2 + FTopLineWidth + FBottomLineWidth;
    Exit;
  End;
  // 隶属与某CELL时
  If FOwnerCell <> Nil Then
  Begin
    // 取得最下的单元格
    FMinCellHeight := 16 + 2 + FTopLineWidth + FBottomLineWidth;
    BottomCell := Nil;
    Height := 0;
    Top := 0;
    For I := 0 To FOwnerCell.FCellsList.Count - 1 Do
    Begin
      ThisCell := FOwnerCell.FCellsList[i];
      ThisCell.FMinCellHeight := 16 + 2 + ThisCell.TopLineWidth +
        ThisCell.BottomLineWidth;
      ThisCell.OwnerLine.CalcLineHeight;
      Height := Height + ThisCell.OwnerLineHeight;

      If ThisCell.CellTop > Top Then
      Begin
        BottomCell := ThisCell;
        Top := ThisCell.CellTop;
      End;
    End;

    If BottomCell <> Self Then
    Begin
      FMinCellHeight := 16 + 2 + FTopLineWidth + FBottomLineWidth;
      Exit;
    End  Else
    Begin
      TotalHeight := Height + FOwnerCell.OwnerLineHeight;
      If FOwnerCell.RequiredCellHeight > TotalHeight Then
        FMinCellHeight := FOwnerCell.RequiredCellHeight - TotalHeight +
          OwnerLineHeight
      Else
        FMinCellHeight := 16 + 2 + FTopLineWidth + FBottomLineWidth;
      Exit;
    End;
  End;
  hTempFont := CreateFontIndiRect(FLogFont);
  // 此处取得窗口的指针用于计算大小
  If (Length(FCellText) <= 0) Then
    TempString := '汉'
      Else TempString := FCellText;  //文本

  hTempDC := GetDC(0);
  hPrevFont := SelectObject(hTempDC, hTempFont);

  SetRect(TempRect, 0, 0, 0, 0);

  TempRect.left := FCellLeft + FLeftMargin;
  TempRect.top := GetCellTop + 2;
  TempRect.right := FCellLeft + FCellWidth - FLeftMargin;
  TempRect.bottom := 65535;

  Format := DT_EDITCONTROL Or DT_WORDBREAK;
  Case FHorzAlign Of
    0:Format := Format Or DT_LEFT;
    1:Format := Format Or DT_CENTER;
    2:Format := Format Or DT_RIGHT;
  Else
    Format := Format Or DT_LEFT;
  End;

  Format := Format Or DT_CALCRect;

  DrawText(hTempDC, PChar(TempString), Length(TempString), TempRect, Format);
    // 补偿文字最后的回车带来的误差
  If Length(TempString) >= 2 Then
  Begin
    If (TempString[Length(TempString)] = Chr(10)) And
      (TempString[Length(TempString) - 1] = Chr(13)) Then
    Begin
      GetTextExtentPoint(hTempDC, 'A', 1, TempSize);
      TempRect.Bottom := TempRect.Bottom + TempSize.cy;
    End;
  End;

  SelectObject(hTempDc, hPrevFont);
  DeleteObject(hTempFont);
  ReleaseDC(0, hTempDC);

  If (FCellsList.Count > 0) Then
  Begin
    FRequiredCellHeight := FRequiredCellHeight + 2;
    FRequiredCellHeight := FRequiredCellHeight + FTopLineWidth +FBottomLineWidth;

    If TempRect.Bottom - TempRect.Top <= 0 Then FRequiredCellHeight := 16
      Else FRequiredCellHeight :=TempRect.Bottom - TempRect.Top;//  FDefineCellHeight;//

    FMinCellHeight := 16 + 2 + FTopLineWidth + FBottomLineWidth;
    OwnerLine.CalcLineHeight;

 For I := 0 To FCellsList.Count - 1 Do
      TReportCell(FCellsList[I]).CalcMinCellHeight;
  End  Else  //If (FCellsList.Count > 0)
  Begin
    If TempRect.Bottom - TempRect.Top <= 0 Then
      FMinCellHeight := 16
    Else
      FMinCellHeight :=TempRect.Bottom - TempRect.Top;//  FDefineCellHeight;//
      FMinCellHeight := FMinCellHeight + 2;
      FMinCellHeight := FMinCellHeight + FTopLineWidth + FBottomLineWidth;
  End;
End;

Procedure TReportCell.CalcCellRect;
Var
  TempRect: TRect;
  TotalHeight: Integer;
  I: Integer;
Begin
  // 如果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   //If FCellsList.Count >0 Then
  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; //If FCellsList.Count <= 0 Then
End;
//画单元格bPrint  画线等 打印,false 设计期 套打
//PrintDesign true 显示虚线 false不显示  PrintLine 是否套打(画线)
Procedure TReportCell.PaintCell(hPaintDC: HDC; PrintDesign,bPrintLine: 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 PrintDesign 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);