控件连线问题,急救,在线等待!(100分)

  • 主题发起人 主题发起人 bladevke
  • 开始时间 开始时间
B

bladevke

Unregistered / Unconfirmed
GUEST, unregistred user!
动态生成两个panel,点一个button,两个panel之间生成一带箭头连线(panel1指向panel2),两个panel移动时线不断。连线两端连接点在panel的四个角或者四个边的中点上,线可以选取,并且线的端点可以在所属panel上8个连接点上随意拖放,偶是新手,请教~~~~
 
偶不做这个的。晕,看看其他人有没有答案吧。
 
如果你是新手,我劝你不要这样做了,要满足你的要求比较难的。
可参考FlowChart组件的做法。
http://soft.0zones.com/softlist
(最近这个网站被人整了,等恢复了可以去下载)
 
to:yostgxf
哎~新手总归是要变成老手的啊~~你给的网站现在是上不去了…………
如果你有关于这方面的代码或者思路就帮帮忙啦~~~~~
 
由于你需要能够选中线,然后拖动它,所以你需要自定义一个组件来画这个线,从TGraphicControl继承。

在移动panel时重画线就可以了。
拖动线的端点,你需要输出一个拖动事件,然后在事件中根据panel的位置大小处理应该就可以了。
 
FlowChart组件是带源码的,很不错,思想也比较简洁,等网站好了你下载一个看看吧。
 
to wnjer
基本的思路是了解了,但在实现方面还存在种种问题,我贴我的代码吧:
unit Unit2;

interface

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
Menus, ComCtrls, StdCtrls, ToolWin, ImgList, MisButton, ExtCtrls;

type
pointss=array of integer;
Tbla_work = class(TForm)
MainMenu1: TMainMenu;
N2: TMenuItem;
N8: TMenuItem;
TreeView1: TTreeView;
StatusBar1: TStatusBar;
ImageList1: TImageList;
ToolBar1: TToolBar;
ToolButton1: TToolButton;
ToolButton2: TToolButton;
ToolButton3: TToolButton;
ToolButton4: TToolButton;
ToolButton5: TToolButton;
ToolButton6: TToolButton;
N9: TMenuItem;
N10: TMenuItem;
N1: TMenuItem;
N3: TMenuItem;
N4: TMenuItem;
N5: TMenuItem;
N7: TMenuItem;
ToolButton7: TToolButton;
ToolButton8: TToolButton;
ToolButton9: TToolButton;
ToolButton10: TToolButton;
N11: TMenuItem;
N6: TMenuItem;
ScrollBox1: TScrollBox;
Image1: TImage;
image: TPaintBox;
Button1: TButton;

procedure N7Click(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure FormCreate(Sender: TObject);
procedure N8Click(Sender: TObject);
procedure N10Click(Sender: TObject);
procedure N9Click(Sender: TObject);
procedure Button1Click(Sender: TObject);
procedure FormPaint(Sender: TObject);
procedure imagePaint(Sender: TObject);
procedure ScrollBox1Resize(Sender: TObject);
procedure ScrollBox1ConstrainedResize(Sender: TObject; var MinWidth,
MinHeight, MaxWidth, MaxHeight: Integer);
procedure imageMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);






private
procedure RepaintLine;

{ Private declarations }
public
{ Public declarations }
end;
{type
//MyPanel = class (Tpanel)
private
procedure WmNCHitTest(var Msg : TWMNCHitTest); message WM_NCHITTEST;

end;
}
var

pt:pointss;
bla_work: Tbla_work;
flag:boolean;
sx,sy,oldx,oldy:integer;

implementation

uses Unit1,Unit3, Unit4;


{$R *.DFM}
{
procedure MyPanel.WmNCHitTest(var Msg: TWMNCHitTest);
const v=5; //border width
var p:TPoint;
begin
Inherited;
p:=Point(Msg.XPos,Msg.YPos);
p:=ScreenToClient(p);
if PtInRect(Rect(0,0,v,v),p) then
Msg.Result:=HTTOPLEFT
else if PtInRect(Rect(Width-v,Height-v,Width,Height),p) then
Msg.Result:=HTBOTTOMRIGHT
else if PtInRect(Rect(Width-v,0,Width,v),p) then
Msg.Result:=HTTOPRIGHT
else if PtInRect(Rect(0,Height-v,v,Height),p) then
Msg.Result:=HTBOTTOMLEFT
else if PtInRect(Rect(v,0,Width-v,v),p) then
Msg.Result:=HTTOP
else if PtInRect(Rect(0,v,v,Height-v),p) then
Msg.Result:=HTLEFT
else if PtInRect(Rect(Width-v,v,Width,Height-v),p) then
Msg.Result:=HTRIGHT
else if PtInRect(Rect(v,Height-v,Width-v,Height),p) then
Msg.Result:=HTBOTTOM;
if Msg.Result = htClient then //这一句去掉就不动了
Msg.Result := htCaption;
end;
}
procedure Tbla_work.N7Click(Sender: TObject);
begin
{application.Terminate; }
bla_work.close;
end;









