baseprint1.pas

在打沙场用的最简单

unit BasePrint1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, MDIBase, Grids, DBGridEh, Buttons, 
  DB, DBClient, Menus, FR_Desgn, FR_DSet,
  FR_DBSet, FR_Class, Base, ImgList, ActnList, StdCtrls, ExtCtrls;

type
  TfrmBasePrint1 = class(TfrmMDIbase)
    paneltop: TPanel;
    formTitle: TLabel;
    SpeedButton1: TSpeedButton;
    spbtnprint: TSpeedButton;
    Grid: TDBGridEh;
    ActionList1: TActionList;
    ToolButtonImages: TImageList;
    acsearch: TAction;
    acprint: TAction;
    CDSbaseinfo: TClientDataSet;
    dsBaseinfo: TDataSource;
    frBaseinfo: TfrReport;
    frDBDSBaseinfo: TfrDBDataSet;
    popupprint: TPopupMenu;
    N1: TMenuItem;
    N2: TMenuItem;
    N3: TMenuItem;
    N4: TMenuItem;
    N5: TMenuItem;
    N6: TMenuItem;
    N7: TMenuItem;
    N8: TMenuItem;
    N9: TMenuItem;
    ActionListprint: TActionList;
    p01: TAction;
    p02: TAction;
    p03: TAction;
    p04: TAction;
    p05: TAction;
    procedure GridGetCellParams(Sender: TObject; Column: TColumnEh;
      AFont: TFont; var Background: TColor; State: TGridDrawState);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
    procedure p01Execute(Sender: TObject);
    procedure p02Execute(Sender: TObject);
    procedure p03Execute(Sender: TObject);
    procedure p04Execute(Sender: TObject);
    procedure acprintExecute(Sender: TObject);
    procedure acsearchExecute(Sender: TObject);
    procedure frBaseinfoUserFunction(const Name: String; p1, p2,
      p3: Variant; var Val: Variant);
  private
    { Private declarations }
  protected
    frName:string;
  public
    { Public declarations }
  end;

var
  frmBasePrint1: TfrmBasePrint1;

implementation

uses Global, common, uitem_f;

{$R *.dfm}

procedure TfrmBasePrint1.GridGetCellParams(Sender: TObject;
  Column: TColumnEh; AFont: TFont; var Background: TColor;
  State: TGridDrawState);
begin
  inherited;
  if Grid.SumList.RecNo mod 2=1 then
    BackGround:=$00EAEFED
    else
    BackGround:=clWhite;
end;

procedure TfrmBasePrint1.FormClose(Sender: TObject;
  var Action: TCloseAction);
begin
  inherited;
  Action:=caFree;
end;

procedure TfrmBasePrint1.FormCloseQuery(Sender: TObject;
  var CanClose: Boolean);
begin
  inherited;
  Grid.SumList.Active:=False;
end;

procedure TfrmBasePrint1.p01Execute(Sender: TObject);
begin
  inherited;
  CDSbaseinfo.DisableControls;
  FrBaseinfo.LoadFromFile(frName);
  FrBaseinfo.ShowReport;
  CDSBaseinfo.EnableControls;
end;

procedure TfrmBasePrint1.p02Execute(Sender: TObject);
begin
  inherited;
  CDSBaseinfo.DisableControls;
  frBaseinfo.LoadFromFile(frName);
  frBaseinfo.PrepareReport;
  frBaseinfo.PrintPreparedReport('',1,True,frAll);
  CDSBaseinfo.EnableControls;
end;

procedure TfrmBasePrint1.p03Execute(Sender: TObject);
begin
  inherited;
  CDSbaseinfo.DisableControls;
  frBaseinfo.LoadFromFile(frName);
  frBaseinfo.PrepareReport;
  frBaseinfo.PrintPreparedReportDlg;
  CDSbaseinfo.EnableControls;
end;

procedure TfrmBasePrint1.p04Execute(Sender: TObject);
begin
  inherited;
  CDSbaseinfo.DisableControls;
  frBaseinfo.LoadFromFile(frName);
  frBaseinfo.DesignReport;
  CDSBaseinfo.EnableControls;
end;

procedure TfrmBasePrint1.acprintExecute(Sender: TObject);
var
  point:Tpoint;
begin
  inherited;
  Point:=GetScreenPoint(spbtnprint);
  popupprint.Popup(point.X,point.Y); 
end;

procedure TfrmBasePrint1.acsearchExecute(Sender: TObject);
begin
  inherited;
  ClearCDSdata(CDSbaseinfo);
  itemid:=0;
  if not assigned(frmitem_f) then
    frmitem_f:=Tfrmitem_f.Create(application);
    frmitem_f.ShowModal;
  if itemid>0 then
    CDSBaseinfo.Data:=Pdetail(itemid);
end;

procedure TfrmBasePrint1.frBaseinfoUserFunction(const Name: String; p1, p2,
  p3: Variant; var Val: Variant);
begin
  inherited;
  if Ansicomparetext('XTOD',name)=0 then
    Val:=syRMB(frParser.Calc(p1));
end;

end.