⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 preport.~pas

📁 是 delphi6的函数库
💻 ~PAS
📖 第 1 页 / 共 5 页
字号:
  End Else
  Begin
    If FLeftLine and bPrintLine Then
    Begin
      hTempPen := CreatePen(PS_SOLID, FLeftLineWidth, RGB(0, 0, 0));
      hPrevPen := SelectObject(hPaintDc, hTempPen);

      MoveToEx(hPaintDc, FCellRect.left, FCellRect.top, Nil);
      LineTo(hPaintDC, FCellRect.left, FCellRect.bottom);

      SelectObject(hPaintDc, hPrevPen);
      DeleteObject(hTempPen);
    End;
  End;
  // 上边线
  If Not PrintDesign And (FTopLine Or (OwnerLine.Index = 0)) Then
  Begin //画虚线
    bDelete := False;
    hTempPen := hGrayPen;

    If FTopLine Then
    Begin
      hTempPen := CreatePen(PS_SOLID, FTopLineWidth, RGB(0, 0, 0));
      bDelete := True;
    End;

    hPrevPen := SelectObject(hPaintDC, hTempPen);

    MoveToEx(hPaintDc, FCellRect.left, FCellRect.top, Nil);
    LineTo(hPaintDc, FCellRect.right, FCellRect.top);

    SelectObject(hPaintDc, hPrevPen);

    If bDelete Then
      DeleteObject(hTempPen);
  End Else
  Begin
    If FTopLine and bPrintLine Then
    Begin  //画线
      hTempPen := CreatePen(PS_SOLID, FTopLineWidth, RGB(0, 0, 0));
      hPrevPen := SelectObject(hPaintDc, hTempPen);

      MoveToEx(hPaintDc, FCellRect.left, FCellRect.top, Nil);
      LineTo(hPaintDc, FCellRect.right, FCellRect.top);

      SelectObject(hPaintDc, hPrevPen);
      DeleteObject(hTempPen);
    End;
  End;
  // 右边线
  If Not PrintDesign Then
   Begin    //画虚线
    bDelete := False;
    hTempPen := hGrayPen;

    If FRightLine Then
    Begin
      hTempPen := CreatePen(PS_SOLID, FRightLineWidth, RGB(0, 0, 0));
      bDelete := True;
    End;

    hPrevPen := SelectObject(hPaintDc, hTempPen);

    MoveToEx(hPaintDc, FCellRect.right, FCellRect.top, Nil);
    LineTo(hPaintDC, FCellRect.right, FCellRect.bottom);

    SelectObject(hPaintDc, hPrevPen);

    If bDelete Then
      DeleteObject(hTempPen);
  End Else
  Begin
    If FRightLine and bPrintLine Then
    Begin
      hTempPen := CreatePen(PS_SOLID, FRightLineWidth, RGB(0, 0, 0));
      hPrevPen := SelectObject(hPaintDc, hTempPen);

      MoveToEx(hPaintDc, FCellRect.right, FCellRect.top, Nil);
      LineTo(hPaintDC, FCellRect.right, FCellRect.bottom);

      SelectObject(hPaintDc, hPrevPen);
      DeleteObject(hTempPen);
    End;
  End;   // 右边线 If Not bPrint Then

  // 下边线
  If Not PrintDesign Then
  Begin // 设计期  //画虚线
    bDelete := False;
    hTempPen := hGrayPen;

    If FBottomLine Then
    Begin//
      hTempPen := CreatePen(PS_SOLID, FBottomLineWidth, RGB(0, 0, 0));
      bDelete := True;
    End; //

    hPrevPen := SelectObject(hPaintDc, hTempPen);

    MoveToEx(hPaintDc, FCellRect.left, FCellRect.bottom, Nil);
    LineTo(hPaintDc, FCellRect.right, FCellRect.bottom);

    SelectObject(hPaintDc, hPrevPen);

    If bDelete Then  DeleteObject(hTempPen);
  End Else
  Begin//
    If FBottomLine and bPrintLine Then
    Begin //
      hTempPen := CreatePen(PS_SOLID, FBottomLineWidth, RGB(0, 0, 0));
      hPrevPen := SelectObject(hPaintDc, hTempPen);

      MoveToEx(hPaintDc, FCellRect.left, FCellRect.bottom, Nil);
      LineTo(hPaintDc, FCellRect.right, FCellRect.bottom);

      SelectObject(hPaintDc, hPrevPen);
      DeleteObject(hTempPen);
    End;//
  End;  // 下边线 If Not bPrint Then

  DeleteObject(hGrayPen);

  hTempPen := CreatePen(PS_SOLID, 1, RGB(0, 0, 0));
  hPrevPen := SelectObject(hPaintDc, hTempPen);

