main.~pas

一个电梯控制模拟程序 做得很好 有很形象的动画展示

           else dy:=1;   //到此，尚未考虑下方也没请求的分支；
         exit;
         end;
       end
       else
         begin
           BitBtn2.Enabled :=false;
           Panel_dt.Top :=Panel_dt.Top +1;
         end;
     end;
  1: begin                              //电梯处于向上运动状态
       if Panel_dt.Top =(Panel_dt.Height -1)*(9-Current-1) then
       begin                            //经过各楼层时
         bitbtn2.Enabled :=true;
         Current:=Current+1;
         for i:=1 to 9 do
           myLabel[i].Caption :='电梯正在'+inttostr(Current)+'楼';
         //如果电梯到达9楼，则
         if Current=9 then
         begin
//           showmessage('dkfjd');
           DownStop[current]:=false;
           myDownsb[current].Glyph :=Image_Down2.Picture.Bitmap;
           myPanel[current].Color :=clBtnface;
//           showmessage('34');
           door_control:=true;
           dy:=0;
           for i:=1 to 8 do
             if (UpStop[i] or DownStop[i]) then
             begin
               dy:=-1;
               break;
             end;
           Timer_door.Enabled :=true;
           Timer_move.Enabled :=false;
           exit;
         end;
         //如果该楼层有向上的请请或是目的地，则停梯开门
         if UpStop[Current]then
         begin
           door_control:=true;
           UpStop[current]:=false;
           myUpsb[current].Glyph :=Image_Up2.Picture.Bitmap;
           myPanel[current].Color :=clBtnface;
           Timer_door.Enabled :=true;
           Timer_move.Enabled :=false;
           Upflag:=false;
           for i:=current to 8 do
             if UpStop[i] then  exit;
           if not Upflag then
             for i:=current to 9 do
               if DownStop[i] then  exit;
           if not Upflag then
           begin
             Downflag:=false;
             for i:=current downto 2 do
               if DownStop[i] then begin Downflag:=true; break; end;
             if not Downflag then
               for i:=current downto 1 do
                 if UpStop[i] then begin Downflag:=true; break; end;
           end;
           if not Downflag then dy:=0
           else dy:=-1;   //到此，尚未考虑下方也没请求的分支；
         exit;
         end      //if UpStop[Current]
         else if DownStop[Current] then
         //如果存在向下需停时，则检查是否该转向了
         begin
           for i:=current+1 to 8 do
             if UpStop[i] then exit;
           for i:=current+1 to 9 do
             if DownStop[i] then exit;
           door_control:=true;
           DownStop[current]:=false;
           myDownsb[current].Glyph :=Image_Down2.Picture.Bitmap;
           myPanel[current].Color :=clBtnface;
           Timer_door.Enabled :=true;
           Timer_move.Enabled :=false;
           dy:=-1;
         end;
       end
       else
         begin
           bitbtn2.Enabled :=false;
           Panel_dt.Top :=Panel_dt.Top -1;
         end;
     end;
 end;
end;

procedure TForm1.SpeedButton12Click(Sender: TObject);
begin
  UpStop[1]:=true;
  SpeedButton12.Glyph :=Image_Up1.Picture.Bitmap;
end;

procedure TForm1.SpeedButton22Click(Sender: TObject);
begin
  Upstop[2]:=true;
  SpeedButton22.Glyph :=Image_Up1.Picture.Bitmap;
end;

procedure TForm1.SpeedButton32Click(Sender: TObject);
begin
  Upstop[3]:=true;
  SpeedButton32.Glyph :=Image_Up1.Picture.Bitmap;
end;

procedure TForm1.SpeedButton42Click(Sender: TObject);
begin
  Upstop[4]:=true;
  SpeedButton42.Glyph :=Image_Up1.Picture.Bitmap;
end;

procedure TForm1.SpeedButton52Click(Sender: TObject);
begin
  Upstop[5]:=true;
  SpeedButton52.Glyph :=Image_Up1.Picture.Bitmap;
