📄 main.pas
字号:
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 + -