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

📄 ufrmpb.pas

📁 一个会议签到系统
💻 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 + -