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

📄 reportcontrol.pas

📁 企业智能(ERP)管理系统
💻 PAS
📖 第 1 页 / 共 5 页
字号:
    property TablePerPage: Integer read FTablePerPage write FTablePerPage default 2147483647;

  published
    { Published declarations }
    property Left;
    property Top;
    property Cursor;
    property Hint;
    property Visible default True;
    property Enabled default True;
    property OnMouseMove;
    property OnMouseDown;
    property OnMouseUp;
    property ShowHint;
    property OnDragOver;
    property OnDragDrop;
    property CreportEdit: boolean read FCreportEdit write setCreportEdit; // add 李泽伦 代表是否处在模板编辑程序调用中
    //property OnUpdateLine;
  end;

  //  TDragOverEvent = procedure(Sender, Source: TObject; X, Y: Integer; State: TDragState; var Accept: Boolean) of object;// add 李泽伦

  TDatasetItem = class(TObject)
    pDataset: TDataset;
    strName: string;
  end;

  TVarTableItem = class(TObject)
    strVarName: string;
    strVarValue: string;
  end;

  TMyRect = class(TObject)
  public
    Left: Integer;
    Top: Integer;
    Right: Integer;
    Bottom: Integer;
  end;


  TDatasetToExcel = class(TComponent) // add 李泽伦 将表的数据导入excl中的控件
  private
    FCol: word;
    FRow: word;
    FDataSet: TDataSet;
    Stream: TStream;
    FWillWriteHead: boolean;
    FBookMark: TBookmark;
    // FfileName:TfileName;
    procedure IncColRow;
    procedure WriteBlankCell;
    procedure WriteFloatCell(const AValue: Double);
    procedure WriteIntegerCell(const AValue: Integer);
    procedure WriteStringCell(const AValue: string);
    procedure WritePrefix;
    procedure WriteSuffix;
    procedure WriteTitle;
    procedure WriteDataCell;
    procedure SetDataset(const value: Tdataset);
    // procedure SetFileName(const value: TFileName);

  public
    procedure SaveToStream(aStream: TStream);
    procedure SaveToExcelFile(FileName: string; WillWriteHead: Boolean);
    //Constructor Create(AOwner: TComponent;aDataSet: TDataSet);
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
  published
    property Dataset: TDataset read FDataset write SetDataset;
    //  property FileName: TFilename read FFileName write SetFileName;

  end;


  TReportRunTime = class(TComponent)
  private
    FPreviewForm:TForm;

    FTempStreams:array of TStream;

    FRepmessForm : TrepmessForm;

    SumPage, SumAll: array[0..40] of real; //小计和合计用,最多40列单元格,否则统计汇总时要出错.

    FFileName: Tfilename;
    FAddSpace: boolean;
    FDBGrid: TDBGrid; //add 李泽伦
    // FOnSetEpt:Tnotifyevent; //add 李泽伦
    FSetData: TstringList; //add 李泽伦

    FEnableEdit: Boolean;

    FVarList: TList; // 保存变量的名字和值的对照表
    FLineList: TList; // 保存报表的设计信息(从文件中读入)
    FPrintLineList: TList; //保存要打印的某一页的行信息
    FOwnerCellList: TList; // 保存每一页中合并后单元格前后的指针

    Cp_DFdList: TList; // 保存数据集的指针和名称的对照

    Width: Integer;
    Height: Integer;

    // 定义换页加表头
    FNewTable: Boolean;

    // 定义打印多少行后从新加表头
    FDataLine: Integer;
    FTablePerPage: Integer;

    FReportScale: Integer;
    FPageWidth: Integer;
    FPageHeight: Integer;

    FHeaderHeight: Integer;

    FallPrint: Boolean; //是否打印全部记录,默认为全部

    FLeftMargin: Integer; //2
    FRightMargin: Integer;
    FTopMargin: Integer;
    FBottomMargin: Integer;

    FLeftMargin1: Integer;
    FRightMargin1: Integer;
    FTopMargin1: Integer;
    FBottomMargin1: Integer;

    FPageCount: Integer; // page count in Print Preview

    FHootNo: Integer;
    FEditEpt: boolean; //表尾的第一行在整个页的第几行 李泽伦

    procedure UpdateLines;
    procedure UpdatePrintLines;
    procedure PrintOnePage;
    procedure LoadRptFile;
    function GetDatasetName(strCellText: string): string;
    function GetDataset(strCellText: string): TDataset;
    function DatasetByName(strDatasetName: string): TDataset;
    function GetVarValue(strVarName: string): string;
    function GetFieldName(strCellText: string): string;
    function GetField(strCellText:String):TField;
    procedure SetRptFileName(const Value: TFilename);


    procedure SetDBGrid(const Value: TDBGrid); // add 李泽伦

    //   procedure LFOnSetEpt(const value:Tnotifyevent);

    procedure LSetData(const value: TstringList); // add 李泽伦

    procedure SetPar(FIDE, Tableopen: boolean; name: string);
    function LFindComponent(Owner: TComponent; Name: string): TComponent;

    procedure SaveToStream(Stream:TStream;PageNumber,Fpageall: Integer;const APosition:Integer=0);
    procedure SaveTempStream(PageNumber, Fpageall: Integer);

    function setSumAllYg(fm, ss: string): string; //add 李泽伦
    function setSumpageYg(fm, ss: string): string; //add 李泽伦

    procedure LoadFromStream(Stream:TStream;const APosition:Integer=0);
    procedure LoadTempStream(Page:Integer);
    procedure DeleteTempStreams;
    procedure SetEnableEdit(Value: Boolean);
    procedure SetEditept(Value: Boolean); //add 李泽伦
    procedure SetNewCell(spyn: boolean; NewCell, ThisCell: TReportCell; TempDataSet: TDataset);
    procedure SetAddSpace(const Value: boolean);
  public
    CreportIDE: Boolean;

    FprPageNo: Integer; //打印文件的纸张序号  李泽伦
    FprPageXy: Integer; //打印文件的纸张纵横方向  李泽伦
    fPaperLength: Integer;
    fPaperWidth: Integer;

    cp_pgw, cp_pgh, scale: Integer;

    NhasSumALl: Integer; //有合计的行在模板中是第几行 lzl.

    cp_prewYn: Boolean; //代表是否处于预览状态, 李泽伦 
    //EditEpt:Boolean; //是否充许用户在预览时调用编辑程序修改模板

    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure SetDataset(strDatasetName: string; pDataSet: TDataSet);
    procedure SetVarValue(strVarName, strVarValue: string);
    property allPrint: Boolean read FallPrint write FallPrint default True;
    procedure ResetContent;
    procedure PrintPreview(bPreviewMode: Boolean);
    function shPreview: Boolean; //重新生成预览有关文件
    function PrintSET(prFile: string): Boolean; //纸张及边距设置,李泽伦
    procedure UpdatePage; //
    function PreparePrintk(SaveYn: Boolean; FpageAll: Integer): Integer; //李泽伦增加

    procedure CreateNewLine;

    procedure PreparePrint;
    procedure LoadFile(value: tfilename);
    procedure Print(pYn: Boolean);
    procedure Resetself;
    function CancelPrint: Boolean;

    procedure PreviewDBGrid(eptname: string); // add 李泽伦

    procedure EditReport; virtual; //add 李泽伦 双击控件调用
    procedure Preview; virtual;
  published
    property ReportFile: TFilename read FFileName write SetRptFileName;

    property PrDBGrid: TDBGrid read FDBGrid write SetDBGrid; //add 李泽伦

    property EnableEdit: Boolean read FEnableEdit write setEnableEdit; //add 李泽伦

    property EditEpt: Boolean read FEditEpt write setEditEpt; // add 李泽伦

    //property OnSetEpt:Tnotifyevent Read FOnSetEpt Write LFOnSetEpt;  // add 李泽伦

    property SetData: TstringList read FSetData write LSetData; // add 李泽伦
    property AddSpace: Boolean read FAddSpace write SetAddSpace; // add 李泽伦

  end;

  TCreportEditor = class(TComponentEditor)
  public
    procedure ExecuteVerb(Index: Integer); override;
    function GetVerb(Index: Integer): string; override;
    function GetVerbCount: Integer; override;
  end;


  TCellTable = class(TObject)
    PrevCell: TReportCell;
    ThisCell: TReportCell;
  end;

