Printable View
Help!! I am trying to crate a program to show Database relationships. I want to be able to move listboxes within a form. Ie drag and drop from one place to another place. For some unknown reason, this has been a problem. It maybe somtthing very simple, but this is doing my head in at the moment. Can someone please help????
that's called Drag&Dropping. I like the manual way but there is an automatic one too.
put a listbox on a from and put this as code:
Dim rX as Single
Dim rY as Single
private Sub Form_Load()
List1.DragMode = vbManual
End Sub
private Sub List1_MouseDown(Button as Integer, Shift as Integer, X as Single, Y as Single)
If Button = vbLeftButton then
rX = X
rY = Y
List1.Drag
End If
End Sub
private Sub Form_DragDrop(Source as Control, X as Single, Y as Single)
Source.Left = X - rX
Source.Top = Y - rY
End Sub
private Sub List1_DragDrop(Source as Control, X as Single, Y as Single)
Form_DragDrop Source, List1.Left + X, List1.Top + Y
End Sub
Then try dragging the list on the form (using the mouse).
----------
The @host is everywhere!
----------
Thanks for the code. But I still cannot drag and drop the list box. Am I doing somthing wrong??
I tried deghosts sample and it worked fine for me. I started a new project. Added a Listbox (List1) then added the code to the form then ran the sample. I clicked and held the Listbox and moved it around the form with no problem.
Could you be a little more explicit as to what you are trying to do and what is failing???
John G
sorry My variables were incorrect. Everything seems ok. By the way do you know how to create a new Listbox. I know how you create new forms by the "NEW" method. How is this done using ListBoxes??
Don't beleive you can create a control using "NEW"
a Fomr is a Window. A ListBox is a control.
You can create controls using the following command but it has a problem in that you can't set a INDEX value to it
option Explicit
' Declare object variable as CommandButton.
private withevents cmdObject as CommandButton
private Sub Form_Load()
set cmdObject = frmCreate.Controls.Add("VB.CommandButton", "cmdOne")
cmdObject.Visible = true
cmdObject.Caption = "Dynamic Command Button"
cmdObject.Move 1000, 1000, 1000, 1000
End Sub
private Sub cmdObject_Click()
print "This is a dynamically added control"
End Sub
private Sub Form_Unload(Cancel as Integer)
' get rid of created control
me.Controls.Remove cmdObject
End Sub
John G
thanks for that. I am trying to create a program to show database table relationships. I want to show multiple listboxes with the fields shown. I then need to create links between listboxes using the LINE method. ANY IDEAS??
THANKS FOR THIS
In order to draw lines between the fields contained in the listboxes you are going to need to know where the fields are in that listbox, bearing in mind that the listbox might be scrolled.
This is done thus:
'\\ API Calls used in this module
Const LB_GETITEMHEIGHT = &H1A1
Const LB_GETITEMRECT = &H198
Const LB_GETTOPINDEX = &H18E
Const LB_FINDSTRING = &H18F
private Declare Function SendMessageByValLong Lib "user32" Alias "SendMessageA" (byval hWnd as Long, byval wMsg as Long, byval wParam as Long, byval lParam as Long) as Long
'\\ --[FieldnameAtPosition]---------------------------------------
'\\ Returns the fieldname of the field at the given X position
'\\ or blank if none.
'\\ --------------------------------------------------------------
public Function FieldnameAtPosition(YPos as Single) as string
Dim lItemHeight as Long 'height of an entry in the listbox in pixels..
Dim lTopIndex as Long
Dim lEntry as Long
Dim nYpos as Integer
on error resume next
'\\ 1 - get the height of each item...
lItemHeight = SendMessageByValLong(lstFields.hWnd, LB_GETITEMHEIGHT, 0, 0)
lItemHeight = lItemHeight * Screen.TwipsPerPixelY
'\\ 2 - get index of the topmost item...
lTopIndex = SendMessageByValLong(lstFields.hWnd, LB_GETTOPINDEX, 0, 0)
'\\ Find the Y position in pixels
nYpos = YPos
lEntry = lTopIndex + (nYpos / lItemHeight)
lstFields.ListIndex = lEntry - 1
FieldnameAtPosition = lstFields.List(lEntry - 1)
End Function
public Function ListPosition(byval sItemName as string) as Long
Dim lItemHeight as Long 'height of an entry in the listbox in pixels..
Dim lEntryPosition as Long
Dim lTopIndex as Long
on error resume next
'\\ 1 - get the height of each item...
lItemHeight = SendMessageByValLong(lstFields.hWnd, LB_GETITEMHEIGHT, 0, 0)
lItemHeight = lItemHeight * Screen.TwipsPerPixelY
'\\ 2 - get the listindex of the string...
lEntryPosition = SendMessageByValString(lstFields.hWnd, LB_FINDSTRING, 0, sItemName)
'\\ get index of the topmost item...
lTopIndex = SendMessageByValLong(lstFields.hWnd, LB_GETTOPINDEX, 0, 0)
If lEntryPosition < lTopIndex then
ListPosition = (lstFields.Top) - lItemHeight
ElseIf ((lEntryPosition - lTopIndex) * lItemHeight) > (lstFields.Height) then
ListPosition = (lstFields.Top) + (lstFields.Height)
else
ListPosition = (lstFields.Top) + ((lEntryPosition - lTopIndex) * lItemHeight)
End If
End Function
HTH,
Duncan
-------------------------------------------------
Ex. Datis: Duncan Jones
Merrion Computing Ltd
http://www.merrioncomputing.com
Check out the new downloads - ImageMap.ocx is the VB control that emulates an HTML image map, EventVB.OCX for adding new events to your VB form and adding System Tray support simply, MCL Hotkey for implemenmting system-wide hotkeys in your application...all with source code included.
thanks. But if I have 50 list boxes. I am aiming to have a similar interface to Microsoft Acces. Where you can view all the relationships. Is this a problem when you want to extend the width of the screen ie over 12000 pixels?
thanks
Each of these functions would work as well if you pass the actual listbox in as a parameter...
HTH,
Duncan
-------------------------------------------------
Ex. Datis: Duncan Jones
Merrion Computing Ltd
http://www.merrioncomputing.com
Check out the new downloads - ImageMap.ocx is the VB control that emulates an HTML image map, EventVB.OCX for adding new events to your VB form and adding System Tray support simply, MCL Hotkey for implemenmting system-wide hotkeys in your application...all with source code included.