📄 ufrmpb.pas
字号:
unit uFrmPB;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, ImgList, ExtCtrls, ComCtrls, StdCtrls, CheckLst, Buttons, Grids,
DB, ADODB;
type
TFrmPB = class(TForm)
StatusBar1: TStatusBar;
Panel1: TPanel;
Bevel1: TBevel;
Panel2: TPanel;
Bevel2: TBevel;
IMGTree: TImageList;
Panel3: TPanel;
TrvBM: TTreeView;
Panel4: TPanel;
GroupBox1: TGroupBox;
Label2: TLabel;
Label3: TLabel;
DTPA: TDateTimePicker;
DTPB: TDateTimePicker;
SpbtnRefresh: TSpeedButton;
LBoxBC: TListBox;
SpeedButton6: TSpeedButton;
SpbtnCancel: TSpeedButton;
SpeedButton1: TSpeedButton;
LBoxPB: TListBox;
QrvV_BM: TADOQuery;
LBoxRen: TListBox;
SpeedButton2: TSpeedButton;
SpeedButton3: TSpeedButton;
SpeedButton4: TSpeedButton;
SpeedButton5: TSpeedButton;
Bevel3: TBevel;
LBoxRenA: TListBox;
PnlRen: TPanel;
PnlRenA: TPanel;
ProgressBar1: TProgressBar;
procedure SpbtnRefreshClick(Sender: TObject);
procedure LBoxBCClick(Sender: TObject);
procedure SpeedButton1Click(Sender: TObject);
procedure SpbtnCancelClick(Sender: TObject);
procedure FormShow(Sender: TObject);
procedure TrvBMChange(Sender: TObject; Node: TTreeNode);
procedure SpeedButton2Click(Sender: TObject);
procedure SpeedButton4Click(Sender: TObject);
procedure SpeedButton3Click(Sender: TObject);
procedure SpeedButton5Click(Sender: TObject);
procedure SpeedButton6Click(Sender: TObject);
procedure LBoxRenDblClick(Sender: TObject);
procedure LBoxRenADblClick(Sender: TObject);
private
{ Private declarations }
public
Procedure PLoadBuMen();
Procedure PSavePBA(sKH:String);
Procedure PDoNULL();
{ Public declarations }
end;
var
FrmPB: TFrmPB;
implementation
uses uFunSys, uDMOA, uDataOA;
{$R *.dfm}
procedure TFrmPB.SpbtnRefreshClick(Sender: TObject);
var
I:Integer;
xT:TDate;
Str:String;
begin
LBoxPB.Items.Clear;
if DTPA.Date > DTPB.Date then Exit;
xT:=DTPA.Date;
for I:=1 to 10000 do begin
Str:=FZDateStr(xT,False);
Str:=MyChecKStr(3,IntToStr(I))+' '+Str;
LBoxPB.Items.Add(Str);
xT:=xT+1;
if XT > DTPB.Date then Exit;
end;
end;
procedure TFrmPB.LBoxBCClick(Sender: TObject);
var
I:Integer;
Str,sT,s1,s2:String;
begin
if LBoxBC.Count <= 0 then Exit;
if LBoxPB.Count <= 0 then Exit;
I:=LBoxBC.ItemIndex;
if I <=0 then I:=0;
Str:=LBoxBC.Items.Strings[I];
sT:=MyCutString(True,Str);
I:=LBoxPB.ItemIndex;
if I <=0 then I:=0;
Str:=LBoxPB.Items.Strings[I];
S1:=MyCutString(True,Str);// bian hao
S2:=MyCutString(False,Str);
S2:=MyCutString(True,S2); //日期
LBoxPB.Items.Strings[I]:=S1+' '+S2+' '+sT;
I:=I+1;
if I < LBoxPB.Items.Count then LBoxPB.Selected[I]:=True;//自动跳转焦点
end;
//循环应用 从最后 到最前
procedure TFrmPB.SpeedButton1Click(Sender: TObject);
var
Str,S:String;
I,K,J:Integer;
begin
K:=LBoxPB.Count-1;
for I:=LBoxPB.Count-1 downto 0 do begin
Str:=LBoxPB.Items.Strings[I];
S:=MyCutString(False,Str);
S:=MyCutString(False,S);
if S <> '' then begin
K:=I;
Break;
end;
end;
J:=0;
for I:=K+1 to LBoxPB.Count-1 do begin
Str:=LBoxPB.Items.Strings[J];
S:=MyCutString(False,Str);
S:=MyCutString(False,S);
Str:=LBoxPB.Items.Strings[I];
LBoxPB.Items.Strings[I]:=Str+' '+S;
J:=J+1;
if J > K then J:=0;
end;
end;
procedure TFrmPB.SpbtnCancelClick(Sender: TObject);
begin
SpbtnRefreshClick(Sender);
end;
procedure TFrmPB.PLoadBuMen;
var
Str:String;
I:integer;
begin
FCarryOutSQL(DMOA.ADOQry,QrvV_BM.SQL.Text,True);
PCuiFengFillTreeB(TrvBM,DMOA.ADOQry,'dpt_name','dpt_name','iLevel');
for I:=0 to TrvBM.Items.Count-1 do begin
TrvBM.Items[I].Text:=MyCutString(True,TrvBM.Items[I].Text);
end;
Str:='Select WRK_CODE,WRK_DESC from WorkTime Order by WRK_CODE';
FCarryOutSQL(DMOA.ADOQry,Str,True);
DMOA.ADOQry.First;
LBoxBC.Items.Clear;
While not DMOA.ADOQry.Eof do begin
Str:=Trim(DMOA.ADOQry.FieldByName('WRK_CODE').AsString)
+' '+Trim(DMOA.ADOQry.FieldByName('WRK_DESC').AsString);
LBoxBC.Items.Add(Str);
DMOA.ADOQry.Next;
end;
end;
procedure TFrmPB.FormShow(Sender: TObject);
begin
PLoadBuMen();
DTPA.DateTime:=now(); DTPB.DateTime:=now();
end;
procedure TFrmPB.TrvBMChange(Sender: TObject; Node: TTreeNode);
var
Str:String;
begin
if TrvBM.Selected = nil then Exit;
if TrvBM.Selected.Level = 0 then
Str:='Select per_code,per_name from Personal';
if TrvBM.Selected.Level = 1 then
Str:='Select per_code,per_name from Personal Where per_dpt ='
+''''+TrvBM.Selected.Text+'''';
if TrvBM.Selected.Level = 2 then
Str:='Select per_code,per_name from Personal Where per_dpt ='
+''''+TrvBM.Selected.Parent.Text+''''
+' And per_zhu = '+''''+TrvBM.Selected.Text+'''';
if TrvBM.Selected.Level = 3 then
Str:='Select per_code,per_name from Personal Where per_dpt ='
+''''+TrvBM.Selected.Parent.Parent.Text+''''
+' And per_zhu = '+''''+TrvBM.Selected.Parent.Text+''''
+' And per_ban ='+''''+TrvBM.Selected.Text+'''';
Str:=Str+' Order by per_code';
FCarryOutSQL(DMOA.ADOQry,Str,True);
DMOA.ADOQry.First;LBoxRen.Items.Clear;
While not DMOA.ADOQry.Eof do begin
Str:=Trim(DMOA.ADOQry.FieldByName('per_code').AsString)
+' '+Trim(DMOA.ADOQry.FieldByName('per_name').AsString);
LBoxRen.Items.Add(Str);
DMOA.ADOQry.Next;
end;
PnlRen.Caption:='人数:'+IntToStr(DMOA.ADOQry.RecordCount);
end;
procedure TFrmPB.SpeedButton2Click(Sender: TObject);
var
I,J,n:integer;
Str,S,SA:String;
begin
I:=LBoxRen.ItemIndex;
if I < 0 then Exit;
Str:=LBoxRen.Items.Strings[I];
S:=MyCutString(True,Str);
N:=0;
for J:=0 to LBoxRenA.Items.Count-1 do begin
Str:=LBoxRenA.Items.Strings[J];
SA:=MyCutString(True,Str);
if SA = S then begin
n:=100;Break;
end;
end;
if n = 0 then begin
Str:=LBoxRen.Items.Strings[I];
LBoxRenA.Items.Add(Str);
end;
PnlRenA.Caption:='人数:'+IntToStr(LBoxRenA.Items.Count);
end;
procedure TFrmPB.SpeedButton4Click(Sender: TObject);
var
I,J,n:integer;
Str,S,SA:String;
begin
for I:=0 to LBoxRen.Items.Count-1 do begin
Str:=LBoxRen.Items.Strings[I];
S:=MyCutString(True,Str);
N:=0;
for J:=0 to LBoxRenA.Items.Count-1 do begin
Str:=LBoxRenA.Items.Strings[J];
SA:=MyCutString(True,Str);
if SA = S then begin
n:=100;Break;
end;
end;
if n = 0 then begin
Str:=LBoxRen.Items.Strings[I];
LBoxRenA.Items.Add(Str);
end;
end;
PnlRenA.Caption:='人数:'+IntToStr(LBoxRenA.Items.Count);
end;
procedure TFrmPB.SpeedButton3Click(Sender: TObject);
begin
LBoxRenA.Items.Clear;
PnlRenA.Caption:='人数:'+IntToStr(LBoxRenA.Items.Count);
end;
procedure TFrmPB.SpeedButton5Click(Sender: TObject);
var
I:integer;
begin
I:=LBoxRenA.ItemIndex;
if I < 0 then Exit;
LBoxRenA.Items.Delete(I);
PnlRenA.Caption:='人数:'+IntToStr(LBoxRenA.Items.Count);
end;
{oooooooooooooooo 排班是以卡号为准泽 ooooooooooooooooooooo}
procedure TFrmPB.SpeedButton6Click(Sender: TObject);
var
Str:String;
I:integer;
begin
ProgressBar1.Max:=LBoxRenA.Items.Count;
Screen.Cursor:=crHourGlass;
for I:=0 to LBoxRenA.Items.Count-1 do begin
Str:=LBoxRenA.Items.Strings[I];
Str:=MyCutString(True,Str);
PSavePBA(Str);
ProgressBar1.Position:=I+1;
end;
Screen.Cursor:=crDefault;
PDoNULL();
DlgWarningA('保存成功');
end;
//先删除
procedure TFrmPB.PSavePBA(sKH:String);
var
Str,S:String;
I,iNian,iYue,iRi,iDo:integer;
sFDName,sBCCode:String;
begin
iNian:=-1;iYue:=-1;
for I:=0 to LBoxPB.Count-1 do begin
S:=LBoxPB.Items.Strings[I];
S:=MyCutString(False,S);
Str:=MyCutString(True,S);
sBCCode:=MyCutString(False,S);
Str:=FZDateStr((DTPA.Date + I),False);
iRi:=StrToInt(Copy(Str,9,2));//
iDo:=0;
if iNian <> StrToInt(Copy(Str,1,4)) then begin
iNian:=StrToInt(Copy(Str,1,4));//
iDO:=100;
end;
if iYue <> StrToInt(Copy(Str,6,2)) then begin
iYue:=StrToInt(Copy(Str,6,2));//
iDo:=100;
end;
Str:=' Delete From att_info Where att_code ='+''''+sKH+''''
+' And att_year ='+IntToStr(iNian)
+' And att_month ='+ IntToStr(iYue);
Str:=Str+' '+FCreateInSertOneSQL(['att_code','att_year','att_month'],
[sKH,IntToStr(iNian),IntToStr(iYue)],
[0],'att_info');
if iDO = 100 then FCarryOutSQL(nil,Str,False);
sFDName:='att_'+IntToStr(iRi);
Str:='Update att_info Set '+sFDName+' = '+''''+sBCCode+''''
+' Where att_code ='+''''+sKH+''''
+' And att_year ='+IntToStr(iNian)
+' And att_month ='+ IntToStr(iYue);
FCarryOutSQL(nil,Str,False);
end;
end;
procedure TFrmPB.LBoxRenDblClick(Sender: TObject);
begin
SpeedButton2Click(Sender);
end;
procedure TFrmPB.LBoxRenADblClick(Sender: TObject);
begin
SpeedButton5Click(Sender);
end;
procedure TFrmPB.PDoNULL;
var
Str,sFDName:String;
I:integer;
begin
for I:=1 to 31 do begin
sFDName:='att_'+IntToStr(I);
Str:='Update att_info Set '+sFDName+' = '+''''+''+''''
+' Where '+sFDName+' IS NULL';
FCarryOutSQL(nil,Str,False);
end;
end;
end.
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -