📄 umain.~pas

📁 商场活动抽奖系统,无需控件,可以正常使用.
💻 ~PAS
📖 第 1 页 / 共 2 页
字号:
12 下一页
unit UMain;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls, Buttons, StdCtrls, DB, ADODB, Menus, jpeg, MMSystem;

type
  TfrmMain = class(TForm)
    Panel2: TPanel;
    btnStart: TSpeedButton;
    pan_nmb1: TPanel;
    lb_nmb: TListBox;
    edt_nmb: TEdit;
    Rdo: TRadioGroup;
    ADOC: TADOConnection;
    ADOQuery: TADOQuery;
    lab_title: TLabel;
    btnClose: TSpeedButton;
    imgB: TImage;
    i1: TImage;
    i2: TImage;
    i3: TImage;
    i4: TImage;
    i5: TImage;
    lab_company_down: TLabel;
    PopupMenu: TPopupMenu;
    MenuInfo: TMenuItem;
    MenuInit: TMenuItem;
    MenuClose: TMenuItem;
    Timer_j: TTimer;
    lab_ld: TLabel;
    lab_info: TLabel;
    lab_jg: TLabel;
    lab_jp: TLabel;
    Shape1: TShape;
    MenuAward: TMenuItem;
    Shape2: TShape;
    lab_ru: TLabel;
    MenuAbort: TMenuItem;
    Timer_nmb: TTimer;
    Timer: TTimer;
    pan_nmb: TPanel;
    lab_n1: TLabel;
    lab_n2: TLabel;
    lab_n3: TLabel;
    lab_n4: TLabel;
    lab_n5: TLabel;
    lab_n6: TLabel;
    lab_n7: TLabel;
    lab_n8: TLabel;
    lab_n9: TLabel;
    Timer_Flash: TTimer;
    i6: TImage;
    i7: TImage;
    i8: TImage;
    i9: TImage;
    Shape3: TShape;
    lab_company_up: TLabel;
    procedure FormCreate(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure btnStartClick(Sender: TObject);
    procedure btnCloseClick(Sender: TObject);
    procedure FormKeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure imgBMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure MenuCloseClick(Sender: TObject);
    procedure MenuInitClick(Sender: TObject);
    procedure MenuInfoClick(Sender: TObject);
    procedure Timer_jTimer(Sender: TObject);
    procedure MenuAwardClick(Sender: TObject);
    procedure MenuAbortClick(Sender: TObject);
    procedure Timer_nmbTimer(Sender: TObject);
    procedure TimerTimer(Sender: TObject);
    procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  frmMain: TfrmMain;
  StartNmb,Interval,StopNmb:Integer;
implementation
 uses
  UPlay, UInit,Ulist, UInfo, UAward, UAbort;

{$R *.dfm}
//{$R sounds.res}
{$R source.res}
procedure TfrmMain.FormCreate(Sender: TObject);
begin
//PlaySound(PChar('cb'), hInstance, SND_LOOP or snd_ASync or snd_Resource);
//wavestr:='swz.MID';
//ExtractRes('MIDI','bj',wavestr);
MCISendString('OPEN swz.MID TYPE SEQUENCER ALIAS NN','', 0, 0);
MCISendString('PLAY NN FROM 0', '', 0, 0);
//MCISendString('CLOSE ANIMATION', '', 0, 0);
 ADOC.ConnectionString:=
      'Provider=Microsoft.Jet.OLEDB.4.0;Password="";'
      +'Data Source='+ExtractFilePath (Application.ExeName)
      +'data.mdb;Persist Security Info=True';
 ADOC.Connected;
 ADOQuery.Connection:=ADOC;
end;

procedure TfrmMain.FormShow(Sender: TObject);
var
 List:ListC;
begin

 lb_nmb.Items.Clear;
 lab_jg.Caption:='';
 lab_jp.Caption:='';
 ADOQuery.Close;
 ADOQuery.SQL.Text:='select * from awInfo';
 ADOQuery.Open;
 lab_company_up.Caption:=ADOQuery.fieldByName('aw_company').AsString;
 lab_company_down.Caption:=lab_company_up.Caption;
 lab_Title.Caption:=ADOQuery.fieldByName('aw_title').AsString;
 frmInit.edt_count.Text:=ADOQuery.FieldByName('aw_base_nmb').AsString;
 frmInit.edt_start.Text:=ADOQuery.FieldByName('aw_start_nmb').AsString;

ADOQuery.Close;
ADOQuery.SQL.Text:='select * from award where enter=''N''';
ADOQuery.Open;
lb_nmb.Items.Clear;
while not ADOQuery.Eof do
 begin
  lb_nmb.Items.Add(ADOQuery.Fields.Fields[0].AsString);
  ADOQuery.Next;
 end;
ADOQuery.Close;
sleep(100);
end;

procedure TfrmMain.btnStartClick(Sender: TObject);
var
 emplno:String;
 i:Integer;
begin
if lb_nmb.Items.Count=0 then
  begin
     btnStart.Enabled:=False;
     ShowMessage('抽奖已经结束!');
     exit;
  end;
StartNmb:=10;
Interval:=5;
StopNmb:=150;
self.Tag:=1;
//取中奖号码
randomize;
i:=random(lb_nmb.Items.Count);
emplno:=lb_nmb.Items.Strings[i];
lb_nmb.ItemIndex:=i;
edt_nmb.Text:=emplno;
lab_n1.Visible:=True;
lab_n2.Visible:=True;
lab_n3.Visible:=True;
lab_n4.Visible:=True;
lab_n5.Visible:=True;
lab_n6.Visible:=True;
lab_n7.Visible:=True;
lab_n8.Visible:=True;
lab_n9.Visible:=True;
i1.Visible:=True;
i2.Visible:=True;
i3.Visible:=True;
i4.Visible:=True;
i5.Visible:=True;
i6.Visible:=True;
i7.Visible:=True;
i8.Visible:=True;
i9.Visible:=True;
//抽奖前准备
 case length(Edt_nmb.Text) of
  2:
   begin
    pan_nmb.Width:=160;
    pan_nmb.Left:=(Self.Width-pan_nmb.Width) div 2;
    lab_n3.Visible:=False;
    lab_n4.Visible:=False;
    lab_n5.Visible:=False;
    lab_n6.Visible:=False;
    lab_n7.Visible:=False;
    lab_n8.Visible:=False;
    lab_n9.Visible:=False;
    pan_nmb1.Width:=160;
    pan_nmb1.Left:=(Self.Width-pan_nmb1.Width) div 2;
    i3.Visible:=False;
    i4.Visible:=False;
    i5.Visible:=False;
    i6.Visible:=False;
    i7.Visible:=False;
    i8.Visible:=False;
    i9.Visible:=False;
   end;
  3:
   begin
    pan_nmb.Width:=320;
    pan_nmb.Left:=(Self.Width-pan_nmb.Width) div 2;
    lab_n4.Visible:=False;
    lab_n5.Visible:=False;
    lab_n6.Visible:=False;
    lab_n7.Visible:=False;
    lab_n8.Visible:=False;
    lab_n9.Visible:=False;
    pan_nmb1.Width:=320;
    pan_nmb1.Left:=(Self.Width-pan_nmb1.Width) div 2;
    i4.Visible:=False;
    i5.Visible:=False;
    i6.Visible:=False;
    i7.Visible:=False;
    i8.Visible:=False;
    i9.Visible:=False;
   end;
  4:
   begin
    pan_nmb.Width:=300;
    pan_nmb.Left:=(Self.Width-pan_nmb.Width) div 2;
    lab_n5.Visible:=False;
    lab_n6.Visible:=False;
    lab_n7.Visible:=False;
    lab_n8.Visible:=False;
    lab_n9.Visible:=False;
    pan_nmb1.Width:=300;
    pan_nmb1.Left:=(Self.Width-pan_nmb1.Width) div 2;
    i5.Visible:=False;
    i6.Visible:=False;
    i7.Visible:=False;
    i8.Visible:=False;
    i9.Visible:=False;
   end;
  5:
   begin
    pan_nmb.Width:=370;
    pan_nmb.Left:=(Self.Width-pan_nmb.Width) div 2;
    lab_n6.Visible:=False;
    lab_n7.Visible:=False;
    lab_n8.Visible:=False;
    lab_n9.Visible:=False;
    pan_nmb1.Width:=370;
    pan_nmb1.Left:=(Self.Width-pan_nmb1.Width) div 2;
    i6.Visible:=False;
    i7.Visible:=False;
    i8.Visible:=False;
    i9.Visible:=False;
   end;
  6:
   begin
    pan_nmb.Width:=440;
    pan_nmb.Left:=(Self.Width-pan_nmb.Width) div 2;
    lab_n7.Visible:=False;
    lab_n8.Visible:=False;
    lab_n9.Visible:=False;
    pan_nmb1.Width:=440;
    pan_nmb1.Left:=(Self.Width-pan_nmb1.Width) div 2;
    i7.Visible:=False;
    i8.Visible:=False;
    i9.Visible:=False;
   end;
  7:
   begin
    pan_nmb.Width:=510;
    pan_nmb.Left:=(Self.Width-pan_nmb.Width) div 2;
    lab_n8.Visible:=False;
    lab_n9.Visible:=False;
    pan_nmb1.Width:=510;
    pan_nmb1.Left:=(Self.Width-pan_nmb1.Width) div 2;
    i8.Visible:=False;
    i9.Visible:=False;
   end;
  8:
   begin
    pan_nmb.Width:=580;
    pan_nmb.Left:=(Self.Width-pan_nmb.Width) div 2;
    lab_n9.Visible:=False;
    pan_nmb1.Width:=580;
    pan_nmb1.Left:=(Self.Width-pan_nmb1.Width) div 2;
    i9.Visible:=False;
   end;
  9:
   begin
    pan_nmb.Width:=650;
    pan_nmb.Left:=(Self.Width-pan_nmb.Width) div 2;
    lab_n9.Visible:=True;
    pan_nmb1.Width:=650;
    pan_nmb1.Left:=(Self.Width-pan_nmb.Width) div 2;
    i9.Visible:=True;
   end;
 end; 

Randomize;
Lab_n2.Caption:=intToStr(Random(9));
Randomize;
Lab_n3.Caption:=intToStr(Random(9));
Randomize;
Lab_n4.Caption:=intToStr(Random(9));
Randomize;
Lab_n5.Caption:=intToStr(Random(9));
Randomize;
Lab_n6.Caption:=intToStr(Random(9));
Randomize;
Lab_n7.Caption:=intToStr(Random(9));
Randomize;
Lab_n8.Caption:=intToStr(Random(9));
Randomize;
Lab_n9.Caption:=intToStr(Random(9));

Timer_nmb.Interval:=StartNmb;
Timer_Flash.Enabled:=False;
Timer_nmb.Enabled:=True;
Timer.Enabled:=True;

btnStart.Enabled:=False;
btnClose.Enabled:=False;

MenuInfo.Enabled:=False;
MenuInit.Enabled:=False;
MenuClose.Enabled:=False;
lab_jg.Caption:='';
lab_jp.Caption:='';


end;

procedure TfrmMain.btnCloseClick(Sender: TObject);
begin
application.Terminate;
end;

procedure TfrmMain.FormKeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
 case key of
  VK_SPACE:
     begin
      if btnStart.Enabled=False then
       exit;
      btnStart.OnClick(nil);
     end;
 end;
end;

procedure TfrmMain.imgBMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
ReleaseCapture;
PerForm(WM_syscommand,$F012,0);
if self.Top<0 then
 self.Top:=0;
if self.Left<0 then
 self.Left:=0;
if self.Left+self.Width>screen.Width then
  self.Left:=screen.Width-self.Width;
if self.Top+self.Height>screen.Height then
  self.Top:=screen.Height-self.Height;
end;

procedure TfrmMain.MenuCloseClick(Sender: TObject);
begin
close;
end;

procedure TfrmMain.MenuInitClick(Sender: TObject);
begin
frmInit.Show;
end;

procedure TfrmMain.MenuInfoClick(Sender: TObject);
begin
frmInfo.Show;
end;

procedure TfrmMain.Timer_jTimer(Sender: TObject);
begin

if lab_jp.Font.Color=clWindowText then
 begin
  lab_jg.Font.Color:=clWhite;
  lab_jp.Font.Color:=clWhite;
 end
else
 begin
  lab_jg.Font.Color:=clWindowText;
  lab_jp.Font.Color:=clWindowText;
 end;
end;

procedure TfrmMain.MenuAwardClick(Sender: TObject);
begin
frmAward.Show;
end;

procedure TfrmMain.MenuAbortClick(Sender: TObject);
begin
frmAbort.Show;
end;

procedure TfrmMain.Timer_nmbTimer(Sender: TObject);
var
 n1,nmb:String;
 Play:PlayS;
begin
//循环选定单个数字
nmb:=copy(Edt_nmb.Text,self.Tag,1);
if nmb='' then
 self.Tag:=0;
Timer_nmb.Interval:=Timer_nmb.Interval+Interval;
case self.Tag of
 1:
  begin
    n1:=lab_n1.Caption;
    if n1='9' then
       n1:='-1' ;
     lab_n1.Caption:=IntToStr(StrToInt(n1)+1);
     i1.Picture.Bitmap.Handle:=
                   LoadBitmap(hInstance, PChar('i'+lab_n1.Caption));
    if Timer_nmb.Interval>StopNmb then
     begin
      if lab_n1.Caption=nmb then
       begin
        PlaySound(PChar('bStop'), hInstance, snd_ASync or snd_Resource);
        self.Tag:=Self.Tag+1;
        Timer_nmb.Interval:=StartNmb;
       end;
     end;
  end;
 2:
  begin
    n1:=lab_n2.Caption;
    if n1='9' then
       n1:='-1' ;
     lab_n2.Caption:=IntToStr(StrToInt(n1)+1);
     i2.Picture.Bitmap.Handle:=
12 下一页
⌨️ 快捷键说明

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