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

📄 ctcdlr.pas

📁 集成酒店桑拿食管管理的完整程序
💻 PAS
📖 第 1 页 / 共 3 页
字号:
unit ctcdlr;

interface

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

type
  Tctdcform = class(TForm)
    Query1: TQuery;
    Label1: TLabel;
    hdno: TMaskEdit;
    Button1: TButton;
    Button2: TButton;
    Button3: TButton;
    md: TCheckBox;
    xfname: TTabControl;
    xflx: TLabel;
    Panel1: TPanel;
    Label6: TLabel;
    xf: TMaskEdit;
    Label7: TLabel;
    Edit1: TEdit;
    Label3: TLabel;
    czy: TMaskEdit;
    Panel2: TPanel;
    Label8: TLabel;
    pd: TComboBox;
    Panel3: TPanel;
    Panel4: TPanel;
    xj: TCheckBox;
    grid: TStringGrid;
    sl: TSpinEdit;
    djno: TEdit;
    Label9: TLabel;
    TabControl1: TTabControl;
    xflist1: TStringGrid;
    xftype: TComboBox;
    typebm: TComboBox;
    xfbm: TComboBox;
    xfsl: TSpinEdit;
    GroupBox1: TGroupBox;
    Label2: TLabel;
    xlb: TLabel;
    Label4: TLabel;
    xdm: TLabel;
    Label5: TLabel;
    xmc: TEdit;
    Label10: TLabel;
    xdj: TEdit;
    Label11: TLabel;
    xdw: TEdit;
    iszk: TCheckBox;
    Button4: TButton;
    Button5: TButton;
    Query2: TQuery;
    pdid: TComboBox;
    Label12: TLabel;
    Label13: TLabel;
    Label14: TLabel;
    zy: TLabel;
    mc: TEdit;
    zyry1: TComboBox;
    SpinEdit1: TSpinEdit;
    GroupBox2: TGroupBox;
    jc1: TRadioButton;
    RadioButton2: TRadioButton;
    bx: TRadioButton;
    Panel7: TPanel;
    Label22: TLabel;
    Label23: TLabel;
    DBGrid1: TDBGrid;
    jc: TEdit;
    DataSource1: TDataSource;
    procedure FormCreate(Sender: TObject);
    procedure gridSetEditText(Sender: TObject; ACol, ARow: Integer;
      const Value: String);
    procedure FormKeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure hdnoExit(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure gridKeyPress(Sender: TObject; var Key: Char);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure hdnoEnter(Sender: TObject);
    procedure djnoExit(Sender: TObject);
    procedure xjClick(Sender: TObject);
    procedure mdClick(Sender: TObject);
    procedure xflist1DblClick(Sender: TObject);
    procedure djnoKeyPress(Sender: TObject; var Key: Char);
    procedure gridKeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure hdnoDblClick(Sender: TObject);
    procedure hdnoKeyPress(Sender: TObject; var Key: Char);
    procedure Grid2Enter(Sender: TObject);
    procedure gridMouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure slKeyPress(Sender: TObject; var Key: Char);
    procedure slExit(Sender: TObject);
    procedure gridEnter(Sender: TObject);
    procedure xflist1MouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure xfnameChange(Sender: TObject);
    procedure xflist1KeyPress(Sender: TObject; var Key: Char);
    procedure xflist1KeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure xflist1KeyUp(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure xfslExit(Sender: TObject);
    procedure Button5Click(Sender: TObject);
    procedure Button4Click(Sender: TObject);
    procedure xmcChange(Sender: TObject);
    procedure gridDblClick(Sender: TObject);
    procedure mcExit(Sender: TObject);
    procedure mcKeyPress(Sender: TObject; var Key: Char);
    procedure SpinEdit1Exit(Sender: TObject);
    procedure SpinEdit1KeyPress(Sender: TObject; var Key: Char);
    procedure zyry1Exit(Sender: TObject);
    procedure zyry1KeyPress(Sender: TObject; var Key: Char);
    procedure mcKeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure jcExit(Sender: TObject);
    procedure jcKeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure jcKeyPress(Sender: TObject; var Key: Char);
    procedure jcKeyUp(Sender: TObject; var Key: Word; Shift: TShiftState);
    procedure DBGrid1DblClick(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  ctdcform: Tctdcform;
  bbb:array[0..5] of string;

implementation
uses dataproc, newdj, ctdj;

{$R *.DFM}
var
  acc,ls:string;

procedure qkgrid(gridd:tstringgrid);
var i,j:integer;
begin
 with ctdcform do
   begin
     for i:=0 to Gridd.RowCount-1 do
       for j:=0 to Gridd.colCount-1 do
         gridd.Cells[j,i]:='';
   end;
end;


procedure init;
var
  i:integer;
begin
  acc:='';
with  ctdcform do
  begin
    Panel4.Enabled :=true;
    xj.Checked :=false;
    md.Enabled :=true;
    md.Checked :=false;
    hdno.text:='';
    djno.text:='';
    czy.text:=curper.name;
    pd.text:='';
    xf.Text :='0';
    edit1.text:='0';
    xj.Checked :=false;
    md.Checked :=false;
    Panel3.Visible:=false;
    //pd.Text :='';
    i:=1;
    while i<grid.RowCount  do
      begin
      grid.Cells [2,i]:=' ';
      grid.Cells [3,i]:=' ';
//      grid.Cells [4,i]:=' ';
      i:=i+1;
      end;
   qkgrid(xflist1);
   xflist1.Cells[0,0]:='  消费项目 ';
   xflist1.Cells[1,0]:='单价';
   xflist1.cells[2,0]:='金额';
   xflist1.cells[3,0]:='数量';
  end
end;

procedure delete(arow:integer;gd:Tstringgrid);
var
  i,j:integer;
begin
with ctdcform do
   begin
     i:=arow;
     while trim(gd.Cells[0,i])<>'' do
     begin
        for j:=0 to gd.ColCount-1 do gd.Cells[j,i]:=gd.Cells[j,i+1];
        i:=i+1;
     end;
   end;
end;

procedure seexfmx(d:integer);
var
  i:integer;
begin
with ctdcform do
 begin
   if (xfname.TabIndex>=0) then
   begin
     query1.Active :=false;
     query1.sql.clear;
     query1.sql.add('select cusname,price,cuscode,iszk from cusitem where custype='''+xftype.Items[d]+'''');
     query1.Prepare;
     query1.Open;
     query1.Active :=true;
     typebm.Items.Clear;
     i:=1;
     if query1.RecordCount >0 then
        begin
         query1.First ;
         while not query1.EOF  do
         begin
           grid.Cells [0,i]:=query1.fieldbyname('cusname').asstring;
           grid.Cells [1,i]:=floattostr(query1.fieldbyname('price').asfloat);
           if query1.fieldbyname('iszk').asboolean  then
              grid.Cells [4,i]:='是'
           else
              grid.Cells [4,i]:='否';
           typebm.Items.Add(query1.fieldbyname('cuscode').asstring);
           i:=i+1;
           query1.next;
         end
        end;
     grid.RowCount :=query1.RecordCount+1;
     if query1.RecordCount >0 then
      begin
        grid.Enabled :=true;
        grid.FixedRows :=1;
      end
     else
       grid.Enabled :=false;
     i:=1;
     while i<grid.RowCount  do
      begin
        grid.Cells [2,i]:=' ';
        grid.Cells [3,i]:=' ';
//        grid.Cells [4,i]:=' ';
        i:=i+1;
      end;
    end;
   end;
end;



procedure Tctdcform.FormCreate(Sender: TObject);
var
  tt:tregistry;
begin
   tt:=Tregistry.Create;
   tt.Rootkey:=HKEY_LOCAL_MACHINE;
   if  tt.openkey('system\currentcontrolset\control\computername\computername',false) then
       ls:=tt.readstring('computername');
   tt.free;
   shortdateformat:='yyyy-mm-dd';
//   lc:=copy(curper.Headship,1,1);
   init;
   rytobox(pd,pdid,'餐厅服务员');
   query1.Active :=false;
   query1.sql.clear;
   query1.sql.add('select custype,cusname from custype ');
   query1.Open;
   xfname.Tabs.Clear;
   xftype.Items.Clear;
   while not query1.eof do
   begin
     xftype.items.Add(query1.fields[0].asstring);
     xfname.Tabs.Add(query1.fields[1].asstring);
     query1.next;
   end;
//   Grid2.RowCount:=strtoint(floattostr(int(Grid2.Height/21.4)));

   seexfmx(0);
   grid.Cells[0,0]:='    消费项目   ';
   grid.Cells[1,0]:='单价';
   grid.cells[2,0]:='金额';
   grid.cells[3,0]:='数量';
end;



procedure Tctdcform.slExit(Sender: TObject);
var i:integer;
begin
   if (trim(sl.Text)<>'') then
   begin
     try
        if trim(sl.text)<>'' then i:=strtoint(sl.text);
        grid.Cells[3,grid.Row]:=inttostr(sl.value);
     except
     begin
        grid.Cells[3,grid.Row]:=trim(sl.text);
     end;
     end;
   end
   else
     grid.Cells[3,grid.Row]:='';
  sl.Value:=1;
  sl.Visible:=False;
  sl.Enabled:=false;
  ActiveControl:=grid;

end;

procedure Tctdcform.gridSetEditText(Sender: TObject; ACol, ARow: Integer;
  const Value: String);
var
  curxf:double;
  i,j:integer;
begin
  try
     //*****************************************//
     curxf:=0.00;
     if length(trim(grid.cells[3,arow]))>0 then
     begin
        grid.Cells [2,arow]:=floattostr(strtofloat(grid.cells[1,arow])*strtofloat(grid.cells[3,arow]));
        curxf:=0.00;
        i:=1;
        while trim(xflist1.Cells[0,i])<>'' do
        begin
           if trim(xflist1.Cells[0,i])=trim(grid.Cells[0,arow]) then
           begin
             delete(i,xflist1);
             xfbm.Items.Delete(i-1);
           end
           else
           begin
              curxf:=curxf+strtofloat(trim(xflist1.Cells[2,i]));
              i:=i+1;
           end;
        end;
        if  trim(grid.Cells[2,arow])<>'0' then
        begin
           for j:=0 to 4 do xflist1.Cells[j,i]:=grid.Cells[j,arow];
           curxf:=curxf+strtofloat(trim(xflist1.Cells[2,i]));
           xfbm.Items.Add(typebm.Items[arow-1]);
        end;
        if i>=xflist1.RowCount then xflist1.RowCount:=xflist1.RowCount+1;

     end
     else
        grid.Cells [2,arow]:='';
    edit1.text:=floattostr(curxf);

     //*****************************************//
     //*****************************************//
  except
  end;
end;

⌨️ 快捷键说明

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