crctrls.pas

企业智能(ERP)管理系统

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

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


procedure TReportCell.SetCellDispFormat(CellDispFormat: string);
begin
  if CellDispFormat = FCellDispFormat then
    Exit;

  FCellDispFormat := CellDispFormat;

end;

{ 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);
  //CellWidth:=33; //李
  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;
  CPreviewEdit := True; //预览时是否允许编辑单元格中的字符
  FPreviewStatus := False;

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


  Celldisp := nil;
  cellline_d := nil;
  FEditCell := nil;

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

  cp_pgw := 0;
  cp_pgh := 0;

  FReportScale := 100;
  scale := FReportScale;
  FPageWidth := 0;
  FPageHeight := 0;

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

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

  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;

  if FEditFont <> INVALID_HANDLE_VALUE then
    DeleteObject(FEditFont);
  if FEditBrush <> INVALID_HANDLE_VALUE then
    DeleteObject(FEditBrush);
  if FEditWnd <> INVALID_HANDLE_VALUE then
    DeleteObject(FEditWnd);

  inherited Destroy;
end;

procedure TReportControl.SetPageSize(w, h: Integer); //add 李泽伦 动态报表设置纸张大小
var
  hClientDC: HDC;
begin

end;

procedure TReportControl.CalcWndSize;
var
  hClientDC: HDC;
begin
  if not IsInstalledPrinter then
  begin
    //未安装打印机
    if cp_pgw <> 0 then
    begin
      FPageWidth := cp_pgw;
      FPageHeight := cp_pgh;
    end;
  end;

  // 根据用户选择的纸来确定报表窗口的大小并对该窗口进行设置。
  hClientDC := GetDC(0);
  if cp_pgw = 0 then
  begin
    if not IsInstalledPrinter then
    begin
      FPageWidth := 768; //未安装打印机时，设置默认纸宽
      FPageHeight := 1058; //未安装打印机时，设置默认纸高
    end
    else
    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;
  end;
  cp_pgw := FPageWidth; //cp_pgw,cp_pgh用于打印
  cp_pgh := FPageHeight;
  Width := trunc(FPageWidth * FReportScale / 100 + 0.5); //width,heght用于显示
  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;

  Acanvas: Tcanvas; // add 李泽伦
  //x,y:Integer;
  LTempRect: 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));
  try
    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);
  finally
    DeleteObject(hGrayPen);
  end;

  ///////////////////////////////////////////////////////////////////////////
    // 绘制所有与失效区相交的矩形
  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;

      // add 李泽伦 将cell中的图片画出
      //  y:=ThisCell.CellTop+ ((ThisCell.OwnerLineHeight-ThisCell.FBmp.Height) div 2);
      //  x:=ThisCell.CellLeft+((ThisCell.CellWidth- ThisCell.FBmp.Width) div 2);
      Acanvas := Tcanvas.Create;
      try
        Acanvas.Handle := getdc(Handle);
        //Acanvas.Draw(x,y,loadbmp(ThisCell));
        LTempRect := ThisCell.FCellRect;
        LTempRect.Left := trunc((ThisCell.FCellRect.Left) * FReportScale / 100 + 0.5) + 3;
        LTempRect.Top := trunc((ThisCell.FCellRect.Top) * FReportScale / 100 + 0.5) + 3;
        LTempRect.Right := trunc((ThisCell.FCellRect.Right) * FReportScale / 100 + 0.5) - 3;
        LTempRect.Bottom := trunc((ThisCell.FCellRect.Bottom) * FReportScale / 100 + 0.5) - 3;
        acanvas.StretchDraw(LTempRect, loadbmp(ThisCell));
        ReleaseDC(Handle, ACanvas.Handle);
      finally
        ACanvas.Free;
      end;

      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, TRepor