VB 5/6-Tipp 0234: Absolute Position eines Steuerelements

'Dieser Quellcode stammt von http://www.activevb.de
'und kann frei verwendet werden. Für eventuelle Schäden
'wird nicht gehaftet.

'Um Fehler oder Fragen zu klären, nutzen Sie bitte unser Forum.
'Ansonsten viel Spaß und Erfolg mit diesem Source!

'------------- Anfang Projektdatei Project1.vbp -------------
'--------- Anfang Formular "Form1" alias Form1.frm  ---------
' Steuerelement: Timersteuerelement "Timer1"
' Steuerelement: Schaltfläche "Command1"
' Steuerelement: Beschriftungsfeld "Label1"

Option Explicit

Private Declare Function ClientToScreen Lib "user32" _
        (ByVal hwnd As Long, lpPoint As POINTAPI) As Long

Private Type POINTAPI
  X As Long
  Y As Long
End Type

Private Sub Timer1_Timer()
  Dim X&, Y&
    Call GetPositionOf(Form1, Command1, X, Y)
    Me.Caption = "X - " & X & "  Y - " & Y
End Sub

Private Sub GetPositionOf(F As Form, CTRL As Control, X&, Y&)
  Dim P As POINTAPI
  
    Call ClientToScreen(F.hwnd, P)
    X = P.X + CTRL.Top / Screen.TwipsPerPixelX
    Y = P.Y + CTRL.Left / Screen.TwipsPerPixelY
End Sub
'---------- Ende Formular "Form1" alias Form1.frm  ----------
'-------------- Ende Projektdatei Project1.vbp --------------

Kommentar von Manfred Mirsch am 31.08.2006 um 11:29

Top und Left sind verwechselt:
X = P.X + CTRL.Top / Screen.TwipsPerPixelX
Y = P.Y + CTRL.Left / Screen.TwipsPerPixelY

Stattdessen muesste es heissen:
X = P.X + CTRL.Left / Screen.TwipsPerPixelX
Y = P.Y + CTRL.Top / Screen.TwipsPerPixelY

Ich verwende eine andere Funkrion fuer die Umrechnung, so dass mein Code so asussieht:
Public Function GetPositionOf(formular As Form, element As Control) As POINTAPI
Dim pos As POINTAPI

Call ClientToScreen(formular.hwnd, pos)
GetPositionOf.X = PixelsToTwips(pos.X, True) + element.Left
GetPositionOf.Y = PixelsToTwips(pos.Y, False) + element.Top
End Function

Die Funktion PixelsToTwips lautet folgendermassen:
Public Function PixelsToTwips(Pixel As Long, DirHorizontal As Boolean) As Long
Const LOGPIXELSX = 88&
Const LOGPIXELSY = 90&
'Handle to device
Dim hDC As Long, PixelsPerInch As Long
Const TWIPSPERINCH = 1440
hDC = GetDC(0&)

If DirHorizontal Then 'Horizontal
PixelsPerInch = apiGetDeviceCaps(hDC, LOGPIXELSX)
Else 'Vertical
PixelsPerInch = apiGetDeviceCaps(hDC, LOGPIXELSY)
End If
hDC = ReleaseDC(0, hDC)
PixelsToTwips = (Pixel / PixelsPerInch) * TWIPSPERINCH
End Function

Kommentar von HaPe am 19.08.2006 um 07:28

Hallo ActiveVB,

ich suche eine Möglichkeit in Access ein Formular unter einem Steuerelement zu positionieren. Bisher ohne Erfolg.
Nun habe ich Euer ClientToScreen gefunden.

Nach dem Übernehmen in Access bekomme ich eine Fehlermeldung bei Screen.TwipsPerPixelX.

Gibt es eine Möglicheit das Beispiel für mein Problem in Access einzusetzen, oder funktioniert dies nicht?

HaPe

Kommentar von woeh am 26.04.2004 um 11:39

die tip ist ungenau, sobald das control ein weiteres Parent hat (z.B. Frame)

Kommentar von Carsten Jahner am 05.02.2004 um 11:05

Die letzten beiden Zeilen müssen so aussehen damit es funktioniert:

[code]
X = p.X + CTRL.Left / Screen.TwipsPerPixelX
Y = p.Y + CTRL.Top / Screen.TwipsPerPixelY
[/coode]

Die Eigenschaften Left & Top wurden vertauscht.
Ansonsten: Prima Tip!

Kommentar von Mirko Klotz am 02.08.2002 um 14:45

Geht auch so:
Private Declare Function GetWindowRect Lib "user32" (ByVal hwnd As Long, lpRect As RECT) As Long
Private Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type
Public Sub GetAbsolutePosition(aControl As Control, ByRef OUT_Left As Single, ByRef OUT_Top As Single)
Dim myRECT As RECT
Call GetWindowRect(aControl.hwnd, myRECT)
OUT_Left = myRECT.Left
OUT_Top = myRECT.Top
End Sub
Als Antwort kommt die absolute Position in Pixeln heraus. Wenn dann noch OUT_Top mit Screen.TwipsPerPixelY multipliziert wird (OUT_Left analog), bekommt man die absolute Position in VB-Twips.

Kommentar von Daubner am 04.04.2002 um 14:34

Mit folgenden Änderungen funktioniert die Sache:
x = P.x * Screen.TwipsPerPixelX + CTRL.Top
y = P.y * Screen.TwipsPerPixelY + CTRL.Left

Kommentar von Andreas am 05.03.2001 um 18:09

Ich habe versucht mit Hilfe des Codebsp:
Absolute Position eines Controls
und folgender eigenen Funktion:
Private Sub Command1_Click()
Dim X As Long
Dim Y As Long
Call GetPositionOf(Form1, Command1, X, Y)
Form2.Top = Y + Command1.Height
Form2.Left = X + Command1.Width - Form2.Width
Form2.Show
End Sub
Form2 unterhalb des Buttons Command1 anzuzeigen. Leider funktioniert das nicht. Verschiebt man Form1 (großzügig) ergibt dies nur minimale Änderungen an der Pos. von Form 2