Hej!

Har ett litet problem! Vill ha en ruta som följer musens position. I rutan ska det finnas info som ska updateras hela tiden vartefter musen flytar sig.

Tackar på förhand!

//Robban Ahlbeck
robbanahlbeck@hotmail.com

OKej.... Jag har försökt lösa ditt problem..... Men det är en liten grej jag inte får till men kanske det finns någon annan person i detta forum som kan fixa den grejjen.... Andreas Hellqvist (Fick till och med namnet rätt denna gång) eller SvenPon brukar kunna fixa till lite utöver det mesta.

Men här är mitt förslag:

1. Starta ett nytt projekt och lägg till Form1, Form2 och module1
2. På Form2 lägger du en Label1. Labeln storlek bör vara ungefär som en tooltip-ruta
3. Lägg denna kod i Form1

'============================================

Option Explicit

Private Sub Form_Load()
setTopMost Form2, True
End Sub

Private Sub Form_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
Form2.Left = Me.Left + x + 400
Form2.Top = Me.Top + y + 500
Form2.Label1.Caption = CStr(x) & " ," & CStr(y)
End Sub

Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
setTopMost Form2, False
Form2.Hide
End Sub

'============================================

4. Lägg denna kod i Form2

'============================================

Option Explicit

Private Sub Form_Load()
Label1.Width = Me.ScaleWidth
Label1.Height = Me.ScaleHeight
Label1.Left = Me.ScaleLeft
Label1.Top = Me.ScaleTop
Label1.BackColor = vbInfoBackground
Label1.ForeColor = vbInfoText
End Sub

'============================================

5. Lägg denna kod i Module1

'============================================

#If Win16 Then
Private Declare Sub SetWindowPos Lib "User" (ByVal hwnd As Integer, ByVal hWndInsertAfter As Integer, ByVal x As Integer, ByVal y As Integer, ByVal cx As Integer, ByVal cy As Integer, ByVal wFlags As Integer)
#ElseIf Win32 Then
Private Declare Function SetWindowPos Lib "user32" (ByVal hwnd As Long, ByVal hWndInsertAfter As Long, ByVal x As Long, ByVal y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long
#End If

Const SWP_NOACTIVATE = &H10
Const SWP_SHOWWINDOW = &H40
Const SWP_NOSIZE = &H1
Const SWP_NOMOVE = &H2
Const HWND_TOPMOST = -1
Const HWND_NOTOPMOST = -2

Public Sub setTopMost(frm As Form, TopMost As Boolean)
SetWindowPos frm.hwnd, HWND_TOPMOST, 0, 0, 0, 0, SWP_NOSIZE Or SWP_NOMOVE Or SWP_SHOWWINDOW
End Sub

'============================================

Nu skall du ha en lite tooltip-box som följer din mus på Form1...

Buggen är: Om man flyttar form 1. Och sedan drar muspekaren utanför Form1 så man kan klicka på toolTip-boxen så hänger det sig. Break med Ctrl-Break.

Jag kan inte hitta ett sätt att fixa detta men någon annan kanske kan göra det.

Lycka till.

/peterh

Jag vet inte om detta är till någon hjälp.

Har lekt lite med olika infallsvinklar och kommit fram till följande.

* Att använda SetCapture är inte lämpligt. Eftersom endast ett fönster kan behålla det åt gången. Ger lite konstiga följder om man vil dra och släppa fönster.
* Använda en timer och GetCursorPos ger en ryckig rörelse.
* Hittad sedan något som verkade intressant. Hooks vilket fångar alla medalande av en viss typ, däribland meddelande från musen. Nackdelen är att det ger en instabil utvecklings miljö. Eftersom den anropar en procedur genom adressen. Vilket upphör att existera om man stoppar koden. Går ju att lösa om man skapar en extern kontroll eller dll. Så Låt oss skapa en kontroll... :O)

------------------------------------------------------------------------------------
2001-01-13 Gjort lite förändringar av koden.
------------------------------------------------------------------------------------
* Skapa ett nytt ActivX Control Projekt
* Byt namn på projektet till VBMouseTracker
* Updatera följande egenskaper för UserControl1:
Name = TrackerControl
InvisibleAtRuntime = True
* Lägg till följande kod till TrackerControl
Option Explicit

Private Const SWP_NOSIZE = &H1
Private Const SWP_NOMOVE = &H2
Private Const SWP_NOZORDER = &H4
Private Const SWP_NOACTIVATE = &H10
Private Const SWP_NOOWNERZORDER = &H200

