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

📄 drawu.pas

📁 运筹学演示程序之运输问题
💻 PAS
📖 第 1 页 / 共 2 页
字号:
unit DrawU;

interface

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

type
  Smatrix=array [0..7,0..7] of string[10];
  Srec=array[0..7]of string[10];
  Point=record
    x,y:byte;
    end;
  Stack=array[1..10] of point;
  rcdraw=record
    data_type:byte;
      // data_type : 1 -> 演示数据   2 -> 小规模问题   3 -> 大规模问题
      //             4 -> 迭代中数据  5 -> 最终结果(小)  6 -> 最终结果(大)
    pc,sc:integer;
    title:string[30];
    produce,sale:srec;
    p2,s2:srec;
    label1,label2:string[30];
    type1,type2:byte;
      // 两个表格的显示方式
      // 1-> 运费表格式    2-> 检验表格式    3->调整表格式
    c,ma1,add:smatrix;
    ne1,ne2,sw1,sw2:string[6];
    txt1,txt2,txt3,txt4:string[200];
    st:stack;
  end;
  TShowForm = class(TForm)
    Label1: TLabel;
    Label2: TLabel;
    DriveComboBox1: TDriveComboBox;
    DirectoryListBox1: TDirectoryListBox;
    Label4: TLabel;
    BitBtn1: TBitBtn;
    BitBtn2: TBitBtn;
    ShowPanel: TPanel;
    DrawDesk: TPaintBox;
    SecPnl: TPanel;
    SecPB: TPaintBox;
    PopupMenu1: TPopupMenu;
    N1: TMenuItem;
    B1: TMenuItem;
    N2: TMenuItem;
    A1: TMenuItem;
    X1: TMenuItem;
    GroupBox1: TGroupBox;
    GroupBox2: TGroupBox;
    RadioButton1: TRadioButton;
    RadioButton2: TRadioButton;
    RadioButton4: TRadioButton;
    RadioButton5: TRadioButton;
    RadioButton6: TRadioButton;
    procedure FormCreate(Sender: TObject);
    procedure BitBtn1Click(Sender: TObject);
    procedure DrawDeskMouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure SecPnlMouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure SecPBMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure BitBtn2Click(Sender: TObject);
    procedure X1Click(Sender: TObject);
    procedure N1Click(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure DrawDeskMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure B1Click(Sender: TObject);
    procedure A1Click(Sender: TObject);
    procedure FormKeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
  private
    { Private declarations }
    ShowStep:integer;
    Showing,SecPnlOpen,SecPnlEnable:boolean;
    procedure cleanup(cnvs:Tcanvas);
    procedure CleanSecPnl;

//    procedure DrawMatrix(cnvs:Tcanvas;left,top,width,height,sc,pc:integer;
//              title:string);

    procedure DrawCost(cnvs:Tcanvas;left,top,width,height,sc,pc:integer;
              sale,produce:srec;c:Smatrix;title:string;
              sw,ne:string);
    procedure DrawCheck(cnvs:Tcanvas;left,top,width,height,sc,pc:integer;
              sale,produce:srec;c,add:Smatrix;title:string);
    procedure DrawAdjust(cnvs:Tcanvas;left,top,width,height,sc,pc:integer;
              sale,produce:srec;c:Smatrix;title:string;st:stack);
    procedure OpenSecPnl;
    procedure CloseSecPnl;
    function readdata:byte;
    procedure redraw;
    procedure show;
    function getfilename:string;
  public
    FileName:string;
    { Public declarations }
  end;

var
  ShowForm: TShowForm;

implementation

uses Main;

{$R *.DFM}
var rate:real;
    f:file of rcdraw;
    rec,old_rec:rcdraw;

procedure TShowForm.CleanSecPnl;
begin
  with secpb.canvas do
  begin
    pen.color:=secpb.color;
    brush.color:=secpb.color;
    rectangle(0,0,secpb.width,secpb.height);
  end;
end;

procedure TShowForm.cleanup(cnvs:Tcanvas);
begin
 with cnvs do
 begin
  pen.color:=clblack;
  brush.color:=clblack;
  rectangle(round(10*rate),round(50*rate),round(790*rate),round(350*rate));
  rectangle(round(10*rate),round(350*rate),round(790*rate),round(500*rate));
  pen.color:=cllime;
 end;
end;

procedure TShowForm.DrawAdjust(cnvs:Tcanvas;left,top,width,height,sc,pc:integer;
              sale,produce:srec;c:Smatrix;title:string;st:stack);
var h,w:integer;
    ht,wt:integer;
    i,j:integer;
  function in_stack(x,y:byte):boolean;
  var get:boolean;
      i:integer;
  begin
    get:=false;
    for i:=1 to 10 do
     if (st[i].x<100) then     // <100 表示存储着某个点的位置坐标。
       if ((x=st[i].x)and(y=st[i].y)) then
         get:=true;
    result:=get;
  end;
begin
//  rate:=640/800;
  left:=round(left*rate);
  top:=round(top*rate);
  width:=round(width*rate);
  height:=round(height*rate);
  h:=(height-round(55*rate))div pc;
  w:=(width-round(100*rate))div sc;
  ht:=height-(h * pc)-25;
  wt:=(width-(w * sc)) div 2-1;
  with Cnvs do
  begin
    pen.color:=claqua;
    pen.width:=1;
    rectangle(left,top,left+width,top+height);
    moveto(left,top+ht);   lineto(left+width,top+ht);
    moveto(left,top+height-25);    lineto(left+width,top+height-25);
    moveto(left+wt,top);   lineto(left+wt,top+height);
    moveto(left+wt+(w*sc),top);       lineto(left+wt+(w*sc),top+height);
    moveto(left,top);      lineto(left+wt,top+ht);
    font.size:=round(13*rate);
    font.Color:=clfuchsia;
    if (title<>'') then
      textout(left+(width-round(9*rate)*length(title))div 2,top-30,title);
    font.size:=round(12*rate);
    font.Color:=cllime;
    for i:=0 to sc-1 do
    begin
      textout(left+wt+(w*i)+(w div 2)-(4*length(sale[i])),
              top+height-22,sale[i]);
      textout(left+wt+(w*i)+(w div 2)-(4*length(inttostr(i+1))),
              top+round(8*rate),inttostr(i+1));
    end;
    for i:=0 to pc-1 do
    begin
      textout(left+width-wt+round(8*rate),
              top+ht+(h*i)+(h-round(12*rate)) div 2,produce[i]);
      textout(left+(wt div 2)-round(10*rate),
              top+ht+(h*i)+(h-round(12*rate)) div 2,inttostr(i+1));
    end;
    for i:=0 to pc-1 do for j:=0 to sc-1 do
    begin
      if (in_stack(j,i)) then
      begin
        font.color:=clwhite;
        font.size:=round(10*rate);
        textout(left+wt+(w*j)+(w div 2)-(4*length(c[i,j])),
              top+ht+(h*i)+(h-round(8*rate)) div 2,c[i,j]);
      end
      else
      begin
        font.color:=clgray;
        font.size:=round(12*rate);
        textout(left+wt+(w*j)+(w div 2)-(4*length(c[i,j])),
               top+ht+(h*i)+(h-round(12*rate)) div 2,c[i,j]);
      end;
    end;
    font.color:=clyellow;
    font.size:=round(10*rate);
    textout(left+(wt div 2)-10,top+height-20,'Bj');
    textout(left+width-(wt div 2)-10,top+round(8*rate),'Ai');
    font.size:=round(10*rate);
    textout(left+round(2*rate),top+(ht div 2)+round(2*rate),'产地');
    textout(left+wt-round(28*rate),top+round(2*rate),'销地');
    pen.color:=clred;
    pen.width:=1;
    pen.Style:=psDot;
    if (st[1].x<100) then
    begin
      moveto(left+wt+(w*st[1].x)+(w div 2),top+ht+(h*st[1].y)+(h div 2));
      for i:=2 to 10 do
        if (st[i].x<100) then
          lineto(left+wt+(w*st[i].x)+(w div 2),top+ht+(h*st[i].y)+(h div 2));
      lineto(left+wt+(w*st[1].x)+(w div 2),top+ht+(h*st[1].y)+(h div 2));
    end;
    pen.style:=psSolid;
  end;
end;

procedure TShowForm.DrawCheck(cnvs:Tcanvas;left,top,width,height,sc,pc:integer;
              sale,produce:srec;c,add:Smatrix;title:string);
var h,w:integer;
    ht,wt:integer;
    i,j:integer;
    x,y:integer;
  procedure do_check;
  var max,add_r,c_r:real;
      m,n:integer;
  begin
    max:=-1;  x:=-1;  y:=-1;
    for m:=0 to pc-1 do for n:=0 to sc-1 do
    begin
      if (add[m,n]<>'')then
      begin
        add_r:=strtofloat(add[m,n]);
        c_r:=strtofloat(c[m,n]);
        if (add_r>c_r) then
          if ((add_r-c_r)>max) then
          begin
            max:=add_r-c_r;
            x:=m;
            y:=n;
          end;
      end;
    end;
  end;
begin
//  rate:=640/800;
  do_check;
  left:=round(left*rate);
  top:=round(top*rate);
  width:=round(width*rate);
  height:=round(height*rate);
  h:=(height-round(55*rate))div pc;
  w:=(width-round(100*rate))div sc;
  ht:=height-(h * pc)-25;
  wt:=(width-(w * sc)) div 2-1;
  with Cnvs do
  begin
    pen.color:=claqua;
    pen.width:=1;
    rectangle(left,top,left+width,top+height);
    moveto(left,top+ht);   lineto(left+width,top+ht);
    moveto(left,top+height-25);    lineto(left+width,top+height-25);
    moveto(left+wt,top);   lineto(left+wt,top+height);
    moveto(left+wt+(w*sc),top);       lineto(left+wt+(w*sc),top+height);
    moveto(left,top);      lineto(left+wt,top+ht);
    for i:=1 to sc-1 do
    begin
      moveto(left+wt+(i*w),top+ht);   lineto(left+wt+(i*w),top+height-25);
    end;
    for i:=1 to pc-1 do
    begin
      moveto(left+wt,top+ht+(i*h));   lineto(left+wt+(sc*w),top+ht+(i*h));
    end;
    font.size:=round(13*rate);
    font.Color:=clfuchsia;
    if (title<>'') then
      textout(left+(width-round(9*rate)*length(title))div 2,top-30,title);
    font.size:=round(11*rate);
    font.Color:=cllime;
    for i:=0 to sc-1 do
    begin
      textout(left+wt+(w*i)+(w div 2)-(4*length(sale[i])),
              top+height-22,sale[i]);
//      textout(left+wt+(w*i)+16,top+round(8*rate),inttostr(i+1));
      textout(left+wt+(w*i)+(w div 2)-(4*length(inttostr(i+1))),
              top+round(8*rate),inttostr(i+1));
    end;
    for i:=0 to pc-1 do
    begin
      textout(left+width-wt+round(8*rate),
              top+ht+(h*i)+(h-round(12*rate)) div 2,produce[i]);
      textout(left+(wt div 2)-round(10*rate),
              top+ht+(h*i)+(h-round(12*rate)) div 2,inttostr(i+1));
    end;
    for i:=0 to pc-1 do for j:=0 to sc-1 do
    begin
      if (add[i,j]='') then
      begin
        font.color:=cllime;
        font.size:=round(11*rate);
        textout(left+wt+(w*j)+(w div 2)-(4*length(c[i,j])),
              top+ht+(h*i)+(h-round(12*rate)) div 2,c[i,j]);
      end
      else
      begin
        font.size:=round(9*rate);
        moveto(left+wt+(w*j),top+ht+h*(i+1));
        lineto(left+wt+w*(j+1),top+ht+h*i);
        font.color:=clgray;
        if ((i=x)and(j=y)) then
          font.color:=clred
        else
          font.color:=clwhite;
        textout(left+wt+(w*j)+(w div 4)-round(rate*2*length(add[i,j])),
                 top+ht+h*i+(h div 4)-round(4*rate),add[i,j]);
        textout(left+wt+w*j+round(3*w/4)-round(rate*2*length(c[i,j])),
                 top+ht+h*i+round(3*h/4)-round(8*rate),c[i,j]);
      end;
    end;
    font.color:=clyellow;
    font.size:=round(11*rate);
    textout(left+(wt div 2)-10,top+height-22,'Vj');
    textout(left+width-(wt div 2)-10,top+round(8*rate),'Ui');
    font.size:=round(10*rate);
    textout(left+round(2*rate),top+(ht div 2)+round(2*rate),'产地');
    textout(left+wt-round(28*rate),top+round(4*rate),'销地');
  end;
end;

procedure TShowForm.DrawCost(cnvs:Tcanvas;left,top,width,height,sc,pc:integer;
              sale,produce:srec;c:Smatrix;title:string;sw,ne:string);
var h,w:integer;
    ht,wt:integer;
    i,j:integer;
begin
//  rate:=640/800;
  left:=round(left*rate);
  top:=round(top*rate);
  width:=round(width*rate);
  height:=round(height*rate);
  h:=(height-round(55*rate))div pc;
  w:=(width-round(100*rate))div sc;
  ht:=height-(h * pc)-25;
  wt:=(width-(w * sc)) div 2-1;
  with Cnvs do
  begin
    pen.color:=claqua;
    pen.width:=1;
    rectangle(left,top,left+width,top+height);
    moveto(left,top+ht);   lineto(left+width,top+ht);
    moveto(left,top+height-25);    lineto(left+width,top+height-25);
    moveto(left+wt,top);   lineto(left+wt,top+height);
    moveto(left+wt+(w*sc),top);       lineto(left+wt+(w*sc),top+height);
    moveto(left,top);      lineto(left+wt,top+ht);
    font.size:=round(13*rate);
    font.Color:=clfuchsia;
    if (title<>'') then
      textout(left+(width-round(9*rate)*length(title))div 2,top-30,title);
    font.size:=round(12*rate);
    font.Color:=cllime;
    for i:=0 to sc-1 do
    begin
      textout(left+wt+(w*i)+(w div 2)-(4*length(sale[i])),
              top+height-22,sale[i]);
      textout(left+wt+(w*i)+(w div 2)-(4*length(inttostr(i+1))),
              top+round(8*rate),inttostr(i+1));
    end;
    for i:=0 to pc-1 do
    begin
      textout(left+width-wt+round(8*rate),
              top+ht+(h*i)+(h-round(12*rate)) div 2,produce[i]);
      textout(left+(wt div 2)-round(10*rate),
              top+ht+(h*i)+(h-round(12*rate)) div 2,inttostr(i+1));
    end;
    font.color:=clwhite;
    for i:=0 to pc-1 do for j:=0 to sc-1 do
        textout(left+wt+(w*j)+(w div 2)-(4*length(c[i,j])),
              top+ht+(h*i)+(h-round(12*rate)) div 2,c[i,j]);
    font.color:=clyellow;
    font.size:=round(10*rate);
    textout(left+(wt div 2)-4*length(sw),top+height-20,sw);
    textout(left+width-(wt div 2)-4*length(sw),top+round(8*rate),ne);
    font.size:=round(10*rate);
    textout(left+round(2*rate),top+(ht div 2)+round(2*rate),'产地');
    textout(left+wt-round(28*rate),top+round(2*rate),'销地');
  end;
end;

{
procedure Tform1.DrawMatrix(cnvs:Tcanvas;
           left,top,width,height,sc,pc:integer;title:string);
var h,w:integer;
    ht,wt:integer;
    i:integer;
begin
  left:=round(left*rate);
  top:=round(top*rate);
  width:=round(width*rate);
  height:=round(height*rate);
  h:=(height-round(55*rate))div pc;
  w:=(width-round(100*rate))div sc;
  ht:=height-(h * pc)-25;
  wt:=(width-(w * sc)) div 2-1;
  with Cnvs do
  begin
    pen.color:=claqua;
    pen.width:=1;
    rectangle(left,top,left+width,top+height);
    moveto(left,top+ht);   lineto(left+width,top+ht);
    moveto(left,top+height-25);    lineto(left+width,top+height-25);
    moveto(left+wt,top);   lineto(left+wt,top+height);
    moveto(left+wt+(w*sc),top);       lineto(left+wt+(w*sc),top+height);
    moveto(left,top);      lineto(left+wt,top+ht);

⌨️ 快捷键说明

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