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

📄 main.pas

📁 一个智能交通管理系统Delphi源码,适合学生朋友使用
💻 PAS
📖 第 1 页 / 共 2 页
字号:
unit main;

interface

uses
  registry,shellapi,Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls, Buttons, StdCtrls, Menus, ActnList, ToolWin, ComCtrls,
  ImgList, OleCtrls, SHDocVw;

const
mousemsg=wm_user+1;
iid=100;

type
  TForm1 = class(TForm)
    test: TTimer;
    SpeedButton6: TSpeedButton;
    SpeedButton7: TSpeedButton;
    SpeedButton8: TSpeedButton;
    Image8: TImage;
    label_time: TLabel;
    s_timer: TTimer;
    move_Timer: TTimer;
    ini_Button: TButton;
    stakeout: TTimer;
    cross: TTimer;
    warning: TLabel;
    PageControl1: TPageControl;
    TabSheet1: TTabSheet;
    Panel2: TPanel;
    Shape1: TShape;
    Shape2: TShape;
    Image1: TImage;
    Image2: TImage;
    Image3: TImage;
    Image4: TImage;
    Image5: TImage;
    Image6: TImage;
    timeRemain: TLabel;
    Shape3: TShape;
    Shape4: TShape;
    Shape5: TShape;
    Shape6: TShape;
    Shape7: TShape;
    Shape8: TShape;
    Shape9: TShape;
    Shape10: TShape;
    Shape11: TShape;
    Shape12: TShape;
    Shape13: TShape;
    Shape14: TShape;
    Shape15: TShape;
    Shape16: TShape;
    Shape17: TShape;
    Shape18: TShape;
    NNum: TEdit;
    WNum: TEdit;
    SNum: TEdit;
    ENum: TEdit;
    TabSheet2: TTabSheet;
    TabSheet3: TTabSheet;
    Panel1: TPanel;
    SpeedButton2: TSpeedButton;
    Label2: TLabel;
    Label1: TLabel;
    SpeedButton1: TSpeedButton;
    settting: TSpeedButton;
    Label10: TLabel;
    Label11: TLabel;
    Label12: TLabel;
    Label13: TLabel;
    Label14: TLabel;
    Label15: TLabel;
    Label16: TLabel;
    Label17: TLabel;
    Label18: TLabel;
    Label19: TLabel;
    LoadWidth1: TEdit;
    averageLen1: TEdit;
    averageWidth1: TEdit;
    a1: TEdit;
    initTime1: TEdit;
    TabSheet4: TTabSheet;
    reg_Label: TLabel;
    SpeedButton3: TSpeedButton;
    Label20: TLabel;
    Edit1: TEdit;
    Label21: TLabel;
    showNorth: TEdit;
    Label4: TLabel;
    north: TTrackBar;
    showSouth: TEdit;
    south: TTrackBar;
    Label5: TLabel;
    Label6: TLabel;
    showWest: TEdit;
    West: TTrackBar;
    showEast: TEdit;
    East: TTrackBar;
    Label7: TLabel;
    test_img: TImage;
    test_img2: TImage;
    SpeedButton5: TSpeedButton;
    test2: TTimer;
    Label22: TLabel;
    SpeedButton9: TSpeedButton;
    Shape19: TShape;
    Shape20: TShape;
    Shape21: TShape;
    Shape22: TShape;
    Shape23: TShape;
    Shape24: TShape;
    Shape25: TShape;
    Shape26: TShape;
    Shape27: TShape;
    Shape28: TShape;
    Shape29: TShape;
    Shape30: TShape;
    Shape31: TShape;
    Shape32: TShape;
    Shape33: TShape;
    Shape34: TShape;
    Shape35: TShape;
    Shape36: TShape;
    Shape37: TShape;
    Shape38: TShape;
    Shape39: TShape;
    Shape40: TShape;
    Shape41: TShape;
    Shape42: TShape;
    Shape43: TShape;
    Shape44: TShape;
    Shape45: TShape;
    Shape46: TShape;
    Shape47: TShape;
    Shape48: TShape;
    Shape49: TShape;
    Shape50: TShape;
    Shape51: TShape;
    Image10: TImage;
    Image9: TImage;
    ini2: TButton;
    Label23: TLabel;
    Image7: TImage;
    Label24: TLabel;
    Label9: TLabel;
    Label3: TLabel;
    status: TImage;
    Image12: TImage;
    TabSheet5: TTabSheet;
    RichEdit1: TRichEdit;
    Shape52: TShape;
    PopupMenu1: TPopupMenu;
    N1: TMenuItem;
    procedure northChange(Sender: TObject);
    procedure southChange(Sender: TObject);
    procedure WestChange(Sender: TObject);
    procedure EastChange(Sender: TObject);
    procedure showNorthChange(Sender: TObject);
    procedure showSouthChange(Sender: TObject);
    procedure showWestChange(Sender: TObject);
    procedure showEastChange(Sender: TObject);
    procedure stakeoutTimer(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure crossTimer(Sender: TObject);
    procedure testTimer(Sender: TObject);
    procedure SpeedButton2Click(Sender: TObject);
    procedure N2Click(Sender: TObject);
    procedure SpeedButton1Click(Sender: TObject);
    procedure s_timerTimer(Sender: TObject);
    procedure move_TimerTimer(Sender: TObject);
    procedure ini_ButtonClick(Sender: TObject);
    procedure TabSheet2Show(Sender: TObject);
    procedure SpeedButton8Click(Sender: TObject);
    procedure SpeedButton7Click(Sender: TObject);
    procedure SpeedButton6Click(Sender: TObject);
    procedure TabSheet4Show(Sender: TObject);
    procedure SpeedButton3Click(Sender: TObject);
    procedure TabSheet3Show(Sender: TObject);
    procedure SpeedButton5Click(Sender: TObject);
    procedure test2Timer(Sender: TObject);
    procedure setttingClick(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure ini2Click(Sender: TObject);
    procedure N1Click(Sender: TObject);
    procedure exitclick(sender:tobject);

  private
    { Private declarations }
    procedure mousemessage(var message:tmessage);message
   mousemsg;
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
  ntida:TnotifyicondataA;

implementation

uses load;

var
 temp3, temp2,temp1,testtime:integer;
  alternate,change,once,compute:boolean;
  RedLightTime,yongjiTime:integer;
  NSum,SSum,WSum,ESum,deductNumTemp:real;
   LoadWidth,averageWidth,averageLen,a:real;
  reged:boolean;


{$R *.dfm}

{ tform1 }
procedure Tform1.mousemessage(var message:tmessage);
var
mousept:tpoint;
begin
inherited;
if message.LParam=wm_rbuttonup then begin
getcursorpos(mousept);
form1.popupmenu1.Popup(mousept.X,mousept.Y);
end;
if message.lparam=wm_lbuttonup then begin
showwindow(Handle,Sw_show);
showwindow(application.Handle,sW_show);
setwindowlong(application.Handle,GWL_exstyle, not (getwindowlong(Application.Handle,GWL_exstyle)
or WS_EX_toolwindow and not WS_EX_appwindow));
end;
message.result:=0;
end;


procedure catchInfo(LWidth,averWidth,averLength,acceleration:real;initWaitTime:integer);
begin
  LoadWidth:=LWidth;
  averageWidth:=averWidth;
  averageLen:=averLength;
  a:=acceleration;
  RedLightTime:=initWaitTime;
end;

function MaxNum(num1,num2:integer):integer;
begin
  if num1>=num2 then
    MaxNum:=num1
  else
    MaxNum:=num2;
end;

function TimeOfWaitToPass(ColNum:integer):real;
var
  AddLen,PassTime,s:real;
begin
  AddLen:=colNum*averageLen+colNum+1.5;
  s:=LoadWidth+AddLen;
  PassTime:=sqrt(2*(s/a));
  TimeOfWaitToPass:=PassTime;
end;

function column(CarSum:integer):integer;
var
  rowNum:integer;
begin
  rowNum:=Trunc((LoadWidth/2)/averageWidth);
  if Frac(CarSum/rowNum)=0 then
    column:=Trunc(CarSum/rowNum)
  else
    column:=Trunc(CarSum/rowNum)+1;
end;

function GuessTime(baseSum1,baseSum2,currentColNum:integer;PassX1,PassX2,WaitTime:real):integer;
var
  sum,guessColNum:integer;
  guessSum1,guessSum2,backWaitTime:real;
begin
  guessSum1:=baseSum1+PassX1*WaitTime;
  guessSum2:=baseSum2+PassX2*WaitTime;
  sum:=MaxNum(round(guessSum1),round(guessSum2));
  guessColNum:=column(sum);
  if currentColNum<=15 then
  begin
    if guessColNum<=15 then
    begin
      RedLightTime:=Trunc(WaitTime)+1;
      Form1.warning.Caption:='';
      GuessTime:=0;
    end
    else
    begin
      currentColNum:=currentColNum-1;
      if currentColNum>0 then
      begin
        backWaitTime:=TimeOfWaitToPass(currentColNum);
        GuessTime:=GuessTime(baseSum1,baseSum2,currentColNum,PassX1,PassX2,backWaitTime);
      end
      else
      begin
        Form1.warning.Caption:='道路拥挤!';
        form1.Label23.Caption:='     〖安全告示〗     '+#13+'如果交通拥挤太久'+#13+'则人有可能跑到马'+#13+'路外去.请行人注意'+#13+'安全';
        form1.image7.visible:=true;
        RedlightTime:=yongjiTime;
        GuessTime:=0;
      end;
    end;
  end
  else
  begin
    if guessColNum<=15 then
    begin
      RedLightTime:=Trunc(WaitTime)+1;
      Form1.warning.Caption:='';
      GuessTime:=0;
    end
    else
    begin
      Form1.warning.Caption:='道路拥挤!';
      form1.Label23.Caption:='     〖安全告示〗     '+#13+'如果交通拥挤太久'+#13+'则人有可能跑到马'+#13+'路外去.请行人注意'+#13+'安全';
      form1.image7.visible:=true;
      RedLightTime:=yongjiTime;
      GuessTime:=0;
    end;
  end;
end;

procedure DeductCar();
var
  deductNum,s:real;
  rowNumber,dif:integer;
begin
  s:=0.5*a*sqr(RedLightTime-strtoint(Form1.timeRemain.Caption));
  rowNumber:=Trunc((LoadWidth/2)/averageWidth);
  if s<1.5+LoadWidth then
    deductNum:=0
  else
  begin
    deductNum:=(s-1.5-LoadWidth)/(averageLen+1);
    dif:=Trunc(deductNum)-Trunc(deductNumTemp);
    deductNumTemp:=deductNum;
    if dif>=1 then
    begin
      if Form1.north.Tag=1 then
      begin
        NSum:=NSum-(dif*rowNumber);
        SSum:=SSum-(dif*rowNumber);
        if NSum<=0 then
        begin
          NSum:=0;
          Form1.NNum.Text:='0';
        end
        else
          Form1.NNum.Text:=inttostr(Trunc(NSum));
        if SSum<=0 then
        begin
          SSum:=0;
          Form1.SNum.Text:='0';
        end
        else
          Form1.SNum.Text:=inttostr(Trunc(SSum));
      end;
      if Form1.West.Tag=1 then
      begin
        WSum:=WSum-(dif*rowNumber);
        ESum:=ESum-(dif*rowNumber);
        if WSum<=0 then
        begin
          WSum:=0;
          Form1.WNum.Text:='0';
        end
        else
          Form1.WNum.Text:=inttostr(Trunc(WSum));
        if ESum<=0 then
        begin
          ESum:=0;
          Form1.ENum.Text:='0';
        end
        else
          Form1.ENum.Text:=inttostr(Trunc(ESum));
      end;
    end;
  end;
end;

procedure AddCar();
var
  times:integer;
  x,sum,number:real;
begin
  for times:=1 to 4 do
  begin
    case times of
    1: begin
         x:=strtofloat(Form1.showNorth.Text);
         sum:=NSum;
       end;
    2: begin
         x:=strtofloat(Form1.showSouth.Text);
         sum:=SSum;
       end;
    3: begin
         x:=strtofloat(Form1.showWest.Text);
         sum:=WSum;
       end;
    4: begin
         x:=strtofloat(Form1.showEast.Text);
         sum:=ESum;
       end;
    end;
    number:=x*0.1;
    sum:=sum+number;
    case times of
    1: begin
         Form1.NNum.Text:=inttostr(round(sum));
         NSum:=sum;
       end;
    2: begin
         Form1.SNum.Text:=inttostr(round(sum));
         SSum:=sum;
       end;
    3: begin
         Form1.WNum.Text:=inttostr(round(sum));
         WSum:=sum;
       end;
    4: begin
         Form1.ENum.Text:=inttostr(round(sum));
         ESum:=sum;
       end;
    end;
  end;
end;

procedure changelight();
begin
  Form1.cross.Enabled:=false;
  if change then
  begin
    Form1.image2.Picture.LoadFromFile('yellow.ico');
    Form1.image1.Picture.LoadFromFile('yellow.ico');
    Form1.timeRemain.Color:=clYellow;
    Form1.timeRemain.Caption:='1';
    change:=false;
    compute:=true;
  end
  else
  begin
    Form1.timeRemain.Color:=clSkyBlue;
    if Form1.north.Tag=1 then
    begin
      Form1.image2.Picture.LoadFromFile('red.ico');
      Form1.image1.Picture.LoadFromFile('green.ico');
      form1.ini2.click;
      Form1.West.Tag:=1;
      Form1.north.Tag:=0;
    end
    else
      if Form1.West.Tag=1 then
      begin
        Form1.image2.Picture.LoadFromFile('green.ico');
        Form1.image1.Picture.LoadFromFile('red.ico');
        Form1.ini_Button.Click;
        Form1.north.Tag:=1;
        Form1.West.Tag:=0;
      end;
    Form1.timeRemain.Caption:=inttostr(RedLightTime);
    change:=true;
    deductNumTemp:=0;
  end;
  Form1.cross.Enabled:=true;
end;

procedure TForm1.northChange(Sender: TObject);
var
  x:real;
begin
  if once then
  begin
    image2.Picture.LoadFromFile('yellow.ico');
    image1.Picture.LoadFromFile('yellow.ico');
    image2.Tag:=1;
    stakeout.Enabled:=true;
  end;
  x:=north.Position/10;
  showNorth.Text:=floattostr(x);
end;

procedure TForm1.southChange(Sender: TObject);
var
  x:real;
begin
  if once then
  begin
    image2.Picture.LoadFromFile('yellow.ico');
    image1.Picture.LoadFromFile('yellow.ico');
    image2.Tag:=1;
    stakeout.Enabled:=true;
  end;
  x:=south.Position/10;
  showSouth.Text:=floattostr(x);
end;

procedure TForm1.WestChange(Sender: TObject);
var
  x:real;
begin
  if once then
  begin
    image2.Picture.LoadFromFile('yellow.ico');
    image1.Picture.LoadFromFile('yellow.ico');

⌨️ 快捷键说明

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