if bPrintLine then //非套打
begin
  // 绘制斜线
  If FDiagonal > 0 Then
  Begin //
    If ((FDiagonal And LINE_LEFT1) > 0) Then
    Begin //
      MoveToEx(hPaintDC, FCellRect.left + 1, FCellRect.top + 1, Nil);
      LineTo(hPaintDC, FCellRect.right - 1, FCellRect.bottom - 1);
    End;//

    If ((FDiagonal And LINE_LEFT2) > 0) Then
    Begin //
      MoveToEx(hPaintDC, FCellRect.left + 1, FCellRect.top + 1, Nil);
      LineTo(hPaintDC, FCellRect.right - 1, trunc((FCellRect.bottom +
        FCellRect.top) / 2 + 0.5));
    End;//

    If ((FDiagonal And LINE_LEFT3) > 0) Then
    Begin//
      MoveToEx(hPaintDC, FCellRect.left + 1, FCellRect.top + 1, Nil);
      LineTo(hPaintDC, trunc((FCellRect.right + FCellRect.left) / 2 + 0.5),
        FCellRect.bottom - 1);
    End;//

    If ((FDiagonal And LINE_RIGHT1) > 0) Then
    Begin//
      MoveToEx(hPaintDC, FCellRect.right - 1, FCellRect.top + 1, Nil);
      LineTo(hPaintDC, FCellRect.left + 1, FCellRect.bottom - 1);
    End;//

    If ((FDiagonal And LINE_RIGHT2) > 0) Then
    Begin//
      MoveToEx(hPaintDC, FCellRect.right - 1, FCellRect.top + 1, Nil);
      LineTo(hPaintDC, FCellRect.left + 1, trunc((FCellRect.bottom +
        FCellRect.top) / 2 + 0.5));
    End;//

    If ((FDiagonal And LINE_RIGHT3) > 0) Then
    Begin //
      MoveToEx(hPaintDC, FCellRect.right - 1, FCellRect.top + 1, Nil);
      LineTo(hPaintDC, trunc((FCellRect.right + FCellRect.left) / 2 + 0.5),
        FCellRect.bottom - 1);
    End; //
  End;  // 绘制斜线 If FDiagonal > 0

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

end;//以上为画线 if PrintLine

  // 绘制文字
  If Length(FCellText) > 0 Then
   Begin //
    Windows.SetTextColor(hPaintDC, FTextColor);
    Format := DT_EDITCONTROL Or DT_WORDBREAK;
    Case FHorzAlign Of
      TEXT_ALIGN_LEFT:
        Format := Format Or DT_LEFT;
      TEXT_ALIGN_CENTER:
        Format := Format Or DT_CENTER;
      TEXT_ALIGN_RIGHT:
        Format := Format Or DT_RIGHT;
    Else
      Format := Format Or DT_LEFT;
    End;
    hTextFont := CreateFontIndiRect(FLogFont);
    hPrevFont := SelectObject(hPaintDC, hTextFont);
    TempRect := FTextRect;

    if PrintDesign then    //设计期
     DrawText(hPaintDC, PChar(FCellText), Length(FCellText), TempRect, Format)
      else  DrawText(hPaintDC, PChar(FCellDef), Length(FCellDef), TempRect, Format);
    SelectObject(hPaintDC, hPrevFont);
    DeleteObject(hTextFont);
  End; // 绘制文字

  RestoreDC(hPaintDC, SaveDCIndex);
