Die Community zu .NET und Classic VB.

Startseite / Tipps / VB 5/6-Tipp 0183: 2D-Formular mit 3D-Rahmen und Pseudo-Caption

VB 5/6-Tipp 0183: 2D-Formular mit 3D-Rahmen und Pseudo-Caption

 von ActiveVB

Schwierigkeitsgrad:

Verwendete API-Aufrufe: DrawCaption, DrawFrameControl, ReleaseCapture, SendMessageA (SendMessage), SetRect

Download: Download des Beispielprojektes [2,39 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 Project1.vbp -------------
'--------- Anfang Formular "Form1" alias Form1.frm  ---------
' Steuerelement: Kontrollkästchen-Steuerelement "Check2"
' Steuerelement: Schaltfläche "Command1"
' Steuerelement: Kontrollkästchen-Steuerelement "Check1"

Option Explicit

Private Declare Function DrawCaption Lib "User32" (ByVal _
        hWnd As Long, ByVal hdc As Long, pcRect As RECT, _
        ByVal un As Long) As Long
        
        
Private Declare Function DrawFrameControl Lib "User32" _
        (ByVal hdc As Long, lpRect As RECT, ByVal un1 _
        As Long, ByVal un2 As Long) As Long
        
        
Private Declare Function SetRect Lib "User32" (lpRect _
        As RECT, ByVal X1 As Long, ByVal Y1 As Long, _
        ByVal X2 As Long, ByVal Y2 As Long) As Long

Private Declare Function SendMessage Lib "User32" Alias _
        "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As _
        Long, ByVal wParam As Long, lParam As Any) As Long

Private Declare Sub ReleaseCapture Lib "User32" ()

Private Type RECT
  Left As Long
  Top As Long
  Right As Long
  Bottom As Long
End Type

Const DC_ACTIVE = &H1
Const DC_ICON = &H4
Const DC_TEXT = &H8
Const DFC_BUTTON = 4
Const DFCS_BUTTON3STATE = &H10
Const DC_GRADIENT = &H20

Const WM_NCLBUTTONDOWN = &HA1
Const HTCAPTION = 2

Private Sub Form_Load()
  Me.ScaleMode = vbPixels
End Sub

Private Sub Form_MouseMove(Button As Integer, Shift As Integer, _
                           X As Single, Y As Single)
  If Button = 1 And Check2.Value = vbChecked Then
    Call ReleaseCapture
    Call SendMessage(Me.hWnd, WM_NCLBUTTONDOWN, HTCAPTION, 0)
  End If
End Sub

Private Sub Form_Paint()
  Dim R As RECT

    Call SetRect(R, 0, 0, Me.ScaleWidth, Me.ScaleHeight)
    DrawFrameControl Me.hdc, R, DFC_BUTTON, DFCS_BUTTON3STATE
    
    If Check1.Value = vbChecked Then
      SetRect R, 4, 3, Me.ScaleWidth - 4, 20
      Call DrawCaption(Me.hWnd, Me.hdc, R, DC_ACTIVE Or _
                       DC_ICON Or DC_TEXT Or DC_GRADIENT)
   End If
End Sub

Private Sub Command1_Click()
  Unload Me
End Sub

Private Sub Check1_Click()
  Call Form_Paint
End Sub
'---------- Ende Formular "Form1" alias Form1.frm  ----------
'-------------- Ende Projektdatei Project1.vbp --------------