procedure Tbla_work.FormClose(Sender: TObject; var Action: TCloseAction);
begin
{bla_login.close;
bla_work.free;
Application.Terminate; }
end;

procedure Tbla_work.FormCreate(Sender: TObject);

begin
setlength(e1.t1,1);
setlength(e1.a2,1);
setlength(pt,4);
try
bla_login := Tbla_login.Create(Application);
bla_login.ShowModal;
if bla_Login.ModalResult = mrcancel then
Application.Terminate;
finally
bla_login.free;
end;
end;

procedure Tbla_work.N8Click(Sender: TObject);
begin
bla_newl:=Tbla_newl.create(application);
bla_newl.ShowModal;
freeandnil(bla_newl);



end;

procedure Tbla_work.N10Click(Sender: TObject);
var
i:integer;
begin
for i:=low(e1.t1) to (high(e1.t1)-1) do
if e1.t1.BevelInner=bvLowered then
begin
bla_info:=tbla_info.create(application);
bla_info.Edit1.text:=e1.a2;
bla_info.ShowModal;
freeandnil(bla_info);
end;
end;

procedure Tbla_work.N9Click(Sender: TObject);
var
i:integer;
begin
for i:=low(e1.t1) to (high(e1.t1)-1) do
if e1.t1.BevelInner=bvLowered then
begin
e1.t1.Destroy;

end;
end;




procedure Tbla_work.Button1Click(Sender: TObject);

begin
pt[0]:=e1.t1[0].left+e1.t1[0].Width;
pt[1]:=e1.t1[0].top+round(e1.t1[0].Height/2);
pt[2]:=e1.t1[1].left;
pt[3]:=e1.t1[1].top+round(e1.t1[1].Height/2);
image.Canvas.MoveTo(pt[0], pt[1]);
image.Canvas.LineTo(pt[2], pt[3]);
end;

procedure Tbla_work.RepaintLine;

begin

image.Refresh;
image.Canvas.MoveTo(pt[0], pt[1]);
image.Canvas.LineTo(pt[2], pt[3]);
end;

procedure Tbla_work.FormPaint(Sender: TObject);
begin
RepaintLine;
end;

procedure Tbla_work.imagePaint(Sender: TObject);
begin
// RepaintLine;
end;

procedure Tbla_work.ScrollBox1Resize(Sender: TObject);
begin
//RepaintLine;
end;

procedure Tbla_work.ScrollBox1ConstrainedResize(Sender: TObject;
var MinWidth, MinHeight, MaxWidth, MaxHeight: Integer);
begin
//RepaintLine;
end;

procedure Tbla_work.imageMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
RepaintLine;
end;
end.

unit Unit3;

interface

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, ExtCtrls;
type
MyPanel = class (Tpanel)
private
procedure WmNCHitTest(var Msg : TWMNCHitTest); message WM_NCHITTEST;
//procedure MyDbClick(Sender:TObject);
end;
type
//Tbla_newl = class(TForm)
//MyPanel = class (Tpanel)
TIntArray=array of MyPanel;
a1=string[50];
e=record
a2:array of a1;
t1:tintarray;
end;
Tbla_newl = class(TForm)
Edit1: TEdit;
Button1: TButton;
Label1: TLabel;
Button2: TButton;
Label2: TLabel;
Label3: TLabel;
Label4: TLabel;
Label5: TLabel;
Label6: TLabel;
Label7: TLabel;
Memo1: TMemo;
ComboBox2: TComboBox;
ComboBox3: TComboBox;
ComboBox4: TComboBox;
GroupBox2: TGroupBox;
RadioButton1: TRadioButton;
RadioButton2: TRadioButton;
GroupBox1: TGroupBox;
RadioButton3: TRadioButton;
RadioButton4: TRadioButton;


procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
private
{ Private declarations }
private

procedure MyDbClick(Sender:TObject);
procedure MyClick(Sender:TObject);
procedure MyPanelMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);

procedure MyPanelDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure MyPanelUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
public
{ Public declarations }
end;
{ type
MyPanel = class (Tpanel)
end; }


var
bla_newl: Tbla_newl;
e1:e;
flag:boolean;
sx,sy,oldx,oldy:integer;

implementation

uses Unit2, Unit4;

{$R *.DFM}

