ABOUT Visual Basic Programmieren Programmierung Download Downloads Tips & Tricks Tipps & Tricks Know-How Praxis VB VBA Visual Basic for Applications VBS VBScript Scripting Windows ActiveX COM OLE API ComputerPC Microsoft Office Microsoft Office 97 Office 2000 Access Word Winword Excel Outlook Addins ASP Active Server Pages COMAddIns ActiveX-Controls OCX UserControl UserDocument Komponenten DLL EXE
Diese Seite wurde zuletzt aktualisiert am 25.10.1999

Diese Seite wurde zuletzt aktualisiert am 25.10.1999
Aktuell im ABOUT Visual Basic-MagazinGrundlagenwissen und TechnologienKnow How, Tipps und Tricks rund um Visual BasicAddIns für die Visual Basic-IDE und die VBA-IDEVBA-Programmierung in MS-Office und anderen AnwendungenScripting-Praxis für IE, Windows Scripting Host und das Scripting-ControlTools, Komponenten und Dienstleistungen des MarktesRessourcen für Programmierer (Bücher, Job-Börse)Dies&Das...

Themen und Stichwörter im ABOUT Visual Basic-Magazin
Code, Beispiele, Komponenten, Tools im Überblick, Shareware, Freeware
Ihre Service-Seite, Termine, Job-Börse
Melden Sie sich an, um in den vollen Genuss des ABOUT Visual Basic-Magazins zu kommen!
Informationen zur AVB-Web-Site, Kontakt und Impressum

Zurück...

Zurück...


Anzeige

Code des Controls SizeGrip

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

Private Declare Function DrawFrameControl Lib "user32" _
 (ByVal hDC As Long, lpRect As RECT, ByVal nCtlType As Long, _
 ByVal nFlags As Long) As Long
Private Declare Function GetSystemMetrics Lib "user32" _
 (ByVal nIndex As Long) As Long
Private Declare Function ReleaseCapture Lib "user32" () _
 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 mForm As Form

Private WithEvents eForm As Form

Public Event MouseDown(Button As Integer, Shift As Integer, _
 X As Single, Y As Single)
Public Event MouseMove(Button As Integer, Shift As Integer, _
 X As Single, Y As Single)
Public Event MouseUp(Button As Integer, Shift As Integer, _
 X As Single, Y As Single)
Public Event ScrollbarSizeChanged(ByVal VScrollWidth As Long, _
 ByVal HScrollHeight As Long)

Private pAutoZOrder As Boolean
Private pHScrollHeight As Long
Private pVScrollWidth As Long

Public Property Get AutoZOrder() As Boolean
  AutoZOrder = pAutoZOrder
End Property

Public Property Let AutoZOrder(ByVal New_AutoZOrder As Boolean)
  pAutoZOrder = New_AutoZOrder
  PropertyChanged "AutoZOrder"
End Property

Public Property Get HScrollHeight() As Long
  HScrollHeight = pHScrollHeight
End Property

Public Property Get VScrollWidth() As Long
  VScrollWidth = pVScrollWidth
End Property

Public Sub DoSize(ByVal AnyHwnd As Long)
  zSize AnyHwnd
End Sub

Private Sub eForm_Resize()
  UserControl_Resize
End Sub

Private Sub UserControl_Initialize()
  pAutoZOrder = True
End Sub

Private Sub UserControl_MouseDown(Button As Integer, _
 Shift As Integer, X As Single, Y As Single)
  If mForm Is Nothing Then
    RaiseEvent MouseDown(Button, Shift, X, Y)
  Else
    Select Case Button
      Case vbLeftButton
        zSize mForm.Hwnd
    End Select
  End If
End Sub

Private Sub UserControl_MouseMove(Button As Integer, _
 Shift As Integer, X As Single, Y As Single)
  RaiseEvent MouseMove(Button, Shift, X, Y)
End Sub

Private Sub UserControl_MouseUp(Button As Integer, _
 Shift As Integer, X As Single, Y As Single)
  RaiseEvent MouseUp(Button, Shift, X, Y)
