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

📄 reportcontrol.~pa

📁 国产的报表控件
💻 ~PA
📖 第 1 页 / 共 5 页
字号:
         FCellrect.Left :=FCellrect.Left * 100 div Scale;
         FCellrect.top :=FCellrect.top * 100 div Scale;
         FCellrect.right :=FCellrect.right * 100 div Scale;
         FCellrect.bottom :=FCellrect.bottom * 100 div Scale;
        end;
}
    // 计算文本框的矩形
    TempRect := FCellRect;

    TempRect.left := TempRect.Left + FLeftMargin + 1;
    TempRect.top := TempRect.top + FTopLineWidth + 1;
    TempRect.right := TempRect.right - FLeftMargin - 1;
    TempRect.bottom := TempRect.top + FMinCellHeight - 2 - FTopLineWidth - FBottomLineWidth;

    case FVertAlign of
      TEXT_ALIGN_VCENTER:
        begin
          TempRect.Top := TempRect.Top + trunc((OwnerLineHeight - FMinCellHeight) / 2 + 0.5);
          TempRect.Bottom := TempRect.Bottom + trunc((OwnerLineHeight - FMinCellHeight) / 2 + 0.5);
        end;
      TEXT_ALIGN_BOTTOM:
        begin
          TempRect.Top := TempRect.Top + OwnerLineHeight - FMinCellHeight;
          TempRect.Bottom := TempRect.Bottom + OwnerLineHeight - FMinCellHeight;
        end;
    end;
{        if Scale <> 100 then
        begin
         temprect.top := temprect.top * 100 div Scale;
         temprect.bottom :=temprect.Bottom  * 100 div Scale;
         temprect.Left  := temprect.left * 100 div Scale;
         temprect.Right  := temprect.Right  * 100 div Scale;
        end;
}
    FTextRect := TempRect;
  end
  else
  begin
    TotalHeight := OwnerLineHeight;

    for I := 0 to FCellsList.Count - 1 do
      TotalHeight := TotalHeight + TReportCell(FCellsList[I]).OwnerLineHeight;

    FCellRect.left := FCellLeft;
    FCellRect.top := CellTop;
    FCellRect.right := FCellRect.left + FCellWidth;
    FCellRect.bottom := FCellRect.top + TotalHeight;

    // 计算文本框的矩形
    TempRect := FCellRect;

    TempRect.left := TempRect.Left + FLeftMargin + 1;
    TempRect.top := TempRect.top + FTopLineWidth + 1;
    TempRect.right := TempRect.right - FLeftMargin;
    TempRect.bottom := TempRect.top + FRequiredCellHeight - 2 - FTopLineWidth - FBottomLineWidth;

    case FVertAlign of
      TEXT_ALIGN_VCENTER:
        begin
          TempRect.Top := TempRect.Top + trunc((FCellRect.Bottom - FCellRect.Top - FRequiredCellHeight) / 2 + 0.5);
          TempRect.Bottom := TempRect.Bottom + trunc((FCellRect.Bottom - FCellRect.Top - FRequiredCellHeight) / 2 + 0.5);
        end;
      TEXT_ALIGN_BOTTOM:
        begin
          TempRect.Top := TempRect.Top + FCellRect.Bottom - FCellRect.Top - FRequiredCellHeight;
          TempRect.Bottom := TempRect.Bottom + FCellRect.Bottom - FCellRect.Top - FRequiredCellHeight;
        end;
    end;
{
        if Scale <> 100 then
        begin
         temprect.top := temprect.top * 100 div Scale;
         temprect.bottom :=temprect.Bottom  * 100 div Scale;
         temprect.Left  := temprect.left * 100 div Scale;
         temprect.Right  := temprect.Right  * 100 div Scale;
        end;
}
    FTextRect := TempRect;
  end;
end;

procedure TReportCell.PaintCell(hPaintDC: HDC; bPrint: Boolean);
var
  SaveDCIndex: Integer;
  hTempBrush: HBRUSH;
  TempLogBrush: TLOGBRUSH;
  hGrayPen, hPrevPen, hTempPen: HPEN;
  bDelete: Boolean;
  Format: UINT;
  hTextFont, hPrevFont: HFONT;
  TempRect: TRect;
begin
  if FOwnerCell <> nil then
    Exit;

  SaveDCIndex := SaveDC(hPaintDC);

  SetBkMode(hPaintDC, TRANSPARENT);

  // 绘制底色
  TempRect := FCellRect;
  TempRect.Top := TempRect.Top + 1;
  TempRect.Right := TempRect.Right + 1;
  if FBackGroundColor <> RGB(255, 255, 255) then
  begin
    TempLogBrush.lbStyle := BS_SOLID;
    TempLogBrush.lbColor := FBackGroundColor;
    hTempBrush := CreateBrushIndirect(TempLogBrush);
    FillRect(hPaintDC, TempRect, hTempBrush);
    DeleteObject(hTempBrush);
  end;

  // 绘制边框
  hGrayPen := CreatePen(BS_SOLID, 1, RGB(192, 192, 192));

  // 左边线
  if not bPrint and (FLeftLine or (FCellIndex = 0)) then
  begin
    bDelete := False;
    hTempPen := hGrayPen;
    if FLeftLine then
    begin
      hTempPen := CreatePen(PS_SOLID, FLeftLineWidth, RGB(0, 0, 0));
      bDelete := True;
    end;

    hPrevPen := SelectObject(hPaintDc, hTempPen);

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

    SelectObject(hPaintDc, hPrevPen);

    if bDelete then
      DeleteObject(hTempPen);
  end
  else
  begin
    if FLeftLine 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 bPrint 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 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 bPrint 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 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
  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 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;


  DeleteObject(hGrayPen);

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

  // 绘制斜线
  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;

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

  // 绘制文字
  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;
    DrawText(hPaintDC, PChar(FCellText), Length(FCellText), 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;
  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;
  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 := '';

  // 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 := '宋体';

  // Hey, I pass a invalid window's handle to you, what you return to me ?
  // Haha, is a device context of the DESKTOP WINDOW !
  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;

  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;

⌨️ 快捷键说明

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