Unregelmaessige Formen auf Basis einer Bitmap Stört Sie das eintönige Standard-Windows, was die eckige Darstellung der Fenster betrifft? Dann ändern Sie doch einfach die Fenster-Form anhand eine...
Autor:   Heinz Prelle	Bewertung:     [ Jetzt bewerten ]	Views:  18.109
www.visual-basic5.de	System:  Win9x, WinNT, Win2k, WinXP, Win7, Win8, Win10, Win11	Beispielprojekt auf CD

Geben Sie hier Ihre persönliche Bewertung ab! Anzahl Bewertungen bisher: 51 Bewertung insgesamt: gut Durchschnittliche Bewertung: 3.7 von 5 Sternen

sehr gut     gut     nützlich     mittelmäßig     mangelhaft

Stört Sie das eintönige Standard-Windows, was die eckige Darstellung der Fenster betrifft? Dann ändern Sie doch einfach die Fenster-Form anhand eines unregelmäßig geformten Bitmaps.

Hier sehen Sie ein Beispiel für eine unregelmäßige Form auf Basis eines Bitmap-Bildes.

' zunächst die benötigten Deklarationen
Public Declare Function GetPixel Lib "gdi32" ( _
  ByVal hDC As Long, _
  ByVal lngX As Long, _
  ByVal lngY As Long) As Long
Public Declare Function SetWindowRgn Lib "user32" ( _
  ByVal hWnd As Long, _
  ByVal hRgn As Long, _
  ByVal bRedraw As Boolean) As Long
Public Declare Function CreateRectRgn Lib "gdi32" ( _
  ByVal X1 As Long, _
  ByVal Y1 As Long, _
  ByVal X2 As Long, _
  ByVal Y2 As Long) As Long
Public Declare Function CombineRgn Lib "gdi32" ( _
  ByVal hDestRgn As Long, _
  ByVal hSrcRgn1 As Long, _
  ByVal hSrcRgn2 As Long, _
  ByVal nCombineMode As Long) As Long
Public Declare Function SendMessage Lib "user32" _
  Alias "SendMessageA" ( _
  ByVal hWnd As Long, _
  ByVal wMsg As Long, _
  ByVal wParam As Long, _
  lParam As Any) As Long
Public Declare Function ReleaseCapture Lib "user32" () As Long
Public Declare Function DeleteObject Lib "gdi32" ( _
  ByVal hObject As Long) As Long
 
Public Const RGN_OR = 2
Public Const WM_NCLBUTTONDOWN = &HA1
Public Const HTCAPTION = 2
 
Public Function BereichHerstellen(objBild As PictureBox) _
    As Long
 
  Dim lngTransparenteFarbe As Long
  Dim bolErsterBereich As Boolean
  Dim bolEingangsLinie As Boolean
  Dim hDC As Long
  Dim lngBildWeite As Long
  Dim lngBildHoehe As Long
  Dim lngX As Long
  Dim lngY As Long
  Dim lngStartLinie_X As Long
  Dim lngGesamtBereich As Long
  Dim lngLinienBereich As Long
 
  hDC = objBild.hDC
  lngBildWeite = objBild.ScaleWidth
  lngBildHoehe = objBild.ScaleHeight
 
  bolErsterBereich = True: bolEingangsLinie = False
  lngX = lngY = lngStartLinie_X = 0
  ' Die transparente Farbe ist die Farbe die sich in der
  ' PictureBox oben Links befindet...
  lngTransparenteFarbe = GetPixel(hDC, 0, 0)
  For lngY = 0 To lngBildHoehe - 1
    For lngX = 0 To lngBildWeite - 1
      If GetPixel(hDC, lngX, lngY) = lngTransparenteFarbe Or _
       lngX = lngBildWeite Then
        If bolEingangsLinie Then
          bolEingangsLinie = False
          lngLinienBereich = CreateRectRgn(lngStartLinie_X, _
           lngY, lngX, lngY + 1)
          If bolErsterBereich Then
            lngGesamtBereich = lngLinienBereich
            bolErsterBereich = False
          Else
            CombineRgn lngGesamtBereich, lngGesamtBereich, _
             lngLinienBereich, RGN_OR
            DeleteObject lngLinienBereich
          End If
        End If
      Else
        If Not bolEingangsLinie Then
          bolEingangsLinie = True
          lngStartLinie_X = lngX
        End If
      End If
    Next
  Next
  BereichHerstellen = lngGesamtBereich
End Function

Hier ein Beispiel für den Funktionsaufruf:

Private Sub Form_Load()
  Dim FensterBereich As Long
  Set Picture1.Picture = LoadPicture(App.Path & "\test.bmp")
  Me.Width = Picture1.Width
  Me.Height = Picture1.Height
  FensterBereich = BereichHerstellen(Picture1)
  SetWindowRgn Me.hWnd, FensterBereich, True
End Sub