End Sub

Private Sub UserControl_Paint()
  Dim nRect As RECT
  
  Const DFC_SCROLL = 3
  Const DFCS_SCROLLSIZEGRIP = &H8

  Static sInProc As Boolean
  
  If sInProc Then
    Exit Sub
  Else
    sInProc = True
  End If
  UserControl_Resize
  With UserControl
    nRect.Right = .ScaleWidth
    nRect.Bottom = .ScaleHeight
    DrawFrameControl .hDC, nRect, DFC_SCROLL, DFCS_SCROLLSIZEGRIP
    If Not Ambient.UserMode Then
      UserControl.Line (0, 0)-(.ScaleWidth - 1, .ScaleHeight - 1), _
       vbBlack, B
    End If
  End With
  sInProc = False
End Sub

Private Sub UserControl_ReadProperties(PropBag As PropertyBag)
  pAutoZOrder = PropBag.ReadProperty("AutoZOrder", True)
  With UserControl
    If TypeOf .Parent Is Form Then
      If Not TypeOf .Parent Is MDIForm Then
        Set mForm = .Parent
        If Ambient.UserMode Then
          Set eForm = mForm
        End If
      End If
    End If
  End With
End Sub

Private Sub UserControl_Resize()
  Dim nVScrollWidth As Long
  Dim nHScrollHeight As Long
  Dim nChanged As Boolean
  Dim nWidth As Single
  Dim nHeight As Single
  
  Const SM_CXVSCROLL = 2
  Const SM_CYHSCROLL = 3
  
  Static sInProc As Boolean
  
  If sInProc Then
    Exit Sub
  Else
    sInProc = True
  End If
  On Error Resume Next
  If pAutoZOrder Then
    Extender.ZOrder 1
  End If
  nVScrollWidth = GetSystemMetrics(SM_CXVSCROLL)
  nHScrollHeight = GetSystemMetrics(SM_CYHSCROLL)
  If CBool(nVScrollWidth <> pVScrollWidth) _
   Or CBool(nHScrollHeight <> pHScrollHeight) Then
    pVScrollWidth = nVScrollWidth
    pHScrollHeight = nHScrollHeight
    nChanged = True
  End If
  If Ambient.UserMode Then
    If mForm Is Nothing Then
      UserControl.Size pVScrollWidth * Screen.TwipsPerPixelX, _
       pHScrollHeight * Screen.TwipsPerPixelY
    Else
      With mForm
        nWidth = .ScaleX(pVScrollWidth, vbPixels, .ScaleMode)
        nHeight = .ScaleY(pHScrollHeight, vbPixels, .ScaleMode)
        Extender.Move .ScaleWidth - nWidth, _
         .ScaleHeight - nHeight, nWidth, nHeight
      End With
    End If
  Else
    UserControl.Size pVScrollWidth * Screen.TwipsPerPixelX, _
     pHScrollHeight * Screen.TwipsPerPixelY
  End If
  UserControl_Paint
  If nChanged Then
    RaiseEvent ScrollbarSizeChanged(pVScrollWidth, pHScrollHeight)
  End If
  sInProc = False
End Sub

Private Sub UserControl_WriteProperties(PropBag As PropertyBag)
  PropBag.WriteProperty "AutoZOrder", pAutoZOrder, True
End Sub

Private Sub zSize(ByVal iHwnd As Long)
  Const WM_NCLBUTTONDOWN = &HA1
  Const HTBOTTOMRIGHT = 17

  ReleaseCapture
  SendMessage iHwnd, WM_NCLBUTTONDOWN, HTBOTTOMRIGHT, 0
End Sub

Zurück zu "Grip mit Grips" Zurück zum Text   


Komponenten-Übersicht

Zum Seitenanfang

Copyright © 1999 - 2017 Harald M. Genauck, ip-pro gmbh  /  Impressum

Zum Seitenanfang

Zurück...

Zurück...

Download Internet Explorer