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

📄 yaojiangunit.~pas

📁 过年过节公司或单位都会举行抽奖的活动。 我这个程序就是用来电脑自动随机抽奖的。
💻 ~PAS
📖 第 1 页 / 共 5 页
字号:
      Exit;
    end;
  end;
  Button10.Enabled :=False;
  Button12.Enabled :=False;//退出按扭
  Button11.Enabled :=True; //停止按扭
  I3:=1;
  while I3<>0 do
  begin
    label160.Caption := TeQry.fieldbyname('Name_id').asString;
    Label161.Caption := TeQry.FieldByname('Name_code').AsString;
    Label162.Caption :=Jiangqry.fieldbyname('J_name').AsString;
    label160.Refresh;
    Label161.Refresh;
    Label162.Refresh;
    application.ProcessMessages;
    if I3=0 then
    Break;
    I3:=I3+1;
    TeQry.Next;
    JiangQry.Next;
    if TeQry.Eof then
     TeQry.First;
     if JiangQry.Eof then
       Jiangqry.First;
  end;
end;

procedure TForm1.Button11Click(Sender: TObject);
Var
  J_Rkey:integer;
  Y_Rkey:integer;
  KaiNum,NoKaiNum:integer;
begin
  I3:=0;
  Button10.Enabled :=True;
  Button11.Enabled :=False;//停止按扭
  Button12.Enabled :=True;  //退出按扭
  Button34.Enabled :=True;
  with J_FlagQry do
  begin             //如果中奖了则奖中奖数字段值加1
    Active:=False;
    Sql.Clear;
    Sql.Add('update Jiang set J_Kai_num=J_Kai_num+1 ');
    SQl.Add(' where J_Type=3 and Rkey=:Rkey' );
    sql.Add(' select * from Jiang where J_type=3');
    Parameters.ParamByName('Rkey').Value :=JiangQry.fieldbyname('Rkey').AsInteger ;
    Active:=true;
    Active:=False;
  end;
  J_Rkey:=JiangQry.fieldbyname('rkey').AsInteger ;
  Y_Rkey:=TeQry.fieldbyname('rkey').asInteger;
  with J_FlagQry do
  begin            //将中奖的奖品赋值给中奖之人,并标记该人已中过奖了
    Active:=False;
    sql.Clear;
    sql.Add('update yuan set Yuan.J_code=Jiang.J_code,Yuan.J_name=Jiang.J_name,Yuan.J_type=Jiang.J_type,Yuan.J_Flag=1 from yuan ,Jiang ' );
    sql.Add('where Jiang.Rkey=:J_key and Yuan.Rkey=:Y_key ');
    J_FlagQry.Parameters.ParamByName('J_key').Value :=J_Rkey;
    J_FlagQry.Parameters.ParamByName('Y_key').Value :=Y_Rkey;
    Sql.Add(' select * from Yuan ');
    Active:=true;
    Active:=False;
  end;
  with JiangNumQry do
  begin
    Active:=False;
    SQl.Clear;
    Sql.Add('select J_Kai_Num,(J_Sum-J_Kai_Num) Wei from Jiang where J_type=3');
    Active:=True;
    First;
    KaiNum:=0;
    NoKaiNum:=0;
    while not eof do
    begin
      KaiNum:=KaiNum+fieldbyName('J_Kai_Num').AsInteger;
      NoKaiNum:=NoKaiNum+fieldbyName('Wei').AsInteger;
      Next;
    end;
    Edit14.Text :=IntToStr(KaiNum)+'名';
    Edit13.Text :=IntToStr(NoKaiNum)+'名';
    JiangNumQry.Active :=False;
  end;
end;