procedure prDeviceMode; //取得当前打印机的DeviceMode的结构成员
function IsInstalledPrinter: Boolean; //用于是否已安装打印机

procedure Register;

type
  TCXIsBlank = array[0..4] of Word;
  TCXlsNumber = array[0..4] of Word;
  TCXlsRk = array[0..4] of Word;
  TCXlsLabel = array[0..5] of Word;
  TCXlsBof = array[0..5] of Word;
  TCXlsEof = array[0..1] of Word;

const
  CXlsBof: TCXlsBof = ($809, 8, 0, $10, 0, 0); // add 李泽伦
  CXlsEof: TCXlsEof = ($0A, 00);
  CXlsLabel: TCXlsLabel = ($204, 0, 0, 0, 0, 0);
  CXlsNumber: TCXlsNumber = ($203, 14, 0, 0, 0);
  CXlsRk: TCXlsRk = ($27E, 10, 0, 0, 0);
  CXlsBlank: TCXIsBlank = ($201, 6, 0, 0, $17);

var
  Adevice, Adriver, Aport: array[0..255] of char; //prdevixemode调用 李泽伦2002.3
  DeviceHandle: THandle;
  DevMode: PdeviceMode; //当前打印机结构成员,调用prdevixemode初始化 李泽伦

implementation

{$R ReportControl.dcr}
uses PreviewDBGrid, Margin, Preview,
  Creport, About, Border, vsplit, Color, diagonal, Margink, NewDialog; //add 李泽伦

