📄 sbgl_ref.pas
字号:
unit sbgl_ref;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, Buttons;
type
Tf_sbgl_ref = class(TForm)
xsgb: TGroupBox;
CheckBox1: TCheckBox;
CheckBox3: TCheckBox;
CheckBox4: TCheckBox;
CheckBox5: TCheckBox;
CheckBox6: TCheckBox;
CheckBox7: TCheckBox;
CheckBox8: TCheckBox;
CheckBox9: TCheckBox;
CheckBox10: TCheckBox;
CheckBox11: TCheckBox;
CheckBox12: TCheckBox;
CheckBox13: TCheckBox;
CheckBox14: TCheckBox;
CheckBox15: TCheckBox;
CheckBox16: TCheckBox;
GroupBox2: TGroupBox;
CheckBox2: TCheckBox;
sour_list: TListBox;
dest_list: TListBox;
s2ds: TSpeedButton;
d2ss: TSpeedButton;
s2da: TSpeedButton;
d2sa: TSpeedButton;
ClickCheck: TCheckBox;
CheckBox0: TCheckBox;
ups: TSpeedButton;
downs: TSpeedButton;
ok: TBitBtn;
cancel: TBitBtn;
sl_c: TListBox;
dl_c: TListBox;
Label1: TLabel;
Label2: TLabel;
CheckBox17: TCheckBox;
Label3: TLabel;
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure FormShow(Sender: TObject);
procedure RefQu;
procedure Init;
procedure ClickCheckClick(Sender: TObject);
procedure sour_listDblClick(Sender: TObject);
procedure dest_listDblClick(Sender: TObject);
Function CheckExistSour(s : string) : integer;
Function CheckExistDest(s : string) : integer;
procedure s2dsClick(Sender: TObject);
procedure d2ssClick(Sender: TObject);
procedure s2daClick(Sender: TObject);
procedure d2saClick(Sender: TObject);
procedure upsClick(Sender: TObject);
procedure downsClick(Sender: TObject);
procedure searchClick(Sender: TObject);
procedure okClick(Sender: TObject);
procedure cancelClick(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
const numcount = 17;
var
f_sbgl_ref: Tf_sbgl_ref;
dis_pro : array[0..numcount] of TCheckBox; //数组控件
CheckFlag : integer; //CheckBox是(1)否(0)处于人工修改状态
i : integer;
implementation
uses sbgl, data, gbv;
{$R *.DFM}
procedure Tf_sbgl_ref.FormClose(Sender: TObject; var Action: TCloseAction);
begin
f_sbgl.Enabled:=True;
end;
procedure Tf_sbgl_ref.RefQu();
var dis_sql : string; //SQL语句
setnum : string;
yypd : integer;
wdate : TDateTime;
begin //显示数据库
wdate:=date;
//预约判断
with ds_data.Qu_zwb do
begin
Close;
Open;
for i:= 1 to RecordCount do
begin
//判断预约
setnum:=FieldByName('setnum').AsString;
With ds_data.Qu_yypd do
begin
Close;
ParamByName('setnum').value:=setnum;
ParamByName('sjdate').AsDate:=wdate;
Open;
yypd:=RecordCount;
Close;
end;
//预约更新
with ds_data.Qu_upf do
begin
Close;
ParamByName('setnum').value:=setnum;
Open;
Edit;
FieldByName('fused').AsBoolean:=(yypd>0);
Post;
Close;
end;
Next; //下一个座位
end;
Close; //关闭座位表数据库
end;
ds_data.Qu_sbdp.Open;
ds_data.Qu_sbsys.Open;
//第一项必须显示
dis_sql:='Select '+ds_data.Qu_sbsys.FieldByName('ch1').AsString+' '+
ds_data.Qu_sbsys.FieldByName('ch2').AsString;
ds_data.Qu_sbdp.Next;
ds_data.Qu_sbsys.Next;
//显示其它各项
for i:=1 to numcount do
begin
if ds_data.Qu_sbdp.FieldByName('display').AsBoolean then
dis_sql:=dis_sql+','+ds_data.Qu_sbsys.FieldByName('ch1').AsString+' '+
ds_data.Qu_sbsys.FieldByName('ch2').AsString;
if i=1 then //记录setnum项的状态
f_gbv.setnum.Checked:=ds_data.Qu_sbdp.FieldByName('display').AsBoolean;
ds_data.Qu_sbdp.Next;
ds_data.Qu_sbsys.Next;
end;
ds_data.Qu_sbdp.Close;
ds_data.Qu_sbsys.Close;
dis_sql:=dis_sql+' From sbgl'; //指向设备数据库
//目标框若不为空，则排序
if dest_list.Items.Count>0 then
begin
dis_sql:=dis_sql+' Order by ';
//目标框排序
for i:=1 to dest_list.Items.Count do
begin
if i>1 then dis_sql:=dis_sql+',';
dis_sql:=dis_sql+dest_list.Items[i-1];
end;
//限制写数据库的操作
f_sbgl.db_insert.Enabled:=False;
f_sbgl.db_append.Enabled:=False;
f_sbgl.db_delete.Enabled:=False;
f_sbgl.db_post.Enabled:=False;
f_sbgl.db_cancel.Enabled:=False;
end
else
begin //恢复写数据库的操作
if ds_data.Qu_sbgl.RequestLive then
begin
f_sbgl.db_insert.Enabled:=True;
f_sbgl.db_append.Enabled:=True;
f_sbgl.db_delete.Enabled:=True;
f_sbgl.db_post.Enabled:=True;
f_sbgl.db_cancel.Enabled:=True;
end;
end;
//初始化数据库
ds_data.Qu_sbgl.Close;
ds_data.Qu_sbgl.Sql.Clear;
ds_data.Qu_sbgl.Sql.Add(dis_sql);
ds_data.Qu_sbgl.Open;
end;
procedure Tf_sbgl_ref.FormShow(Sender: TObject);
begin
Init; //初始化控件
//手动修改CheckBox
CheckFlag:=1;
ds_data.Qu_sbdp.Open;
ds_data.Qu_sbsys.Open;
for i:=0 to numcount do
begin
dis_pro[i].Caption:=ds_data.Qu_sbsys.FieldByName('ch2').AsString;
dis_pro[i].OnClick:=ClickCheckClick;
dis_pro[i].Checked:=ds_data.Qu_sbdp.FieldByName('display').AsBoolean;
ds_data.Qu_sbdp.Next;
ds_data.Qu_sbsys.Next;
end;
ds_data.Qu_sbdp.Close;
ds_data.Qu_sbsys.Close;
CheckFlag:=0; //自动修改CheckBox
ClickCheckClick(nil); //调整CheckBox
end;
procedure Tf_sbgl_ref.Init();
begin
//初始化数组控件
dis_pro[0]:=CheckBox0; dis_pro[1]:=CheckBox1; dis_pro[2]:=CheckBox2;
dis_pro[3]:=CheckBox3; dis_pro[4]:=CheckBox4; dis_pro[5]:=CheckBox5;
dis_pro[6]:=CheckBox6; dis_pro[7]:=CheckBox7; dis_pro[8]:=CheckBox8;
dis_pro[9]:=CheckBox9; dis_pro[10]:=CheckBox10; dis_pro[11]:=CheckBox11;
dis_pro[12]:=CheckBox12; dis_pro[13]:=CheckBox13; dis_pro[14]:=CheckBox14;
dis_pro[15]:=CheckBox15; dis_pro[16]:=CheckBox16; dis_pro[17]:=CheckBox17;
//初始化ListBox
sour_list.Items.Clear; dest_list.Items.Clear;
for i:=1 to sl_c.Items.Count do
sour_list.Items.Add(sl_c.Items[i-1]);
for i:=1 to dl_c.Items.Count do
dest_list.Items.Add(dl_c.Items[i-1]);
end;
procedure Tf_sbgl_ref.ClickCheckClick(Sender: TObject);
begin
if CheckFlag=1 then exit; //若手动修改则退出
sour_list.Items.Clear; //清空源框
for i:=0 to numcount do
begin
if dis_pro[i].Checked=True then
begin
//若目标框不存在，则添加于源框
if CheckExistDest(dis_pro[i].Caption)<0 then
sour_list.Items.add(dis_pro[i].Caption);
end
else
//若目标框存在，则删除
if CheckExistDest(dis_pro[i].Caption)>=0 then
dest_list.Items.Delete(CheckExistDest(dis_pro[i].Caption));
end;
end;
procedure Tf_sbgl_ref.sour_listDblClick(Sender: TObject);
var index : integer; //ListBox中的索引
begin //从源框转移到目标框
index:=sour_list.ItemIndex;
if index<0 then exit;
dest_list.Items.Add(sour_list.Items[index]);
sour_list.Items.Delete(index);
end;
procedure Tf_sbgl_ref.dest_listDblClick(Sender: TObject);
var index : integer; //ListBox中的索引
begin //从目标框转移到源框
index:=dest_list.ItemIndex;
if index<0 then exit;
sour_list.Items.Clear;
for i:=0 to numcount do
begin
if dis_pro[i].Checked=True then
if CheckExistDest(dis_pro[i].Caption)<0 then
//若目标框不存在，则添加于源框
sour_list.Items.add(dis_pro[i].Caption)
else
if CheckExistDest(dis_pro[i].Caption)=index then
//若目标框存在，且是被转移项，则添加于源框
sour_list.Items.add(dis_pro[i].Caption);
end;
dest_list.Items.Delete(index); //删除目标框中的index项
end;
Function Tf_sbgl_ref.CheckExistSour(s : string) : integer;
var index : integer; //ListBox中的索引
begin
Result:=-1;
for index:=1 to sour_list.Items.Count do
if sour_list.Items[index-1]=s then
begin //框中存在该项
Result:=index-1;
break;
end;
end;
Function Tf_sbgl_ref.CheckExistDest(s : string) : integer;
var index : integer; //ListBox中的索引
begin
Result:=-1;
for index:=1 to dest_list.Items.Count do
if dest_list.Items[index-1]=s then
begin //框中存在该项
Result:=index-1;
break;
end;
end;
procedure Tf_sbgl_ref.s2dsClick(Sender: TObject);
begin //从源框转移到目标框
sour_listDblClick(nil);
end;
procedure Tf_sbgl_ref.d2ssClick(Sender: TObject);
begin //从目标框转移到源框
dest_listDblClick(nil);
end;
procedure Tf_sbgl_ref.s2daClick(Sender: TObject);
begin //从源框全部转移到目标框
for i:=1 to sour_list.Items.Count do
dest_list.Items.add(sour_list.Items[i-1]);
sour_list.Items.Clear;
end;
procedure Tf_sbgl_ref.d2saClick(Sender: TObject);
begin //从目标框全部转移到源框
if dest_list.Items.Count<=0 then exit;
sour_list.Items.Clear;
dest_list.Items.Clear;
for i:=0 to numcount do
if dis_pro[i].Checked=True then
sour_list.Items.add(dis_pro[i].Caption);
end;
procedure Tf_sbgl_ref.upsClick(Sender: TObject);
var index : integer; //ListBox中的索引
begin //上调选项
index:=dest_list.ItemIndex;
if (index<=0) or (index>dest_list.Items.Count-1) then exit;
dest_list.Items.Exchange(index-1,index);
dest_list.ItemIndex:=index-1;
end;
procedure Tf_sbgl_ref.downsClick(Sender: TObject);
var index : integer; //ListBox中的索引
begin //下调选项
index:=dest_list.ItemIndex;
if (index<0) or (index>=dest_list.Items.Count-1) then exit;
dest_list.Items.Exchange(index,index+1);
dest_list.ItemIndex:=index+1;
end;
procedure Tf_sbgl_ref.searchClick(Sender: TObject);
begin
Application.MessageBox('本功能注册后才可使用。', '提示', Mb_OK);
end;
procedure Tf_sbgl_ref.okClick(Sender: TObject);
var ItemNum : integer; //数组控件数目
begin
//将CheckBox状态写入数据库
ds_data.Qu_sbdp.Open;
for i:=0 to numcount do
begin
with ds_data.Qu_sbdp do
begin
Edit;
FieldByName('display').AsBoolean:=dis_pro[i].Checked;
Post;
Next;
end;
end;
ds_data.Qu_sbdp.Close;
//将ListBox状态写入ListBox的copy
sl_c.Items.Clear; dl_c.Items.Clear;
for i:=1 to sour_list.Items.Count do
sl_c.Items.Add(sour_list.Items[i-1]);
for i:=1 to dest_list.Items.Count do
dl_c.Items.Add(dest_list.Items[i-1]);
RefQu; //调整显示
f_sbgl_ref.Close;
end;
procedure Tf_sbgl_ref.cancelClick(Sender: TObject);
begin
//初始化ListBox
sour_list.Items.Clear; dest_list.Items.Clear;
for i:=1 to sl_c.Items.Count do
sour_list.Items.Add(sl_c.Items[i-1]);
for i:=1 to dl_c.Items.Count do
dest_list.Items.Add(dl_c.Items[i-1]);
f_sbgl_ref.Close;
end;
end.
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -