reportcontrol.pas

delphi编程控件

  TCellTable = Class(TObject)
    PrevCell : TReportCell;
    ThisCell : TReportCell;
  End;

Function DeleteFiles(FilePath, FileMask : String) : Boolean;

Procedure Register;

Var
  pgw, pgh : integer;

Implementation

//{{{{{{{$R ReportControl.dcr}}}}}}}}}
Uses Preview;

Function DeleteFiles(FilePath, FileMask : String) : Boolean;
Var
  Attributes : Word;
  DeleteFilesSearchRec : TSearchRec;
Begin
  Result := true;
  Try
    FindFirst(FilePath + '\' + FileMask, faAnyFile, DeleteFilesSearchRec);

    If Not (DeleteFilesSearchRec.Name = '') Then
      Begin
        Result := True;
        Attributes := FileGetAttr(FilePath + '\' + DeleteFilesSearchRec.Name);
        //      Attributes := Attributes And Not (faReadonly Or faHidden Or fasysfile);
        FileSetAttr(FilePath + '\' + DeleteFilesSearchRec.Name, Attributes);
        DeleteFile(FilePath + '\' + DeleteFilesSearchRec.Name);

        While FindNext(DeleteFilesSearchRec) = 0 Do
          Begin
            Attributes := FileGetAttr(FilePath + '\' + DeleteFilesSearchRec.Name);
            //        Attributes := Attributes And Not (faReadOnly Or faHidden Or fasysfile);
            FileSetAttr(FilePath + '\' + DeleteFilesSearchRec.Name, Attributes);
            DeleteFile(FilePath + '\' + DeleteFilesSearchRec.Name);
          End;
      End;

    FindClose(DeleteFilesSearchRec);

  Except
    Result := false;
    Exit;
  End;
End;

Procedure Register;
Begin
  RegisterComponents('中国式报表', [TReportControl]);
  RegisterComponents('中国式报表', [TReportRunTime]);
End;

///////////////////////////////////////////////////////////////////////////
// TReportCell

{TReportCell}

Procedure TReportCell.SetLeftMargin(LeftMargin : Integer);
Begin
  // 修改左右预留的空白区域
  // 呵呵，目前只能是5。
  If (LeftMargin = FLeftMargin) Or
    (LeftMargin < 5) Or (LeftMargin > 5) Then
    Exit;

  FLeftMargin := LeftMargin;
  CalcMinCellHeight;
End;

Procedure TReportCell.SetOwnerLine(OwnerLine : TReportLine);
Begin
  If OwnerLine <> Nil Then
    FOwnerLine := OwnerLine;
End;

Procedure TReportCell.SetOwnerCell(Cell : TReportCell);
Begin
  FOwnerCell := Cell;
  //  CalcMinCellHeight;
End;

Function TReportCell.GetOwnedCellCount : Integer;
Begin
  Result := FCellsList.Count;
End;

Procedure TReportCell.AddOwnedCell(Cell : TReportCell);
Var
  I : Integer;
  TempCellList : TList;
Begin
  If (Cell = Nil) Or (FCellsList.IndexOf(Cell) >= 0) Then
    Exit;

  Cell.OwnerCell := Self;
  FCellText := FCellText + Cell.CellText;
  Cell.CellText := '';

  FCellsList.Add(Cell);

  TempCellList := TList.Create;
  For I := 0 To Cell.FCellsList.Count - 1 Do
    TempCellList.Add(Cell.FCellsList[I]);

  Cell.RemoveAllOwnedCell();

  For I := 0 To TempCellList.Count - 1 Do
    Begin
      FCellsList.Add(TempCellList[I]);
      TReportCell(TempCellList[I]).OwnerCell := Self;
    End;

  //   CalcMinCellHeight;
End;

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

  FCellsList.Clear;
  //  CalcMinCellHeight;
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;

Function TReportCell.GetCellHeight : Integer;
Begin
  If FOwnerLine = Nil Then
    Result := 0
  Else
    Begin
      If FDragCellHeight > FMinCellHeight Then
        Result := FDragCellHeight
      Else
        Result := FMinCellHeight;
    End;
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;
  // InvalidateRect here because Cell;s Rect no change
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.SetLogFont(NewFont : TLOGFONT);
Begin
  FLogFont := NewFont;
  CalcMinCellHeight;
End;

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

  FBackGroundColor := BkColor;
  // InvalidateRect
End;

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

  FTextColor := TextColor;
  // InvalidateRect
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);
  //  DrawText(hTempDC, PChar(TempString), -1, 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
      If TempRect.Bottom - TempRect.Top <= 0 Then
        FRequiredCellHeight := 16
      Else
        FRequiredCellHeight := TempRect.Bottom - TempRect.Top;

      FRequiredCellHeight := FRequiredCellHeight + 2;
      FRequiredCellHeight := FRequiredCellHeight + FTopLineWidth + FBottomLineWidth;

      FMinCellHeight := 16 + 2 + FTopLineWidth + FBottomLineWidth;

      OwnerLine.CalcLineHeight;

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

    End
  Else
    Begin
      If TempRect.Bottom - TempRect.Top <= 0 Then
        FMinCellHeight := 16
      Else
        FMinCellHeight := TempRect.Bottom - TempRect.Top;

      FMinCellHeight := FMinCellHeight + 2;
      FMinCellHeight := FMinCellHeight + FTopLineWidth + FBottomLineWidth;
    End;
End;

Procedure TReportCell.CalcCellRect;
Var
  TempRect : TRect;
  TotalHeight : Integer;
  I : Integer;
Begin