reportcontrol.~pa

国产的报表控件

    ThisCell: TReportCell;
  end;

function DeleteFiles(FilePath, FileMask: string): Boolean;

procedure Register;

var
  pgw, pgh, scale: integer;
  cellline_d: treportcell; //用于保存选中单元格的属性 1999.1.25
  isprint: byte; //用于是否已安装打印机
  celldisp: TReportCell; //用于显示Mouse位置的单元格属性

implementation

//{$R ReportControl.dcr}
//{{{{{{{$R ReportControl.dcr}}}}}}}}}         //1999.11.20
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
  // 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;
{        if scale <> 100 then  //1999.1.23
        begin