home *** CD-ROM | disk | FTP | other *** search
/ Planet Source Code Jumbo …e CD Visual Basic 1 to 7 / 5_2007-2008.ISO / data / Zips / Update_3_N2054733192007.psc / Aero.frm < prev    next >
Text File  |  2007-03-19  |  8KB  |  213 lines
  1. VERSION 5.00
  2. Begin VB.Form Aero 
  3.    AutoRedraw      =   -1  'True
  4.    BorderStyle     =   0  'None
  5.    Caption         =   "Skin Aero Vista For VB6 Good"
  6.    ClientHeight    =   8055
  7.    ClientLeft      =   0
  8.    ClientTop       =   0
  9.    ClientWidth     =   10695
  10.    ClipControls    =   0   'False
  11.    Icon            =   "Aero.frx":0000
  12.    LinkTopic       =   "Form2"
  13.    ScaleHeight     =   537
  14.    ScaleMode       =   3  'Pixel
  15.    ScaleWidth      =   713
  16.    ShowInTaskbar   =   0   'False
  17.    StartUpPosition =   3  'Windows Default
  18.    Begin VB.Timer Timer1 
  19.       Interval        =   1
  20.       Left            =   2040
  21.       Top             =   3840
  22.    End
  23.    Begin VB.PictureBox Picture1 
  24.       BorderStyle     =   0  'None
  25.       Height          =   975
  26.       Left            =   0
  27.       ScaleHeight     =   975
  28.       ScaleWidth      =   10695
  29.       TabIndex        =   0
  30.       Top             =   0
  31.       Width           =   10695
  32.    End
  33. End
  34. Attribute VB_Name = "Aero"
  35. Attribute VB_GlobalNameSpace = False
  36. Attribute VB_Creatable = False
  37. Attribute VB_PredeclaredId = True
  38. Attribute VB_Exposed = False
  39. 'Karmba_a@hotmail.com
  40. ' MSLE 2007
  41. Private Const ULW_OPAQUE = &H4
  42. Private Const ULW_COLORKEY = &H1
  43. Private Const ULW_ALPHA = &H2
  44. Private Const BI_RGB As Long = 0&
  45. Private Const DIB_RGB_COLORS As Long = 0
  46. Private Const AC_SRC_ALPHA As Long = &H1
  47. Private Const AC_SRC_OVER = &H0
  48. Private Const WS_EX_LAYERED = &H80000
  49. Private Const GWL_STYLE As Long = -16
  50. Private Const GWL_EXSTYLE As Long = -20
  51. Private Const HWND_TOPMOST As Long = -1
  52.  
  53. Private Type BLENDFUNCTION
  54.     BlendOp As Byte
  55.     BlendFlags As Byte
  56.     SourceConstantAlpha As Byte
  57.     AlphaFormat As Byte
  58. End Type
  59.  
  60. Private Type Size
  61.     CX As Long
  62.     CY As Long
  63. End Type
  64.  
  65. Private Type POINTAPI
  66.     X As Long
  67.     Y As Long
  68. End Type
  69.  
  70. Private Type RGBQUAD
  71.     rgbBlue As Byte
  72.     rgbGreen As Byte
  73.     rgbRed As Byte
  74.     rgbReserved As Byte
  75. End Type
  76.  
  77. Private Type BITMAPINFOHEADER
  78.     biSize As Long
  79.     biWidth As Long
  80.     biHeight As Long
  81.     biPlanes As Integer
  82.     biBitCount As Integer
  83.     biCompression As Long
  84.     biSizeImage As Long
  85.     biXPelsPerMeter As Long
  86.     biYPelsPerMeter As Long
  87.     biClrUsed As Long
  88.     biClrImportant As Long
  89. End Type
  90.  
  91. Private Type BITMAPINFO
  92.     bmiHeader As BITMAPINFOHEADER
  93.     bmiColors As RGBQUAD
  94. End Type
  95.  
  96. Dim blendFunc32bpp As BLENDFUNCTION
  97. Dim mDC As Long
  98. Dim mainBitmap As Long
  99. Dim oldBitmap As Long
  100. Dim token As Long
  101.  
  102. Private Declare Function BitBlt Lib "gdi32.dll" (ByVal hDestDC As Long, ByVal X As Long, ByVal Y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC As Long, ByVal XSrc As Long, ByVal YSrc As Long, ByVal dwRop As Long) As Long
  103. Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
  104. Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
  105. Private Declare Function AlphaBlend Lib "Msimg32.dll" (ByVal hdcDest As Long, ByVal nXOriginDest As Long, ByVal lnYOriginDest As Long, ByVal nWidthDest As Long, ByVal nHeightDest As Long, ByVal hdcSrc As Long, ByVal nXOriginSrc As Long, ByVal nYOriginSrc As Long, ByVal nWidthSrc As Long, ByVal nHeightSrc As Long, ByVal bf As Long) As Boolean
  106. Private Declare Function UpdateLayeredWindow Lib "user32.dll" (ByVal hWnd As Long, ByVal hdcDst As Long, pptDst As Any, psize As Any, ByVal hdcSrc As Long, pptSrc As Any, ByVal crKey As Long, ByRef pblend As BLENDFUNCTION, ByVal dwFlags As Long) As Long
  107. Private Declare Function CreateDIBSection Lib "gdi32.dll" (ByVal hdc As Long, pBitmapInfo As BITMAPINFO, ByVal un As Long, ByRef lplpVoid As Any, ByVal handle As Long, ByVal dw As Long) As Long
  108. Private Declare Function GetDIBits Lib "gdi32.dll" (ByVal aHDC As Long, ByVal hBitmap As Long, ByVal nStartScan As Long, ByVal nNumScans As Long, lpBits As Any, lpBI As BITMAPINFO, ByVal wUsage As Long) As Long
  109. Private Declare Function SetDIBits Lib "gdi32.dll" (ByVal hdc As Long, ByVal hBitmap As Long, ByVal nStartScan As Long, ByVal nNumScans As Long, lpBits As Any, lpBI As BITMAPINFO, ByVal wUsage As Long) As Long
  110. Private Declare Function CreateCompatibleDC Lib "gdi32.dll" (ByVal hdc As Long) As Long
  111. Private Declare Function SelectObject Lib "gdi32.dll" (ByVal hdc As Long, ByVal hObject As Long) As Long
  112. Private Declare Function DeleteDC Lib "gdi32.dll" (ByVal hdc As Long) As Long
  113. Private Declare Sub CopyMemory Lib "kernel32.dll" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
  114. Private Declare Function GetWindowLong Lib "user32.dll" Alias "GetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long) As Long
  115. Private Declare Function GetDC Lib "user32.dll" (ByVal hWnd As Long) As Long
  116.  
  117. Dim FileRes As Integer
  118. Dim Buffer() As Byte
  119. Function Function_End()
  120.     Call GdiplusShutdown(token)
  121.     SelectObject mDC, oldBitmap
  122.     DeleteObject mainBitmap
  123.     DeleteObject oldBitmap
  124.     Unload Skin
  125.     Unload Me
  126. End Function
  127. Function Cool_Memory()
  128.     SelectObject mDC, oldBitmap
  129.     DeleteObject mainBitmap
  130.     DeleteObject oldBitmap
  131. End Function
  132. Private Function MakeTrans(pngPath As String) As Boolean
  133.    Dim tempBI As BITMAPINFO
  134.    Dim tempBlend As BLENDFUNCTION
  135.    Dim lngHeight As Long, lngWidth As Long
  136.    Dim curWinLong As Long
  137.    Dim img As Long
  138.    Dim graphics As Long
  139.    Dim winSize As Size
  140.    Dim srcPoint As POINTAPI
  141.    
  142.    With tempBI.bmiHeader
  143.       .biSize = Len(tempBI.bmiHeader)
  144.       .biBitCount = 32
  145.       .biHeight = Me.ScaleHeight
  146.       .biWidth = Me.ScaleWidth
  147.       .biPlanes = 1
  148.       .biSizeImage = .biWidth * .biHeight * (.biBitCount / 8)
  149.    End With
  150.    mDC = CreateCompatibleDC(Me.hdc)
  151.    mainBitmap = CreateDIBSection(mDC, tempBI, DIB_RGB_COLORS, ByVal 0, 0, 0)
  152.    oldBitmap = SelectObject(mDC, mainBitmap)
  153.  
  154.    Call GdipCreateFromHDC(mDC, graphics)
  155.    Call GdipLoadImageFromFile(StrConv(pngPath, vbUnicode), img)
  156.    Call GdipGetImageHeight(img, lngHeight)
  157.    Call GdipGetImageWidth(img, lngWidth)
  158.    Call GdipDrawImageRect(graphics, img, 0, 0, lngWidth, lngHeight)
  159.  
  160.    curWinLong = GetWindowLong(Me.hWnd, GWL_EXSTYLE)
  161.    SetWindowLong Me.hWnd, GWL_EXSTYLE, curWinLong Or WS_EX_LAYERED
  162.    
  163.    srcPoint.X = 0
  164.    srcPoint.Y = 0
  165.    winSize.CX = Me.ScaleWidth
  166.    winSize.CY = Me.ScaleHeight
  167.     
  168.    With blendFunc32bpp
  169.       .AlphaFormat = AC_SRC_ALPHA
  170.       .BlendFlags = 0
  171.       .BlendOp = AC_SRC_OVER
  172.       .SourceConstantAlpha = 255
  173.    End With
  174.     
  175.    Call GdipDisposeImage(img)
  176.    Call GdipDeleteGraphics(graphics)
  177.    Call UpdateLayeredWindow(Me.hWnd, Me.hdc, ByVal 0&, winSize, mDC, srcPoint, 0, blendFunc32bpp, ULW_ALPHA)
  178. End Function
  179. Sub MoveForm(TheForm As Form)
  180. ReleaseCapture
  181. Call SendMessage(TheForm.hWnd, &HA1, 2, 0&)
  182. End Sub
  183. Sub Center(FormName As Form)
  184. Move (Screen.Width - FormName.Width) \ 2, (Screen.Height - FormName.Height) \ 2
  185. End Sub
  186. Private Sub Form_Initialize()
  187.    Dim GpInput As GdiplusStartupInput
  188.    GpInput.GdiplusVersion = 1
  189.    If GdiplusStartup(token, GpInput) <> 0 Then
  190.      MsgBox "Error loading GDI+!", vbCritical
  191.      Function_End
  192.    End If
  193.    MakeTrans (TheSystemDir() & "\Vista.png")
  194.    Cool_Memory
  195. End Sub
  196.  
  197. Private Sub Form_Load()
  198. Call Center(Aero)
  199. Cool_Memory
  200. End Sub
  201. Private Sub Form_Unload(Cancel As Integer)
  202. Function_End
  203. End Sub
  204. Private Sub Picture1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
  205.     MoveForm Me
  206.     Cool_Memory
  207. End Sub
  208. Private Sub Timer1_Timer()
  209.     Cool_Memory
  210.     Skin.Move (Aero.Left) + 198, (Aero.Top) + 220
  211.     Skin.Show
  212. End Sub
  213.