Die Community zu .NET und Classic VB.
Menü

VB 5/6-Tipp 0562: UDT-Pointer an Klasse übergeben

 von 

Beschreibung 

Es handelt sich um den berühmten VB-Bug, der es verhindert, dass man einen UDT an eine Klasse übergeben kann.
Das wohl meistbenutzte Workaround ist das einzelne Übergeben der UDT-Members, das aber bei größeren Strukturen wie z.B. der Bitmap-Struktur ausfällt.
Ein anderes Workaround ist die Benutzung von Klassen anstatt von UDTs, aber auch diese Methode hat ihre Nachteile, so kann es zu Konflikten kommen, wenn man die UDT einer API übergeben muss.

Das vorliegende Beispiel benutzt die VarPtr()-Funktion um einen Long-Pointer auf die Struktur an die Prozedur der Klasse zu übergeben, die dort mit RtlMoveMemory wieder in eine Struktur gepackt wird.
Das Ganze kommt einer ByRef-Übergabe gleich. Wenn man die in der Funktion modifizierten Daten manipuliert zurücksenden möchte, muss man wohl oder übel ein zweites Mal RtlMoveMemory benutzen.

Schwierigkeitsgrad:

Schwierigkeitsgrad 2

Verwendete API-Aufrufe:

LineTo, MoveToEx, RtlMoveMemory (Peek)

Download:

Download des Beispielprojektes [3,34 KB]

'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 projUDTPointer.vbp ----------
'------- Anfang Formular "dlgMain" alias dlgMain.frm  -------
' Steuerelement: Schaltfläche "cmdlpPaint"
' Steuerelement: Schaltfläche "cmdPaint"
' Steuerelement: Beschriftungsfeld "Label1"

'
'Autor: Konrad Rudolph   <mail@madrat.net>
'
'Hinweis: Um den auftretenden Fehler ohne die Verwendung
'         der UDT-Pointer-Methode nach zu konstruieren
'         löschen Sie die Kommentarzeichen im
'         entsprechenden Code weg.

Option Explicit

'****************************************************
'* UDT-Pointer-Beispiel                             *
'* demonstriert die Benutzung von Pointern um den   *
'* bekannten VB-Bug zu umgehen, der UDTs nicht in   *
'* Klassen zulässt.                                 *
'* Programmed: Konrad Rudolph, Mad Rat Pro.         *
'* Last Change: 27.11.2002 18:27                    *
'****************************************************

Private myDraw As CDraw

Private Sub cmdlpPaint_Click()
    Dim anyRect As RECT
    
    With anyRect
        .Left = 50
        .Top = 50
        .Right = 200
        .Bottom = 100
    End With
    
    ' hier geht's:
    myDraw.Paint_lpRect VarPtr(anyRect)
End Sub

Private Sub cmdPaint_Click()
    Dim anyRect As RECT
    
    With anyRect
        .Left = 50
        .Top = 50
        .Right = 200
        .Bottom = 100
    End With
    
    ' Fehler!
    'myDraw.PaintRect anyRect
End Sub

Private Sub Form_Load()
    Set myDraw = New CDraw
    
    myDraw.DC = Me.hDC
End Sub
'-------- Ende Formular "dlgMain" alias dlgMain.frm  --------
'---------- Anfang Klasse "CDraw" alias CDraw.cls  ----------
Option Explicit

Private m_DC As Long

Public Property Get DC() As Long
    DC = m_DC
End Property

Public Property Let DC(newDC As Long)
    m_DC = newDC
End Property

' geht nicht:
' Kommentare entfernen um Fehler zu erhalten!
'Public Sub PaintRect(myRect As RECT)
'    With myRect
'        Call MoveToEx(m_DC, .Left, .Top, ByVal 0&)
'        Call LineTo(m_DC, .Right, .Top)
'        Call LineTo(m_DC, .Right, .Bottom)
'        Call LineTo(m_DC, .Left, .Bottom)
'        Call LineTo(m_DC, .Left, .Top)
'    End With
'End Sub

' geht
Public Sub Paint_lpRect(lpRect As Long)
    Dim tmpRect As RECT
    
    Call Peek(tmpRect, lpRect, LenB(tmpRect))
    
    With tmpRect
        Call MoveToEx(m_DC, .Left, .Top, ByVal 0&)
        Call LineTo(m_DC, .Right, .Top)
        Call LineTo(m_DC, .Right, .Bottom)
        Call LineTo(m_DC, .Left, .Bottom)
        Call LineTo(m_DC, .Left, .Top)
    End With