Private Declare Function SetWindowPos Lib "user32" (ByVal hwnd As Long, ByVal hWndInsertAfter As Long, ByVal X As Long, ByVal Y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long

Public Event MouseEvent(X As Long, Y As Long)

Private mTrackMouse As Boolean
Private mXOffset As Long
Private mYOffset As Long

Public Property Get TrackMouse() As Boolean
TrackMouse = mTrackMouse
End Property
Public Property Let TrackMouse(vData As Boolean)
If UserControl.Ambient.UserMode Then
If vData Then
If Not mTrackMouse Then
AddControl Me
End If
Else
If mTrackMouse Then
RemoveControl Me
End If
End If
End If
mTrackMouse = vData
PropertyChanged "TrackMouse"
End Property

Public Property Get XOffset() As Long
XOffset = mXOffset
End Property
Public Property Let XOffset(vData As Long)
mXOffset = vData
PropertyChanged "XOffset"
End Property

Public Property Get YOffset() As Long
YOffset = mYOffset
End Property
Public Property Let YOffset(vData As Long)
mYOffset = vData
PropertyChanged "YOffset"
End Property

Public Sub MouseEvent(X As Long, Y As Long)
Dim lReturn As Long
lReturn = SetWindowPos(ContainerHwnd, 0&, X + mXOffset, Y + mYOffset, 0&, 0&, SWP_NOSIZE Or SWP_NOACTIVATE Or SWP_NOOWNERZORDER Or SWP_NOSIZE)
RaiseEvent MouseEvent(X, Y)
End Sub


Private Sub UserControl_InitProperties()
mTrackMouse = False
mXOffset = 0
mYOffset = 0
End Sub

Private Sub UserControl_ReadProperties(PropBag As PropertyBag)
TrackMouse = PropBag.ReadProperty("TrackMouse")
mXOffset = PropBag.ReadProperty("XOffset")
mYOffset = PropBag.ReadProperty("YOffset")
End Sub

Private Sub UserControl_Terminate()
If mTrackMouse Then
RemoveControl Me
End If
End Sub

Private Sub UserControl_WriteProperties(PropBag As PropertyBag)
PropBag.WriteProperty "TrackMouse", mTrackMouse
PropBag.WriteProperty "XOffset", mXOffset
PropBag.WriteProperty "YOffset", mYOffset
End Sub


* Lägg till en module
* Lägg till följande kod i Module1
Option Explicit

Private Const WH_MOUSE = 7

Public Type POINTAPI
X As Long
Y As Long
End Type

Public Type MOUSEHOOKSTRUCT
pt As POINTAPI
hwnd As Long
wHitTestCode As Long
dwExtraInfo As Long
End Type

Private Declare Function SetWindowsHookEx Lib "user32" Alias "SetWindowsHookExA" (ByVal idHook As Long, ByVal lpfn As Long, ByVal hmod As Long, ByVal dwThreadId As Long) As Long
Private Declare Function CallNextHookEx Lib "user32" (ByVal hHook As Long, ByVal nCode As Long, ByVal wParam As Long, lParam As Any) As Long
Private Declare Function UnhookWindowsHookEx Lib "user32" (ByVal hHook As Long) As Long
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)

Private mHook As Long
Private mControls As Collection

Public Function AddControl(Control As TrackerControl)
If mControls Is Nothing Then
Set mControls = New Collection
StartHook
End If
mControls.Add Control
End Function
Public Function RemoveControl(Control As TrackerControl)
Dim Ctrl As TrackerControl
Dim Index As Integer
If Not mControls Is Nothing Then
For Each Ctrl In mControls
Index = Index + 1
If Ctrl Is Control Then
mControls.Remove Index
Exit For
End If
Next
If mControls.Count = 0 Then
StopHook
Set mControls = Nothing
End If
End If
End Function

Public Function MouseProc(ByVal nCode As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Dim lpMouse As MOUSEHOOKSTRUCT
Dim Ctrl As TrackerControl
On Error Resume Next
CopyMemory lpMouse, ByVal lParam, Len(lpMouse)
MouseProc = CallNextHookEx(mHook, nCode, wParam, ByVal lParam)

If Not mControls Is Nothing Then
For Each Ctrl In mControls
Ctrl.MouseEvent lpMouse.pt.X, lpMouse.pt.Y
Next
End If
End Function

Public Sub StartHook()
mHook = SetWindowsHookEx(WH_MOUSE, AddressOf MouseProc, App.hInstance, App.ThreadID)
End Sub

Public Sub StopHook()
UnhookWindowsHookEx mHook
mHook = 0
End Sub

Kompilera den och lägg sedan till den på formuläret du vill skall följa musen och ställ in XOffset och YOffset. Aktivera den genom att sätta TrackMouse = True på kontrollen.

Får varna att jag inte hunnit testa koden så mycket. Finns säkert några otrevliga buggar. Har inte heller hunnit "snygg" till den. Men bör ge en liten fingervisning i hur man kan göra.

//Mvh, Andreas Hillqvist

Hello Folks
När jag läser Er kod här ovan kommer jag att
tänka på ett gammalt ordspråk.

"Mycket skrik för lite ull , sa käringen när hon klippte grisen"

Så här mycket kod kan väl inte behövas för att lösa grund
frågeställningen.

Mera ved i brasan :
Någon skrev för ett tag sedan "Varför optimera när man har
800 mhz processor" Oproffsig inställning tycker jag !

Skall kolla in hur jag vill lösa grundproblemmet

mvh
Sven

Hoppas du lyckas bättre än mig. Får väl ta i försvar att det var söndags kväll, efter tolv jag skrev mitt inlägg...

Är peterh och hpeter samma person?

peterh utallade det kända uttrycket:
"Men att optimera för en 486 kan jag förstå men för en PIII-800 Mhz"
(diskussionen Allmänt/RGB värden i en picturebox)

Och det är hpeter som gett oss en utmaning... :O)

