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 17.10.1999

Diese Seite wurde zuletzt aktualisiert am 17.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 UserControls FormX

Option Explicit

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

Private Declare Function CombineRgn Lib "gdi32" _
 (ByVal hDestRgn&, ByVal hSrcRgn1&, ByVal hSrcRgn2&, _
 ByVal nCombineMode&) As Long

Private Declare Function CreateRectRgn Lib "gdi32" _
 (ByVal X1&, ByVal Y1&, ByVal X2&, ByVal Y2&) As Long

Private Declare Function DeleteObject Lib "gdi32" _
 (ByVal hObject&) As Long

Private Declare Function GetClientRect Lib "user32" _
 (ByVal hWnd As Long, lpRect As RECT) As Long

Private Declare Function GetDesktopWindow Lib "user32" _
 () As Long

Private Declare Function GetWindowRect Lib "user32" _
 (ByVal hWnd As Long, lpRect As RECT) 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 Declare Function SetParent Lib "user32" _
 (ByVal hWndChild As Long, ByVal hWndNewParent As Long) As Long

Private Declare Function SetWindowPos Lib "user32" _
 (ByVal hWnd As Long, ByVal Order As Long, ByVal X As Long, _
 ByVal Y As Long, ByVal cX As Long, ByVal cY As Long, _
 ByVal Flags As Long) As Long

Private Declare Function SetWindowRgn Lib "user32" _
 (ByVal hWnd&, ByVal hrgn&, ByVal bRedraw As Boolean) As Long

Private WithEvents eForm As Form

Private mDummyButtonName As String
Private mFirst As Boolean
Private mFormName As String
Private mHRgn As Long
Private mLeft As Long
Private mTop As Long
Private mToMoveBack As Boolean

Public Enum ftTransparentConstants
  fttOpaque
  fttTransparentIfControls
  fttTransparentAlways
  fttInvisibleButOnTaskBar
End Enum

Private pTransparent As ftTransparentConstants
Private pTopMost As Boolean

Public Property Get Transparent() As ftTransparentConstants
  Transparent = pTransparent
End Property

Public Property Let Transparent(ByVal New_Transparent _
 As ftTransparentConstants)
  Select Case New_Transparent
    Case fttOpaque To fttInvisibleButOnTaskBar
      If Ambient.UserMode Then
        If eForm Is Nothing Then
          pTransparent = fttOpaque
        Else
          pTransparent = New_Transparent
          If pTransparent Then
            zMakeTransparent
          Else
            zMakeIntransparent
          End If
        End If
      Else
        pTransparent = New_Transparent
      End If
    Case Else
      Err.Raise 380
  End Select
  PropertyChanged "Transparent"
End Property

Public Property Get TopMost() As Boolean
  TopMost = pTopMost
End Property

Public Property Let TopMost(ByVal New_TopMost As Boolean)
  pTopMost = New_TopMost
  zTopMost
  PropertyChanged "TopMost"
End Property

Public Sub DragForm()
  Const WM_NCLBUTTONDOWN = &HA1
  Const HTCAPTION = 2
  
  If Not (eForm Is Nothing) Then
    ReleaseCapture
    SendMessage eForm.hWnd, WM_NCLBUTTONDOWN, HTCAPTION, 0
  End If
End Sub

Public Sub Refresh()
  If pTransparent Then
    If Ambient.UserMode Then
      If Not (eForm Is Nothing) Then
        zMakeTransparent
      End If
    End If
  End If
End Sub

Private Sub eForm_Load()
  If mFirst Then
    mLeft = eForm.Left
    mTop = eForm.Top
    eForm.Move -10000, -10000
  End If
End Sub

Private Sub eForm_Resize()
  With eForm
    If .MDIChild Then
      If pTransparent Then
        Select Case .WindowState
          Case vbMinimized
            zMakeIntransparent
          Case Else
            .Refresh
            zMakeTransparent
        End Select
      End If
    ElseIf mFirst Then
      Me.Refresh
      eForm.Move mLeft, mTop
    End If
  End With
  mFirst = False
End Sub

Private Sub eForm_Unload(Cancel As Integer)
  zMakeIntransparent
End Sub

Private Sub tmr_Timer()
  tmr.Enabled = False
  If Len(mDummyButtonName) Then
    eForm.Controls.Remove mDummyButtonName
  End If
  mDummyButtonName = ""
End Sub

Private Sub UserControl_ReadProperties(PropBag As PropertyBag)
  pTransparent = PropBag.ReadProperty("Transparent", fttOpaque)
  If Ambient.UserMode Then
    With UserControl
      If TypeOf .Parent Is Form Then
        If Not TypeOf .Parent Is MDIForm Then
          Set eForm = .Parent
          mFormName = eForm.Name
          If pTransparent Then
            mFirst = True
          End If
        End If
      End If
    End With
  End If
  Me.TopMost = PropBag.ReadProperty("TopMost", False)
End Sub

Private Sub UserControl_Resize()
  Static sInProc As Boolean
  
  If sInProc Then
    Exit Sub
  Else
    sInProc = True
  End If
  UserControl.Size 32 * Screen.TwipsPerPixelX, _
   32 * Screen.TwipsPerPixelY
  sInProc = False
End Sub

Private Sub UserControl_Terminate()
  zMakeIntransparent
End Sub

Private Sub UserControl_WriteProperties(_
 PropBag As PropertyBag)
  PropBag.WriteProperty "Transparent", pTransparent, fttOpaque
  PropBag.WriteProperty "TopMost", pTopMost, False
End Sub

