reportcontrol.pas

delphi编程控件

  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;

// 一觉醒来，又是一个阳光灿烂的日子

///////////////////////////////////////////////////////////////////////////
// CReportLine

{ TReportLine }

Procedure TReportCell.RemoveOwnedCell(Cell : TReportCell);
Begin
  FCellsList.Remove(Cell);
  Cell.OwnerCell := Nil;
End;

Procedure TReportLine.CalcLineHeight;
Var
  I : Integer;
  ThisCell : TReportCell;
Begin
  FMinHeight := 0;

  For I := 0 To FCells.Count - 1 Do
    Begin
      ThisCell := TReportCell(FCells[I]);
      If ThisCell.CellHeight > FMinHeight Then
        FMinHeight := ThisCell.CellHeight;
      ThisCell.CellIndex := I;

      If (I = 0) And (ReportControl <> Nil) Then
        ThisCell.CellLeft := ReportControl.FLeftMargin;

      If I > 0 Then
        ThisCell.CellLeft := TReportCell(FCells[I - 1]).CellLeft + TReportCell(FCells[I - 1]).CellWidth;
    End;
End;

Procedure TReportLine.CopyLine(Line : TReportLine; bInsert : Boolean);
Var
  I : Integer;
  NewCell : TReportCell;
Begin
  If Line = Nil Then
    Exit;

  FDragHeight := 0;
  FMinHeight := 20;
  FReportControl := Line.FReportControl;

  For I := 0 To Line.FCells.Count - 1 Do
    Begin
      NewCell := TReportCell.Create;
      FCells.Add(NewCell);
      NewCell.FOwnerLine := Self;
      NewCell.CopyCell(Line.FCells[I], bInsert);
    End;
End;

Constructor TReportLine.Create;
Begin
  FReportControl := Nil;
  FCells := TList.Create;
  FIndex := 0;

  FMinHeight := 0;
  FDragHeight := 0;
  FLineTop := 0;
  FLineRect.left := 0;
  FLineRect.top := 0;
  FLineRect.right := 0;
  FLineRect.bottom := 0;
End;

Destructor TReportLine.Destroy;
Var
  I : Integer;
  ThisCell : TReportCell;
Begin
  For I := FCells.Count - 1 Downto 0 Do
    Begin
      ThisCell := TReportCell(FCells[I]);
      ThisCell.Free;
    End;

  FCells.Free;
  FCells := Nil;

  Inherited Destroy;
End;

Procedure TReportLine.CreateLine(LineLeft, CellNumber, PageWidth : Integer);
Var
  I : Integer;
  NewCell : TReportCell;
  CellWidth : Integer;
Begin
  CellWidth := trunc(PageWidth / CellNumber + 0.5);

  For I := 0 To CellNumber - 1 Do
    Begin
      NewCell := TReportCell.Create;
      FCells.Add(NewCell);
      NewCell.OwnerLine := Self;
      NewCell.CellIndex := I;
      NewCell.CellLeft := I * CellWidth + LineLeft;
      NewCell.CellWidth := CellWidth;
    End;
End;

Function TReportLine.GetLineHeight : Integer;
Begin
  If FMinHeight > FDragHeight Then
    Result := FMinHeight
  Else Result := FDragHeight;
End;

Function TReportLine.GetLineRect : TRect;
Var
  I : Integer;
Begin
  // 重新由各个CELL计算出该行的矩形来

  // 由各个CELL计算出行的高度
//  CalcLineHeight;                  // 移到UpdateLines中乐，呵呵。

  // 通知每个CELL重新计算坐标
  For I := 0 To FCells.Count - 1 Do
    Begin
      TReportCell(FCells[I]).CellIndex := I;
      TReportCell(FCells[I]).CalcCellRect;
    End;

  If FCells.Count > 0 Then
    Result.Left := TReportCell(FCells.First).CellLeft;
  Result.Top := FLineTop;
  Result.Bottom := Result.Top + LineHeight;
  Result.Right := Result.Left;

  For I := 0 To FCells.Count - 1 Do
    Result.Right := Result.Right + TReportCell(FCells[I]).CellWidth;

  FLineRect := Result;
End;

Procedure TReportLine.SetDragHeight(Const Value : Integer);
Begin
  FDragHeight := Value;
End;

Procedure TReportLine.SetLineTop(Const Value : Integer);
Var
  I : Integer;
Begin
  If FLineTop = Value Then
    Exit;

  FLineTop := Value;

  For I := 0 To FCells.Count - 1 Do
    Begin
      TReportCell(FCells[I]).CalcCellRect;
    End;
End;

