我动态生成1000个speedbutton.想在运行时当鼠标按并拖动时对其动态移动位置,不知如何写移动代码,关于procedure部分:(60分)

  • 主题发起人 主题发起人 tl_lyq
  • 开始时间 开始时间
T

tl_lyq

Unregistered / Unconfirmed
GUEST, unregistred user!
[?]我动态生成1000个speedbutton.想在运行时当鼠标按并拖动时对其动态移动位置,不知如何写移动代码,关于procedure部分:
procedure Tform1.Button1Click(Sender: TObject);
begin
(sender as tspeedbutton).OnMouseDown:=mousedown;
(sender as tspeedbutton).OnMouseup:=mouseup;
(sender as tspeedbutton).OnMousemove:=mousemove;
end;
其中mousedown,onmouseup,mousemove是自己写的事件(依照Tform1.speedbutton1.mousedown...改写成通用的)。但上面的赋值报错。
 
aSpeedbutton := TSpeedbutton.Create(Self);
aSpeedbutton.OnMouseDown:=mousedown;//其他类似
其中申明
procedure MouseDown(Sender: TObject
Button: TMouseButton
Shift: TShiftState
X, Y: Integer);
 
移动代码:(加份)
procedure Torm1.控件MouseDown(Sender: TObject
Button: TMouseButton;
Shift: TShiftState
X, Y: Integer);
begin
if Button <> mbRight then
begin
ReleaseCapture;
控件.Perform(WM_SysCommand, $f017, 0)

end;
end;
 
(sender as tspeedbutton).OnMouseDown:=mousedown;
运行至此报错。incompatible types:"tobject" and "tmousedown"
 
(sender as tspeedbutton).OnMouseDown:=mousedown;
运行至此报错。incompatible types:"tobject" and "tmousedown"
报错是因为:sender 在你那个过程里是指Tform1.Button1
其余的按:sun77wind的做。
 
up^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^_^^ _^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
 
到http://delphi.mychangshu.com/上查找DsnSys

DsnSys可以让你在运行时(Runtime)调整控件的属性(大小、位置等),
有了它你就可以实现IDE啦
 
这样为什么也报错:
procedure MouseDown(Sender: TObject
Button: TMouseButton;
Shift: TShiftState
X, Y: Integer);
begin
if Button <> mbRight then
begin
ReleaseCapture;
(sender as tspeedbutton).Perform(WM_SysCommand, $f017, 0);
end;
end;

procedure Tjtplt1.SpeedButton1Click(Sender: TObject);
begin
(sender as tspeedbutton).OnMouseDown :=mousedown;
end;
 
错误信息?
 
(sender as tspeedbutton).OnMouseDown:=mousedown;
运行至此报错。incompatible types:"tobject" and "tmousedown"
 
你有没有在此之前判断是否为
tspeedbutton啊,加多一句if sender is tspeedbutton then
判断是否好一些呢??
 
把你的MouseDown过程换个名称吧,其他不变
 
MOVECOMP.DPR
program MoveComp;

uses
Forms,
MoveForm in 'MoveForm.pas' {Form1},
HitForm in 'HitForm.pas' {Form2};

{$R *.RES}

begin
Application.Initialize;
Application.CreateForm(TForm1, Form1);
Application.CreateForm(TForm2, Form2);
Application.Run;
end.

MOVEFORM.PAS
unit MoveForm;

interface

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls;

type
TForm1 = class(TForm)
Button1: TButton;
CheckBox1: TCheckBox;
RadioButton1: TRadioButton;
procedure ControlMouseDown(Sender: TObject
Button: TMouseButton;
Shift: TShiftState
X, Y: Integer);
procedure FormMouseDown(Sender: TObject
Button: TMouseButton;
Shift: TShiftState
X, Y: Integer);
private
{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;

implementation

{$R *.DFM}

const
sc_DragMove: Longint = $F012;

procedure TForm1.ControlMouseDown(Sender: TObject
Button: TMouseButton;
Shift: TShiftState
X, Y: Integer);
begin
if ssCtrl in Shift then
begin
ReleaseCapture;
(Sender as TWinControl).Perform (
wm_SysCommand, sc_DragMove, 0);
end;
end;

procedure TForm1.FormMouseDown(Sender: TObject
Button: TMouseButton;
Shift: TShiftState
X, Y: Integer);
begin
if ssCtrl in Shift then
begin
ReleaseCapture;
SendMessage (Handle, wm_SysCommand, sc_DragMove, 0);
end;
end;

end.

HITFORM.PAS
unit HitForm;

interface

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
Buttons;

type
TForm2 = class(TForm)
procedure FormResize(Sender: TObject);
procedure FormPaint(Sender: TObject);
private
MoveRect, TransRect: TRect;
public
procedure WmNcHitTest (var Msg: TWmNcHitTest);
message wm_NcHitTest;
end;

var
Form2: TForm2;

implementation

{$R *.DFM}

procedure TForm2.WmNcHitTest(var Msg: TWmNcHitTest);
var
Pt: TPoint;
begin
Pt := Point (Msg.XPos, Msg.YPos);
Pt := ScreenToClient (Pt);
if PtInRect (MoveRect, pt) then
Msg.Result := htCaption
else if PtInRect (TransRect, pt) then
Msg.Result := htTransparent
else
inherited;
end;

procedure TForm2.FormResize(Sender: TObject);
begin
MoveRect := Rect (20, 20,
ClientWidth - 20, ClientHeight div 2 - 10);
TransRect := Rect (20, ClientHeight div 2 + 10,
ClientWidth - 20, ClientHeight - 20);
Invalidate;
end;

procedure TForm2.FormPaint(Sender: TObject);
begin
// draw the rectangles
Canvas.Brush.Color:= Font.Color;
Canvas.FrameRect (MoveRect);
Canvas.FrameRect (TransRect);
// draw the text
Canvas.Brush.Color:= Color;
DrawText (Canvas.Handle, 'Move', 4, MoveRect,
dt_Center or dt_VCenter or dt_SingleLine);
DrawText (Canvas.Handle, 'Transparent', 11, TransRect,
dt_Center or dt_VCenter or dt_SingleLine);
end;

end.

MOVEFORM.DFM
object Form1: TForm1
Left = 194
Top = 108
Width = 278
Height = 213
Caption = 'MoveForm'
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'MS Sans Serif'
Font.Style = []
OnMouseDown = FormMouseDown
PixelsPerInch = 96
TextHeight = 13
object Button1: TButton
Left = 80
Top = 48
Width = 75
Height = 25
Caption = 'Button1'
TabOrder = 0
OnMouseDown = ControlMouseDown
end
object CheckBox1: TCheckBox
Left = 80
Top = 88
Width = 97
Height = 17
Caption = 'CheckBox1'
TabOrder = 1
OnMouseDown = ControlMouseDown
end
object RadioButton1: TRadioButton
Left = 80
Top = 120
Width = 113
Height = 17
Caption = 'RadioButton1'
TabOrder = 2
OnMouseDown = ControlMouseDown
end
end

HITFORM.DFM
object Form2: TForm2
Left = 477
Top = 120
Width = 234
Height = 207
Caption = 'HitForm'
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'MS Sans Serif'
Font.Style = []
Visible = True
OnPaint = FormPaint
OnResize = FormResize
PixelsPerInch = 96
TextHeight = 13
end

一个例子
 
后退
顶部