Quantcast
Channel: VBForums - CodeBank - Visual Basic 6 and earlier
Viewing all articles
Browse latest Browse all 1529

Transform your form in YingYang with transparency

$
0
0
This code is also very very old, it changes the layout of the form as a YingYang with transparency

Name:  YingYang.png
Views: 22
Size:  12.5 KB

Just add this code
Private Sub Form_Load()

YingYang Me

End Sub

Code:

Option Explicit

Private Declare Function CreateRectRgn Lib "gdi32" (ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 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 CombineRgn Lib "gdi32" (ByVal hDestRgn As Long, ByVal hSrcRgn1 As Long, ByVal hSrcRgn2 As Long, ByVal nCombineMode As Long) As Long
Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject 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 RGN_AND = 1
Private Const RGN_OR = 2
Private Const RGN_XOR = 3
Private Const RGN_DIFF = 4
Private Const RGN_COPY = 5

Private YY              As Long

Public Sub YingYang(obj As Form)
  Dim Cercle          As Long
  Dim RECT            As Long
  Dim PCercleH        As Long
  Dim PCercleB        As Long
  Dim HCercle          As Long
  Dim Cadre            As Long
  Dim TrouB            As Long
  Dim TrouH            As Long
  Dim CercleBis        As Long
  Dim HCercleBis      As Long
  Dim CercleBisBis    As Long
  Dim Ying_Yang        As Long
  Dim YYang            As Long

  Dim h                As Long
  Dim l                As Long
  Dim HBord            As Long
  Dim LBord            As Long
  Dim HT              As Long
  Dim lT              As Long

  h = obj.Height / Screen.TwipsPerPixelY
  l = obj.Width / Screen.TwipsPerPixelX

  HBord = Int(h / 100)
  LBord = Int(l / 100)

  HT = Int(h / 10)
  lT = Int(l / 10)

  HCercle = CreateEllipticRgn(((l - (2 * LBord)) / 4) + LBord, ((h - (2 * HBord)) / 2) + HBord, 3 * (((l - (2 * LBord)) / 4) + LBord), (h - HBord))
  Cercle = CreateEllipticRgn(LBord, HBord, l - LBord, h - HBord)
  RECT = CreateRectRgn(l / 2, 0, l, h)
  CombineRgn HCercle, Cercle, RECT, RGN_DIFF

  HCercleBis = CreateEllipticRgn(LBord, HBord, l - LBord, h - HBord)
  PCercleB = CreateEllipticRgn(((l - (2 * LBord)) / 4) + LBord, ((h - (2 * HBord)) / 2) + HBord, 3 * (((l - (2 * LBord)) / 4) + LBord), (h - HBord))
  CombineRgn HCercleBis, HCercle, PCercleB, RGN_DIFF

  CercleBis = CreateEllipticRgn(LBord, HBord, l - LBord, h - HBord)
  PCercleH = CreateEllipticRgn(((l - (2 * LBord)) / 4) + LBord, HBord, 3 * (((l - (2 * LBord)) / 4) + LBord), ((h - (2 * HBord)) / 2) + HBord)
  CombineRgn CercleBis, Cercle, PCercleH, RGN_DIFF

  CercleBisBis = CreateEllipticRgn(LBord, HBord, l - LBord, h - HBord)
  HCercle = CreateEllipticRgn(0, 0, l, h)
  CombineRgn CercleBisBis, CercleBis, HCercleBis, RGN_DIFF

  Ying_Yang = CreateEllipticRgn(0, 0, l, h)
  Cadre = CreateEllipticRgn(0, 0, l, h)
  CombineRgn Ying_Yang, Cadre, CercleBisBis, RGN_DIFF

  YYang = CreateEllipticRgn(0, 0, l, h)
  TrouB = CreateEllipticRgn(((l - (2 * LBord)) / 2) + LBord - (lT / 2), ((3 * (h - (2 * HBord)) / 4)) + HBord - (HT / 2), ((l - (2 * LBord)) / 2) + LBord + (lT / 2), ((3 * (h - (2 * HBord)) / 4)) + HBord + (HT / 2))
  CombineRgn YYang, Ying_Yang, TrouB, RGN_OR

  YY = CreateEllipticRgn(0, 0, l, h)
  TrouH = CreateEllipticRgn(((l - (2 * LBord)) / 2) + LBord - (lT / 2), ((h - (2 * HBord)) / 4) + HBord - (HT / 2), ((l - (2 * LBord)) / 2) + LBord + (lT / 2), ((h - (2 * HBord)) / 4) + HBord + (HT / 2))
  CombineRgn YY, YYang, TrouH, RGN_DIFF

  SetWindowRgn obj.hWnd, YY, True

  DeleteObject Cercle
  DeleteObject RECT
  DeleteObject PCercleH
  DeleteObject PCercleB
  DeleteObject HCercle
  DeleteObject Cadre
  DeleteObject TrouB
  DeleteObject TrouH
  DeleteObject CercleBis
  DeleteObject HCercleBis
  DeleteObject CercleBisBis
  DeleteObject Ying_Yang
  DeleteObject YYang

End Sub

Sample app YingYang.zip
Attached Images
 
Attached Files

Viewing all articles
Browse latest Browse all 1529

Trending Articles



<script src="https://jsc.adskeeper.com/r/s/rssing.com.1596347.js" async> </script>