PHẦN PHỤ LỤC Phụ lục Unit chứa khai báo cấu trúc liệu cho đồ thị cài đặt thủ tục tìm đường ngắn theo thuật toán unit Func_DoThi; interface type TypeToaDo=record x,y:integer; end; TypeChiPhi=record VoCung:boolean;//Neu VoCung=True thi co nghia la chi phi bang Vo Cung, nguoc lai thi chi phi bang Gia Gia:real; end; TypeDinh=record Ten:String; ToaDo:TypeToaDo; MucKichHoat:Byte; end; TypeDanhSachDinh=array of TypeDinh; TypeCanh=record DinhDau,DinhCuoi:Integer;//Tham chieu danh sach Dinh TrongSo:TypeChiphi; end; TypeDanhSachCanh=Array of TypeCanh; TypeDoThi=Record SoDinh:Integer; DSDinh:TypeDanhSachDinh; SoCanh:Integer; DSCanh:TypeDanhSachCanh; end; TypeCost=Array of Array of TypeChiPhi; TypeDist=Array of TypeChiPhi; TypeDuongDi=Array of Integer; Function DuongDiNganNhat(G:TypeDoThi;X,Y:Integer;Var DuongDiTuXdenY:TypeDuongDi;Var ChiPhi:real):Boolean; Procedure DeleteGraph(VAR G:TypeDoThi); var G:TypeDoThi; 135 implementation Function DuongDiNganNhat(G:TypeDoThi;X,Y:Integer;Var DuongDiTuXdenY:TypeDuongDi;var ChiPhi:real):Boolean; Var s:Array of byte;{S[i]=0 hoac S[i]=1} Cost:TypeCost;Dist:TypeDist;MocXich:Array of Integer; M,i,j,K,u,w:Integer; Min:TypeChiPhi; begin M:=G.SoDinh; {Thuc M=N, ma tran vuong kich thuoc MxM} Setlength(Cost,M,M); Setlength(Dist,M); Setlength(MocXich,M); Setlength(S,M); for i:=0 to M-1 for j:=0 to M-1 Cost[i,j].VoCung:=True; for k:=0 to G.SoCanh-1 begin i:=G.DSCanh[K].DinhDau;j:=G.DSCanh[K].DinhCuoi; Cost[i,j]:=G.DSCanh[K].TrongSo; end; for i:=0 to M-1 begin S[i]:=0;Dist[i]:=Cost[X,i];MocXich[i]:=X;end; S[X]:=1;Dist[X].VoCung:=False;Dist[X].Gia:=0;K:=2; {Dua X vao S} while k(Dist[u].Gia+Cost[u,w].Gia))) then 136 begin Dist[w].VoCung:=false; Dist[w].Gia:=Dist[u].Gia+Cost[u,w].Gia; MocXich[w]:=u;{Duong di ngan nhat den W thi phai di qua U} end; end; end; {Tim duong di tu X den Y} Setlength(DuongDiTuXdenY,M); If not Dist[Y].VoCung then begin DuongDiNganNhat:=true; ChiPhi:=Dist[Y].gia; {Xac dinh cac dinh phai di qua (theo day chuyen nguoc)} {k:=0;DuongDiTuXdenY[k]:=Y;k:=k+1; i:=MocXich[Y];DuongDiTuXdenY[k]:=i;} K:=0;i:=Y;DuongDiTuXdenY[k]:=i; while iX begin i:=MocXich[i];k:=k+1;DuongDiTuXdenY[k]:=i; end; {Vi chuoi chua DuongDiTuXdenY la mot chuoi nguoc nen ta se dao lai} for i:=0 to (k div 2) begin j:=DuongDiTuXdenY[i]; DuongDiTuXdenY[i]:=DuongDiTuXdenY[K-i]; DuongDiTuXdenY[K-i]:=j; end; {Dat lai kich thuoc cua mang DuongDiTuXdenY bang so dinh phai di qua} Setlength(DuongDiTuXdenY,K+1); end else DuongDiNganNhat:=false; Setlength(Cost,0,0); Setlength(Dist,0); Setlength(MocXich,0); Setlength(S,0); end; Procedure DeleteGraph(VAR G:TypeDoThi); begin G.SoDinh:=0; G.SoCanh:=0; Setlength(G.DSDinh,0); Setlength(G.DSCanh,0); end; BEGIN G.SoDinh :=0;G.SoCanh:=0; END 137 Thiết kế giao diện cho chương trình (Form 2) Với đối tượng gồm: Các khai báo cài đặt cho chương form2: unit Unit2; 138 interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, Mask, Buttons, ExtCtrls,Func_Dothi,Func_Graph, Menus,IdGlobal, ImgList,Jpeg; const BanKinh=20; RMuiTen=10; type TForm2 = class(TForm) Panel1: TPanel; MaskEdit1: TMaskEdit; MaskEdit2: TMaskEdit; StaticText1: TStaticText; StaticText2: TStaticText; MainMenu1: TMainMenu; imduongdingannhat1: TMenuItem; imduongdingannhat2: TMenuItem; Caykhungbenhat1: TMenuItem; Image1: TImage; PopupMenu1: TPopupMenu; Rename1: TMenuItem; Delete1: TMenuItem; N1: TMenuItem; N2: TMenuItem; ImageList1: TImageList; File1: TMenuItem; New1: TMenuItem; Open1: TMenuItem; Save1: TMenuItem; N3: TMenuItem; Exit1: TMenuItem; ScrollBox1: TScrollBox; PaintBox1: TPaintBox; Save2: TMenuItem; N6: TMenuItem; ExportPicturefile1: TMenuItem; DeleteAll1: TMenuItem; SaveDialog1: TSaveDialog; OpenDialog1: TOpenDialog; ImageList2: TImageList; SpeedButton1: TSpeedButton; SpeedButton2: TSpeedButton; ExportPicturefile2: TMenuItem; N4: TMenuItem; procedure PaintBox1DragDrop(Sender, Source: TObject; X, Y: Integer); 139 procedure PaintBox1DragOver(Sender, Source: TObject; X, Y: Integer; State: TDragState; var Accept: Boolean); Procedure DrawPaint(PaintBox:TPaintBox;Bitmap:TBitmap); procedure FormResize(Sender: TObject); procedure FormCreate(Sender: TObject); function DownDinh(x,y:integer;G:TypeDothi):integer; procedure PaintBox1MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); procedure PaintBox1MouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer); procedure PaintBox1MouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); procedure HienThamSoCung(G:TypeDoThi); procedure MaskEdit1Change(Sender: TObject); procedure MaskEdit2Change(Sender: TObject); procedure PaintBox1Paint(Sender: TObject); procedure imduongdingannhat2Click(Sender: TObject); procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean); procedure FormDestroy(Sender: TObject); procedure Rename1Click(Sender: TObject); procedure Exit1Click(Sender: TObject); procedure Delete1Click(Sender: TObject); procedure DeleteAll1Click(Sender: TObject); procedure Save1Click(Sender: TObject); procedure Open1Click(Sender: TObject); procedure SpeedButton1Click(Sender: TObject); procedure SpeedButton2Click(Sender: TObject); procedure New1Click(Sender: TObject); procedure ExportPicturefile2Click(Sender: TObject); private { Private declarations } public { Public declarations } end; var Form2: TForm2; Pic:Tbitmap; Mouse_Down:Boolean; Dx,Dy,DinhDown:Integer; TextSizeTrongSo:Integer=10; Filename:String; FileChanged:Boolean; procedure Vecung(Pic:Tbitmap;T1,T2:TypeToaDo;Gia:Real;Line:Boolean;LineColor,TextColor:T color); Procedure VeDoThi(G:TypeDothi;Pic:Tbitmap;Imagelist:Timagelist); Function Delen(x,y,Width,Height:integer;DinhDown:integer):boolean; 140 Procedure Veline(T1,T2:TypeToaDo;Gia:real;Pic:Tbitmap;LineColor:Tcolor;TimeDelay:TdateTi me); implementation {$R *.dfm} Function MidPoint(T1,T2:TypeToaDo;PhanTram:Integer):TypeToaDo; Var Dx,Dy:integer; begin Dx:=T2.x -T1.x ;Dy:=T2.y -T1.y ; MidPoint.x:=T1.x +Round(Dx*PhanTram/100); MidPoint.y:=T1.y +Round(Dy*PhanTram/100); end; Procedure Veline(T1,T2:TypeToaDo;Gia:real;Pic:Tbitmap;LineColor:Tcolor;TimeDelay:TdateTi me); var i:integer;T3:TypeToaDo;TimeNow:TDateTime; TempPic:Tbitmap; begin TempPic:=Tbitmap.Create; For i:=1 to 100 begin TempPic.Assign(Pic); TimeNow:=Time; T3:=MidPoint(T1,T2,i); Vecung(TempPic,T1,T3,Gia,True,RGB(255,0,0),RGB(0,0,255)); Form2.DrawPaint(Form2.PaintBox1,TempPic); repeat Application.ProcessMessages; until (TimeNow+TimeDelay)>Time; end; TempPic.Free; end; Procedure TForm2.DrawPaint(PaintBox:TPaintBox;Bitmap:TBitmap); begin Paintbox.Canvas.Draw(0,0,Bitmap); end; procedure CatZeroThua(var St:string); var i,P,L:integer; begin L:=length(st); If St[L]=' ' then begin delete(st,1,L);L:=length(st);end; P:=pos('.',st);i:=L; If P=0 then exit; while (i>P)and(st[i]='0') i:=i-1; 141 If st[i]='.' then i:=i-1; delete(St,i+1,L-i); end; Function Quay(P,Tam:TypeToaDo;Goc:Real):TypeToaDo; Var Q:TypeToaDo; begin Goc:=Goc*Pi/180; P.x:=P.x-Tam.x; P.y:=P.y-Tam.y; Q.x:=Round(P.x*Cos(goc)-P.y*Sin(goc)); Q.y:=Round(P.x*Sin(goc)+P.y*Cos(goc)); Q.x:=Q.x+Tam.x; Q.y:=Q.y+Tam.y; Quay:=Q; end; procedure Vecung(Pic:Tbitmap;T1,T2:TypeToaDo;Gia:Real;Line:Boolean;LineColor,TextColor:T color); var DX,DY,X,Y:Integer;P,Q1,Q2:TypeToaDo;L,TL:real;St:String; begin DX:=T2.x-T1.x;DY:=T2.y-T1.y; L:=sqrt(DX*DX+DY*DY); if L