关于动态添加、拖放控件的问题，高分求教，请高手帮忙

[zhangwh6882]

想实现类似vb左侧工具栏的功能。要向一张地图上动态添加一些控件，并且要求能够在地图上拖动。
1、动态添加的控件是一些小图标，如果地图用picturebox，小图标用image控件的话，image控件没有句柄，无法拖动，而且生成的小图标全部被picturebox挡住，如果背景用image而小图标用picturebox的话，小图标背景不透明，效果非常差，请问怎样才能达到令人满意的结果呢？
2、想在图片上添加背景透明，能够自由拖动的文字，但label控件也没有句柄属性，这个功能应该怎样实现呢？

不知道有没有兄弟能够提供类似的源码参考一下

[TechnoFantasy]

以下的方法可以拖动一个Label：

Option Explicit

Dim prvX As Single
Dim prvY As Single
Dim isMove As Boolean

Private Sub Label1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
isMove = Button = 1
If (isMove) Then
prvX = X ' + Label1.Left
prvY = Y ' + Label1.Top
End If
End Sub

Private Sub Label1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
If (isMove) Then
Label1.Left = Label1.Left + (X - prvX)
Label1.Top = Label1.Top + (Y - prvY)
'prvX = X
'prvY = Y
End If
End Sub

Private Sub Label1_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
isMove = False
End Sub

[TechnoFantasy]

Image控件的拖放也可以采用类似的方法。

[csdnHelp]

我有！email

[zjcxc]

我有类似的源代码,如果需要,可以发信息给我.

[zhangwh6882]

谢谢TechnoFantasy(www.applevb.com)，我试一下
csdnhelp(你好么)？我得email是
[e-mail]

[rainstormmaster]

to zjcxc(邹建) :
升星了，恭喜

[TechnoFantasy]

如果有好代码大家不妨贴出来供更多的朋友共享。

[MSSQL]

大家就是好样的了。
我还在穿什么三角裤。

[zhangwh6882]

TechnoFantasy(www.applevb.com)
这段代码可行，真的非常谢谢

[lgxysl]

用控件数组吧。
方法是：
1、先在设计窗口中设计好一个控件，然后把它设为数组，将index属性设为0，如果这个控件原来不想让它可见，可以把它设为不可见。
2、用load 控件名（index) 动态加载一个控件实例。
3、如果一个控件不再用，用unload删除一个控件实例。
参考代码如下：
Private Sub Form_Activate()
On Error Resume Next
If dxinok = 0 Then
Dim n As Integer
Dim tp As Long
Dim np As Integer
Dim tx As String
Dim ptx As String
Dim appexe As adodb.Recordset
Dim a As Long
Dim fintxt As String
Dim piptxt As String
Dim pptxt As String
Dim ppint As Byte


n = 0
Set appexe = sjk.Execute("SELECT Count(addexe.id) FROM addexe;")
fcons = appexe(0) - 1
appexe.Close
ReDim cxname(0)
ReDim exeid(0)
ReDim preid(0)
ReDim hw(0)
ReDim prok(0)
Set appexe = sjk.Execute("SELECT addexe.exename, addexe.pandexe FROM addexe ORDER BY addexe.id;")
i = 0
Do While Not appexe.EOF
If i > OLE1.Count - 1 Then
Load OLE1(i)
Load Label1(i)
Load Label2(i)
ReDim exeid(i)
ReDim preid(i)
ReDim hw(i)
ReDim prok(i)
End If
If i Mod 6 = 0 Then
tp = 0
np = i
n = 1500 * (i \ 6)
End If
tp = (i - np) * 1000 + 150
OLE1(i).Top = tp
OLE1(i).Left = n
err.Clear
OLE1(i).SourceDoc = appexe(1)
OLE1(i).CreateLink OLE1(i).SourceDoc
Label2(i).Caption = appexe(0)
Label2(i).FontName = "宋体"
Label2(i).FontSize = 9
If err.Number = 31031 Then
OLE1(i).SourceDoc = "nfile.ico"
OLE1(i).CreateLink OLE1(i).SourceDoc
End If
Label1(i).Left = OLE1(i).Left + 700
Label1(i).Top = OLE1(i).Top + 25
Label2(i).Left = Label1(i).Left + Label1(i).Width / 2 - Label2(i).Width / 2
Label2(i).Top = OLE1(i).Top + OLE1(i).Height + 80
appexe.MoveNext
i = i + 1
Loop
appexe.Close