///////////////////////////////////////////////////////////////////////////
// TReportControl

{TReportControl}

Procedure TReportControl.CreateWnd;
Begin
  Inherited;

  If Handle <> INVALID_HANDLE_VALUE Then
    SetClassLong(Handle, GCL_HCURSOR, 0);
End;

Constructor TReportControl.Create(AOwner : TComponent);
Var
  hDesktopDC : HDC;
  nPixelsPerInch : Integer;
Begin
  Inherited Create(AOwner);

  // 设定为无光标，防止光标闪烁。
//  Cursor := crNone;

  FPreviewStatus := False;

  Color := clWhite;
  FLineList := TList.Create;
  FSelectCells := TList.Create;

  FEditCell := Nil;

  FNewTable := True;
  //  FDataLine := 2147483647;
  //  FTablePerPage := 2147483647;
  FDataLine := 57; //廖伯志 1999.1.16
  FTablePerPage := 1; //

  pgw := 0;
  pgh := 0;
  FReportScale := 100;
  FPageWidth := 0;
  FPageHeight := 0;

  hDesktopDC := GetDC(0);
  nPixelsPerInch := GetDeviceCaps(hDesktopDC, LOGPIXELSX);

  FLeftMargin1 := 20;
  FRightMargin1 := 20;
  FTopMargin1 := 20;
  FBottomMargin1 := 20;

  FLeftMargin := trunc(nPixelsPerInch * FLeftMargin1 / 25 + 0.5);
  FRightMargin := trunc(nPixelsPerInch * FRightMargin1 / 25 + 0.5);
  FTopMargin := trunc(nPixelsPerInch * FTopMargin1 / 25 + 0.5);
  FBottomMargin := trunc(nPixelsPerInch * FBottomMargin1 / 25 + 0.5);

  ReleaseDC(0, hDesktopDC);

  // 鼠标操作支持
  FMousePoint.x := 0;
  FMousePoint.y := 0;

  // 编辑、颜色及字体
  FEditWnd := INVALID_HANDLE_VALUE;
  FEditBrush := INVALID_HANDLE_VALUE;
  FEditFont := INVALID_HANDLE_VALUE;

  CalcWndSize;
End;

Destructor TReportControl.Destroy;
Var
  I : Integer;
  ThisLine : TReportLine;
Begin
  FSelectCells.Free;
  FSelectCells := Nil;

  For I := FLineList.Count - 1 Downto 0 Do
    Begin
      ThisLine := TReportLine(FLineList[I]);
      ThisLine.Free;
    End;

  FLineList.Free;
  FLineList := Nil;

  Inherited Destroy;
End;

Procedure TReportControl.CalcWndSize;
Var
  hClientDC : HDC;
Begin
  // 根据用户选择的纸来确定报表窗口的大小并对该窗口进行设置。
  hClientDC := GetDC(0);
  If pgw = 0 Then
    Begin
      FPageWidth := trunc(Printer.PageWidth / GetDeviceCaps(Printer.Handle, LOGPIXELSX)
        * GetDeviceCaps(hClientDC, LOGPIXELSX) + 0.5);
      FPageHeight := trunc(Printer.PageHeight / GetDeviceCaps(Printer.Handle, LOGPIXELSY)
        * GetDeviceCaps(hClientDC, LOGPIXELSY) + 0.5);
    End;
  pgw := FPageWidth;
  pgh := FPageHeight;
  // 1999.1.16 廖伯志 改
  {  If FPageWidth > 768 Then
      FPageWidth := 768;

    If FPageHeight > 1056 Then
      FPageHeight := 1056;
  }
  Width := trunc(FPageWidth * FReportScale / 100 + 0.5);
  Height := trunc(FPageHeight * FReportScale / 100 + 0.5);
  ReleaseDC(0, hClientDC);
End;

Procedure TReportControl.WMPaint(Var Message : TMessage);
Var
  hPaintDC : HDC;
  ps : TPaintStruct;
  I, J : Integer;
  TempRect : TRect;
  hGrayPen, hPrevPen : HPEN;
  ThisLine : TReportLine;
  ThisCell : TReportCell;
  WndSize : TSize;
  rectPaint : TRect;