end;

procedure TForm1.SpeedButton62Click(Sender: TObject);
begin
  Upstop[6]:=true;
  SpeedButton62.Glyph :=Image_Up1.Picture.Bitmap;
end;

procedure TForm1.SpeedButton72Click(Sender: TObject);
begin
  Upstop[7]:=true;
  SpeedButton72.Glyph :=Image_Up1.Picture.Bitmap;
end;

procedure TForm1.SpeedButton82Click(Sender: TObject);
begin
  Upstop[8]:=true;
  SpeedButton82.Glyph :=Image_Up1.Picture.Bitmap;
end;

procedure TForm1.SpeedButton91Click(Sender: TObject);
begin
  Downstop[9]:=true;
  SpeedButton91.Glyph :=Image_Down1.Picture.Bitmap;
end;

procedure TForm1.SpeedButton81Click(Sender: TObject);
begin
  DownStop[8]:=true;
  SpeedButton81.Glyph :=Image_Down1.Picture.Bitmap;
end;

procedure TForm1.SpeedButton71Click(Sender: TObject);
begin
  DownStop[7]:=true;
  SpeedButton71.Glyph :=Image_Down1.Picture.Bitmap;
end;

procedure TForm1.SpeedButton61Click(Sender: TObject);
begin
  DownStop[6]:=true;
  SpeedButton61.Glyph :=Image_Down1.Picture.Bitmap;
end;

procedure TForm1.SpeedButton51Click(Sender: TObject);
begin
  DownStop[5]:=true;
  SpeedButton51.Glyph :=Image_Down1.Picture.Bitmap;
end;

procedure TForm1.SpeedButton41Click(Sender: TObject);
begin
  DownStop[4]:=true;
  SpeedButton41.Glyph :=Image_Down1.Picture.Bitmap;
end;

procedure TForm1.SpeedButton31Click(Sender: TObject);
begin
  DownStop[3]:=true;
  SpeedButton31.Glyph :=Image_Down1.Picture.Bitmap;
end;

procedure TForm1.SpeedButton21Click(Sender: TObject);
begin
  DownStop[2]:=true;
  SpeedButton21.Glyph :=Image_Down1.Picture.Bitmap;
end;

procedure TForm1.Panel1Click(Sender: TObject);
begin
  if Current=1 then exit;
  Panel1.Color :=clRed;
  if dy=1 then UpStop[1]:=true
  else if dy=-1 then DownStop[1]:=true
  else
  begin
    if Current<1 then begin UpStop[1]:=true;end
    else begin DownStop[1]:=true;end;
  end;
  Timer_move.Enabled :=true;
  WaitTime:=0;
end;

procedure TForm1.Panel2Click(Sender: TObject);
begin
  if Current=2 then exit;
  Panel2.Color :=clRed;
  if dy=1 then UpStop[2]:=true
  else if dy=-1 then DownStop[2]:=true
  else
  begin
    if Current<2 then begin UpStop[2]:=true;end
    else begin DownStop[2]:=true;end;
  end;
  Timer_move.Enabled :=true;
  WaitTime:=0;
end;

procedure TForm1.Panel3Click(Sender: TObject);
begin
  if Current=3 then exit;
  Panel3.Color :=clRed;
  if dy=1 then UpStop[3]:=true
  else if dy=-1 then DownStop[3]:=true
  else
  begin
    if Current<3 then begin UpStop[3]:=true;end
    else begin DownStop[3]:=true;end;
  end;
  Timer_move.Enabled :=true;
  WaitTime:=0;
end;

procedure TForm1.Panel4Click(Sender: TObject);
begin
  if Current=4 then exit;
  Panel4.Color :=clRed;
  if dy=1 then UpStop[4]:=true
  else if dy=-1 then DownStop[4]:=true
  else
  begin
    if Current<4 then begin UpStop[4]:=true;end
    else begin DownStop[4]:=true;end;
  end;
  Timer_move.Enabled :=true;
  WaitTime:=0;
