›
›

Giáo trình Toán rời rạc - Phụ lục 1

Download
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)))  
136  
then  
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;  
137  
END.  
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:  
138  
unit Unit2;  
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;  
139  
N4: TMenuItem;  
procedure PaintBox1DragDrop(Sender, Source: TObject; X, Y: Integer);  
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:  
Tcolor);  
140  
Procedure VeDoThi(G:TypeDothi;Pic:Tbitmap;Imagelist:Timagelist);  
Function Delen(x,y,Width,Height:integer;DinhDown:integer):boolean;  
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;  
141  
If P=0 then exit;  
while (i>P)and(st[i]='0') do i:=i-1;  
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:  
Tcolor);  
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;  
142  
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);  
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;  
143  
Pic.Canvas.Font.Color:=rgb(0,255,0);  
Pic.Canvas.Brush.Style:=bsClear;  
W:=Pic.Canvas.TextWidth(ten);  
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  
144  
count:=count+1;  
If G.DSDinh[i].MucKichHoat=1 then D1:=i else D2:=i;  
If count=2 then i:=G.SoDinh  
end;  
i:=i+1;  
end;  
TimCacDinhKichHoat:=count;  
end;  
function TimCung(G:TypeDoThi;D1,D2:integer; var Chiso:integer):Boolean;  
var i:integer;  
begin  
Timcung:=false;  
for i:=0 to G.SoCanh -1 do  
If (G.DSCanh[i].DinhDau=D1)and(G.DSCanh[i].DinhCuoi=D2) then  
begin  
ChiSo:=i;  
TimCung:=true;  
exit;  
end;  
end;  
procedure Tform2.HienThamSoCung(G:TypeDoThi);  
var i,D1,D2,count,loi:integer;St:string;  
begin  
maskedit1.Enabled:=False;maskedit1.Text:='';  
maskedit2.Enabled:=False;maskedit2.Text:='';  
statictext1.Caption:='';  
statictext2.Caption:='';  
If TimCacDinhKichHoat(G,D1,D2)=2 then  
begin count:=0;  
maskedit1.Enabled:=False;maskedit1.Text:='';  
maskedit2.Enabled:=False;maskedit2.Text:='';  
statictext1.Caption:='';  
statictext2.Caption:='';  
SpeedButton1.Down:=False;  
SpeedButton2.Down:=False;  
i:=0;  
while i<=(G.SoCanh-1) do  
begin  
if (G.DSCanh[i].DinhDau=D2)and(G.DSCanh[i].DinhCuoi=D1) then  
begin  
statictext1.Caption:=G.DSDinh[D2].Ten + '--->' + G.DSDinh[D1].Ten;  
str(G.DSCanh[i].TrongSo.Gia:0:10,st);  
catzerothua(st);  
maskedit1.Text:=(st);  
maskedit1.Enabled:=true;  
SpeedButton1.Down:=True;  
Count:=count+1;  
If count=2 then i:=G.SoCanh;  
145  
end  
else  
if (G.DSCanh[i].DinhDau=D1)and(G.DSCanh[i].DinhCuoi=D2) then  
begin  
statictext2.Caption:=G.DSDinh[D2].Ten + '<---' + G.DSDinh[D1].Ten;  
str(G.DSCanh[i].TrongSo.Gia:0:0,st);  
catzerothua(st);  
maskedit2.Text:=st;  
maskedit2.Enabled:=true;  
SpeedButton2.Down:=True;  
Count:=count+1;  
If count=2 then i:=G.SoCanh;  
end;  
i:=i+1;  
end;  
//bitbtn2.Enabled:=True;  
//bitbtn3.Enabled:=True;  
SpeedButton1.Enabled:=True;  
SpeedButton2.Enabled:=True;  
end  
else  
begin  
//bitbtn2.Enabled:=False;  
//bitbtn3.Enabled:=False;  
SpeedButton1.Enabled:=False;  
SpeedButton2.Enabled:=False;  
end;  
end;  
procedure TForm2.PaintBox1MouseDown(Sender: TObject; Button: TMouseButton;  
Shift: TShiftState; X, Y: Integer);  
var i:integer;T:Tpoint;  
begin  
i:=DownDinh(x,y,G);  
If (button=mbRight)and(i<>-1) then  
begin  
DinhDown:=i;  
T:=PaintBox1.ClientToScreen(Point(x,y));  
PopupMenu1.Popup(T.X,T.Y);  
exit;  
end;  
If i<>-1 then  
begin  
Mouse_Down:=true;  
DinhDown:=i;  
if G.DSDinh[i].MucKichHoat=0 then  
begin  
146  
KhuKichHoatThua(G);  
G.DSDinh[i].MucKichHoat:=1;  
Dx:=x-G.DSDinh[i].ToaDo.x;  
Dy:=y-G.DSDinh[i].ToaDo.y;  
end  
else  
G.DSDinh[i].MucKichHoat:=0;  
HienThamSoCung(G);  
end;  
end;  
procedure TForm2.PaintBox1DragDrop(Sender, Source: TObject; X, Y: Integer);  
Var H:Integer;  
begin  
if {(Sender is TListBox) and} (Source is Timage) then  
If Timage(Source).Name ='Image1' then  
begin  
G.SoDinh:=G.SoDinh+1;  
Setlength(G.DSDinh,G.SoDinh);  
G.DSDinh[G.SoDinh-1].ToaDo.X:=x;  
G.DSDinh[G.SoDinh-1].ToaDo.Y:=y;  
G.DSDinh[G.SoDinh-1].Ten:='T' + InttoStr(G.SoDinh);  
VeDoThi(G,Pic,imagelist1);  
DrawPaint(PaintBox1,Pic);  
FileChanged:=true;  
end;  
end;  
procedure TForm2.PaintBox1DragOver(Sender, Source: TObject; X, Y: Integer;  
State: TDragState; var Accept: Boolean);  
Var i:integer;  
begin  
Accept:=true;  
i:=0;  
While i<=(G.SoDinh-1) do  
if not Delen(x,y,imagelist1.Width,imagelist1.Height,i) then  
i:=i+1  
else  
begin  
Accept:=False;  
i:=G.SoDinh;  
end;  
If Accept then  
begin  
VeDoThi(G,Pic,imagelist1);  
Pic.Canvas.Draw(x+20,y,Image1.Picture.Bitmap);  
DrawPaint(PaintBox1,Pic);  
end  
147  
else  
begin  
VeDoThi(G,Pic,imagelist1);  
DrawPaint(PaintBox1,Pic);  
end;  
end;  
procedure TForm2.FormResize(Sender: TObject);  
begin  
If (self.WindowState<>wsMinimized)and((pic is Tbitmap)) then  
begin  
Pic.Width:=Paintbox1.Width;  
Pic.Height:=Paintbox1.Height;  
end;  
end;  
procedure TForm2.FormCreate(Sender: TObject);  
begin  
Pic:=Tbitmap.Create;  
Pic.PixelFormat:=Pf24bit;  
Pic.Width:=Paintbox1.Width;  
Pic.Height:=Paintbox1.Height;  
FileChanged:=false;  
Filename:='';  
Self.Caption:='Graph Algorithm - New documents'  
end;  
function TForm2.DownDinh(x,y:integer;G:TypeDothi):integer;  
var i:integer;  
begin  
For i:=0 to G.Sodinh-1 do  
with G.DSDinh[i] do  
If Sqrt(sqr(Toado.x-x)+sqr(Toado.y-y))<20 then  
begin  
DownDinh:=i; exit;  
end;  
DownDinh:=-1;  
end;  
procedure TForm2.PaintBox1MouseMove(Sender: TObject; Shift: TShiftState; X,  
Y: Integer);  
begin  
If mouse_Down then  
begin  
if (not Delen(x,y,imagelist1.Width,imagelist1.Height,DinhDown))  
and((0<x)and(x<Pic.Width)and(0<y)and(y<Pic.Height)) then  
begin  
G.DSDinh[DinhDown].ToaDo.x:=x-Dx;  
148  
G.DSDinh[DinhDown].ToaDo.y:=y-Dy;  
VeDoThi(G,Pic,imagelist1);  
DrawPaint(PaintBox1,Pic);  
end  
end  
else  
begin  
end;  
end;  
procedure TForm2.PaintBox1MouseUp(Sender: TObject; Button: TMouseButton;  
Shift: TShiftState; X, Y: Integer);  
begin  
If mouse_Down then  
if (not Delen(x,y,imagelist1.Width,imagelist1.Height,DinhDown))  
and((0<x)and(x<Pic.Width)and(0<y)and(y<Pic.Height)) then  
begin  
G.DSDinh[DinhDown].ToaDo.x:=x-Dx;  
G.DSDinh[DinhDown].ToaDo.y:=y-Dy;  
mouse_Down:=false;  
VeDoThi(G,Pic,imagelist1);  
DrawPaint(PaintBox1,Pic);  
FileChanged:=True;  
end  
else  
begin  
mouse_Down:=false;  
end  
end;  
procedure TForm2.MaskEdit1Change(Sender: TObject);  
var D1,D2,ChiSo,Loi:integer; X:real;  
begin  
if not maskedit1.Focused then exit;  
val(maskedit1.Text,X,Loi);  
If TimCacDinhKichHoat(G,D1,D2)=2 then  
if Timcung(G,D2,D1,ChiSo) then  
begin G.DSCanh[ChiSo].TrongSo.Gia:=X;  
VeDoThi(G,Pic,imagelist1);  
DrawPaint(PaintBox1,Pic);  
end;  
end;  
procedure TForm2.MaskEdit2Change(Sender: TObject);  
var D1,D2,ChiSo,Loi:integer; X:real;  
begin  
if not maskedit2.Focused then exit;  
val(maskedit2.Text,X,Loi);  
149  
If TimCacDinhKichHoat(G,D1,D2)=2 then  
if Timcung(G,D1,D2,ChiSo) then  
begin  
G.DSCanh[ChiSo].TrongSo.Gia:=X;  
VeDoThi(G,Pic,imagelist1);  
DrawPaint(PaintBox1,Pic);  
end;  
end;  
procedure TForm2.PaintBox1Paint(Sender: TObject);  
begin  
//VeDoThi(G,Pic,imagelist1);  
DrawPaint(PaintBox1,Pic);  
end;  
Function TrongSo(DinhDau,DinhCuoi:Integer):TypeChiPhi;  
Var i:integer;  
begin  
Trongso.VoCung:=true;  
i:=0;  
While (i<=(G.SoCanh-1)) do  
If (G.DSCanh[i].DinhDau=DinhDau)and(G.DSCanh[i].DinhCuoi=DinhCuoi) then  
begin  
TrongSo:=G.DSCanh[i].TrongSo;  
i:=G.SoCanh;  
end  
else i:=i+1;  
end;  
procedure TForm2.imduongdingannhat2Click(Sender: TObject);  
Var D1,D2,i,x,y:integer;ChiPhi:real;DuongDi:TypeDuongDi;St,So:string;  
TimeNow:TDateTime;  
SubPic:Tbitmap;  
begin  
If TimCacDinhKichHoat(G,D1,D2)=2 then  
begin  
If DuongDiNganNhat(G,D2,D1,DuongDi,ChiPhi) then  
begin  
SubPic:=Tbitmap.Create;  
Imagelist2.GetBitmap(0,SubPic);  
x:=G.DSDinh[DuongDi[0]].ToaDo.x;  
y:=G.DSDinh[DuongDi[0]].ToaDo.y;  
Pic.Canvas.Brush.Style:=BSclear;  
Pic.Canvas.BrushCopy(rect(x,y-  
SubPic.Height,x+Subpic.Width,y),SubPic,Rect(0,0,SubPic.Width-1,SubPic.Height-  
1),RGB(255,255,255));  
for i:=0 to high(DuongDi)-1 do  
begin  
150  
Veline(G.DSDinh[DuongDi[i]].ToaDo,G.DSDinh[DuongDi[i+1]].ToaDo,  
TrongSo(DuongDi[i],DuongDi[i+1]).Gia,Pic,RGB(255,0,0),100000);  
TimeNow:=Time;  
repeat  
Application.ProcessMessages;  
until (TimeNow+100000)>Time;  
end;  
St:='Duong di Tu ' + G.DSDinh[D1].Ten + ' Den ' + G.DSDinh[D2].Ten +'  
la:' + Cr + Lf;  
for i:=0 to high(DuongDi)-1 do  
begin  
st:=st+G.DsDinh[DuongDi[i]].Ten +' --> ';  
Vecung(Pic,G.DSDinh[DuongDi[i]].ToaDo,G.DSDinh[DuongDi[i+1]].ToaDo,  
TrongSo(DuongDi[i],DuongDi[i+1]).Gia,True,RGB(255,0,0),RGB(0,0,255))  
//Veline(G.DSDinh[DuongDi[i]].ToaDo,G.DSDinh[DuongDi[i+1]].ToaDo,  
//  
TrongSo(DuongDi[i],DuongDi[i+1]).Gia,Pic,RGB(255,0,0),10000)  
end;  
st:=st+G.DsDinh[DuongDi[high(DuongDi)]].Ten+ cr+lf;  
Str(ChiPhi:0:10,So);Catzerothua(So);  
St:=St+ 'Voi chi phi la: ' + So;  
Pic.Canvas.BrushCopy(rect(x,y-  
SubPic.Height,x+Subpic.Width,y),SubPic,Rect(0,0,SubPic.Width-1,SubPic.Height-  
1),RGB(255,255,255));  
x:=G.DSDinh[DuongDi[high(DuongDi)]].ToaDo.x;  
y:=G.DSDinh[DuongDi[high(DuongDi)]].ToaDo.y;  
Pic.Canvas.Brush.Style:=BSclear;  
Imagelist2.GetBitmap(1,SubPic);  
Pic.Canvas.BrushCopy(rect(x,y-  
SubPic.Height,x+Subpic.Width,y),SubPic,Rect(0,0,SubPic.Width-1,SubPic.Height-  
1),RGB(255,255,255));  
SubPic.Free;  
DrawPaint(PaintBox1,Pic);  
showmessage(st);  
end  
else  
begin  
Showmessage('Khong co duong di Tu ' + G.DSDinh[D1].Ten + ' Den ' +  
G.DSDinh[D2].Ten);  
151  
end;  
end;  
end;  
procedure TForm2.FormCloseQuery(Sender: TObject; var CanClose: Boolean);  
var TraLoi:Word;  
begin  
If FileChanged then  
begin  
TraLoi:=MessageDlg('File changed. Do you want to save?',mtConfirmation  
,[mbYes,mbNo,mbCancel],0);  
If TraLoi=mrYes then  
Form2.Save1Click(Sender)  
else  
If TraLoi=mrCancel then  
begin CanClose:=false; exit;end;  
end;  
pic.FreeImage;  
DeleteGraph(G);  
end;  
procedure TForm2.FormDestroy(Sender: TObject);  
begin  
pic.FreeImage;  
end;  
procedure TForm2.Rename1Click(Sender: TObject);  
begin  
G.DSDinh[DinhDown].Ten:=inputbox('Rename','Name:',G.DSDinh[DinhDown].Ten);  
HienThamSoCung(G);  
VeDoThi(G,Pic,imagelist1);  
DrawPaint(PaintBox1,Pic);  
FileChanged:=True;  
end;  
procedure TForm2.Exit1Click(Sender: TObject);  
begin  
close;  
end;  
procedure TForm2.Delete1Click(Sender: TObject);  
Var i,N,Start:integer;  
Index:Array of integer;  
begin  
For i:=DinhDown to G.SoDinh-2 do  
G.DSDinh[i]:=G.DSDinh[i+1];  
152  
G.SoDinh:=G.SoDinh-1;  
Setlength(G.DSDinh,G.SoDinh);  
Setlength(Index,G.SoCanh);  
N:=0;Start:=-1;  
For i:=0 to G.SoCanh-1 do  
If (G.DSCanh[i].DinhDau=DinhDown)or(G.DSCanh[i].DinhCuoi=DinhDown) then  
begin  
If Start=-1 then Start:=N;  
end  
else  
begin  
Index[N]:=i;  
N:=N+1;  
end;  
If Start<>-1 then  
begin  
G.SoCanh:=N;  
For i:=Start to G.SoCanh-1 do  
G.DSCanh[i]:=G.DSCanh[Index[i]];  
For i:=0 to G.SoCanh-1 do  
With G.DSCanh[i] do  
begin  
If DinhDau>DinhDown then DinhDau:=DinhDau-1;  
If DinhCuoi>DinhDown then DinhCuoi:=DinhCuoi-1;  
end;  
Setlength(G.DSCanh,G.SoCanh);  
end;  
Setlength(Index,0);  
HienThamSoCung(G);  
VeDoThi(G,Pic,imagelist1);  
DrawPaint(PaintBox1,Pic);  
FileChanged:=True;  
end;  
procedure TForm2.DeleteAll1Click(Sender: TObject);  
begin  
G.SoDinh:=0;G.SoCanh:=0;  
Setlength(G.DSDinh,0);Setlength(G.DSCanh,0);  
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));  
DrawPaint(PaintBox1,Pic);  
FileChanged:=true;  
end;  
153  
procedure TForm2.Save1Click(Sender: TObject);  
var F:textfile;  
i:integer;  
begin  
SaveDialog1.DefaultExt:='*.GRD';  
SaveDialog1.Filter:='Graph data file (*.GRD)|*.GRD';  
If not SaveDialog1.Execute then exit;  
AssignFile(F,SaveDialog1.FileName);  
Rewrite(F);  
Try  
Writeln(f,G.Sodinh,' ',G.Socanh);  
For i:=0 to G.SoDinh-1 do  
Writeln(F,G.DSDinh[i].ToaDo.x,' ',G.DSDinh[i].ToaDo.y,' ',G.DSDinh[i].Ten);  
For i:=0 to G.SoCanh-1 do  
Writeln(F,G.DSCanh[i].DinhDau,' ',G.DSCanh[i].DinhCuoi,'  
',G.DSCanh[i].TrongSo.Gia);  
except  
Showmessage('Writting error');  
end;  
CloseFile(F);  
FileChanged:=false;  
end;  
procedure TForm2.Open1Click(Sender: TObject);  
Var F:TextFile;  
i:integer;  
begin  
OpenDialog1.DefaultExt:='*.GRD';  
OpenDialog1.Filter:='Graph data file (*.GRD)|*.GRD';  
If not OpenDialog1.Execute then exit;  
AssignFile(F,OpenDialog1.FileName);  
ReSet(F);  
Try  
Readln(f,G.Sodinh,G.Socanh);  
Setlength(G.DSDinh,G.SoDinh);  
Setlength(G.DSCanh,G.SoCanh);  
For i:=0 to G.SoDinh-1 do  
begin  
Readln(F,G.DSDinh[i].ToaDo.x,G.DSDinh[i].ToaDo.y,G.DSDinh[i].Ten);  
G.DSDinh[i].Ten:=trimleft(G.DSDinh[i].Ten);  
G.DSDinh[i].MucKichHoat:=0;  
end;  
154  
Tải về để xem bản đầy đủ
doc 23 trang baolam 06/05/2022 2520
Download
Bạn đang xem 20 trang mẫu của tài liệu "Giáo trình Toán rời rạc - Phụ lục 1", để tải tài liệu gốc về máy hãy click vào nút Download ở trên

File đính kèm:

  • docgiao_trinh_toan_roi_rac_phu_luc_1.doc