Begin
  hPaintDC := BeginPaint(Handle, ps);

  SetMapMode(hPaintDC, MM_ISOTROPIC);
  WndSize.cx := Width;
  WndSize.cy := Height;
  SetWindowExtEx(hPaintDC, FPageWidth, FPageHeight, @WndSize);
  SetViewPortExtEx(hPaintDC, Width, Height, @WndSize);

  rectPaint := ps.rcPaint;

  If FReportScale <> 100 Then
    Begin
      rectPaint.Left := trunc(rectPaint.Left * 100 / FReportScale + 0.5);
      rectPaint.Top := trunc(rectPaint.Top * 100 / FReportScale + 0.5);
      rectPaint.Right := trunc(rectPaint.Right * 100 / FReportScale + 0.5);
      rectPaint.Bottom := trunc(rectPaint.Bottom * 100 / FReportScale + 0.5);
    End;

  Rectangle(hPaintDC, 0, 0, FPageWidth, FPageHeight);

  hGrayPen := CreatePen(PS_SOLID, 1, RGB(128, 128, 128));
  hPrevPen := SelectObject(hPaintDC, hGrayPen);

  // 左上
  MoveToEx(hPaintDC, FLeftMargin, FTopMargin, Nil);
  LineTo(hPaintDC, FLeftMargin, FTopMargin - 25);

  MoveToEx(hPaintDC, FLeftMargin, FTopMargin, Nil);
  LineTo(hPaintDC, FLeftMargin - 25, FTopMargin);

  // 右上
  MoveToEx(hPaintDC, FPageWidth - FRightMargin, FTopMargin, Nil);
  LineTo(hPaintDC, FPageWidth - FRightMargin, FTopMargin - 25);

  MoveToEx(hPaintDC, FPageWidth - FRightMargin, FTopMargin, Nil);
  LineTo(hPaintDC, FPageWidth - FRightMargin + 25, FTopMargin);

  // 左下
  MoveToEx(hPaintDC, FLeftMargin, FPageHeight - FBottomMargin, Nil);
  LineTo(hPaintDC, FLeftMargin, FPageHeight - FBottomMargin + 25);

  MoveToEx(hPaintDC, FLeftMargin, FPageHeight - FBottomMargin, Nil);
  LineTo(hPaintDC, FLeftMargin - 25, FPageHeight - FBottomMargin);

  // 右下
  MoveToEx(hPaintDC, FPageWidth - FRightMargin, FPageHeight - FBottomMargin, Nil);
  LineTo(hPaintDC, FPageWidth - FRightMargin, FPageHeight - FBottomMargin + 25);

  MoveToEx(hPaintDC, FPageWidth - FRightMargin, FPageHeight - FBottomMargin, Nil);
  LineTo(hPaintDC, FPageWidth - FRightMargin + 25, FPageHeight - FBottomMargin);

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

  ///////////////////////////////////////////////////////////////////////////
    // 绘制所有与失效区相交的矩形
  For I := 0 To FLineList.Count - 1 Do
    Begin
      ThisLine := TReportLine(FLineList[I]);
      {
          if ThisLine.LineRect.Bottom < ps.rcPaint.top then
            Continue;

          if ThisLine.LineTop > ps.rcPaint.bottom then
            Break;
      }
      For J := 0 To TReportLine(FLineList[i]).FCells.Count - 1 Do
        Begin
          ThisCell := TReportCell(ThisLine.FCells[J]);

          If ThisCell.CellRect.Left > rectPaint.Right Then
            Break;

          If ThisCell.CellRect.Right < rectPaint.Left Then
            Continue;

          If ThisCell.CellRect.Top > rectPaint.Bottom Then
            Break;

          If ThisCell.CellRect.Bottom < rectPaint.Top Then
            Continue;

          If ThisCell.OwnerCell = Nil Then
            ThisCell.PaintCell(hPaintDC, FPreviewStatus);
        End;
    End;

  If Not FPreviewStatus Then
    Begin
      For I := 0 To FSelectCells.Count - 1 Do
        Begin
          IntersectRect(TempRect, ps.rcPaint, TReportCell(FSelectCells[I]).CellRect);
          If (TempRect.right >= TempRect.Left) And (TempRect.bottom >= TempRect.top) Then
            InvertRect(hPaintDC, TempRect);
        End;
    End;

  // 划线的算法目前还没有想出来
  // 各个CELL之间表线重叠的部分如何处理，如何存储这些线的设置呢？显然，现在的方法太土了。

  // 改乐，如果右面的CELL或下面的CELL的左边线或上边线为0时，不画不就得乐。(1998.9.9)

  EndPaint(Handle, ps);
End;

Procedure TReportControl.WMLButtonDBLClk(Var Message : TMessage);
Var
  ThisCell : TReportCell;
  TempPoint : TPoint;
  dwStyle : DWORD;
Begin
  RemoveAllSelectedCell;
  GetCursorPos(TempPoint);
  Windows.ScreenToClient(Handle, TempPoint);

  ThisCell := CellFromPoint(TempPoint);