End;

Constructor TReportCell.Create;
Var
  hTempDC: HDC;
  pt, ptOrg: TPoint;
Begin
  FCellsList := TList.Create;
  Fbmp := TBitmap.Create;
  FLeftMargin := 5;
  FOwnerLine := Nil;
  FOwnerCell := Nil;

  FCellIndex := -1;

  FCellLeft := 0;
  FCellWidth := 0;

  FCellRect.Left := 0;
  FCellRect.Top := 0;
  FCellRect.Right := 0;
  FCellRect.Bottom := 0;

  FTextRect.Left := 0;
  FTextRect.Top := 0;
  FTextRect.Right := 0;
  FTextRect.Bottom := 0;

  FDragCellHeight := 0;
  FDefineCellHeight:=18;
  FMinCellHeight := 0;
  FRequiredCellHeight := 0;

  // border
  FLeftLine := True;
  FLeftLineWidth := 1;

  FTopLine := True;
  FTopLineWidth := 1;

  FRightLine := True;
  FRightLineWidth := 1;

  FBottomLine := True;
  FBottomLineWidth := 1;

  // 斜线
  FDiagonal := 0;

  // color
  FTextColor := RGB(0, 0, 0);
  FBackGroundColor := RGB(255, 255, 255);

  // align
  FHorzAlign := TEXT_ALIGN_LEFT;
  FVertAlign := TEXT_ALIGN_CENTER;

  // string
  FCellText := '';
  FCellDef:='';

  // font
  FLogFont.lfHeight := 120;
  FLogFont.lfWidth := 0;
  FLogFont.lfEscapement := 0;
  FLogFont.lfOrientation := 0;
  FLogFont.lfWeight := 0;
  FLogFont.lfItalic := 0;
  FLogFont.lfUnderline := 0;
  FLogFont.lfStrikeOut := 0;
  FLogFont.lfCharSet := DEFAULT_CHARSET;
  FLogFont.lfOutPrecision := 0;
  FLogFont.lfClipPrecision := 0;
  FLogFont.lfQuality := 0;
  FLogFont.lfPitchAndFamily := 0;
  FLogFont.lfFaceName := '宋体';

  hTempDC := GetDC(0);

  pt.y := GetDeviceCaps(hTempDC, LOGPIXELSY) * FLogFont.lfHeight;
  pt.y := trunc(pt.y / 720 + 0.5);      // 72 points/inch, 10 decipoints/point
  DPtoLP(hTempDC, pt, 1);
  ptOrg.x := 0;
  ptOrg.y := 0;
  DPtoLP(hTempDC, ptOrg, 1);
  FLogFont.lfHeight := -abs(pt.y - ptOrg.y);
  ReleaseDC(0, hTempDC);

End;

Destructor TReportCell.Destroy;
Begin
  FCellsList.Free;
  FCellsList := Nil;
  fbmp.Free;
  Inherited Destroy;
End;

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

Procedure TReportCell.CopyCell(Cell: TReportCell; bInsert: Boolean);
Begin
  FLeftMargin := Cell.FLeftMargin;

  // Index
  FCellIndex := Cell.FCellIndex;

  // size & position
  FCellLeft := Cell.FCellLeft;
  FCellWidth := Cell.FCellWidth;

  FCellRect.Left := 0;
  FCellRect.Top := 0;
  FCellRect.Right := 0;
  FCellRect.Bottom := 0;

  FTextRect.Left := 0;
  FTextRect.Top := 0;
  FTextRect.Right := 0;
  FTextRect.Bottom := 0;

  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;
  // 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;
//
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 (PReportCtl <> Nil) Then
      ThisCell.CellLeft := PReportCtl.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;
  FPRControl := Line.FPRControl;

  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;

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -