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

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; 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 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 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. 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; 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); 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); 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:TdateTime); 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:TdateTime); 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; 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; 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 (iDinhDown)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); 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 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; 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 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 else begin VeDoThi(G,Pic,imagelist1); DrawPaint(PaintBox1,Pic); end; end; procedure TForm2.FormResize(Sender: TObject); begin If (self.WindowStatewsMinimized)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; 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); 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 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); 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]; 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; 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; For i:=0 to G.SoCanh-1 do Readln(F,G.DSCanh[i].DinhDau,G.DSCanh[i].DinhCuoi,G.DSCanh[i].TrongSo.Gia); except DeleteGraph(G); showmessage('Error struct file'); CloseFile(F); Self.Caption:='Graph Algorithm - New document'; VeDoThi(G,Pic,imagelist1); DrawPaint(PaintBox1,Pic); exit; end; CloseFile(F); VeDoThi(G,Pic,imagelist1); DrawPaint(PaintBox1,Pic); Filename:=OpenDialog1.FileName; Self.Caption:='Graph Algorithm - ' + Filename; FileChanged:=False; end; procedure TForm2.SpeedButton1Click(Sender: TObject); var D1,D2,ChiSo,i:integer; begin TimCacDinhKichHoat(G,D1,D2); If Not SpeedButton1.Down then begin Timcung(G,D2,D1,ChiSo); for i:=Chiso to G.SoCanh-2 do G.DSCanh[i]:=G.DSCanh[i+1]; G.SoCanh:=G.SoCanh-1; Setlength(G.DSCanh,G.SoCanh); end else begin G.SoCanh:=G.SoCanh+1; Setlength(G.DSCanh,G.SoCanh); With G.DSCanh[G.SoCanh-1] do begin DinhDau:=D2; DinhCuoi:=D1; TrongSo.VoCung:=false; TrongSo.Gia:=0; end; end; HienThamSoCung(G); VeDoThi(G,Pic,imagelist1); DrawPaint(PaintBox1,Pic); end; procedure TForm2.SpeedButton2Click(Sender: TObject); var D1,D2,ChiSo,i:integer; begin TimCacDinhKichHoat(G,D1,D2); If not SpeedButton2.Down then begin Timcung(G,D1,D2,ChiSo); for i:=Chiso to G.SoCanh-2 do G.DSCanh[i]:=G.DSCanh[i+1]; G.SoCanh:=G.SoCanh-1; Setlength(G.DSCanh,G.SoCanh); end else begin G.SoCanh:=G.SoCanh+1; Setlength(G.DSCanh,G.SoCanh); With G.DSCanh[G.SoCanh-1] do begin DinhDau:=D1; DinhCuoi:=D2; TrongSo.VoCung:=false; TrongSo.Gia:=0; end; end; HienThamSoCung(G); VeDoThi(G,Pic,imagelist1); DrawPaint(PaintBox1,Pic); end; procedure TForm2.New1Click(Sender: TObject); begin Filename:=''; FileChanged:=false; DeleteGraph(G); VeDoThi(G,Pic,imagelist1); DrawPaint(PaintBox1,Pic); end; procedure TForm2.ExportPicturef