run3.~pas

dephi 7.0实现的TDMA工作原理.用于演示TDMA的工作流程

unit run3;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, Buttons, ExtCtrls, pubdata, jpeg,ThreadparaIO,
  TeEngine, Series, TeeProcs, Chart;

type
  Trunfrm3 = class(TForm)
    Image_data: TImage;
    Timer1: TTimer;
    Image_wait: TImage;
    Image_tran: TImage;
    Image_stop: TImage;
    GroupBox13: TGroupBox;
    CheckBox1: TCheckBox;
    CheckBox2: TCheckBox;
    CheckBox3: TCheckBox;
    CheckBox4: TCheckBox;
    CheckBox5: TCheckBox;
    CheckBox6: TCheckBox;
    Image14: TImage;
    Image15: TImage;
    Image16: TImage;
    Image17: TImage;
    Image18: TImage;
    Image19: TImage;
    GroupBox1: TGroupBox;
    Image2: TImage;
    GroupBox2: TGroupBox;
    Image3: TImage;
    GroupBox3: TGroupBox;
    Image4: TImage;
    GroupBox4: TGroupBox;
    Image5: TImage;
    GroupBox5: TGroupBox;
    Image6: TImage;
    GroupBox6: TGroupBox;
    Image7: TImage;
    GroupBox7: TGroupBox;
    Image8: TImage;
    GroupBox8: TGroupBox;
    Image9: TImage;
    GroupBox9: TGroupBox;
    Image10: TImage;
    GroupBox10: TGroupBox;
    Image11: TImage;
    GroupBox11: TGroupBox;
    Image12: TImage;
    GroupBox12: TGroupBox;
    Image13: TImage;
    Label3: TLabel;
    Label4: TLabel;
    GroupBox14: TGroupBox;
    GroupBox15: TGroupBox;
    BitBtn3: TBitBtn;
    BitBtn2: TBitBtn;
    BitBtn1: TBitBtn;
    Memo1: TMemo;
    BitBtn4: TBitBtn;
    Label1: TLabel;
    Label5: TLabel;
    GroupBox16: TGroupBox;
    Label6: TLabel;
    GroupBox17: TGroupBox;
    Label9: TLabel;
    Label10: TLabel;
    Label11: TLabel;
    Label12: TLabel;
    Label13: TLabel;
    Label14: TLabel;
    Label15: TLabel;
    Label16: TLabel;
    Label7: TLabel;
    Label8: TLabel;
    Label17: TLabel;
    Label18: TLabel;
    Label19: TLabel;
    Label20: TLabel;
    Label21: TLabel;
    Label24: TLabel;
    Label25: TLabel;
    Label22: TLabel;
    Label23: TLabel;
    Label26: TLabel;
    Label27: TLabel;
    Label28: TLabel;
    Label29: TLabel;
    Label30: TLabel;
    Label31: TLabel;
    Label32: TLabel;
    GroupBox18: TGroupBox;
    Label33: TLabel;
    Label34: TLabel;
    Label35: TLabel;
    Label36: TLabel;
    Label37: TLabel;
    Label38: TLabel;
    Label39: TLabel;
    Label40: TLabel;
    Label41: TLabel;
    Label42: TLabel;
    Label43: TLabel;
    Label44: TLabel;
    Label45: TLabel;
    Label46: TLabel;
    RadioButton1: TRadioButton;
    RadioButton2: TRadioButton;
    RadioButton3: TRadioButton;
    Label47: TLabel;
    Label2: TLabel;
    Label48: TLabel;
    Image_data1: TImage;
    Image_data2: TImage;
    Image_data3: TImage;
    Image_data4: TImage;
    Image_data5: TImage;
    Image_data6: TImage;
    GroupBox19: TGroupBox;
    GroupBox20: TGroupBox;
    Image_Rv: TImage;
    Label49: TLabel;
    Image1: TImage;
    Label50: TLabel;
    Label51: TLabel;
    Label52: TLabel;
    Label53: TLabel;
    Label54: TLabel;
    Label55: TLabel;
    Label56: TLabel;
    Label57: TLabel;
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure FormDestroy(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
    procedure BitBtn2Click(Sender: TObject);
    procedure BitBtn3Click(Sender: TObject);
    procedure BitBtn1Click(Sender: TObject);
    procedure ask_hardware();
    procedure image_show(a:Timage;k:integer);
    procedure CheckBox1Click(Sender: TObject);
    procedure CheckBox2Click(Sender: TObject);
    procedure CheckBox3Click(Sender: TObject);
    procedure CheckBox4Click(Sender: TObject);
    procedure CheckBox5Click(Sender: TObject);
    procedure CheckBox6Click(Sender: TObject);
    procedure initialize_user(i:integer);           //用户初始化
    procedure data_show(p,k:integer;m:string);
    procedure hardware_answer();
    procedure request_hardware();
    procedure FormCreate(Sender: TObject);
    procedure initialize_image_state();
    procedure usercancel(k:integer);             //用户退出
    procedure checkbox_click(k:integer);
    procedure BitBtn4Click(Sender: TObject);
    procedure RadioButton2Click(Sender: TObject);
    procedure RadioButton1Click(Sender: TObject);
    procedure RadioButton3Click(Sender: TObject);
    procedure initialize_image_label();
    procedure rvdata_show(k,g,c:integer;m:string);
    procedure advantage(m:integer);
    procedure ask();
    procedure creatdata();//k为用户号 ,g为时隙号
    procedure senddata();
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  runfrm3: Trunfrm3;
  procedure TimeDelay(DT:WORD);

implementation

uses  main,adduser, run,run2, adduser2;

{$R *.dfm}


procedure TimeDelay(DT:WORD);
var
 TT:DWORD;
 begin
 TT:=GetTickCount();
 while GetTickCount()-TT<DT do
   Application.ProcessMessages;
 end;

procedure Trunfrm3.usercancel(k:integer);        //用户退出
var
   i:integer;
   cancel_confirm:boolean;
begin
//若用户在请求队列中，则取消之
user_request[k]:=0;

cancel_confirm:=false;
//检查是否已给该用户分配了时隙
for i:=0 to 5 do
   begin
   if timegap[i]=k then
      cancel_confirm:=true;
   end;

//用户加入撤销队列
if cancel_confirm then
   begin
   user_cancel[k]:=true;

   //show
   if label19.Caption='' then
      label19.Caption:=inttostr(k)
   else
      label19.Caption:=label19.Caption+'、'+inttostr(k);
   user_request_label[k].Caption:='请求退出';

   end;
end;

procedure Trunfrm3.initialize_image_state();          //初始化状态图标
var
   i:integer;
   Dct:TRect;
   target_dct,source_dct:TRect;
begin
target_dct:=rect(0,0,32,32);
source_dct:=rect(0,0,32,32);
for i:=1 to 6 do
   begin
   image_state[i].Canvas.CopyRect(target_dct,image_wait.Canvas,source_dct);
   if check_box[i].Checked=true then
      user_state_label[i].Caption:='等待'
   else
      user_state_label[i].Caption:='---';
   end;
end;

procedure Trunfrm3.data_show(p,k:integer;m:string);     //k:用户号   p:数据长度    m:发送(S)或接收(R)
var
   i:integer;
   source_dct,target_dct:TRect;
   left,right:integer;
   Dct:TRect;
begin
source_dct:=rect(0,0,16,16);

//清空作图区
if m='S' then
   begin
   image_S[k].Canvas.Brush.Color:=RGB(165,203,247);
   Dct:=Rect(0,0,160,16);
   image_S[k].Canvas.FillRect(Dct);              {擦除上次绘图}
   end
else if m='R' then
   begin
   image_R[k].Canvas.Brush.Color:=RGB(165,203,247);
   Dct:=Rect(0,0,160,16);
   image_R[k].Canvas.FillRect(Dct);              {擦除上次绘图}
   end;

//显示
for i:=1 to p do
   begin
   if m='S' then                 //发送
      begin
      //left:=160-i*16;
      //right:=left+16;
      left:=16*(i-1);
      right:=left+16;
      target_dct:=rect(left,0,right,16);
      image_S[k].Canvas.CopyRect(target_dct,image_datas[k].Canvas,source_dct);
      end
   else if m='R' then            //接收
      begin
      //left:=16*(i-1);
      //right:=left+16;
      left:=160-i*16;
      right:=left+16;
      target_dct:=rect(left,0,right,16);
      image_R[k].Canvas.CopyRect(target_dct,image_datas[k].Canvas,source_dct);
      //image_Rv.Canvas.CopyRect(target_dct,image_datas[k].Canvas,source_dct);
      end;
   end;
end;

procedure Trunfrm3.rvdata_show(k,g,c:integer;m:string);
var
 source_dct,target_dct:TRect;
 left,right,f:integer;
begin
  f:=(c-1) div 10 ;

 left:=16*(g+6*(c-1-10*f));
 right:=left+16;
 source_dct:=rect(0,0,16,16);
 target_dct:=rect(left,(0+16*f),right,(16+16*f));

 if  m='Y' then
 begin
   Image_Rv.Canvas.CopyRect(target_dct,image_datas[k].Canvas,source_dct);
   end
 else if m='N' then
   begin
   image_rv.Canvas.CopyRect(target_dct,image_data.Canvas,source_dct);
   end;
  if m='b' then
   image_rv.Canvas.CopyRect(target_dct,image1.Canvas,source_dct);

   end;


procedure Trunfrm3.initialize_user(i:integer);                   //用户初始化
begin
user_length[i]:=0;
sended_data[i]:=0;
check_box[i].Checked:=false;
user_state_label[i].Caption:='---';
//清空画图区

end;

procedure Trunfrm3.image_show(a:Timage;k:integer);
var
   source_dct,target_dct:TRect;
   left,right:integer;
begin
source_dct:=rect(0,0,33,33);
left:=33*(k-1);
right:=left+33;
target_dct:=rect(left,0,right,33);

//a.Canvas.CopyRect(target_dct,image1.Canvas,source_dct);

end;

procedure Trunfrm3.ask_hardware();
begin


//激发硬件回答过程
hardware_answer();
end;

procedure Trunfrm3.hardware_answer();  //模拟硬件应答
var
   i:integer;
begin
for i:=1 to 6 do
   begin
   //清空请求队列
   //user_request[i]:=0;

   //清空撤销队列
   user_cancel[i]:=false;

   //SHOW
   if timegap[i-1]=0 then
      timegap_state_label[i].Caption:='未分配'
   else
      timegap_state_label[i].Caption:='用户'+inttostr(timegap[i-1]);

   user_request_label[i].Caption:='无请求';

   end;

label18.Caption:='';
label19.Caption:='';

creatdata();
senddata();
//激活计时器
if timer1_b=false then
runfrm3.timer1.enabled:=true;
end;

procedure Trunfrm3.request_hardware();     //向硬件发送请求队列
var
   i,j,m,l,p,k,x,b,e:integer;
   //goon:boolean;
   source_dct,target_dct:TRect;
begin
  //goon:=true;
  l:=0;
  m:=1;
  timer1_b:=false;
for i:=1 to 6 do
  begin
  if (user_request[i]>0) {or (user_wait[i]>0)} then
      begin
      in_user[m]:=i;
      //memo1.Lines.Add(inttostr(in_user[m]));
      m:=m+1;
      end;
      end;         //m-1是请求加入的用户数量

 n:=1;

 for j:=0 to 5 do
  begin
  if timegap[j]=0 then
     begin
      free_gap[n]:=j+1;
      //memo1.Lines.Add(inttostr(free_gap[n]));
      n:=n+1;
     end;           //n-1是空闲的时隙数量
   end;

 //for b:=1 to 6 do
   //memo1.Lines.Add('user_request['+inttostr(b)+']='+inttostr(user_request[b]));

  if m>1 then //用户假如有请求
  begin
  //memo1.Lines.Add('error');
 l:=(n-1) div (m-1);

    if n-1=0 then     //假如无空闲时隙
    begin
     for e:=1 to m-1 do
      begin
       source_dct:=rect(0,0,32,32);
       target_dct:=rect(0,0,32,32);
       image_state[in_user[e]].Canvas.CopyRect(target_dct,image_stop.Canvas,source_dct);
      end;

     if aduser_state=false then
      begin
      timer1_b:=true;
      runfrm2.Visible:=true;
      runfrm2.Show;
      end;
      advantage(m);
      //ask();
      end

    else if n-1>0 then  //如果有空闲时隙
      begin

      x:=0;
  //in_user值是加入用户号
  //free_gap值是空闲时隙号
    memo1.lines.add ('\\\\\\\\\\\\\\\\\\\\');
    memo1.lines.add('★时隙分配过程:');
  for p:=1 to(m-1) do
   begin

    for  k:=1 to l do
      begin

     timegap[free_gap[k+x]-1]:=in_user[p] ;
     user_length[in_user[p]]:=user_request[in_user[p]];

     memo1.Lines.Add('timegap['+inttostr(free_gap[k+x]-1)+']:=用户号'+inttostr(in_user[p]));
     memo1.Lines.Add('传输数据长度'+inttostr(user_length[in_user[p]])) ;

     end;

     user_request[in_user[p]]:=0;
     x:=x+l;
     end;
     end;
     end;
     {else if m=1 then
     begin
     for d:=0 to 5 do
     timegap[d]:=timegap[d];
     end;}

  //for b:=1 to 6 do
   //memo1.Lines.Add('user_request['+inttostr(b)+']='+inttostr(user_request[b]));
   memo1.Lines.Add('\\\\\\\\\\\\\\\\\\\\');
   memo1.lines.add('★时隙分配情况总览:');
   memo1.Lines.Add('请求加入的用户数量:'+inttostr(m-1));
   memo1.lines.add('空闲时隙数量:'+inttostr(n-1));
   memo1.lines.add('每个用户分配的时隙数量:'+inttostr(l));
  for b:=0 to 5 do
   memo1.Lines.Add('timegap['+inttostr(b)+']='+inttostr(timegap[b]));





//模拟硬件处理用户退出请求
for i:=1 to 6 do
   begin
   if user_cancel[i]=true then      //用户退出
      begin
      //回收已分配给用户i的时隙
      for j:=0 to 5 do
         begin
         if timegap[j]=i then
            timegap[j]:=0;
         end;
      //接受撤销请求，用户初始化
      initialize_user(i);
      user_pri[i]:=0;
      end;
   end;

   //激发硬件回答过程
   hardware_answer();
end;



procedure Trunfrm3.advantage(m:integer);  //m-1是请求加入的用户的数量

var
  i,j:integer;
  goon:boolean;
begin
    goon:=false;
   for i:=1 to m-1 do