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

📄 run.~pas

📁 dephi 7.0实现的TDMA工作原理.用于演示TDMA的工作流程
💻 ~PAS
📖 第 1 页 / 共 2 页
字号:
unit run;

interface

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

type
  Trunfrm = class(TForm)
    Timer1: TTimer;
    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;
    GroupBox19: TGroupBox;
    GroupBox20: TGroupBox;
    Image_Rv: TImage;
    Label49: TLabel;
    Label50: TLabel;
    Label51: TLabel;
    Label52: TLabel;
    Label53: TLabel;
    Label54: TLabel;
    Label55: TLabel;
    GroupBox21: TGroupBox;
    Image_wait: TImage;
    Image_tran: TImage;
    Image_stop: TImage;
    Image_data: TImage;
    Image_data4: TImage;
    Image_data1: TImage;
    Image_data5: TImage;
    Image_data2: TImage;
    Image_data3: TImage;
    Image_data6: TImage;
    Label56: TLabel;
    Label57: TLabel;
    Label58: TLabel;
    Label59: TLabel;
    Label60: 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 creatdata();
    procedure senddata();
    procedure BitBtn5Click(Sender: TObject);

  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  runfrm: Trunfrm;
  procedure TimeDelay(DT:WORD);

implementation

uses main, adduser, run3, adduser2;

{$R *.dfm}
procedure TimeDelay(DT:WORD);
var
 TT:DWORD;
 begin
 TT:=GetTickCount();
 while GetTickCount()-TT<DT do
   Application.ProcessMessages;
 end;

procedure Trunfrm.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 Trunfrm.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
   if user_stop[i]=true then
      image_state[i].Canvas.CopyRect(target_dct,image_stop.Canvas,source_dct)
   else
      image_state[i].Canvas.CopyRect(target_dct,image_wait.Canvas,source_dct);
   if check_box[i].Checked then
      user_state_label[i].Caption:='等待'
   else
      user_state_label[i].Caption:='---';
   end;
end;

procedure Trunfrm.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 Trunfrm.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;
   
   end;


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

end;

procedure Trunfrm.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 Trunfrm.ask_hardware();
begin


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

procedure Trunfrm.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();

//激活计时器
timer1.enabled:=true;
end;

procedure Trunfrm.request_hardware();     //发送请求队列       时隙分配
var
   i,ii,iii,j,m,n,l,p,k,x:integer;
   goon,goon2:boolean;
   user_pri_temp:array[1..6]of byte;
   sended_data_temp:array[1..6]of integer;
   user_length_temp:array[1..6]of integer;
   max_length:integer;
   max_pri:byte;           //最高优先级
   max_user:byte;          //最高优先级用户
begin

//简单模式
if mode_select=1 then
   begin
   for i:=1 to 6 do
      begin
      if user_request[i]<>0 then       //用户有请求
         begin
         j:=0;
         goon:=true;
         while(goon) do    //寻找空闲时隙
            begin
            if timegap[j]=0 then
               begin
               timegap[j]:=i;      //分配时隙
               user_length[i]:=user_request[i];      //数据长度
               user_request[i]:=0;                 //清除请求队列
               goon:=false;
               end;
            j:=j+1;
            if j=6 then
               goon:=false;
            end;
         end;
      end;
   end
//优化模式
else if mode_select=2 then
   begin
   for i:=1 to 6 do
      begin
      timegap[i-1]:=0;
      user_pri_temp[i]:=user_pri[i];
      sended_data_temp[i]:=sended_data[i];
      user_pri_label[i].Caption:=inttostr(user_pri[i]);
      if user_request[i]<>0 then
         begin
         user_length[i]:=user_request[i];      //数据长度
         user_request[i]:=0;                 //清除请求队列
         end;
      //memo1.lines.add(inttostr(user_pri[i]));
      end;

   //遍历时隙
   for i:=0 to 5 do
      begin
      //将当前时隙分配给优先级最高的用户
      max_pri:=0;
      max_user:=0;
      for ii:=1 to 6 do
         begin
         if (user_pri_temp[ii]>max_pri)and(sended_data_temp[ii]<user_length[ii]) then
            begin
            max_pri:=user_pri_temp[ii];
            max_user:=ii;
            end;
         end;

      user_pri_temp[max_user]:=user_pri_temp[max_user]-1;
      sended_data_temp[max_user]:=sended_data_temp[max_user]+1;

      //分配时隙
      timegap[i]:=max_user;
      end;
   end
//大作业优先模式
else if mode_select=3 then
  begin
   for i:=1 to 6 do
      begin
      timegap[i-1]:=0;
     // user_length_temp[i]:=user_request[i];
      sended_data_temp[i]:=sended_data[i];
      memo1.lines.add(inttostr(sended_data_temp[i]));
      //user_pri_label[i].Caption:=inttostr(user_pri[i]);
      if user_request[i]<>0 then
         begin
         user_length[i]:=user_request[i];      //数据长度
         user_request[i]:=0;                 //清除请求队列
         end;
      //memo1.lines.add(inttostr(user_pri[i]));
      user_length_temp[i]:=user_length[i];
      user_pri_label[i].Caption:=inttostr(user_length[i]);
      end;

   //遍历时隙
   for i:=0 to 5 do
      begin
      //将当前时隙分配给作业量最高的用户
      max_length:=0;
      max_user:=0;
      for ii:=1 to 6 do
         begin
         if (user_length_temp[ii]>max_length)and(sended_data_temp[ii]<user_length[ii]) then
            begin
            max_length:=user_length_temp[ii];
            max_user:=ii;
            end;
         end;

      user_length_temp[max_user]:=user_length_temp[max_user]-1;

⌨️ 快捷键说明

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