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

📄 untcustomerrent.pas

📁 用delphi编写的数据库管理软件
💻 PAS
字号:
unit untCustomerRent;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, MDIBase, FR_DSet, FR_DBSet, FR_Class, Menus, ActnList, DB,
  DBClient, Grids, DBGridEh, StdCtrls, ExtCtrls, Buttons, Mask,
  DBCtrlsEh, ComCtrls, wwdblook, Wwdbdlg, wwdbedit, Wwdotdot;

Const
  WM_USER_GETDATA = WM_USER+1024;
  WM_USER_SETFOOTER = WM_USER+8028;

type
  TfrmCustomerRent = class(TfrmMDIBase)
    Panel1: TPanel;
    FormTitle: TLabel;
    Panel3: TPanel;
    btnExit: TButton;
    Panel2: TPanel;
    btnadd: TButton;
    btncopy: TButton;
    btnedit: TButton;
    btndelete: TButton;
    Panel4: TPanel;
    btnrefresh: TButton;
    btnprint: TButton;
    grid: TDBGridEh;
    CDSBaseinfo: TClientDataSet;
    DSbaseinfo: TDataSource;
    ActionList1: TActionList;
    Action1: TAction;
    Action2: TAction;
    Action3: TAction;
    Action4: TAction;
    Action5: TAction;
    ppmreport: TPopupMenu;
    N1: TMenuItem;
    N2: TMenuItem;
    N3: TMenuItem;
    N4: TMenuItem;
    N5: TMenuItem;
    N6: TMenuItem;
    N7: TMenuItem;
    N8: TMenuItem;
    N9: TMenuItem;
    frBaseinfo: TfrReport;
    frDBDataSet1: TfrDBDataSet;
    ActionList2: TActionList;
    acrefresh: TAction;
    acsearch: TAction;
    acfieldproperty: TAction;
    acexit: TAction;
    acfirst: TAction;
    acprior: TAction;
    acnext: TAction;
    aclast: TAction;
    popupgrid: TPopupMenu;
    N10: TMenuItem;
    N11: TMenuItem;
    N12: TMenuItem;
    N13: TMenuItem;
    N14: TMenuItem;
    N15: TMenuItem;
    N16: TMenuItem;
    N17: TMenuItem;
    N18: TMenuItem;
    N20: TMenuItem;
    N21: TMenuItem;
    Button1: TButton;
    PopupMenu1: TPopupMenu;
    ts01: TAction;
    ts02: TAction;
    ts03: TAction;
    ts04: TAction;
    ts05: TAction;
    ts06: TAction;
    ts07: TAction;
    ts08: TAction;
    N19: TMenuItem;
    N22: TMenuItem;
    N23: TMenuItem;
    N24: TMenuItem;
    N25: TMenuItem;
    N26: TMenuItem;
    N27: TMenuItem;
    N28: TMenuItem;
    Label7: TLabel;
    SpeedButton1: TSpeedButton;
    Label1: TLabel;
    DBDateTimeEditEh1: TDateTimePicker;
    DBDateTimeEditEh2: TDateTimePicker;
    wwDBLookupCombo1: TwwDBComboDlg;
    CDSBaseinfofno_r: TWideStringField;
    CDSBaseinfofno: TWideStringField;
    CDSBaseinfofcustomerCode: TWideStringField;
    CDSBaseinfofcustomerName: TWideStringField;
    CDSBaseinfofcustomerMobile: TWideStringField;
    CDSBaseinfofCustomerAddress: TWideStringField;
    CDSBaseinfofcode: TWideStringField;
    CDSBaseinfofname: TWideStringField;
    CDSBaseinfofamount: TBCDField;
    CDSBaseinfofdate: TWideStringField;
    procedure gridDrawColumnCell(Sender: TObject; const Rect: TRect;
      DataCol: Integer; Column: TColumnEh; State: TGridDrawState);
    procedure acexitExecute(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure acfirstExecute(Sender: TObject);
    procedure acpriorExecute(Sender: TObject);
    procedure acnextExecute(Sender: TObject);
    procedure aclastExecute(Sender: TObject);
    procedure btnprintClick(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure Action1Execute(Sender: TObject);
    procedure Action2Execute(Sender: TObject);
    procedure Action3Execute(Sender: TObject);
    procedure Action4Execute(Sender: TObject);
    procedure frBaseinfoUserFunction(const Name: String; p1, p2,
      p3: Variant; var Val: Variant);
    procedure FormCreate(Sender: TObject);
    procedure acrefreshExecute(Sender: TObject);
    procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
    procedure gridDblClick(Sender: TObject);
    procedure SpeedButton1Click(Sender: TObject);
    procedure ts01Execute(Sender: TObject);
    procedure ts02Execute(Sender: TObject);
    procedure ts03Execute(Sender: TObject);
    procedure ts04Execute(Sender: TObject);
    procedure ts05Execute(Sender: TObject);
    procedure ts06Execute(Sender: TObject);
    procedure ts07Execute(Sender: TObject);
    procedure ts08Execute(Sender: TObject);
    procedure wwDBLookupCombo1CustomDlg(Sender: TObject);
  private
    procedure SetfieldDisplayFormat;
    procedure Getdata(var getdata:Tmessage);Message WM_USER_GETDATA;
    procedure setfooter(var setfooter:Tmessage);Message WM_USER_SETFOOTER;
    { Private declarations }

  protected
    ReportName:String;
        
  public
    { Public declarations }
  end;

var
  frmCustomerRent: TfrmCustomerRent;

implementation

uses DataProcess, Global, untvLeaseState, untCustomerSearch;

{$R *.dfm}

procedure TfrmCustomerRent.Getdata(var getdata: Tmessage);
begin
  if   ((DatetoStr(DBDateTimeEditEh2.Date)='') and (DatetoStr(DBDateTimeEditEh1.Date)<>'')) or
       ((DatetoSTr(DBDateTimeEditEh2.Date)<>'') and (DatetoStr(DBDateTimeEditEh1.Date)='')) or
       (DBDateTimeEditEh2.Date<DBDateTimeEditEh1.Date) then
  begin
    messagedlg('日期设置错误 ! ',mtError,[mbok],0);
    Exit;
  end;
  ClearCDSDATA(CDSBaseinfo);
  CDSBaseinfo.Data:=CustomerRent(wwDBLookupCombo1.Text,DatetoStr(DBDateTimeEditEh1.Date),DatetoStr(DBDateTimeEditEh2.Date));
  Postmessage(handle,WM_USER_SETFOOTER,0,0);
  application.ProcessMessages;
  SetfieldDisplayFormat;
end;

procedure TfrmCustomerRent.gridDrawColumnCell(Sender: TObject;
  const Rect: TRect; DataCol: Integer; Column: TColumnEh;
  State: TGridDrawState);
begin
  inherited;
  if CDSBaseinfo.RecNo  mod 2 = 0 then
    begin
      Grid.Canvas.Brush.Color:=$00EAEFED;
      Grid.Canvas.Font.Color:=clBlack;
    end
    else
    begin
      Grid.Canvas.Brush.Color:=clWhite;
      Grid.Canvas.Font.Color:=clBlack;
    end;
  if gdselected in state then
    begin
      grid.Canvas.Brush.Color:=clBackground;
      grid.Canvas.Font.Color:=clwhite;
    end;
  grid.DefaultDrawColumnCell(Rect,DataCol,Column,State);
end;

procedure TfrmCustomerRent.setfooter(var setfooter: Tmessage);
var
  i,j:integer;
begin
  i:=Grid.Columns.Count;
  if i>0 then
    begin
      for j:=0 to i-1 do
        begin
          Grid.Columns[j].Footer.ValueType:=fvtStaticText;
          Grid.Columns[j].Footer.Value:='合计';
          Grid.Columns[j+1].Footer.ValueType:=fvtCount;
          Grid.Columns[9].Footer.ValueType:=fvtSum;
          break;
        end;
    end;
  application.ProcessMessages;
end;

procedure TfrmCustomerRent.acexitExecute(Sender: TObject);
begin
  inherited;
  Close;
end;

procedure TfrmCustomerRent.FormDestroy(Sender: TObject);
begin
  inherited;
  frmCustomerRent:=nil;
end;

procedure TfrmCustomerRent.acfirstExecute(Sender: TObject);
begin
  inherited;
  CDSBaseinfo.First;
end;

procedure TfrmCustomerRent.acpriorExecute(Sender: TObject);
begin
  inherited;
  CDSBaseinfo.Prior; 
end;

procedure TfrmCustomerRent.acnextExecute(Sender: TObject);
begin
  inherited;
  CDSBaseinfo.Next; 
end;

procedure TfrmCustomerRent.aclastExecute(Sender: TObject);
begin
  inherited;
  CDSBaseinfo.Last; 
end;

procedure TfrmCustomerRent.btnprintClick(Sender: TObject);
var
  Point:Tpoint;
begin
  inherited;
  Point:=GetScreenPoint(btnprint);
  ppmreport.Popup(point.X,point.Y);
end;

procedure TfrmCustomerRent.FormShow(Sender: TObject);
begin
  inherited;
  FormTitle.Caption:=self.Caption;
  postmessage(handle,WM_USER_GETDATA,0,0);
  application.ProcessMessages;
end;

procedure TfrmCustomerRent.Action1Execute(Sender: TObject);
begin
  inherited;
  if CDSbaseinfo.RecordCount = 0 then
    Exit;
  try
    CDSbaseinfo.DisableControls;
    frbaseinfo.LoadFromFile(GetLogDir('Prints')+ReportName);
    frbaseinfo.ShowReport;
    CDSbaseinfo.EnableControls;
  except
    on E:Exception do
      begin
        messagedlg('预览失败 ! '+#10#13+E.Message,mtError,[MBOK],0);
        Exit;
      end;
  end;
end;

procedure TfrmCustomerRent.Action2Execute(Sender: TObject);
begin
  inherited;
  if CDSbaseinfo.RecordCount = 0 then
    Exit;
  try
    CDSbaseinfo.DisableControls;
    frbaseinfo.LoadFromFile(GetLogDir('Prints')+ReportName);
    frbaseinfo.PrepareReport;
    frbaseinfo.PrintPreparedReport('',1,True,frAll);
    CDSbaseinfo.EnableControls;
  except
    on E:Exception do
      begin
        messagedlg('打印失败 !'+#10#13+E.Message,mtError,[MBOK],0);
        Exit;
      end;
  end;
end;

procedure TfrmCustomerRent.Action3Execute(Sender: TObject);
begin
  inherited;
  if CDSbaseinfo.RecordCount = 0 then
    Exit;
  try
    CDSbaseinfo.DisableControls;
    frbaseinfo.LoadFromFile(GetLogDir('Prints')+ReportName);
    frbaseinfo.PrepareReport;
    frbaseinfo.PrintPreparedReportDlg;
    CDSbaseinfo.EnableControls;
  except
    on E:Exception do
      begin
        messagedlg('打印设置失败 ! '+#10#13+E.Message,mtError,[MBOK],0);
        Exit;
      end;
  end;
end;

procedure TfrmCustomerRent.Action4Execute(Sender: TObject);
begin
  inherited;
  if CDSbaseinfo.RecordCount = 0 then
    Exit;
  try
    CDSbaseinfo.DisableControls;
    frbaseinfo.LoadFromFile(GetLogDir('Prints')+ReportName);
    frbaseinfo.DesignReport;
    CDSbaseinfo.EnableControls;
  except
    on E:Exception do
      begin
        messagedlg('报表设置失败 ! '+#10#13+E.Message,mtError,[MBOK],0);
        Exit;
      end;
  end;
end;

procedure TfrmCustomerRent.frBaseinfoUserFunction(const Name: String; p1,
  p2, p3: Variant; var Val: Variant);
begin
  inherited;
  if AnsicompareText('SRTIME',name)=0 then
    Val:=SRNow();
end;

procedure TfrmCustomerRent.FormCreate(Sender: TObject);
begin
  inherited;
  DBDateTimeEditEh1.Date:=Date();
  DBDateTimeEditEh2.Date:=Date();  
  ReportName:='frFinanceBalance.frf';
end;

procedure TfrmCustomerRent.acrefreshExecute(Sender: TObject);
begin
  inherited;
  postmessage(handle,WM_USER_GETDATA,0,0);
  application.ProcessMessages;
end;

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

procedure TfrmCustomerRent.SetfieldDisplayFormat;
var
  i:integer;
begin
  for i:=0 to CDSBaseinfo.FieldCount - 1 do
    begin
    if (CDSBaseinfo.Fields[i] is TNumericField) and (not (CDSBaseinfo.Fields[i] is TIntegerField)) then
      (CDSBaseinfo.Fields[i] as TNumericField).DisplayFormat := '###,##0.00';
    if (CDSBaseinfo.Fields[i] is TFloatField) then
      (CDSBaseinfo.Fields[i] as TFloatField).DisplayFormat := '###,##0.00';
    if (CDSBaseinfo.Fields[i] is TCurrencyField) then
      (CDSBaseinfo.Fields[i] as TCurrencyField).DisplayFormat := '¥###,##0.00';

    end;
end;

procedure TfrmCustomerRent.gridDblClick(Sender: TObject);
var
  V:TbookMark;
begin
  inherited;
  try
  V:=CDSBaseinfo.GetBookmark;
  UserSelectBillNo:=CDSBaseinfo.fieldbyname('fNo_R').AsString;
  if UserSelectBillNo<>'' then
  begin
    openModalForm(TfrmvleaseState,self,Tform(frmvleaseState));
    postMessage(Handle,WM_USER_GETDATA,0,0);
  end;
  CDSBaseinfo.GotoBookmark(V);
  finally
  CDSBaseinfo.FreeBookmark(V);
  end;
end;

procedure TfrmCustomerRent.SpeedButton1Click(Sender: TObject);
var
  Point:Tpoint;
begin
  inherited;
  Point:=GetScreenPoint(SpeedButton1);
  PopupMenu1.Popup(point.X,point.Y);
end;

procedure TfrmCustomerRent.ts01Execute(Sender: TObject);
begin
  inherited;
  DBDateTimeEditEh2.Date:=Date();
  DBDateTimeEditEh1.Date:=Date()-1;
end;

procedure TfrmCustomerRent.ts02Execute(Sender: TObject);
begin
  inherited;
  DBDateTimeEditEh2.Date:=Date();
  DBDateTimeEditEh1.Date:=Date()-3;
end;

procedure TfrmCustomerRent.ts03Execute(Sender: TObject);
begin
  inherited;
  DBDateTimeEditEh2.Date:=Date();
  DBDateTimeEditEh1.Date:=Date()-7;
end;

procedure TfrmCustomerRent.ts04Execute(Sender: TObject);
begin
  inherited;
  DBDateTimeEditEh2.Date:=Date();
  DBDateTimeEditEh1.Date:=Date()-15;
end;

procedure TfrmCustomerRent.ts05Execute(Sender: TObject);
begin
  inherited;
  DBDateTimeEditEh2.Date:=Date();
  DBDateTimeEditEh1.Date:=Date()-30;
end;

procedure TfrmCustomerRent.ts06Execute(Sender: TObject);
begin
  inherited;
  DBDateTimeEditEh2.Date:=Date();
  DBDateTimeEditEh1.Date:=Date()-90;
end;

procedure TfrmCustomerRent.ts07Execute(Sender: TObject);
begin
  inherited;
  DBDateTimeEditEh2.Date:=Date();
  DBDateTimeEditEh1.Date:=Date()-180;
end;

procedure TfrmCustomerRent.ts08Execute(Sender: TObject);
begin
  inherited;
  DBDateTimeEditEh2.Date:=Date();
  DBDateTimeEditEh1.Date:=Date()-360;
end;

procedure TfrmCustomerRent.wwDBLookupCombo1CustomDlg(Sender: TObject);
var
  SearchCDS:TclientDataset;
begin
  inherited;
  openModalForm(TfrmCustomerSearch,self,tForm(frmCustomerSearch));
  if SearchReturnID=0 then
    Exit;
  try
    SearchCDS:=Tclientdataset.create(nil);
    Searchcds.FetchOnDemand:=False;
    GetsqlData(SearchCDS,'tcustomer','fid','fid='+vartosql(SearchReturnID),1);
    if SearchCDS.RecordCount > 0 then
      begin
      wwDBLookupCombo1.Text:=SearchCDS.fieldbyname('fcode').asstring;
      end;
  finally
    SearchCDS.Close;
    Searchcds.Free;
  end;
end;

end.

⌨️ 快捷键说明

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