Unit chứa khai báo các cấu trúc dữ liệu cho đồ thị và cài đặt thủ tục tìm đường đi ngắn nhất theo thuật toán

PHẦN PHỤ LỤC Phụ lục 1 Unit chứa khai báo các cấu trúc dữ liệu cho đồ thị và cài đặt thủ tục tìm đường đi ngắn nhất 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 trong 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 ra 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 do for j:=0 to M-1 do Cost[i,j].VoCung:=True; for k:=0 to G.SoCanh-1 do 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 do 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<M do {Xac dinh M-1 duong di} begin u:=0; While S[u]<>0 do u:=u+1; Min:=Dist[u];i:=u+1; While i<M do begin If S[i]=0 then If ((Min.VoCung)and(not Dist[i].VoCung))or ((Not min.VoCung)and((not Dist[i].VoCung)and(min.Gia>Dist[i].Gia))) then begin Min:=Dist[i];u:=i;end; i:=i+1; end; S[u]:=1;k:=k+1;{Dua u vao tap S} For w:=0 to M-1 do if S[w]=0 then begin If (not Dist[u].VoCung)and(not Cost[u,w].VoCung)and ((Dist[w].VoCung)or(Dist[w].Gia>(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 i<>X do begin i:=MocXich[i];k:=k+1;DuongDiTuXdenY[k]:=i; end; {Vi chuoi chua trong DuongDiTuXdenY la mot chuoi nguoc nen ta se dao lai} for i:=0 to (k div 2) do 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 các đối tượng được gồm: Các khai báo và 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 do 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') do 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<=2*Bankinh then exit; TL:=BanKinh/L; Q1.X:=round(T1.x+DX*TL); Q1.Y:=round(T1.y+DY*TL); Q2.X:=round(T2.x-DX*TL); Q2.Y:=round(T2.y-DY*TL); T1:=Q1;T2:=Q2; DX:=T2.x-T1.x;DY:=T2.y-T1.y; L:=sqrt(DX*DX+DY*DY); If L=0 then exit; TL:=RMuiTen/L; P.X:=round(T2.x-DX*TL); P.Y:=round(T2.y-DY*TL); Q1:=Quay(P,T2,-35); Q2:=Quay(P,T2,35); pic.Canvas.Brush.Style:=bsSolid; pic.Canvas.Brush.Color:=LineColor; pic.Canvas.Pen.Color:=LineColor; If Line then begin pic.Canvas.MoveTo(T1.x,T1.y); pic.Canvas.LineTo(T2.x,T2.y) end; Pic.Canvas.Polygon([point(T2.x,T2.y),point(Q1.x,Q1.y),point((T2.x+P.x) div 2, (T2.y+P.y) div 2),point(Q2.x,Q2.y)]); str(Gia:0:10,st);CatZeroThua(st); 142 Pic.Canvas.Font.Color:=TextColor; Pic.Canvas.Font.Size:=TextSizeTrongSo; Pic.Canvas.Brush.Style:=bsclear; Pic.Canvas.TextOut(T2.x-((T2.x-T1.x) div 3),T2.y -((T2.y-T1.y)div 3),St); end; Function Delen(x,y,Width,Height:integer;DinhDown:integer):boolean; Var i,W,H:integer; begin for i:=0 to G.SoDinh-1 do begin If (i<>DinhDown)and((G.DSDinh[i].ToaDo.x- Width<x)and(x<G.DSDinh[i].ToaDo.x+Width)) and((G.DSDinh[i].ToaDo.y-Height<y)and(y<G.DSDinh[i].ToaDo.y+Height)) then begin Delen:=true;exit; end; end; Delen:=false; end; Procedure VeDoThi(G:TypeDothi;Pic:Tbitmap;Imagelist:Timagelist); Var i,j:integer;R:Trect;W,H:Integer; T1,T2:TypeToaDo;LineColor,TextColor:Tcolor; Bitmap:Tbitmap; begin Pic.Canvas.Brush.Style:=bsSolid; Pic.Canvas.Pen.Style:=psSolid; Pic.Canvas.Brush.Color:=rgb(255,255,255); Pic.Canvas.Pen.Color:=rgb(255,255,255); Pic.Canvas.FillRect(Rect(0,0,Pic.Width,Pic.Height)); Bitmap:=Tbitmap.Create; Bitmap.PixelFormat:=Pf24bit; For i:=0 to G.SoDinh-1 do with G.DSDinh[i] do begin W:=Imagelist.Width; H:=Imagelist.Height; Imagelist.GetBitmap(MucKichHoat,Bitmap); R:=Rect(Toado.x-(W div 2),ToaDo.y-(H div 2),Toado.x+(W div 2),ToaDo.y+(H div 2)); //Pic.Canvas.Draw(Toado.x-(W div 2),ToaDo.y-(H div 2),Bitmap); Pic.Canvas.Brush.Style:=bsClear; Pic.Canvas.BrushCopy(R,Bitmap,Rect(0,0,Bitmap.Width-1,Bitmap.Height- 1),RGB(255,255,255)); Bitmap.FreeImage; Pic.Canvas.Font.Color:=rgb(0,255,0); Pic.Canvas.Brush.Style:=bsClear; W:=Pic.Canvas.TextWidth(ten); 143 H:=Pic.Canvas.TextHeight(ten); If W<Imagelist.Width then Pic.Canvas.TextRect(R,Toado.x-(W div 2),ToaDo.y-(H div 2),ten ) else Pic.Canvas.TextRect(R,R.Left,ToaDo.y-(H div 2),ten ); end; Bitmap.Free; LineColor:=RGB(0,0,255); TextColor:=RGB(255,0,0); for i:=0 to G.SoCanh -1 do with G.DSCanh[i] do begin T1:=G.DsDinh[DinhDau].ToaDo; T2:=G.DsDinh[DinhCuoi].ToaDo; Vecung(Pic,T1,T2,Trongso.Gia,true,LineColor,TextColor); end; end; procedure KhuKichHoatThua(Var G:TypeDothi); var i,count:integer; begin count:=0; for i:=0 to G.SoDinh-1 do begin if (G.DSDinh[i].MucKichHoat>0)and(count<2) then begin count:=count+1; If count=2 then break; end; end; if count>0 then for i:=0 to G.SoDinh-1 do if G.DSDinh[i].MucKichHoat=1 then G.DSDinh[i].MucKichHoat:=2 else if G.DSDinh[i].MucKichHoat=2 then if count=2 then G.DSDinh[i].MucKichHoat:=0 end; Function TimCacDinhKichHoat(G:TypeDoThi;Var D1,D2:integer):Integer; var i,count:integer; begin count:=0; i:=0; while i<=G.SoDinh -1 do begin if G.DSDinh[i].MucKichHoat>0 then begin count:=count+1; If G.DSDinh[i].MucKichHoat=1 then D1:=i else D2:=i; If count=2 then i:=G.SoDinh 144 [...]... Pic.SaveToFile(SaveDialog1.FileName); 2:{Jpeg} begin T:=TJpegimage.Create; T.Assign(Pic); try T.SaveToFile(SaveDialog1.FileName); finally T.Free end; end; end end; end Chương trình chính cài đặt như sau: program Project1; uses Forms, Func_DoThi in 'Func_DoThi.pas', Unit2 in 'Unit2 .pas' {Form2}, {$R *.res} begin Application.Initialize; Application.CreateForm(TForm2, Form2); Application.Run; end 157 (*.JPG)| . PHẦN PHỤ LỤC Phụ lục 1 Unit chứa khai báo các cấu trúc dữ liệu cho đồ thị và cài đặt thủ tục tìm đường đi ngắn nhất theo thuật toán unit Func_DoThi; interface. END. 137 Thiết kế giao diện cho chương trình (Form 2) Với các đối tượng được gồm: Các khai báo và cài đặt cho chương form2: unit Unit2; 138 interface uses