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
![Stick Out Tongue :p :p](https://cdn.jsdelivr.net/joypixels/assets/8.0/png/unicode/64/1f61b.png)
ointss;
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时不会重画,郁闷死了~~