procedure TForm1.Button25Click(Sender: TObject);
var
i,j:integer;
ExcelApp: Variant;
VarFileName:String;
begin
   Showmessage('特别提示:'+#13#10+#13#10+'如果导入原始数据将会覆盖原有的中奖数据!');
  if MessageDlg('您确定要导入原始数据吗?', mtConfirmation, [mbYes, mbNo], 0) = mrNo then
  begin
    Exit;
  end;
  for I:=0 to 9 do
  begin   //给各TabSheet控件中的工号,姓名,奖品的Label.caption赋空值
    TLabel(FindComponent('Label'+intToStr(39+i*3))).Caption := '';
    TLabel(FindComponent('Label'+intToStr(40+i*3))).Caption := '';
    TLabel(FindComponent('Label'+intToStr(41+i*3))).Caption := '';
    TLabel(FindComponent('Label'+intToStr(100+i*3))).Caption := '';
    TLabel(FindComponent('Label'+intToStr(101+i*3))).Caption := '';
    TLabel(FindComponent('Label'+intToStr(102+i*3))).Caption := '';
    TLabel(FindComponent('Label'+intToStr(130+i*3))).Caption := '';
    TLabel(FindComponent('Label'+intToStr(131+i*3))).Caption := '';
    TLabel(FindComponent('Label'+intToStr(132+i*3))).Caption := '';
    label160.Caption := '';
    Label161.Caption := '';
    Label162.Caption := '';
    label166.Caption := '';
    Label167.Caption := '';
    Label168.Caption := '';
    label163.Caption := '';
    Label164.Caption := '';
    Label165.Caption := '';
    label6.Caption := '';
    Label7.Caption := '';
    Label8.Caption := '';
    EDIT30.Text :='';
    eDIT31.Text:='';
    Edit36.Text :='';
    Edit37.Text:='';
  end;
  opendialog1.InitialDir:=ExtractFileDir(paramstr(0));//文件的打存放初始路径
  if  opendialog1.Execute= true then
    VarFileName:=OpenDialog1.FileName
  else
    Exit;
  ExcelApp := CreateOleObject( 'Excel.Application' );
  try
    ExcelApp.WorkBooks.Open( VarFileName );
  except
    begin
      ExcelApp.ActiveWorkBook.Close;
      ExcelApp.Quit;
      Showmessage('请选择EXCEL文档!');
      Exit;
    end;
  end;
  ExcelApp.WorkSheets[1].Activate;
  FrmProgress:=TFrmProgress.Create(nil);
  FrmProgress.Show;
  FrmProgress.ProgressBar1.Max:=1000;
  with self.InPutQry do
  begin
    Active:=False;
    SQL.Clear;
    SQL.Add('delete from Yuan');
    SqL.Add('select rkey from yuan where rkey=1');
    Active:=True;
  end;
  InputTbl.Active :=False;
  InputTbl.TableName:='Yuan';
  InPutTbl.Active :=True;
  For I:=1 to 1000 do
  begin
    for J:=0 to 1 do
    begin
      if trim(ExcelApp.Cells[i,1].Value)<>'' then
      begin
        Stringgrid1.rowCount:=i+1;
        Stringgrid1.Cells[j,i-1]:=Trim(ExcelApp.Cells[i,J+1].Value);
      end ;
    end;
    if trim(ExcelApp.Cells[i+1,1].Value)<>'' then
    begin
      with self.InPutTbl do
      begin
        Append;
        FieldbyName('Name_id').AsString:=Trim(ExcelApp.Cells[i+1,1].Value);
        FieldbyName('Name_code').AsString:=Trim(ExcelApp.Cells[i+1,2].Value);
        FieldbyName('J_Flag').AsInteger:=0;
        FieldbyName('Id_Type').AsString :=Trim(ExcelApp.Cells[i+1,3].Value);
        Post;
      end;
    end;
    FrmProgress.ProgressBar1.StepBy(1);
  end;
    ExcelApp.ActiveWorkBook.Close;
    ExcelApp.Quit;
    FrmProgress.Free;
  with self.TeQry do
  begin
    Active:=False;
    SQL.Clear;
    SQL.Add(' select Rkey as HRASum from yuan where id_type='+''''+'A'+'''');
    Active:=True;
    VarHRASum:=TeQry.RecordCount;
  end;
    { Try
    ExcelApplication1.Connect;//EXCEL应用程序
    Except
    MessageDlg('Excel may not be installed',mtError, [mbOk], 0);
    Abort;
    End;
    ExcelApplication1.Visible[0]:=False;
    ExcelApplication1.Caption:='Excel Application';
    try
    excelapplication1.Workbooks.Open(opendialog1.FileName,
    null,null,null,null,null,null,null,null,null,null,null,null,0);//打开指定的EXCEL 文件
    except
    begin
    ExcelApplication1.Quit;
    ExcelApplication1.Disconnect;//出现异常情况时关闭
    showmessage('请选择EXCEL电子表格!');
    exit;
    end;
    end;
    ExcelWorkbook1.ConnectTo(ExcelApplication1.Workbooks[1]);//ExcelWorkbook1与Eexcelapplication1建立连接
    ExcelWorksheet1.ConnectTo(ExcelWorkbook1.Worksheets[1] as _Worksheet);//Excelworksheet1与Excelworkbook1建立连接
    //开始从EXCEL中取数,放到stringgrid1中,取完数后关闭EXCEL
    for i:=1 to 1000 do//最大取值1000
    for j:=0 to 2 do
    begin
      if trim(excelworksheet1.cells.item[i+1,1])<>'' then
      begin
        stringgrid1.rowCount:=i+1;
        stringgrid1.Cells[j,i]:=ExcelWorksheet1.Cells.Item[i+1,j+1];
      end
      else
      begin
        //label3.caption:=inttostr(i-1);

      end;
    end;
    excelapplication1.Workbooks.Close(1);
    ExcelApplication1.Disconnect;
    ExcelApplication1.Quit;
    }
end;

procedure TForm1.Button26Click(Sender: TObject);
var
i,j:integer;
ExcelApp: Variant;
VarFileName:String;
begin
   Showmessage('特别提示:'+#13#10+#13#10+'如果导入原始数据将会覆盖原有的中奖数据!');
  if MessageDlg('您确定要导入原始数据吗?', mtConfirmation, [mbYes, mbNo], 0) = mrNo then
  begin
    Exit;
  end;
  for I:=0 to 9 do
  begin   //给各TabSheet控件中的工号,姓名,奖品的Label.caption赋空值
    TLabel(FindComponent('Label'+intToStr(39+i*3))).Caption := '';
    TLabel(FindComponent('Label'+intToStr(40+i*3))).Caption := '';
    TLabel(FindComponent('Label'+intToStr(41+i*3))).Caption := '';
    TLabel(FindComponent('Label'+intToStr(100+i*3))).Caption := '';
    TLabel(FindComponent('Label'+intToStr(101+i*3))).Caption := '';
    TLabel(FindComponent('Label'+intToStr(102+i*3))).Caption := '';
    TLabel(FindComponent('Label'+intToStr(130+i*3))).Caption := '';
    TLabel(FindComponent('Label'+intToStr(131+i*3))).Caption := '';
    TLabel(FindComponent('Label'+intToStr(132+i*3))).Caption := '';
    label160.Caption := '';
    Label161.Caption := '';
    Label162.Caption := '';
    label166.Caption := '';
    Label167.Caption := '';
    Label168.Caption := '';
    label163.Caption := '';
    Label164.Caption := '';
    Label165.Caption := '';
    label6.Caption := '';
    Label7.Caption := '';
    Label8.Caption := '';
    EDIT30.Text :='';
    eDIT31.Text:='';
    Edit36.Text :='';
    Edit37.Text:='';
  end;
  opendialog1.InitialDir:=ExtractFileDir(paramstr(0));//文件的打存放初始路径
  if  opendialog1.Execute= true then
    VarFileName:=OpenDialog1.FileName
  else
    Exit;
  ExcelApp := CreateOleObject( 'Excel.Application' );
  try
    ExcelApp.WorkBooks.Open( VarFileName );
  except
    begin
      ExcelApp.ActiveWorkBook.Close;
      ExcelApp.Quit;
      Showmessage('请选择EXCEL文档!');
      Exit;
    end;
  end;
  ExcelApp.WorkSheets[1].Activate;
  FrmProgress:=TFrmProgress.Create(nil);
  FrmProgress.Show;
  FrmProgress.ProgressBar1.Max:=200;
  with self.InPutQry do
  begin
    Active:=False;
    SQL.Clear;
    SQL.Add('delete from Jiang');
    SQL.Add('select rkey from Jiang where rkey=1');
    Active:=True;
  end;
  InputTbl.Active :=False;
  InputTbl.TableName:='Jiang';
  InPutTbl.Active :=True;
  For I:=1 to 200 do
  begin
    for J:=0 to 3 do
    begin
      if trim(ExcelApp.Cells[i,1].Value)<>'' then
      begin
        Stringgrid2.rowCount:=i+1;
        Stringgrid2.Cells[j,i-1]:=Trim(ExcelApp.Cells[i,J+1].Value);
      end ;
    end;
    if trim(ExcelApp.Cells[i+1,1].Value)<>'' then
    begin
      with self.InPutTbl do
      begin
        Append;
        FieldbyName('J_code').AsString:=Trim(ExcelApp.Cells[i+1,1].Value);
        FieldbyName('J_Name').AsString:=Trim(ExcelApp.Cells[i+1,2].Value);
        FieldbyName('J_Sum').AsInteger:=StrToInt(ExcelApp.Cells[i+1,3].Value);
        FieldbyName('J_Type').AsString :=Trim(ExcelApp.Cells[i+1,4].Value);
        FieldByName('J_kai_num').AsInteger:=0;
        Post;
      end;
    end;
    FrmProgress.ProgressBar1.StepBy(1);
  end;
    //ExcelApp.WorkBooks.Close;
    ExcelApp.ActiveWorkBook.Close;
    ExcelApp.Quit;
    FrmProgress.Free;
end;

procedure TForm1.PageControl1Changing(Sender: TObject;
  var AllowChange: Boolean);
begin
  if (I0<>0) or (I1<>0) or (I2<>0) or(I3<>0) or (I4<>0) or (I5<>0) or (I6<>0)or (IeW<>0) then
  begin
    ShowMessage('温馨提示:'+#13#10+#13#10+'抽奖正在进行中,请不要进入其它选项页!'+
    #10#13+#13#10+'如要进入其它选项页,请先停止当前的奖项!');
    AllowChange:=False;
  end;
end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  if MessageDlg('您确定要退抽奖程序吗?',
    mtConfirmation, [mbYes, mbNo], 0) = mrYes then
  begin
    with self.ConnNumQry do
    begin
      Active:=False;
      SQL.Clear;
      SqL.Add('update connectNum set rkey=Rkey-1');
      SQL.Add('select * from connectNum');
      Active:=True;
      Active:=False;
    end;
    Action := caFree
  end else
   Action := caNone;
end;

procedure TForm1.Button28Click(Sender: TObject);
begin
  Button35.Enabled := False;
  with TeQry do
  begin     //取得用来抽额外奖的管理人员
    active:=False;
    Sql.Clear;
    SQl.Add(' Select * from yuan where J_Flag=0 and J_EW_Flag=0');
    SQL.Add(' and ID_type='+''''+'A'+'''');//07年规定不管是中了什么奖项,只要中过一次就不许再中第二次了。
    Sql.Add(' order by NewId() ');//NewId()在一个数据表中随机地选取出数据来
    Active:=True;
    if Recordcount<1 then
    begin
      Showmessage('该奖项没有待抽奖的人员啦,请重新导入人员资料!');
      Exit;
    end;
  end;
  Button28.Enabled := False;
  Button30.Enabled := False;
  Button29.Enabled := True;
  IEW:=1;//标记额外奖  用来控制是否“停止”这一动作的。
  while IEW<>0 do
  begin
    Edit36.Text:= TeQry.fieldbyname('Name_id').asString;
    Edit37.Text:= TeQry.FieldByname('Name_code').AsString;
    Edit36.Refresh;
    Edit37.Refresh;
    application.ProcessMessages;
    if IEW=0 then
    Break;
    IEW:=IEW+1;
    TeQry.Next;
    if TeQry.Eof then
     TeQry.First;
  end;
end;

procedure TForm1.Button29Click(Sender: TObject);
Var
  J_Rkey:integer;
  Y_Rkey:integer;
begin
  IEW:=0;
  Button28.Enabled :=True;
  Button29.Enabled :=False;
  Button30.Enabled :=True;
  Button35.Enabled :=True;
  Y_Rkey:=TeQry.fieldbyname('rkey').asInteger;
  with J_FlagQry do
  begin            //将中奖的奖品赋值给中奖之人,并标记该人已中过奖了
    Active:=False;
    Sql.Clear;
    Sql.Add('update yuan set Yuan.J_ew_Flag=1 from yuan ' );
    Sql.Add('where  Yuan.Rkey=:Y_key ');
    J_FlagQry.Parameters.ParamByName('Y_key').Value :=Y_Rkey;
    Sql.Add(' select rkey from Yuan ');
    Active:=true;
  end;
end;

procedure TForm1.Button31Click(Sender: TObject);
Var
  J_Rkey:integer;
  Y_Rkey:integer;
  KaiNum,NoKaiNum:integer;
begin
  Button31.Enabled :=False;
  if MessageDlg('您确定要作废吗?', mtConfirmation, [mbYes, mbNo], 0) = mrNo then
  begin
    Button31.Enabled :=True;
   

⌨️ 快捷键说明

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