Private Sub zMakeTransparent()
  Dim nXDiff As Long
  Dim nYDiff As Long
  Dim nOldScaleMode As Integer
  Dim nParentRect As RECT
  Dim nClientRect As RECT
  Dim nMeRect As RECT
  Dim nClientXDiff As Long
  Dim nClientYDiff As Long
  Dim nControl As Control
  Dim nControlRect As RECT
  Dim nWindowRgn As Long
  Dim nControlRgn As Long
  Dim nFirstLoop As Boolean
'*** VB 6:
  Dim nDummyButton As CommandButton
'*** Alternative für VB 5:
'  Dim nHelperControl As Control
'  Dim nHelperWnd As Long
'  Dim nHelperLeft As Long
'  Dim nHelperTop As Long
'  Dim nHelperVisible As Boolean
'***
  Dim i%
  
  Const RGN_OR = 2&

  With eForm
    nOldScaleMode = .ScaleMode
    If pTransparent <> fttInvisibleButOnTaskBar Then
      .ScaleMode = vbPixels
      GetWindowRect .hWnd, nParentRect
      GetClientRect .hWnd, nClientRect
      On Error Resume Next
'*** Alternative für VB 5:
'      For Each nHelperControl In .Controls
'        nHelperWnd = nHelperControl.hWnd
'        If Err.Number Then
'          Err.Clear
'        Else
'          Exit For
'        End If
'      Next
'      If nHelperWnd Then
'        With nHelperControl
'          nHelperLeft = .Left
'          nHelperTop = .Top
'          nHelperVisible = .Visible
'          .Visible = False
'          .Move 0, 0
'          GetWindowRect .hWnd, nMeRect
'          .Move nHelperLeft, nHelperTop
'          .Visible = nHelperVisible
'        End With
'      Else
'        .ScaleMode = nOldScaleMode
'        Exit Sub
'      End If
'*** Ende VB 5
'*** VB 6:
      Do
        Err.Clear
        Set nDummyButton = eForm.Controls.Add(_
         "VB.CommandButton", Ambient.DisplayName & _
         "Dummy" & i)
        i = i + 1
      Loop While Err.Number
      With nDummyButton
        .Move 0, 0
        GetWindowRect .hWnd, nMeRect
        mDummyButtonName = .Name
      End With
      eForm.Controls.Remove mDummyButtonName
      If Err.Number = 365 Then
        tmr.Enabled = True
      End If
      Err.Clear
'*** Ende VB 6
      With nParentRect
        nClientXDiff = nMeRect.Left - .Left
        nClientYDiff = nMeRect.Top - .Top
        nXDiff = ((.Right - .Left) - (nClientRect.Right - _
         nClientRect.Left)) - nClientXDiff
        nYDiff = ((.Bottom - .Top) - (nClientRect.Bottom - _
         nClientRect.Top)) '- nClientYDiff
        nYDiff = nYDiff - (nYDiff - nClientYDiff)
      End With
      nFirstLoop = True
      On Error GoTo NextControl
      For Each nControl In .Controls
        With nControl
          If Not TypeOf nControl Is Menu Then
            If .Container.Name = mFormName Then
              If Err.Number = 0 Then
              If .Visible Then
                nControlRect.Left = .Left + nXDiff
                nControlRect.Top = .Top + nYDiff
                nControlRect.Right = (.Left + .Width) + nXDiff
                nControlRect.Bottom = (.Top + .Height) + nYDiff
                With nControlRect
                  nControlRgn = CreateRectRgn(.Left, .Top, .Right, _
                   .Bottom)
                  If nFirstLoop Then
                    nWindowRgn = nControlRgn
                    nFirstLoop = False
                  Else
                    CombineRgn nWindowRgn, nWindowRgn, nControlRgn, _
                     RGN_OR
                    DeleteObject nControlRgn
                  End If
                End With
              End If
              End If
            End If
          End If
        End With
NextControl:
        If Err.Number Then
          Resume NextControl_Resume
NextControl_Resume:
        End If
      Next
    End If
    On Error GoTo 0
    If nWindowRgn = 0 Then
      Select Case pTransparent
        Case fttTransparentAlways, fttInvisibleButOnTaskBar
          With nParentRect
            nWindowRgn = CreateRectRgn(0, 0, 0, 0)
          End With
      End Select
    End If
    If mHRgn Then
      DeleteObject mHRgn
    End If
    mHRgn = nWindowRgn
    SetWindowRgn .hWnd, mHRgn, True
    .ScaleMode = nOldScaleMode
  End With
End Sub

Private Sub zMakeIntransparent()
  If mHRgn Then
    DeleteObject mHRgn
    mHRgn = 0
    With eForm
      SetWindowRgn .hWnd, 0, True
    End With
  End If
End Sub

Private Sub zTopMost()
  Const HWND_TOPMOST = -1
  Const HWND_NOTOPMOST = -2
  Const SWP_NOMOVE = 2
  Const SWP_NOSIZE = 1

  If Ambient.UserMode Then
    If Not (eForm Is Nothing) Then
      Select Case pTopMost
        Case False
          SetWindowPos eForm.hWnd, HWND_NOTOPMOST, _
           0, 0, 0, 0, SWP_NOMOVE Or SWP_NOSIZE
        Case True
          SetWindowPos eForm.hWnd, HWND_TOPMOST, _
           0, 0, 0, 0, SWP_NOMOVE Or SWP_NOSIZE
      End Select
    End If
  End If
End Sub

Zurück zu "Forms mit Durchblick und mehr" Zurück zum Text Code des Beispielprojekts 1 Code des Beispiel-Projekts avbFormXTest
Code des Beispielprojekts 2 Code des Beispiel-Projekts avbFormXTest2


Komponenten-Übersicht

Zum Seitenanfang

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

Zum Seitenanfang

Zurück...

Zurück...

Download Internet Explorer