vb@rchiv
VB Classic
VB.NET
ADO.NET
VBA
C#
Zippen wie die Profis!  
 vb@rchiv Quick-Search: Suche startenErweiterte Suche starten   Impressum  | Datenschutz  | vb@rchiv CD Vol.6  | Shop Copyright ©2000-2024
 
zurück
Rubrik:    |   VB-Versionen: VB602.05.14
Picturebox mit Rahmen in Wellenform versehen

Bild in Picturebox mit Wellenform, mit gerundeten Ecken und als Ellipse anzeigen.

Autor:  ZardozBewertung:     [ Jetzt bewerten ]Views:  1.769 
ohne HomepageSystem:  WinXP, Win7, Win8, Win10, Win11 Beispielprojekt 

Dies ist eine Ergänzung zum Tipp  Bild in Picturebox mit gerundeten Ecken anzeigen.

Das Beispiel zeigt, wie man das Bild in "Wellenform", als "Ellipse" oder mit "gerundeten Ecken" anzeigen kann.

Benötigt werden folgende Controls:

  • 4 x CommandButton (Command1-Command4)
  • 1 x PictureBox (Picture1)
Option Explicit
 
' benötigte API-Deklarationen
Private Type POINTAPI
  x As Long
  y As Long
End Type
 
Private Declare Function CreatePolygonRgn Lib "gdi32" ( _
  lpPoint As POINTAPI, _
  ByVal nCount As Long, _
  ByVal nPolyFillMode As Long) As Long
 
Private Declare Function CreateRoundRectRgn Lib "gdi32" ( _
  ByVal X1 As Long, _
  ByVal Y1 As Long, _
  ByVal X2 As Long, _
  ByVal Y2 As Long, _
  ByVal X3 As Long, _
  ByVal Y3 As Long) As Long
 
Private Declare Function CreateEllipticRgn Lib "gdi32" ( _
  ByVal X1 As Long, _
  ByVal Y1 As Long, _
  ByVal X2 As Long, _
  ByVal Y2 As Long) As Long
 
Private Declare Function SetWindowRgn Lib "user32" ( _
  ByVal hWnd As Long, _
  ByVal hRgn As Long, _
  ByVal bRedraw As Boolean) As Long
 
Private Const ALTERNATE = 1
Private Sub Form_Load()
  ' Bild laden + anzeigen
 
  Dim Pfad As String
 
  Me.WindowState = vbMaximized
 
  Command1.Caption = "Runde Ecken"
  Command2.Caption = "Wellen"
  Command3.Caption = "Ellipse"
  Command4.Caption = "Rückgängig"
 
  Pfad = "C:\EinBild.jpeg" ' Bildpfad hier einsetzen
 
  With Picture1
    .BorderStyle = vbBSNone
    .ScaleMode = vbPixels
    .AutoSize = True
    Set .Picture = LoadPicture(Pfad)
  End With
End Sub
Private Sub Command1_Click()
  ' Bild (PictureBox) mit abgerundeten Ecken darstellen
  Call RoundRectPictureBox(Picture1)
End Sub
Private Sub Command2_Click()
  ' Aufruf Wellenrand
  Call WaveBorder(Picture1)
End Sub
Private Sub Command3_Click()
  ' Aufruf Ellipsenform
  Call EllipticBorder(Picture1)
End Sub
Private Sub Command4_Click()
  ' Aufruf Effekt rückgängig
  Call Effect_back(Picture1)
End Sub
Public Sub RoundRectPictureBox(DestPic As PictureBox, _
  Optional Radius As Long = 60)
 
  ' Abgerundete Ecken
  Dim Rgn1 As Long
 
  With DestPic
    Rgn1 = CreateRoundRectRgn(0, 0, .ScaleWidth, .ScaleHeight, Radius, Radius)
    Call SetWindowRgn(.hWnd, Rgn1, True)
  End With
End Sub
Public Sub EllipticBorder(DestPic As PictureBox)
  ' Ellipsenform
  Dim Rgn1 As Long
 
  With DestPic
    Rgn1 = CreateEllipticRgn(0, 0, .ScaleWidth - 1, .ScaleHeight - 1)
    Call SetWindowRgn(.hWnd, Rgn1, True)
  End With
End Sub
Public Sub WaveBorder(DestPic As PictureBox, _
  Optional WaveWeight As Long = 40, _
  Optional WaveHeight As Long = 6)
 
  ' Wellenförmiger Rand
 
  Dim i As Long, Rgn1 As Long, Wnk As Single, Pi As Single
  Dim X1 As Single, Y1 As Single, X2 As Single, Y2 As Single
  Dim dx As Single, dy As Single, xFkt As Single, yFkt As Single
  Dim Z1 As Long, PtLst() As POINTAPI
 
  X1 = WaveHeight + 1
  Y1 = WaveHeight + 1
  X2 = DestPic.ScaleWidth - WaveHeight - 1
  Y2 = DestPic.ScaleHeight - WaveHeight - 1
  dx = X2 - X1 + 1
  dy = Y2 - Y1 + 1
  xFkt = dx \ WaveWeight
  yFkt = dy \ WaveWeight
  If xFkt < 1 Then xFkt = 1
  If yFkt < 1 Then yFkt = 1
  xFkt = xFkt + 0.5
  yFkt = yFkt + 0.5
  Pi = 4 * Atn(1)
  Z1 = 0
  ReDim PtLst(2 * dx + 2 * dy - 1)
 
  For i = X1 To X2
    Wnk = 2 * Pi * (i - X1) / dx * xFkt
    PtLst(Z1).x = i
    PtLst(Z1).y = Y1 + 0.5 - WaveHeight * Sin(Wnk)
    Z1 = Z1 + 1
  Next i
 
  For i = Y1 To Y2
    Wnk = 2 * Pi * (i - Y1) / dy * yFkt
    PtLst(Z1).x = X2 + 0.5 + WaveHeight * Sin(Wnk)
    PtLst(Z1).y = i
    Z1 = Z1 + 1
  Next i
 
  For i = X2 To X1 Step -1
    Wnk = 2 * Pi * (i - X1) / dx * xFkt
    PtLst(Z1).x = i
    PtLst(Z1).y = Y2 + 0.5 + WaveHeight * Sin(Wnk)
    Z1 = Z1 + 1
  Next i
 
  For i = Y2 To Y1 Step -1
    Wnk = 2 * Pi * (i - Y1) / dy * yFkt
    PtLst(Z1).x = X1 + 0.5 - WaveHeight * Sin(Wnk)
    PtLst(Z1).y = i
    Z1 = Z1 + 1
  Next i
 
  Rgn1 = CreatePolygonRgn(PtLst(0), Z1, ALTERNATE)
  Call SetWindowRgn(DestPic.hWnd, Rgn1, True)
  Erase PtLst
End Sub
Public Sub Effect_back(DestPic As PictureBox)
  ' Rahmeneffekt rückgängig
  Call SetWindowRgn(DestPic.hWnd, 0, True)
End Sub