end;

procedure TForm1.Panel5Click(Sender: TObject);
begin
  if Current=5 then exit;
  Panel5.Color :=clRed;
  if dy=1 then UpStop[5]:=true
  else if dy=-1 then DownStop[5]:=true
  else
  begin
    if Current<5 then begin UpStop[5]:=true;end
    else begin DownStop[5]:=true;end;
  end;
  Timer_move.Enabled :=true;
  WaitTime:=0;
end;

procedure TForm1.Panel6Click(Sender: TObject);
begin
  if Current=6 then exit;
  Panel6.Color :=clRed;
  if dy=1 then UpStop[6]:=true
  else if dy=-1 then DownStop[6]:=true
  else
  begin
    if Current<6 then begin UpStop[6]:=true;end
    else begin DownStop[6]:=true;end;
  end;
  Timer_move.Enabled :=true;
  WaitTime:=0;
end;

procedure TForm1.Panel7Click(Sender: TObject);
begin
  if Current=7 then exit;
  Panel7.Color :=clRed;
  if dy=1 then UpStop[7]:=true
  else if dy=-1 then DownStop[7]:=true
  else
  begin
    if Current<7 then begin UpStop[7]:=true;end
    else begin DownStop[7]:=true;end;
  end;
  Timer_move.Enabled :=true;
  WaitTime:=0;
end;

procedure TForm1.Panel8Click(Sender: TObject);
begin
  if Current=8 then exit;
  Panel8.Color :=clRed;
  if dy=1 then UpStop[8]:=true
  else if dy=-1 then DownStop[8]:=true
  else
  begin
    if Current<8 then begin UpStop[8]:=true;end
    else begin DownStop[8]:=true;end;
  end;
  Timer_move.Enabled :=true;
  WaitTime:=0;
end;

procedure TForm1.Panel9Click(Sender: TObject);
begin
  if Current=9 then exit;
  Panel9.Color :=clRed;
//  DownStop
{  if dy=1 then UpStop[9]:=true
  else if dy=-1 then DownStop[9]:=true
  else
  begin
    if Current<9 then begin UpStop[9]:=true;end
    else begin DownStop[9]:=true;end;
  end;      }
  DownStop[9]:=true;
  Timer_move.Enabled :=true;
  WaitTime:=0;
end;

procedure TForm1.BitBtn1Click(Sender: TObject);
begin
  PlaySound('ring.wav',0,SND_ASYNC or SND_LOOP);
  Timer1.Enabled:=true ;
  Timer_move.Enabled :=false;
end;

procedure TForm1.Timer1Timer(Sender: TObject);
begin
  if Shape1.Brush.Color =clRed then
  begin
    Shape1.Brush.Color :=clGreen;
    Shape2.Brush.Color :=clGreen;
  end
  else
  begin
    Shape1.Brush.Color :=clRed;
    Shape2.Brush.Color :=clRed;
  end;
end;

procedure TForm1.BitBtn3Click(Sender: TObject);
var
  i:integer;
begin
  PlaySound(nil,0,0);
  Timer1.Enabled :=false;
  Timer_move.Enabled :=false;
  for i:=1 to 9 do
    myLabel[i].Caption :='电梯停用';
end;

procedure TForm1.BitBtn4Click(Sender: TObject);
var
  i:integer;
begin
  Timer_move.Enabled :=true;
  for i:=1 to 9 do
    myLabel[i].Caption :='电梯在'+inttostr(Current)+'楼';
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  Application.Terminate;
end;

procedure TForm1.Timer2Timer(Sender: TObject);
begin
       if door_state=OPENED then
       begin
        Inc(WaitTime);
        if WaitTime>=5 then
        begin
          WaitTime:=0;
          Door_control:=false;
          Timer_door.Enabled :=true;
        end;
       end;
end;

end.