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