|
Viele Steuerelemente haben in ihrer Standarddarstellung einen Rahmen, der sie plastisch "eingesunken" darstellt. Wenn Ihnen diese Rahmenart nicht gefällt und Sie beispielsweise lieber eine erhabene Darstellung (wie in Microsoft Access möglich), einen feineren Rahmen oder vielleicht einen gravierten Rahmen (wie beim Frame-Steuerelement) hätten, müssen Sie selbst für einen solchen eigenen Rahmen sorgen.
Sie könnten dies mit Hilfe von umständlich zu platzierenden Line-Steuerelementen oder mit gezeichneten Linien (Line-Methode eines Forms usw.) erledigen. Einfacher haben Sie es jedoch mit der API-Funktion  DrawEdge, die vollständige, rechteckige Rahmen in verschiedenen Darstellungen zeichnen kann. Sie brauchen lediglich den Geräte-Kontext des Containers und das Rechteck anzugeben, das als Rahmen gezeichnet werden soll, und dazu natürlich noch die gewünschte Darstellungsart.
Private Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type
Private Declare Function DrawEdge Lib "user32" (ByVal hDC As Long, _
qrc As RECT, ByVal Edge As Long, ByVal grfFlags As Long) As Long
Private Const BDR_RAISEDINNER = &H4
Private Const BDR_RAISEDOUTER = &H1
Private Const BDR_SUNKENINNER = &H8
Private Const BDR_SUNKENOUTER = &H2
Private Const EDGE_BUMP = (BDR_RAISEDOUTER Or BDR_SUNKENINNER)
Private Const EDGE_ETCHED = (BDR_SUNKENOUTER Or BDR_RAISEDINNER)
Private Const EDGE_RAISED = (BDR_RAISEDOUTER Or BDR_RAISEDINNER)
Private Const EDGE_SUNKEN = (BDR_SUNKENOUTER Or BDR_SUNKENINNER)
Private Const BF_BOTTOM = &H8
Private Const BF_LEFT = &H1
Private Const BF_RIGHT = &H4
Private Const BF_TOP = &H2
Private Const BF_RECT = (BF_LEFT Or BF_TOP Or BF_RIGHT Or BF_BOTTOM)
DrawEdge Control.Container.hDC, RECT, EDGE_RAISED, BF_RECT
Dies sieht allerdings einfacher aus, als es tatsächlich ist. Bei Containern, die den Geräte-Kontext (hDC) als Eigenschaft liefern, bereitet das noch keine allzu großen Schwierigkeiten. Sie ermitteln mit der API-Funktion GetWindowRect das Rechteck des Steuerelements
GetWindowRect Control.hWnd, nRect
und lassen von der API-Funktion ScreenToClient die Koordinaten des Rechtecks in Koordinaten des Containers umrechen. Damit Sie ein wenig Zuweisungsarbeit sparen, verwenden Sie hilfsweise zusätzliche benutzerdefinierte Variablen - POINTAPI für die Koordinaten eines Punkts und RectPoints für die beiden diagonal gegenüberliegenden Punkte, die ein Rechteck festlegen. RectPoints setzt sich aus zwei Elementen des Typs POINTAPI zusammen.
Private Type POINTAPI
X As Long
Y As Long
End Type
Private Type RectPoints
LeftTop As POINTAPI
RightBottom As POINTAPI
End Type
Mit der Visual Basic-Anweisung LSet können Sie ein Rechteck einer Variablen des Typs RectPoint zuweisen. Das funktioniert, weil die vier Long-Elemente eines Rechtecks den zwei mal zwei Long-Werten entsprechen und die Werte an den Positionen 1 zu 1 übertragen werden.
LSet nRectPoints = nRect
ScreenToClient Control.Container.hWnd, nRectPoints.LeftTop
ScreenToClient Control.Container.hWnd, nRectPoints.RightBottom
Nun noch der Rückwärtsgang der Zuweiserei:
LSet nRect = nRectPoints
Dann vergrößern das Rechteck ein wenig mit der API-Funktion InflateRect, beispielsweise um 2 Pixels
InflateRect nRect, 2, 2
und können nun den Rahmen von DrawEdge zeichnen lassen.
DrawEdge Container.hDC, nRect, EDGE_RAISED, BF_RECT
Verfügt der Container nicht über die hDC-Eigenschaft, aber immerhin über ein Fenster-Handle (hWnd-Eigenschaft), können Sie den Geräte-Kontext fast immer über
die API-Funktion GetDC zu einem gegebenen Fenster-Handle erhalten:
DC = GetDC(ContainerWnd)
DrawEdge DC, nRect, EDGE_RAISED, BF_RECT
Allerdings muss der so erhaltene Geräte-Kontext danach wieder mit der API-Funktion ReleaseDC freigegeben werden:
ReleaseDC Container.hWnd, DC
Ist der Container beispielsweise ein UserControl, das nicht über die öffentlichen Eigenschaften hDC oder zumindest hWnd verfügt, sind Sie noch nicht ganz aufgeschmissen, wenn wenigstens das zu umrahmende Steuerelement selbst über eine hWnd-Eigenschaft verfügt. Denn dann können Sie das Fenster-Handle des Containers immerhin noch über die API-Funktion GetParent ermitteln und anhand dessen wieder den Geräte-Kontext:
ContainerWnd = GetParent(Control.hWnd)
DC = GetDC(ContainerWnd)
DrawEdge DC, nRect, EDGE_RAISED, BF_RECT
ReleaseDC ContainerWnd, DC
Falls Sie in Ihrem Programm auf andere Weise an den benötigten Geräte-Kontext des Containers gelangen können, wäre dies der allerletzte Ausweg. Erst wenn auch diese Möglichkeit nicht mehr gegeben ist, werden Sie so ein Steuerelement nicht umrahmen können.
Eine weitere Schwierigkeit bereiten Steuerelemente, die nicht über ein Fenster-Handle verfügen. Denn dann können Sie nicht mit der API-Funktion GetWindowRect das Rechteck des Steuerelements ermitteln. Dies betrifft Steuerelemente wie das Label, das Image-Element oder auch Shape-Elemente.
Bei diesen müssen Sie die Werte für das Rechteck aus der Position des Steuerelements in seinem Container ermitteln. Da die DrawEdge die Werte in der Maßeinheit Pixels erwartet, müssen Sie die Positionswerte im Container anhand dessen ScaleMode-Einstellung und die ScaleX- bzw. ScaleY-Methoden des Containers bzw. Parents des Steuerelements in Pixels umrechnen.
Ein Problem wird aber auch dies, wenn der Container nicht über die ScaleMode-Eigenschaft, und dieser oder der Parent (meistens das Form) nicht über die Scale...-Methoden verfügt.
With Control
On Error Resume Next
ScaleMode = .Container.ScaleMode
If Err.Number = 0 Then
nRect.Left = .Parent.ScaleX(.Left, ScaleMode, vbPixels)
If Err.Number = 0 Then
nRect.Top = .Parent.ScaleY(.Top, ScaleMode, vbPixels)
nRect.Right = nRect.Left + .Parent.ScaleX(.Width, _
ScaleMode, vbPixels)
nRect.Bottom = nRect.Top + .Parent.ScaleY(.Height, _
ScaleMode, vbPixels)
Else
Wenn der Container nicht über die Scale...-Methoden verfügt, könnte immerhin noch der Container darüber verfügen:
Err.Clear
nRect.Left = .Container.ScaleX(.Left, ScaleMode, vbPixels)
If Err.Number = 0 Then
nRect.Top = .Container.ScaleY(.Top, ScaleMode, vbPixels)
nRect.Right = .Left + .Container.ScaleX(.Width, _
ScaleMode, vbPixels)
nRect.Bottom = .Top + .Container.ScaleY(.Height, _
ScaleMode, vbPixels)
End If
End If
End If
End With
Wenn weder Container noch Parent über die Scale...-Methoden verfügen und auch der ScaleMode nicht ermittelt werden kann, ist's wieder Essig mit dem Rahmen-Zeichnen. Auch hier können Sie natürlich den ScaleMode-Wert gegebenenfalls auf andere Weise ermitteln, und auch die Umrechnung auf andere Weise erledigen, etwa mit Hilfe der Scale...-Methoden eines anderen vielleicht verfügbaren Containers.
Die folgende Funktion ControlBorder3D verpackt die notwendigen Ermittlungen und das Zeichnen des Rahmen vollständig für nahezu jedes Steuerelement. Lediglich dann, wenn die zuvor beschriebenen Ermittlungen fehlschlagen, steigt sie mit der Rückgabe von True aus und zeichnet keinen Rahmen.
Sie übergeben ihr zuerst das zu umrahmende Steuerelement und optional den Rahmenstil aus der Enumeration bsBorderStyleConstants. Die Voreinstellung ist bsFlat - bei diesem Stil wird die Funktion gleich wieder verlassen, da nichts gezeichnet werden braucht.
Public Enum bsBorderStyleConstants
bsFlat = 0
bsRaisedThin = BDR_RAISEDINNER
bsRaised = EDGE_RAISED
bsSunkenThin = BDR_SUNKENOUTER
bsSunken = EDGE_SUNKEN
bsBump = EDGE_BUMP
bsEtched = EDGE_ETCHED
End Enum
Als nächstes übergeben Sie den gewünschten Abstand des Rahmens zum Steuerelement.
In den folgenden optionalen Parametern können Sie die benötigten Werte, wie sie oben beschrieben worden sind, auch sozusagen manuell übergeben: hDC oder hWnd des Containers (ContainerDC und ContainerWnd) und den ScaleMode des Containers.
Public Function ControlBorder3D(Control As Control, _
Optional ByVal BorderStyle As bsBorderStyleConstants = bsFlat, _
Optional ByVal BorderWidth As Integer = 1, _
Optional ByVal ContainerDC As Long, _
Optional ContainerWnd As Long, _
Optional ByVal ScaleMode As Integer = -1) As Boolean
Hier nun der Code dieser Funktion im Ganzen mit allen notwendigen Deklarationen:
Private 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
Private Type RectPoints
LeftTop As POINTAPI
RightBottom As POINTAPI
End Type
Private Const BDR_RAISEDINNER = &H4
Private Const BDR_RAISEDOUTER = &H1
Private Const BDR_SUNKENINNER = &H8
Private Const BDR_SUNKENOUTER = &H2
Private Const EDGE_BUMP = (BDR_RAISEDOUTER Or BDR_SUNKENINNER)
Private Const EDGE_ETCHED = (BDR_SUNKENOUTER Or BDR_RAISEDINNER)
Private Const EDGE_RAISED = (BDR_RAISEDOUTER Or BDR_RAISEDINNER)
Private Const EDGE_SUNKEN = (BDR_SUNKENOUTER Or BDR_SUNKENINNER)
Private Const BF_BOTTOM = &H8
Private Const BF_LEFT = &H1
Private Const BF_RIGHT = &H4
Private Const BF_TOP = &H2
Private Const BF_RECT = (BF_LEFT Or BF_TOP Or BF_RIGHT Or BF_BOTTOM)
Private Declare Function DrawEdge Lib "user32" (ByVal hDC As Long, _
qrc As RECT, ByVal edge As Long, ByVal grfFlags As Long) As Long
Private Declare Function GetDC Lib "user32" (ByVal hWnd As Long) _
As Long
Private Declare Function GetWindowRect Lib "user32" _
(ByVal hWnd As Long, lpRect As RECT) As Long
Private Declare Sub InflateRect Lib "user32" (lpRect As RECT, _
ByVal X As Long, ByVal Y As Long)
Private Declare Function ReleaseDC Lib "user32" _
(ByVal hWnd As Long, ByVal hDC As Long) As Long
Private Declare Function ScreenToClient Lib "user32" _
(ByVal hWnd As Long, lpPoint As POINTAPI) As Long
Public Enum bsBorderStyleConstants
bsFlat = 0
bsRaisedThin = BDR_RAISEDINNER
bsRaised = EDGE_RAISED
bsSunkenThin = BDR_SUNKENOUTER
bsSunken = EDGE_SUNKEN
bsBump = EDGE_BUMP
bsEtched = EDGE_ETCHED
End Enum
Public Function ControlBorder3D(Control As Control, _
Optional ByVal BorderStyle As bsBorderStyleConstants = bsFlat, _
Optional ByVal BorderWidth As Integer = 1, _
Optional ByVal ContainerDC As Long, _
Optional ContainerWnd As Long, _
Optional ByVal ScaleMode As Integer = -1) As Boolean
Dim nRect As RECT
Dim nRectPoints As RectPoints
Dim nDC As Long
Dim nDoReleaseDC As Boolean
Dim nControlWnd As Long
Dim nContainerWnd As Long
If BorderStyle = bsFlat Then
Exit Function
End If
With Control
If .Visible Then
On Error Resume Next
If ContainerWnd = 0 Then
ContainerWnd = .Container.hWnd
If Err.Number Then
Err.Clear
nControlWnd = .hWnd
If Err.Number Then
ControlBorder3D = True
Exit Function
Else
nContainerWnd = GetParent(nControlWnd)
If nContainerWnd Then
ContainerWnd = nContainerWnd
Else
ControlBorder3D = True
Exit Function
End If
End If
End If
End If
If ContainerDC = 0 Then
If ContainerWnd = 0 Then
ControlBorder3D = True
Exit Function
Else
With .Container
nDC = .hDC
If Err.Number Then
Err.Clear
nDC = GetDC(ContainerWnd)
nDoReleaseDC = True
End If
End With
End If
Else
nDC = ContainerDC
End If
nControlWnd = .hWnd
If Err.Number Then
Err.Clear
Select Case ScaleMode
Case -1
ScaleMode = .Container.ScaleMode
If Err.Number Then
ControlBorder3D = True
Exit Function
End If
nRect.Left = .Parent.ScaleX(.Left, ScaleMode, vbPixels)
If Err.Number Then
Err.Clear
nRect.Left = .Container.ScaleX(.Left, ScaleMode, _
vbPixels)
If Err.Number Then
ControlBorder3D = True
Exit Function
End If
nRect.Top = .Container.ScaleY(.Top, ScaleMode, _
vbPixels)
nRect.Right = .Left + .Container.ScaleX(.Width, _
ScaleMode, vbPixels)
nRect.Bottom = .Top + .Container.ScaleY(.Height, _
ScaleMode, vbPixels)
Else
nRect.Top = .Parent.ScaleY(.Top, ScaleMode, vbPixels)
nRect.Right = nRect.Left + .Parent.ScaleX(.Width, _
ScaleMode, vbPixels)
nRect.Bottom = nRect.Top + .Parent.ScaleY(.Height, _
ScaleMode, vbPixels)
End If
Case vbTwips
nRect.Left = .Left \ Screen.TwipsPerPixelX
nRect.Top = .Top \ Screen.TwipsPerPixelY
nRect.Right = nRect.Left + (.Width _
\ Screen.TwipsPerPixelX)
nRect.Bottom = nRect.Top + (.Height _
\ Screen.TwipsPerPixelY)
Case vbPixels
nRect.Left = .Left
nRect.Top = .Top
nRect.Right = nRect.Left + .Width
nRect.Bottom = nRect.Top + .Height
End Select
If Err.Number Then
ControlBorder3D = True
Exit Function
End If
Else
GetWindowRect nControlWnd, nRect
LSet nRectPoints = nRect
ScreenToClient ContainerWnd, nRectPoints.LeftTop
ScreenToClient ContainerWnd, nRectPoints.RightBottom
LSet nRect = nRectPoints
End If
InflateRect nRect, BorderWidth, BorderWidth
DrawEdge nDC, nRect, BorderStyle, BF_RECT
If nDoReleaseDC Then
ReleaseDC ContainerWnd, nDC
End If
End If
End With
End Function
Wenn Sie alle Steuerelemente eines Forms oder anderen Containers mit dem gleichen Rahmen versehen möchten, können Sie die folgende Funktion ContainerControlsBorder3D verwenden. Sie übergeben ihr die Controls-Collection des Containers und optional den Rahmenstil und den Rahmenabstand. Dazu können Sie eine bereits instanzierte Collection übergeben, in die jeweils dasjenige Steuerelemente aufgenommen wird, um das ein Rahmen nicht gezeichnet werden konnte. Denn dann gibt der Aufruf von ControlBorder3D den Wert zurück. So können Sie sich im Anschluss an den Aufruf von ContainerControlsBorder3D selbst um diese Steuerelemente kümmern, oder sie einfach ignorieren, wie etwa Menü-Steuerelemente.
Public Function ContainerControlsBorder3D(Controls As Object, _
Optional ByVal BorderStyle As bsBorderStyleConstants = bsFlat, _
Optional ByVal BorderWidth As Integer = 1, _
Optional ByVal ContainerWnd As Long, _
Optional ByVal ScaleMode As Integer = -1, _
Optional ByVal ReturnOddControls As Collection) As Boolean
Dim nControl As Control
If ReturnOddControls Is Nothing Then
For Each nControl In Controls
ControlBorder3D nControl, BorderStyle, BorderWidth, , _
ContainerWnd, ScaleMode
Next
Else
For Each nControl In Controls
If ControlBorder3D(nControl, BorderStyle, BorderWidth, , _
ContainerWnd, ScaleMode) Then
ReturnOddControls.Add nControl
End If
Next
End If
End Function
Zum Schluss noch ein kleiner Tipp: Wenn Sie einen 3D-Rahmen einfach so auf einem Cotnainer darstellen möchten, ohne dass er ein Steuerelement umschließen soll, verwenden Sie doch trotzdem ein Steuerelement - nämlich ein Shape-Element. Setzen Sie bei diesem den BackStyle als auch den BorderStyle transparent, so erscheint es selbst nicht, dient aber als Vorlage für einen Rahmen, der wie oben gezeigt gezeichnet wird. Lassen Sie den BorderStyle zunächst noch sichtbar, können Sie die Position des 3D-Rahmens bequem festlegen und sind nicht auf umständliche Zahlenangaben per Code angewiesen.
|