cus.pas

集成酒店桑拿食管管理的完整程序

unit cus;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  ExtCtrls, StdCtrls, DBCtrls, Mask, Db, DBTables, Grids, DBGrids, Buttons,
  Spin, ComCtrls;

type
  Tcusform = class(TForm)
    xftype: TComboBox;
    Label2: TLabel;
    Label3: TLabel;
    Label4: TLabel;
    Label5: TLabel;
    Button1: TButton;
    Button2: TButton;
    Button3: TButton;
    Button4: TButton;
    Button5: TButton;
    Button6: TButton;
    DataSource1: TDataSource;
    DBGrid1: TDBGrid;
    Label1: TLabel;
    Bevel1: TBevel;
    Bevel2: TBevel;
    Bevel3: TBevel;
    Q1: TQuery;
    bh: TMaskEdit;
    mc: TMaskEdit;
    dw: TMaskEdit;
    js: TCheckBox;
    zy: TCheckBox;
    zk: TCheckBox;
    Q2: TQuery;
    dj: TMaskEdit;
    xfxl: TComboBox;
    procedure FormCreate(Sender: TObject);
    procedure xftypeClick(Sender: TObject);
    procedure Button6Click(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure Button5Click(Sender: TObject);
    procedure Button4Click(Sender: TObject);
    procedure djExit(Sender: TObject);
    procedure FormKeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure xfxlClick(Sender: TObject);
  private
    { Private declarations }
  public
     PPCode,PCode,Level,selbut,oldcode:string;
    { Public declarations }
  end;

var
  cusform: Tcusform;

implementation
uses dataproc;

{$R *.DFM}
var
   but,oldcuscode:string;

procedure formini;
begin
with cusform do
   begin
   bh.text:='';
   mc.text:='';
   dw.text:='';
   dj.text:='0.00';
   js.Checked :=false;
   zy.checked:=false;
   zk.checked:=false;
   button1.Enabled :=true;
   button2.Enabled :=true;
   button3.Enabled :=true;
   button4.Enabled :=false;
   button5.Enabled :=false;
   bh.Enabled :=true;
   end
end;

procedure formunini;
begin
with cusform do
   begin
   button1.Enabled :=false;
   button2.Enabled :=false;
   button3.Enabled :=false;
   button4.Enabled :=true;
   button5.Enabled :=true;
   end
end;

procedure datatoctr;
begin
with cusform do
   begin
   bh.text:=q1.fieldbyname('cuscode').asstring;
   mc.text:=q1.fieldbyname('cusname').asstring;
   dw.text:=q1.fieldbyname('unit').asstring;
   dj.text:=q1.fieldbyname('price').asstring;
   js.Checked :=q1.FieldByName ('isjs').asboolean;
   zy.Checked :=q1.FieldByName ('iszy').asboolean;
   zk.Checked :=q1.FieldByName ('iszk').asboolean;
   end
end;

procedure seeother;
begin
with cusform do
   begin
   q1.Active :=false;
   q1.sql.Clear ;
   q1.sql.add('select cuscode,cusname,price,unit,isjs,iszy,iszk from cusitem where custype=:pcustype');
   if length(trim(xfxl.items[xfxl.itemindex]))=0 then
      begin
      xfxl.enabled:=false;
      q1.ParamByName ('pcustype').asstring:=trim(copy(xftype.items[xftype.itemindex],1,4));
      end
   else
      begin
      xfxl.enabled:=true;
      q1.ParamByName ('pcustype').asstring:=trim(copy(xfxl.items[xfxl.itemindex],1,4));
      end;
   q1.prepare;
   q1.open;
   chinesegrid(dbgrid1);
   q1.active:=true;
   end
end;

procedure Tcusform.FormCreate(Sender: TObject);
begin
   comadd(cusform.xftype,2,'select custype,cusname from custype where parentcode="0" ');
   comadd(cusform.xfxl,2,'select custype,cusname from custype where parentcode="'+trim(copy(xftype.items[xftype.itemindex],1,4))+'"');
   seeother;
   formini;
end;

procedure Tcusform.xftypeClick(Sender: TObject);
begin
  comadd(cusform.xfxl,2,'select custype,cusname from custype where parentcode="'+trim(copy(xftype.items[xftype.itemindex],1,4))+'"');
  seeother;
end;

procedure Tcusform.Button6Click(Sender: TObject);
begin
  cusform.close;
end;

procedure Tcusform.Button1Click(Sender: TObject);
begin
   but:='1';
   formunini;
   bh.SetFocus;
end;

procedure Tcusform.Button2Click(Sender: TObject);
begin
   but:='2';
   if q1.RecordCount >0 then
      begin
      datatoctr;
      oldcuscode:=trim(bh.text);
      formunini;
      end
   else
      showmessage('无记录，不能修改');
end;

procedure Tcusform.Button3Click(Sender: TObject);
begin
   but:='3';
   if q1.RecordCount >0 then
      begin
      datatoctr;
      oldcuscode:=trim(bh.text);
      formunini;
      bh.Enabled :=false;
      end
   else
      showmessage('无记录，不能删除');
end;

procedure Tcusform.Button5Click(Sender: TObject);
begin
   formini;
end;

procedure Tcusform.Button4Click(Sender: TObject);
begin
    if ((length(trim(bh.text))=0) or (length(trim(mc.text))=0) or (length(trim(dw.text))=0)) then
       begin
       showmessage('编号，名称，单位不能为空');
       bh.SetFocus ;
       exit;
       end;
    if but='1' then
       try
          q2.Active :=false;
          q2.sql.clear;
          q2.sql.add('insert into cusitem values(:pcuscode,:pcusname,:pcustype,:pprice,:punit,:pisjs,:piszy,:piszk)');
          q2.ParamByName ('pcuscode').asstring:=trim(bh.text);
          q2.ParamByName ('pcusname').asstring:=trim(mc.text);
          if xfxl.Enabled =true then
             q2.ParamByName ('pcustype').asstring:=copy(xfxl.Items[xfxl.itemindex],1,4)
          else
             q2.ParamByName ('pcustype').asstring:=trim(copy(xftype.Items[xftype.itemindex],1,4));
          q2.ParamByName ('pprice').asfloat:=strtofloat(trim(dj.text));
          q2.ParamByName ('punit').asstring:=trim(dw.text);
          q2.ParamByName ('pisjs').asboolean:=js.Checked ;
          q2.ParamByName ('piszy').asboolean:=zy.Checked ;
          q2.ParamByName ('piszk').asboolean:=zk.Checked ;
          q2.Prepare;
          q2.ExecSQL ;
          seeother;
          formini;
       except
          showmessage('编号已存在');
       end;
    if but='2' then
       try
          q2.Active :=false;
          q2.sql.clear;
          q2.sql.add('update cusitem set cuscode=:pcuscode,cusname=:pcusname,custype=:pcustype,price=:pprice,unit=:punit,isjs=:pisjs,iszy=:piszy,iszk=:piszk where cuscode=:poldcuscode');
          q2.ParamByName ('pcuscode').asstring:=trim(bh.text);
          q2.ParamByName ('pcusname').asstring:=trim(mc.text);
          if xfxl.Enabled =true then
             q2.ParamByName ('pcustype').asstring:=copy(xfxl.Items[xfxl.itemindex],1,4)
          else
             q2.ParamByName ('pcustype').asstring:=trim(copy(xftype.Items[xftype.itemindex],1,4));
          q2.ParamByName ('pprice').asfloat:=strtofloat(trim(dj.text));
          q2.ParamByName ('punit').asstring:=trim(dw.text);
          q2.ParamByName ('pisjs').asboolean:=js.Checked ;
          q2.ParamByName ('piszy').asboolean:=zy.Checked ;
          q2.ParamByName ('piszk').asboolean:=zk.Checked ;
          q2.ParamByName ('poldcuscode').asstring:=oldcuscode;
          q2.Prepare;
          q2.ExecSQL ;
          seeother;
          formini;
       except
          showmessage('编号已存在');
       end;
    if but='3' then
       try
          if messagedlg('确实删除吗？',mtWarning,[mbyes,mbno],1)=mryes then
             begin
             q2.Active :=false;
             q2.sql.clear;
             q2.sql.Add('delete cusitem where cuscode=:pcuscode');
             q2.ParamByName ('pcuscode').asstring:=oldcuscode;
             q2.Prepare;
             q2.ExecSQL ;
             end
       finally
          seeother;
          formini;
          bh.Enabled :=true;
       end;

end;

procedure Tcusform.djExit(Sender: TObject);
var
  a:string;
begin
  try
    a:=floattostr(strtofloat(trim(dj.text)))
  except
    showmessage('单价不对');
    dj.SetFocus ; 
  end;
end;

procedure Tcusform.FormKeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
  if key=13 then
     selectnext(activecontrol,true,true);
end;

procedure Tcusform.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  q1.free;
  q2.free;
end;

procedure Tcusform.xfxlClick(Sender: TObject);
begin
  seeother;
end;

end.