?? fform.pas
字號(hào):
unit FForm;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
mybutton, ExtCtrls, Menus, StdCtrls,VE, anyline, grapoint, ctlpoint,hamilton,
hcplabel,shellapi, ComCtrls;
type
TFindForm = class(TForm)
Panel1: TPanel;
newButton: TMyButton;
OpenButton: TMyButton;
saveButton: TMyButton;
PointButton: TMyButton;
LineButton: TMyButton;
ControlButton: TMyButton;
RunButton: TMyButton;
HelpButton: TMyButton;
DalianButton: TMyButton;
BaguicButton: TMyButton;
buttonTimer: TTimer;
GraphpointPopupMenu: TPopupMenu;
changepointcolor: TMenuItem;
deletepoint: TMenuItem;
ControlpointPopupMenu: TPopupMenu;
addControlpoint: TMenuItem;
changeEdgecolor: TMenuItem;
changeEdgewidth: TMenuItem;
oneWide: TMenuItem;
twowide: TMenuItem;
fourwide: TMenuItem;
restoreEdge: TMenuItem;
deleteEdge: TMenuItem;
OpenDialog1: TOpenDialog;
SaveDialog1: TSaveDialog;
ColorDialog1: TColorDialog;
statusbar: TPanel;
findImage: TImage;
salesmanImage: TImage;
hintlabel: TLabel;
dalianImage1: TImage;
dalianImage2: TImage;
dalianTimer: TTimer;
hcpLabel1: ThcpLabel;
hcpLabel2: ThcpLabel;
procedure FormCreate(Sender: TObject);
procedure buttonTimerTimer(Sender: TObject);
procedure MyButtonMouseEnter(Sender: TObject);
procedure MyButtonMouseLeave(Sender: TObject);
procedure MyButtonClick(Sender: TObject);
procedure newButtonMouseEnter(Sender: TObject);
procedure newButtonMouseLeave(Sender: TObject);
procedure newButtonClick(Sender: TObject);
procedure DalianButtonClick(Sender: TObject);
procedure DalianButtonMouseEnter(Sender: TObject);
procedure DalianButtonMouseLeave(Sender: TObject);
procedure HelpButtonClick(Sender: TObject);
procedure HelpButtonMouseLeave(Sender: TObject);
procedure HelpButtonMouseEnter(Sender: TObject);
procedure FormDragDrop(Sender, Source: TObject; X, Y: Integer);
procedure FormDragOver(Sender, Source: TObject; X, Y: Integer;
State: TDragState; var Accept: Boolean);
procedure FormKeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
procedure FormMouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure OpenButtonClick(Sender: TObject);
procedure OpenButtonMouseEnter(Sender: TObject);
procedure OpenButtonMouseLeave(Sender: TObject);
procedure saveButtonClick(Sender: TObject);
procedure saveButtonMouseEnter(Sender: TObject);
procedure saveButtonMouseLeave(Sender: TObject);
procedure PointButtonClick(Sender: TObject);
procedure PointButtonMouseEnter(Sender: TObject);
procedure PointButtonMouseLeave(Sender: TObject);
procedure LineButtonClick(Sender: TObject);
procedure LineButtonMouseEnter(Sender: TObject);
procedure LineButtonMouseLeave(Sender: TObject);
procedure ControlButtonClick(Sender: TObject);
procedure ControlButtonMouseEnter(Sender: TObject);
procedure ControlButtonMouseLeave(Sender: TObject);
procedure RunButtonClick(Sender: TObject);
procedure RunButtonMouseEnter(Sender: TObject);
procedure RunButtonMouseLeave(Sender: TObject);
procedure changepointcolorClick(Sender: TObject);
procedure deletepointClick(Sender: TObject);
procedure addControlpointClick(Sender: TObject);
procedure changeEdgecolorClick(Sender: TObject);
procedure oneWideClick(Sender: TObject);
procedure twowideClick(Sender: TObject);
procedure threewideClick(Sender: TObject);
procedure restoreEdgeClick(Sender: TObject);
procedure deleteEdgeClick(Sender: TObject);
procedure FormResize(Sender: TObject);
procedure dalianTimerTimer(Sender: TObject);
procedure BaguicButtonClick(Sender: TObject);
procedure BaguicButtonMouseEnter(Sender: TObject);
procedure BaguicButtonMouseLeave(Sender: TObject);
procedure hcpLabel1Click(Sender: TObject);
procedure hcpLabel2Click(Sender: TObject);
private
{ Private declarations }
isfind:boolean;
isbreak:boolean;
isbegin:boolean;
isDalian:Boolean;
isEnter:Boolean;
isDblClick:Boolean;
isdragging :boolean;
isconnecting:boolean;
pointlabel :integer;
grabpoint:Tpoint;
connectpoint:Tpoint;
temppoint:Tgraphpoint;
tempcpoint:Tcontrolpoint;
currgraphpoint:Tgraphpoint;
currControlpoint:TControlpoint;
public
{ Public declarations }
procedure GraphPointMouseDown(Sender: TObject; Button: TMouseButton;Shift: TShiftState; X, Y: Integer);
procedure GraphPointMouseMove(Sender: TObject; Shift: TShiftState; X,Y: Integer);
procedure GraphPointDragOver(Sender, Source: TObject; X, Y: Integer;State: TDragState; var Accept: Boolean);
procedure GraphPointDragDrop(Sender, Source: TObject; X, Y: Integer);
procedure GraphPointMouseUp(Sender: TObject; Button: TMouseButton;Shift: TShiftState; X, Y: Integer);
procedure GraphPointDblClick(Sender: TObject);
procedure GraphPointMouseEnter(Sender: TObject);
procedure GraphPointMouseLeave(Sender: TObject);
procedure ControlPointMouseDown(Sender: TObject; Button: TMouseButton;Shift: TShiftState; X, Y: Integer);
procedure ControlPointMouseMove(Sender: TObject; Shift: TShiftState;X, Y: Integer);
procedure ControlPointMouseUp(Sender: TObject; Button: TMouseButton;Shift: TShiftState; X, Y: Integer);
procedure ControlPointDblClick(Sender: TObject);
procedure newGraph;
procedure puthint(thecolor:Tcolor;thesize:integer;thehint:string);
end;
var
FindForm: TFindForm;
bitmaps:array[1..24] of Tbitmap;
readybitmap,findbitmap,notfindbitmap:Tbitmap;
dlmapbitmap:Tbitmap;
dlanibitmaps:array[1..3] of Tbitmap;
dlanistrings:array[1..3] of string;
dltourbitmaps:array[1..15] of Tbitmap;
dltourStrings:array[1..15] of string;
dalianframe:integer;
bitmappath:string;
frame:integer;
framestep :integer;
currButton:TMyButton;
copybitmap:Tbitmap;
theGlyphpos:Tpoint;
VertexList:Tlist;
EdgeList:Tlist;
Controlpointlist:Tlist;
implementation
uses dalian;
{$R *.DFM}
function CreateBrushPattern(thecolor:Tcolor):Tbitmap;
var
X, Y: Integer;
pattern:Tbitmap;
begin
pattern := TBitmap.Create;
Pattern.Width := 8;
Pattern.Height := 8;
with Pattern.Canvas do
begin
Brush.Style := bsSolid;
Brush.Color := thecolor;
FillRect(Rect(0, 0, Pattern.Width, Pattern.Height));
for Y := 0 to 7 do
for X := 0 to 7 do
begin
if (Y mod 2) = (X mod 2) then { toggles between even/odd pixles }
Pixels[X, Y] := clSilver; { on even/odd rows }
end;
end;
result := pattern;
end;
procedure loadDlbitmap;
begin
dlmapbitmap := Tbitmap.create;
dlmapbitmap.loadfromfile(bitmappath+'dalian.bmp');
dlanibitmaps[1] := Tbitmap.create;
dlanibitmaps[1].loadfromfile(bitmappath+'dlani1.bmp');
dlanistrings[1] := '美哉大連,瀕臨黃海,風(fēng)景秀麗,北有金州,西有旅順,虎灘趕月,星海抱月,'+chr(13)+chr(10)+'足球田徑,雙璧生輝,世界看中國,中國看大連。';
dlanibitmaps[2] := Tbitmap.create;
dlanibitmaps[2].loadfromfile(bitmappath+'dlani2.bmp');
dlanistrings[2] := '美哉大連,氣候宜人,冬暖夏涼,商業(yè)發(fā)達(dá),交通便利,廣場(chǎng)綠地,鴿起鴿落,' + chr(13)+chr(10)+'高校云集,人才匯聚,開拓在中國,發(fā)展在大連。';
dlanibitmaps[3] := Tbitmap.create;
dlanibitmaps[3].loadfromfile(bitmappath+'dlani3.bmp');
dltourbitmaps[1] := Tbitmap.create;
dltourbitmaps[1].loadfromfile(bitmappath+'renmin.bmp');
dltourStrings[1] := '人民廣場(chǎng)';
dltourbitmaps[2] := Tbitmap.create;
dltourbitmaps[2].loadfromfile(bitmappath+'huizhan.bmp');
dltourStrings[2] := '星海廣場(chǎng)';
dltourbitmaps[3] := Tbitmap.create;
dltourbitmaps[3].loadfromfile(bitmappath+'xinghai.bmp');
dltourStrings[3] := '星海公園';
dltourbitmaps[4] := Tbitmap.create;
dltourbitmaps[4].loadfromfile(bitmappath+'lushun.bmp');
dltourStrings[4] := '旅順口';
dltourbitmaps[5] := Tbitmap.create;
dltourbitmaps[5].loadfromfile(bitmappath+'youhao.bmp');
dltourStrings[5] := '友好廣場(chǎng)';
dltourbitmaps[6] := Tbitmap.create;
dltourbitmaps[6].loadfromfile(bitmappath+'Zhongshan.bmp');
dltourStrings[6] := '中山廣場(chǎng)';
dltourbitmaps[7] := Tbitmap.create;
dltourbitmaps[7].loadfromfile(bitmappath+'zoo.bmp');
dltourStrings[7] := '大連森林動(dòng)物園';
dltourbitmaps[8] := Tbitmap.create;
dltourbitmaps[8].loadfromfile(bitmappath+'laohutan.bmp');
dltourStrings[8] := '虎灘樂園';
dltourbitmaps[9] := Tbitmap.create;
dltourbitmaps[9].loadfromfile(bitmappath+'Seayun.bmp');
dltourStrings[9] := '海之韻廣場(chǎng)';
dltourbitmaps[10] := Tbitmap.create;
dltourbitmaps[10].loadfromfile(bitmappath+'laodong.bmp');
dltourStrings[10] := '勞動(dòng)公園';
dltourbitmaps[11] := Tbitmap.create;
dltourbitmaps[11].loadfromfile(bitmappath+'Tower.bmp');
dltourStrings[11] := '電視塔';
dltourbitmaps[12] := Tbitmap.create;
dltourbitmaps[12].loadfromfile(bitmappath+'yejing.bmp');
dltourStrings[12] := '大連夜景';
dltourbitmaps[13] := Tbitmap.create;
dltourbitmaps[13].loadfromfile(bitmappath+'kaifa.bmp');
dltourStrings[13] := '大連開發(fā)區(qū)';
dltourbitmaps[14] := Tbitmap.create;
dltourbitmaps[14].loadfromfile(bitmappath+'golf.bmp');
dltourStrings[14] := '大連金石高爾夫球場(chǎng)';
dltourbitmaps[15] := Tbitmap.create;
dltourbitmaps[15].loadfromfile(bitmappath+'jinst.bmp');
dltourStrings[15] := '金石灘奇石';
end;
procedure freeDlbitmap;
var i:integer;
begin
dlmapbitmap.free;
for i := 1 to 3 do dlanibitmaps[i].free;
for i := 1 to 15 do dltourbitmaps[i].free;
for i := 1 to 15 do dltourstrings[i] := '';
for i := 1 to 3 do dlanistrings[i] := '';
end;
procedure TFindForm.puthint(thecolor:Tcolor;thesize:integer;thehint:string);
begin
with hintlabel do
begin
font.color := thecolor;
font.size := thesize;
caption := thehint;
end;
end;
procedure TFindForm.FormCreate(Sender: TObject);
var i:integer;
thecolor:Tcolor;
red:integer;
readfilestream : TFilestream;
reader : Treader;
theVertexcount,theEdgecount:integer;
begin
red := $FF;
for i := 1 to 24 do
begin
thecolor := RGB(red,red,red);
bitmaps[i] := CreateBrushPattern(thecolor);
red := red - 4;
end;
vertexlist := Tlist.create;
edgelist := Tlist.create;
Controlpointlist := Tlist.create;
pointlabel := 1;
isconnecting := False;
isdragging := False;
isbegin :=true;
isDalian := false;
isEnter := false;
isDblClick := false;
bitmappath := ExtractFilePath(paramstr(0));
readybitmap := Tbitmap.create;
findbitmap := Tbitmap.create;
findbitmap.loadfromfile(bitmappath+'find.bmp');
notfindbitmap := Tbitmap.create;
notfindbitmap.loadfromfile(bitmappath+'notfind.bmp');
isruning := false;
findimage.canvas.draw(0,0,readybitmap);
Screen.Cursors[1] := LoadCursorFromFile(pchar(bitmappath+'hand.cur'));
puthint(clWhite,17,'歡迎來到圖的世界 !');
if fileexists(bitmappath+'hamilton.gph') then
begin
caption := '迷路的旅行推銷員(發(fā)現(xiàn)哈密爾頓回路)/hamilton';
readfilestream := TFilestream.create(bitmappath+'hamilton.gph',fmOpenRead);
reader := Treader.create(readfilestream,256);
if copy(reader.readstring,2,7) <> 'inhai20' then
begin
showmessage('Error graph file!');
reader.free;
readfilestream.free;
exit;
end;
pointlabel := reader.readinteger;
theVertexcount := reader.readinteger;
theEdgecount := reader.readinteger;
for i:= 0 to theVertexcount - 1 do
VertexList.add(TVertex.create(self,-16,-16,0));
for i:= 0 to theEdgecount - 1 do
EdgeList.add(TEdge.create(self,nil,nil));
for i:= 0 to theVertexcount - 1 do
Tvertex(VertexList.items[i]).load(reader);
for i:= 0 to theEdgecount - 1 do
TEdge(EdgeList.items[i]).load(reader);
reader.free;
readfilestream.free;
end;
application.helpfile := bitmappath + 'hcp.hlp';
end;
procedure TFindForm.buttonTimerTimer(Sender: TObject);
var i,j:integer;
begin
with currButton.canvas do Brush.Bitmap := bitmaps[frame];
BitBlt(currButton.canvas.handle,theGlyphpos.X,theGlyphpos.Y,copybitmap.width,copybitmap.height,copybitmap.canvas.handle,0,0,MERGECOPY);
frame :=frame + framestep;
if frame > 24 then
begin
framestep := -1;
frame := 24;
end;
if frame < 1 then
begin
framestep := 1;
frame := 1;
end;
end;
procedure TFindForm.MyButtonMouseEnter(Sender: TObject);
begin
currButton := TMyButton(Sender);
theGlyphpos := point(2,2);
copybitmap := Tbitmap.create;
with copybitmap do
begin
width := currButton.width-4;
height := currButton.height-4;
canvas.copyRect(rect(0,0,width,height),currButton.Glyph.canvas,rect(0,0,width,height));
end;
buttonTimer.enabled := true;
if currButton.down then
frame := 1
else
frame := 16;
framestep := -1;
end;
procedure TFindForm.MyButtonMouseLeave(Sender: TObject);
begin
Buttontimer.enabled := False;
copybitmap.free;
currButton.Invalidate;
end;
procedure TFindForm.MyButtonClick(Sender: TObject);
begin
if currButton.down then
frame := 1
else
frame := 16;
framestep := -1;
end;
procedure TFindForm.GraphPointMouseDown(Sender: TObject;
Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
if isDblClick then
begin
isDblClick := false;
exit;
end;
if ssleft in shift then
begin
if (ssCtrl in Shift) or linebutton.down then
begin
isconnecting := True;
Tgraphpoint(Sender).begindrag(False);
Tgraphpoint(Sender).dragcursor := crDefault ;
canvas.pen.color := clBlack;
Canvas.pen.mode := pmNotXor;
connectpoint := Tgraphpoint(Sender).centerpoint;
canvas.polyline([Tgraphpoint(Sender).centerpoint,connectpoint]);
end
else
begin
grabpoint.X := X;
grabpoint.Y := Y;
?? 快捷鍵說明
復(fù)制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號(hào)
Ctrl + =
減小字號(hào)
Ctrl + -