End Sub
'----------- Ende Klasse "CDraw" alias CDraw.cls  -----------
'--------- Anfang Modul "defDraw" alias defDraw.bas ---------
Option Explicit

' RAM-Zugriff
Public Declare Sub Peek Lib "kernel32" Alias "RtlMoveMemory" ( _
    nDest As Any, ByVal lpSrc As Long, ByVal nLen As Long)

' Grafikfuntionen
Public Declare Function LineTo Lib "gdi32" ( _
    ByVal hDC As Long, ByVal x As Long, _
    ByVal y As Long) As Long

Public Declare Function MoveToEx Lib "gdi32" ( _
    ByVal hDC As Long, ByVal x As Long, _
    ByVal y As Long, lpPoint As Any) As Long

' RECT Struktur
Public Type RECT
    Left    As Long
    Top     As Long
    Right   As Long
    Bottom  As Long
End Type

'Private Type POINTAPI
'    x As Long
'    y As Long
'End Type
'---------- Ende Modul "defDraw" alias defDraw.bas ----------
'----------- Ende Projektdatei projUDTPointer.vbp -----------

Tipp-Kompatibilität:

Windows/VB-VersionWin32sWin95Win98WinMEWinNT4Win2000WinXP
VB4
VB5
VB6

Hat dieser Tipp auf Ihrem Betriebsystem und mit Ihrer VB-Version funktioniert?

Ja, funktioniert!

Nein, funktioniert nicht bei mir!

VB-Version:

Windows-Version:

Ihre Meinung  

Falls Sie Fragen zu diesem Artikel haben oder Ihre Erfahrung mit anderen Nutzern austauschen möchten, dann teilen Sie uns diese bitte in einem der unten vorhandenen Themen oder über einen neuen Beitrag mit. Hierzu können sie einfach einen Beitrag in einem zum Thema passenden Forum anlegen, welcher automatisch mit dieser Seite verknüpft wird.

Archivierte Nutzerkommentare 

Klicken Sie diesen Text an, wenn Sie die 6 archivierten Kommentare ansehen möchten.
Diese stammen noch von der Zeit, als es noch keine direkte Forenunterstützung für Fragen und Kommentare zu einzelnen Artikeln gab.
Aus Gründen der Vollständigkeit können Sie sich die ausgeblendeten Kommentare zu diesem Artikel aber gerne weiterhin ansehen.

Kommentar von Konrad Rudolph am 08.07.2003 um 17:34

@Mikl:

willst du damit sagen, daß Friend Subs UDTs akzeptieren? Das wäre ja mal was! Kann ich gerade nicht ausprobieren, kein VB zur Hand.

Das wäre nun in der Tat ein _sehr_ nettes Workaround, man darf dann bloß nicht vergessen, das in AX-Dlls wieder als Public zu deklarieren, sonst isses mau.

Kommentar von Mikl am 02.07.2003 um 15:06

soweit so gut, aber wenn man PaintRect eine friend sub macht, dann geht es auch.

Kommentar von ChL am 18.06.2003 um 21:52

Das Problem ist nur, dass er mit Strings in den UDT's nicht zurechtkommt. :/

Kommentar von Konrad Rudolph am 02.05.2003 um 01:13

@Philipp:
jaja, das hat wahrscheinlich irgend so'nen irre lustiger Depp da eingetragen, von denen es im Forum ja doch einige gibt.
Oder er hat den auskommentierten Code laufen lassen und bemerkt, daß das nicht geht ;o)

Kommentar von Philipp Stephani am 01.05.2003 um 23:52

Ich hab mal ne Frage zu der Versionstabelle: Wie kommt ihr drauf, dass der Tipp unter Windows 98 nicht funktioniert? Ich habe zwar kein Windows 98, aber ich denke, er müsste schon funktionieren, er verwendet ja nur ein paar einfache APIs.

Kommentar von Konrad Rudolph am 31.03.2003 um 21:07

Ups - grad bemerkt, da ist ein Fehler in der Beschreibung, hier die korrigierte Aussage:

"(...) Das ganze kommt einer **ByRef** Übergabe gleich. (...)"