Hacka på mig ni bara....... (Jag tar inte åt mig). Men kanske ni skall fråga pelle om en "personangreppsarea" eller en "Den här personen skriver inte optimerad kod area"

Det är alltid en fråga om tid och pengar... OK jag håller med om att en optimerad kod snurrar fortare. Men jag har varit med så länge så jag vet precis hur det brukar se ut. Optimerad och odokumenterad kod = näst intill omöjligt för någon annan att debugga, vill vi ha det så. Det är därför jag favoriserar lättläst kod (inte alltid optimerad alltså) väl kommenterad. Men OK ni hackers kanske gör allt dokumenterar era trix så efterkommande debuggers vet hur ni tänkt.

Men tid är pengar. Så länge våra kunder är nöjd är vi nöjd. Våra kunder struntar blankt i om det tar 200 ms eller 90 ms att läsa en textfil. Men att sitta och hitta den optimala koden för att göra det kanske tar lång tid (Detta var bara ett exempel). Naturligtvis om kunden specar detta så löser vi det på ett sätt som kunden vill ha det inget snack.

MEN om man vill ha snabb kod oavsett om det är en 486:a eller en PIII-800 så är det inte VB man skall syssla med.

För er som undrar hpeter och peterh är samma person. Hemma och på Jobbet. (Hade inte inloggningsgrejset med hem så det fick bli en ny).

Jag är inte ute efter personagrepp(Ledsen om någon råkat ut för det). Jag gillar bara att ta mig an utmaningar.

Jag är emot oläslig kod, som du. Får erkänna att jag själv är hemsk på att kommentera min kod.

Bra kod för mig är kod som är tillräckligt lättläst utan att kopensera prestanda allt för mycket.

Den optimering jag är ute efter är den som är onödig. Funktiner och kod som inte tar någon skillnad på att skriva men som påverkar prestandan.
Ju mer man känner till om hur det fungerar ju bättre förutsättningar har du när du skriver funktionen. Om man som jag ägnar sig tid till att utforska hur lång tid olika kod tar och beter sig.
Vet man till nästa gång hur man kunde gjort det bättre.
Låt oss ta ett exempel som att använda varibler för fält när du loopar igenom ett recordset. Det gör koden mer lättläst samt snabbare.
Dim rsTemp
Dim fldKundId
Dim fldKundNamn
Set rsTemp = GetRecordset()
Set fldKundId = rsTemp("KundId")
Set fldKundNamn = rsTemp("KundNamn")
Do Until rsTemp.eof
List1.AddItem fldKundNamn
List1.ItemData(List1.NewIndex) = fldKundId
rsTemp.MoveNext
Loop

Det kommer ju inte märkas någon skillnad på några få poster när du sitter på din utvecklingsmiljö. Men hos en kund som inte har ett snabbt nät eller de senaste maskiner. Kanske det gör en betydande skillnad.

Kan ju lägga på en with Sats:
Dim rsTemp
Dim fldKundId
Dim fldKundNamn
Set rsTemp = GetRecordset()
Set fldKundId = rsTemp("KundId")
Set fldKundNamn = rsTemp("KundNamn")
With
Do Until rsTemp.eof
.AddItem fldKundNamn
.ItemData(.NewIndex) = fldKundId
rsTemp.MoveNext
Loop
End With

"Felaktigt"/mindre optimalt sätt hade varit att skriva.
Efter som detta utför ett anrop per post, i onödan:
Dim rsTemp
Dim fldKundId
Dim fldKundNamn
Set rsTemp = GetRecordset()
Set fldKundId = rsTemp("KundId")
Set fldKundNamn = rsTemp("KundNamn")
Do Until rsTemp.eof
With
.AddItem fldKundNamn
.ItemData(.NewIndex) = fldKundId
rsTemp.MoveNext
End With
Loop

Man kan inte strunta i prestandan för lättläslighet...

Hej
>MEN om man vill ha snabb kod oavsett om det är en 486:a eller en >PIII-800 så är det inte VB man skall syssla med.

Bull Bull ! !

Vb duger alldels bra om man vill vinna tid och bra dokumentation.

För den skull behöver man inte skriva slarvig kod.

mvh
Sven

JAJA...

Ni har självklart rätt och jag har självklart fel... Vill bara att ni skall vara medveten om följande:

På den läroanstalten där jag är utbildad, hade vi två av världens främsta kodare. Den ena pionjär på Java, med från början. Den andra fick erbjudandet att skriva AI:et för TombRaider III. Båda två lärde oss elever det vi nu praktiserar.

(Vad vill jag nu säga med detta...) Knappast att jag är lika duktig som dessa personer. Men jag tror i alla fall att dom har en aning om vad dom pratar om.

Men jag skall inte gnälla på att ni vill optimera kod, (eller gör jag det ?)det är väl bra att några gör det också. Det är en del av datavetenskapen. Andra skriver kod som andra skall förstå.

/peterh