procedure MyPanel.WmNCHitTest(var Msg: TWMNCHitTest);
const v=5; //border width
var p:TPoint;
begin
Inherited;
p:=Point(Msg.XPos,Msg.YPos);
p:=ScreenToClient(p);
if PtInRect(Rect(0,0,v,v),p) then
Msg.Result:=HTTOPLEFT
else if PtInRect(Rect(Width-v,Height-v,Width,Height),p) then
Msg.Result:=HTBOTTOMRIGHT
else if PtInRect(Rect(Width-v,0,Width,v),p) then
Msg.Result:=HTTOPRIGHT
else if PtInRect(Rect(0,Height-v,v,Height),p) then
Msg.Result:=HTBOTTOMLEFT
else if PtInRect(Rect(v,0,Width-v,v),p) then
Msg.Result:=HTTOP
else if PtInRect(Rect(0,v,v,Height-v),p) then
Msg.Result:=HTLEFT
else if PtInRect(Rect(Width-v,v,Width,Height-v),p) then
Msg.Result:=HTRIGHT
else if PtInRect(Rect(v,Height-v,Width-v,Height),p) then
Msg.Result:=HTBOTTOM;

end;

procedure Tbla_newl.Button1Click(Sender: TObject);
begin
ModalResult:=mrOk;
e1.t1[high(e1.t1)]:=MyPanel.create(application);
e1.t1[high(e1.t1)].parent:=bla_work.scrollbox1;
e1.t1[high(e1.t1)].top:=100;
e1.t1[high(e1.t1)].left:=100;
e1.t1[high(e1.t1)].width:=50;
e1.t1[high(e1.t1)].height:=50;
e1.t1[high(e1.t1)].tag:=high(e1.t1);
e1.t1[high(e1.t1)].OndblClick:=MyDbClick;
e1.t1[high(e1.t1)].OnClick:=MyClick;
e1.t1[high(e1.t1)].OnMouseMove:=MyPanelMove;
e1.t1[high(e1.t1)].OnMouseDown:=MyPanelDown;
e1.t1[high(e1.t1)].OnMouseUp:=MyPanelUp;
e1.a2[high(e1.t1)]:=edit1.text;
e1.t1[high(e1.t1)].show;
setlength(e1.t1,high(e1.t1)+2);
setlength(e1.a2,high(e1.a2)+2);
bla_newl.close;
end;

procedure tbla_newl.MyDbClick(Sender: TObject);
begin
bla_info:=tbla_info.create(application);
bla_info.Edit1.text:=e1.a2[(Sender as Tpanel).Tag];
bla_info.ShowModal;
freeandnil(bla_info);
end;

procedure tbla_newl.MyClick(Sender: TObject);
var
i:integer;
begin
for i:=low(e1.t1) to (high(e1.t1)-1) do e1.t1.BevelInner:=bvNone;
(Sender as Tpanel).BevelInner:=bvLowered;

end;

procedure tbla_newl.MyPanelDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
var
i:integer;
begin
for i:=low(e1.t1) to (high(e1.t1)-1) do e1.t1.BevelInner:=bvNone;
(Sender as Tpanel).BevelInner:=bvLowered;
ReleaseCapture;
(Sender as Tpanel).Perform(wm_syscommand,$F012,0);
end;

procedure tbla_newl.MyPanelMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
begin
pt[0]:=e1.t1[0].left+e1.t1[0].Width;
pt[1]:=e1.t1[0].top+round(e1.t1[0].Height/2);
pt[2]:=e1.t1[1].left;
pt[3]:=e1.t1[1].top+round(e1.t1[1].Height/2);
{bla_work.image.Refresh;
bla_work.image.Canvas.MoveTo(pt[0], pt[1]);
bla_work.image.Canvas.LineTo(pt[2], pt[3]);
}
end;

procedure tbla_newl.MyPanelUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin

pt[0]:=e1.t1[0].left+e1.t1[0].Width;
pt[1]:=e1.t1[0].top+round(e1.t1[0].Height/2);
pt[2]:=e1.t1[1].left;
pt[3]:=e1.t1[1].top+round(e1.t1[1].Height/2);
end;

procedure Tbla_newl.Button2Click(Sender: TObject);
begin
ModalResult:=mrCancel;
end;

end.

移动panel时不会重画,郁闷死了~~
 
你可以看一下:
http://www.delphibbs.com/delphibbs/dispq.asp?lid=2256140
但是离你想要得还有不小的差距,如果你想在此基础上发展一下,可以给我email要源码
 
to 枪手哈特

我的:bladevke@163.net
多谢!!
 
to 枪手哈特

我还没收到你的邮件,不过我上了那个网站下了例子看了一下,发现那个很lsjsldemo.exe的例子对我很有用,能不能把源码发给我啊?谢谢了~~
 
看看OPENGL的书
 
sorry,今天加班,晚上回去找找,明天发给你
 
to 枪手哈特

我的:chengxf1@163.com
多谢!!
 
各位,源码已经上传到我的网站
http://www.lsjsoft.com/china
delphi控件页面下,因为时间已经很久了,并且一直也没用过,所以并没有完善它,
不一定对大家有用。
 
多人接受答案了。
 
后退
顶部