procedure prDeviceMode; //取得当前打印机的DeviceMode的结构成员   李泽伦
begin
  Printer.GetPrinter(Adevice, Adriver, Aport, DeviceHandle);
  if DeviceHandle = 0 then
  begin
    Printer.PrinterIndex := Printer.PrinterIndex;
    Printer.GetPrinter(Adevice, Adriver, Aport, DeviceHandle);
  end;
  if DeviceHandle = 0 then
    raise Exception.Create('Could Not Initialize TdeviceMode Structure')
  else
    DevMode := GlobalLock(DeviceHandle);
  {!!!}
  if not DeviceHandle = 0 then
    GlobalLock(DeviceHandle);
end;


function IsInstalledPrinter: Boolean; //用于是否已安装打印机
begin
  Result := not Printer.Printers.Count <= 0;
end;

procedure Register;
begin
  RegisterComponents('CReport', [TReportControl]);
  RegisterComponents('CReport', [TReportRunTime]);
  RegisterComponents('CReport', [TDatasetToExcel]); // add 李泽伦
  RegisterComponentEditor(TReportRunTime, TCreportEditor); // add 李泽伦
end;

///////////////////////////////////////////////////////////////////////////
// TReportCell

{TReportCell}

procedure TReportRunTime.Preview; //add 李泽伦
  function FPreviewForm:TPreviewForm;
  begin
    Result:=Self.FPreviewForm as TPreviewForm;
  end;
var
  i, HasDataNo: Integer;
begin
  DeleteTempStreams;
  for I := Cp_DFdList.Count - 1 downto 0 do
    TDataSetItem(Cp_DFdList[I]).Free;
  Cp_DFdList.Clear;
  if (ReportFile = '') or (SetData.Count = 0) then
  begin
    MessageDlg('ReportFile或SetData属性未填列,不能预览。', mtInFormation, [mbOk], 0);
    exit;
  end;

  ReportFile := ReportFile;
  try
    for i := 0 to SetData.Count - 1 do
      SetPar(True, True, SetData[i]); //参数设置
    //i:=PreparePrintk(False,0);
    HasDataNo := PreparePrintk(True, SetData.Count - 1);
  except
    MessageDlg('形成报表时发生错误,请检查各项参数与模板设置等是否正确', mtInFormation, [mbOk], 0);
    exit;
  end;
  if CreportIDE then
    Self.FPreviewForm:=TPreviewForm.Create(Application)
  else
    Self.FPreviewForm:=TPreviewForm.Create(Self);
  try
    //CreportIDE := True; //处于IDE中调用
    FPreviewForm.ReportControl1.Enabled := Fenableedit;
    FPreviewForm.SpeedButton1.Enabled := False; //预览中页面设置无效
    FPreviewForm.PrintBtn.Enabled := False;
    FPreviewForm.Tag := HasDataNo;
    FPreviewForm.ReportEnable := fenableedit; //预览中是否允许编辑
    //FPreviewForm.ReportEdit:= fenableedit;
    FPreviewForm.SetPreviewMode(True);

    FPreviewForm.ReportControl1.cp_pgw:=cp_pgw;
    FPreviewForm.ReportControl1.cp_pgh:=cp_pgh;
    FPreviewForm.ReportControl1.scale:=scale;
    FPreviewForm.ReportControl1.NhasSumALl:=NhasSumALl;

    FPreviewForm.ReportControl1.cp_prewYn := True; //代表处于预览状态,调用打印时以便区分

    FPreviewForm.PreviewStreams(FTempStreams);
    DeleteTempStreams;
    FPreviewForm.ReportControl1.cp_prewYn := False;
  finally
    FPreviewForm.Free;
  end;
  for i := 0 to SetData.Count - 1 do // add 李泽伦
    SetPar(True, False, SetData[i]); // 关闭打开的数据库

  //CreportIDE := False;
end;

procedure TReportRunTime.EditReport; //add 李泽伦
var
  CreportForm:TCreportForm;
begin
  if CreportIDE then
    CreportForm:=TCreportForm.Create(Application)
  else
    CreportForm:=TCreportForm.Create(Self);
  try
    if ReportFile <> '' then
    begin
      CreportForm.LoadFromFile(ReportFile);
    end;
    CreportForm.ShowModal;
  finally
    CreportForm.Free;
  end;
end;


procedure TCreportEditor.ExecuteVerb(index: Integer); // add 李泽伦
begin
  case index of
    0: (Component as TReportRunTime).EditReport;
    1: (Component as TReportRunTime).Preview;
  end;
end;

function TCreportEditor.GetVerb(Index: Integer): string; // add 李泽伦
begin
  (Component as TReportRunTime).CreportIDE := True; //处于IDE中调用
  case index of
    0: result := 'IEditEpt4.0';
    1: result := 'IPreview'; // do priew
  end;
end;

function TCreportEditor.GetVerbCount: Integer;
begin
  Result := 2;
end;

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;
  try

⌨️ 快捷键说明

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