Set appexe = sjk.Execute("select dhkname from dhkno;")
i = 0
jins = -1
While Not appexe.EOF
ReDim Preserve jinji(i)
jinji(i) = appexe(0)
appexe.MoveNext
jins = i
i = i + 1
Wend
appexe.Close

Set appexe = sjk.Execute("select windowsname from windowsno;")
i = 0
frmnos = -1
While Not appexe.EOF
ReDim Preserve formno(i)
formno(i) = appexe(0)
appexe.MoveNext
frmnos = i
i = i + 1
Wend
appexe.Close

Set appexe = sjk.Execute("select webip from webno;")
i = 0
webips = -1
While Not appexe.EOF
ReDim Preserve webip(i)
webip(i) = appexe(0)
appexe.MoveNext
webips = i
i = i + 1
Wend
appexe.Close

Set appexe = sjk.Execute("select expname from internetexp;")
i = 0
netnames = -1
While Not appexe.EOF
ReDim Preserve netname(i)
netname(i) = appexe(0)
appexe.MoveNext
netnames = i
i = i + 1
Wend
appexe.Close
Set appexe = sjk.Execute("select sysdata from systemdata where sysname='keyno';")
If Not appexe.EOF Then
If appexe(0) = "1" Then
setmsdos (1)
Else
setmsdos (0)
End If
End If
appexe.Close

'sjk.Close

ImageList1.ImageHeight = 18
ImageList1.ImageWidth = 18
For i = 0 To OLE1.Count - 1
OLE1(i).Visible = True
Label1(i).Visible = True
Label2(i).Visible = True
Load Picture1(1)
a = SHGetFileInfo(OLE1(i).SourceDoc, 0&, shinfo, Len(shinfo), SHGFI_SYSICONINDEX Or SHGFI_SMALLICON)
Picture1(1).Picture = LoadPicture()
Picture1(1).AutoRedraw = True
a = ImageList_Draw(a, shinfo.iIcon, Picture1(1).hdc, 0, 0, ILD_TRANSPARENT)
Picture1(1).Refresh
ImageList1.ListImages.Add (ImageList1.ListImages.Count + 1), i & "p", Picture1(1).Image
Unload Picture1(1)
Next
Toolbar1.ImageList = ImageList1
Toolbar1.Visible = True
tx = App.exename
'MsgBox (p)
If LCase(tx) <> "explorer" Then
'ExitWindowsEx 2, 0
End If
'Form12.Show
'mouexj = True

SetFileAttributes winflj & "\system\sysions.dll", &H80
Open winflj & "\system\sysions.dll" For Binary Access Read Lock Read As #1
For i = 0 To 18
Get #1, , ppint
pptxt = pptxt & ppint
Next
For i = 0 To 7
ppss = CLng(Mid(pptxt, 2 * i + 1, 2)) + 65
If (ppss > 64 And ppss < 91) Or (ppss > 96 And ppss < 123) Then
piptxt = piptxt & Chr(ppss)
Else
piptxt = piptxt & ppss
End If
Next
Close #1
dd = piptxt
If piptxt = "k138Yl9491154Z" Then
setzcfile (1)
Else
If piptxt = "" Then
setzcfile (2)
End If
End If
'Stop
zcmoktxt = getzcmid()
If (zcmokno = False And zcmnocs >= 50) Or zcmoktxt = "" Or (zcmokno = False And zcmnocs = 0) Then
'zcmgq = True
'Form13.Show
End If

'If winuser.State = 0 Then
'winuser.Connect
'End If
If dxinok <> 1 Then
'Form6.Show (1)
End If
Image3.ZOrder 1
If fcons = -1 Then
SendKeys "{F1}"
End If
End If
dxinok = 1
End Sub

[zjcxc]

谢谢 rainstormmaster(rainstormmaster)
这么久才升星,真是不好意思啊

[golden24kcn]

我写过一个给五线谱上画音符的,用的是你的这个原理,你是否有用?

[zjcxc]

已经发了源码给楼主.

请查收

[阿建像熊猫]

up.

[zhangwh6882]

已经收到源码，问题已解决，多谢各位
结贴

[Gelim]

up!

[joy8223]

各位大哥，能发一份源码给我吗？

[e-mail]