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

📄 unit1.pas

📁 一个关于电梯的模拟程序算法 拥有良好的用户界面
💻 PAS
📖 第 1 页 / 共 3 页
字号:
unit unit1;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, Buttons, ExtCtrls;

type
  TForm1 = class(TForm)
    GroupBox1: TGroupBox;
    floor7: TLabel;
    floor2: TLabel;
    floor1: TLabel;
    floor5: TLabel;
    floor3: TLabel;
    floor4: TLabel;
    floor6: TLabel;
    GroupBox2: TGroupBox;
    eledoorstate: TLabel;
    eledown2: TBitBtn;
    eleup2: TBitBtn;
    eleup3: TBitBtn;
    eledown3: TBitBtn;
    eledown4: TBitBtn;
    eleup4: TBitBtn;
    eledown5: TBitBtn;
    eleup5: TBitBtn;
    eleup6: TBitBtn;
    eledown6: TBitBtn;
    eledown7: TBitBtn;
    target7: TBitBtn;
    target6: TBitBtn;
    target1: TBitBtn;
    target4: TBitBtn;
    target5: TBitBtn;
    target2: TBitBtn;
    target3: TBitBtn;
    doorclose: TBitBtn;
    eleup1: TBitBtn;
    doortimer: TTimer;
    eletimer: TTimer;
    dooropen: TBitBtn;
    about: TButton;
    exitdemo: TButton;
    GroupBox3: TGroupBox;
    elelocate1: TLabel;
    elestate2: TLabel;
    elemovedown1: TLabel;
    elemoveup1: TLabel;
    GroupBoxin: TGroupBox;
    manin1: TRadioButton;
    manin6: TRadioButton;
    GroupBoxout: TGroupBox;
    manout1: TRadioButton;
    manout6: TRadioButton;
    manin2: TRadioButton;
    manin7: TRadioButton;
    manin3: TRadioButton;
    manin8: TRadioButton;
    manin4: TRadioButton;
    manin9: TRadioButton;
    manin5: TRadioButton;
    manin10: TRadioButton;
    manout2: TRadioButton;
    manout3: TRadioButton;
    manout4: TRadioButton;
    manout5: TRadioButton;
    manout7: TRadioButton;
    manout8: TRadioButton;
    manout9: TRadioButton;
    manout10: TRadioButton;
    Panel1: TPanel;
    Panel2: TPanel;
    eleShape: TShape;
    doorimage: TImage;
    doorocTimer: TTimer;
    ElemoveTimer: TTimer;
    waitTimer: TTimer;
    GroupBox4: TGroupBox;
    elestate3: TLabel;
    elemoveup2: TLabel;
    elemovedown2: TLabel;
    elelocate2: TLabel;
    procedure doorcloseClick(Sender: TObject);
    procedure dooropenClick(Sender: TObject);
    procedure doortimerTimer(Sender: TObject);
    procedure target1Click(Sender: TObject);
    procedure target3Click(Sender: TObject);
    procedure target2Click(Sender: TObject);
    procedure target4Click(Sender: TObject);
    procedure target5Click(Sender: TObject);
    procedure target6Click(Sender: TObject);
    procedure target7Click(Sender: TObject);
    procedure eledown7Click(Sender: TObject);
    procedure eledown6Click(Sender: TObject);
    procedure eledown5Click(Sender: TObject);
    procedure eledown4Click(Sender: TObject);
    procedure eledown3Click(Sender: TObject);
    procedure eledown2Click(Sender: TObject);
    procedure eleup1Click(Sender: TObject);
    procedure eleup2Click(Sender: TObject);
    procedure eleup3Click(Sender: TObject);
    procedure eleup4Click(Sender: TObject);
    procedure eleup5Click(Sender: TObject);
    procedure eleup6Click(Sender: TObject);
    procedure eletimerTimer(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure aboutClick(Sender: TObject);
    procedure exitdemoClick(Sender: TObject);
    procedure doorocTimerTimer(Sender: TObject);
    procedure ElemoveTimerTimer(Sender: TObject);
    procedure waitTimerTimer(Sender: TObject);


  private
   { Private declarations }
   mshowin:boolean;                        {判断Groupboxin是否可见}
   mshowout:boolean;                       {判断Groupboxout是否可见}
   canmove:boolean;                        {用来延迟一会循环}
   whichclick:integer;                     {判断是开门还是关门}
   imagel:integer;                         {门图片的left}
   imagew:integer;                         {门图片的Width}
   elet:integer;                           {eleshape的top}
   doorready:boolean;                      {电梯门是否准备好}
   elemove:boolean;                        {电梯是否运动}
   movedrect:integer;                      {电梯运动方向}
   elelocatefloor:integer;                 {电梯所在楼层}
   nowcall:integer;                        {现在几楼要求电梯运动}
   targetfloor:integer;                    {电梯运动的目标楼层}
   mincallup:integer;                      {电梯外部向下运动的最低楼层}
   maxcalldown:integer;                    {电梯外部向上运动的最高楼层}
   targetobject:integer;                   {电梯内部要求运动的楼层}
   nowtarget:integer;                      {现在电梯内部要求运动的楼层}
   downarray:array[2..7] of boolean;       {外部向下运动的按纽}
   uparray:array[1..6] of boolean;         {外部向上运动的按纽}
   targetarray:array[1..7] of boolean;     {内部运动的按纽}
   procedure waittwosecond();              {等待2秒,一个等待过程,不一定是一秒}
   procedure waitonesecond();                  {等待1秒,同上}
   procedure dooropenclose();                  {开门关门动作}
   procedure eleincall(now:integer);           {电梯里面要求运动}
   procedure eleoutcall(now:integer);          {电梯外面要求运动}
   procedure lighton(nowstate:integer);        {点亮所在楼层字体}
   procedure lightoff(nowstate:integer);       {关掉所在楼层字体}
   procedure downoff(nowstate:integer);        {关掉向下按纽}
   procedure upoff(nowstate:integer);          {关掉向上按纽}
   procedure targetoff(nowstate:integer);      {关掉内部按纽}
   procedure doorbitopen();                    {实现开门动作}
   procedure doorbitclose();                   {实现关门动作}
   procedure wait3sec();                       {实现等待3秒}
   procedure waitformove();                    {用来等待shape的运动}
   procedure showin();                         {用来使groupboxin可见}
   procedure showout();                        {用来使groupboxout可见}
   procedure lightofftarget();                 {用来是关掉内部按纽颜色}
   Function  moverequire():integer;            {运动一回合后是否还要运动}
   Function  getnowcallup():boolean;           {是否还有向上的请求}
   Function  getnowcalldown():boolean;         {是否还有向下的请求}
{   function  getinman(sender:Tobject): integer;              {计算进入电梯的人数}
{   function  getoutman(sender:Tobject):integer;              {计算走出电梯的人数}

  public
   { Public declarations }

  end;

var
  Form1: TForm1;


implementation

{$R *.DFM}

procedure TForm1.lightofftarget();
var i:integer;
begin
 case movedrect of
 1:begin for i:=elelocatefloor downto 1 do
         begin
         targetoff(i);
         targetarray[i]:=False;end;end;
 -1:begin for i:=elelocatefloor to 7 do
          begin
          targetoff(i);
          targetarray[i]:=False;
          end;end;
  end;
end;


procedure TForm1.showin();
begin
if mshowin=true then  groupboxin.Visible:=True;
if mshowout=True then  groupboxout.Visible:=True;
end;

procedure TForm1.showout();
begin
mshowin:=False;
mshowout:=False;
Groupboxin.Visible:=False;
Groupboxout.Visible:=False;
end;

{function TForm1.getinman(Sender:Tobject):integer;
begin
with Groupboxin do
  case (Sender as TRadioButton).tag of
  1:getinman:=1;
  2:getinman:=2;
  3:getinman:=3;
  4:getinman:=4;
  5:getinman:=5;
  6:getinman:=6;
  7:getinman:=7;
  8:getinman:=8;
  9:getinman:=9;
  10:getinman:=10;
  end;
end;

function TForm1.getoutman(Sender:Tobject):integer;
begin
with Groupboxout do
  case (Sender as TRadioButton).tag of
  1:getoutman:=1;
  2:getoutman:=2;
  3:getoutman:=3;
  4:getoutman:=4;
  5:getoutman:=5;
  6:getoutman:=6;
  7:getoutman:=7;
  8:getoutman:=8;
  9:getoutman:=9;
  10:getoutman:=10;
  end;
end; }

procedure TForm1.waitformove();
begin
elemove:=true;
elemovetimer.Enabled:=True;
end;


procedure TForm1.wait3sec();
begin
waittimer.Enabled:=True;
end;

procedure TForm1.doorbitopen();
begin
dooroctimer.Enabled:=True;
whichclick:=1;
end;

procedure TForm1.doorbitclose();
begin
dooroctimer.Enabled:=True;
whichclick:=-1;
end;


{---------------------------初始状态---------------------------------}
procedure TForm1.FormCreate(Sender: TObject);
begin
{shape 336 48}{137 }
imagel:=68;
imagew:=1;
Doorimage.Left:=imagel;
Doorimage.Width:=imagew;
Eleshape.Brush.Color:=clgreen;
elet:=288;
eleshape.top:=elet;
{}{}
canmove:=True;
elelocatefloor:=1;
floor1.Font.color:=clred;
elelocate1.font.color:=clred;
elelocate2.font.color:=clred;
elelocate1.caption:=inttostr(elelocatefloor);
elelocate2.caption:=inttostr(elelocatefloor);
doorready:=true;
elemove:=false;
movedrect:=0;
mshowin:=False;
mshowout:=False;
Targetfloor:=1;
end;



{--------------------以下是定时器,实现2和1秒等待!------------------}
procedure TForm1.waittwosecond();
begin
doortimer.enabled:=True;
end;

procedure TForm1.waitonesecond();
begin
eletimer.enabled:=true;
end;

{-------------------以下是开门和关门过程------------------}
procedure TForm1.dooropenclose();
begin
eletimer.Enabled:=False;
doorready:=false;
dooropen.Font.color:=clred;
doorclose.Font.color:=clwindowtext;
eledoorstate.font.color:=clred;
eledoorstate.caption:='正在开门!';
showin();
doorbitopen();
waittwosecond();
end;

{--------------------定时器doortimer-------------------------}
procedure TForm1.doortimerTimer(Sender: TObject);
begin
if waittimer.Enabled=True then exit;
if (elemove=true) and (dooroctimer.Enabled=True) then exit;
eledoorstate.caption:=' ';
if doorready=true  then doorclose.font.color:=clWindowtext;
doortimer.enabled:=false;
if doorready=false then
     begin
     eledoorstate.Font.color:=clred;
     dooropen.font.color:=clWindowtext;
     doorclose.font.color:=clred;
     eledoorstate.caption:='正在关门!';
     showout();
     doorbitclose();
     waittwosecond();
     doorready:=true;
     if elelocatefloor=Targetfloor then  begin
         if moverequire()=-1 then begin
             elemoveup1.font.color:=clwindowtext;
             elemoveup2.font.color:=clwindowtext;
             eleoutcall(nowcall);end
         else if moverequire()=1 then begin
            elemovedown1.font.color:=clwindowtext;
            elemovedown2.font.color:=clwindowtext;
            eleoutcall(nowcall);end;end;
      end;
if eledoorstate.caption=' ' then  doorready:=true;
if elelocatefloor<>targetfloor then
      begin doortimer.Enabled:=False; eletimer.Enabled:=True; end;
if moverequire()=0 then begin
              if  dooroctimer.enabled=False  then  begin
                  elemoveup1.font.color:=clwindowtext;
                  elemoveup2.font.color:=clwindowtext;
                  elemovedown1.font.color:=clwindowtext;
                  elemovedown2.font.color:=clwindowtext; end;
                  elemove:=False;end;
end;



{--------------------以下是click  <|> 实现开门------------------}
procedure TForm1.dooropenClick(Sender: TObject);
begin
 if imagel<=4 then exit;
 if elet mod 48 <>0 then exit;
 if dooroctimer.Enabled=true then dooroctimer.Enabled:=False;
 eledoorstate.font.color:=clred;
 dooropen.font.color:=clred;
 doorclose.font.color:=clWindowtext;
 eledoorstate.caption:='正在开门!';
 showin();
 doorbitopen();
 waittwosecond();
 doorready:=false;
end;


{-------------------以下是click  >|< 实现关门-----------------}
procedure TForm1.doorcloseClick(Sender: TObject);
begin
 if imagel>=68 then exit;
 if elet mod 48 <>0 then exit;
 if dooroctimer.Enabled=true then dooroctimer.Enabled:=False;
 eledoorstate.font.color:=clred;
 dooropen.font.color:=clwindowtext;
 doorclose.font.color:=clred;
 eledoorstate.caption:='正在关门!';
 showout();
 doorbitclose();
 waittwosecond();
end;

{-----------------------是否还有向上的请求--------------------------}
Function Tform1.getnowcallup():boolean;
var i:integer;
begin
getnowcallup:=False;
for i:=elelocatefloor to 7 do
       begin
       if targetarray[i]=true then
           begin
           nowcall:=i;
           targetobject:=i;
           if nowcall>i then nowcall:=i;
           getnowcallup:=True;
           end;
       if i<7 then
          begin
          if uparray[i]=true then
             begin
             nowcall:=i;
             mincallup:=i;
             if nowcall>i then nowcall:=i;
             getnowcallup:=True;
             end;
          end;
       if i>1 then
          begin
          if downarray[i]=true then
             begin
             nowcall:=i;
             maxcalldown:=i;
             if nowcall>i then nowcall:=i;
             getnowcallup:=True;
             end;
          end;
       end;
end;

{------------------------是否还有向上的请求-----------------------}
Function TForm1.getnowcalldown():boolean;
var i:integer;
begin
getnowcalldown:=False;
for i:=elelocatefloor downto 1 do
       begin
       if targetarray[i]=true then
           begin
           nowcall:=i;
           targetobject:=i;
           if nowcall<i then nowcall:=i;
           getnowcalldown:=True;
           end;
       if i<7 then
          begin
          if uparray[i]=true then
             begin
             nowcall:=i;
             mincallup:=i;
             if nowcall<i then nowcall:=i;
             getnowcalldown:=true;
             end;
          end;
       if i>1 then
          begin
          if downarray[i]=true then
             begin
             nowcall:=i;
             maxcalldown:=i;
             if nowcall<i then nowcall:=i;
             getnowcalldown:=true;
             end;
          end;
       end;
end;

{----------------------------函数mvoerequire()--------------------}
function TForm1.moverequire():integer;
begin
moverequire:=0;

⌨️ 快捷键说明

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