API transparan form

Private Declare Function GetWindowPlacement Lib "user32" (ByVal hwnd As Long, lpwndpl As WINDOWPLACEMENT) As Long
Private Declare Function SetWindowPlacement Lib "user32" (ByVal hwnd As Long, lpwndpl As WINDOWPLACEMENT) As Long
Private Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type
Private Type POINTAPI
x As Long
y As Long
End Type

Private Type WINDOWPLACEMENT
Length As Long
flags As Long
showCmd As Long
ptMinPosition As POINTAPI
ptMaxPosition As POINTAPI
rcNormalPosition As RECT
End Type

Private Const SW_MINIMIZE = 6

Private Type BITMAP
bmType As Long
bmWidth As Long
bmHeight As Long
bmWidthBytes As Long
bmPlanes As Integer
bmBitsPixel As Integer
bmBits As Long
End Type

Private Const WM_NCLBUTTONDOWN = &HA1
Private Const HTCAPTION = 2

Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Any) As Long
Private Declare Sub ReleaseCapture Lib "user32" ()

Private Const ImageWidth = 15
Private Const ImageHeight = 15

Private Const btMin = 1
Private Const btClose = 2
Private Const btMinOver = 3
Private Const btCloseOver = 4
Private Const btMinDown = 5
Private Const btCloseDown = 6

Dim MinDown As Boolean, CloseDown As Boolean
Dim MouseOverMin As Boolean, MouseOverClose As Boolean
Dim MinXPos As Long, MinYPos As Long, CloseXPos As Long, CloseYPos As Long
Private Declare Function BitBlt Lib "gdi32" (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
Private Const SRCINVERT = &H660046
Private Const SRCAND = &H8800C6

Private Declare Function SetWindowRgn Lib "user32" (ByVal hwnd As Long, ByVal hRgn As Long, ByVal bRedraw As Boolean) As Long
Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
Private Declare Function CreateCompatibleDC Lib "gdi32" (ByVal hDC As Long) As Long
Private Declare Function SelectObject Lib "gdi32" (ByVal hDC As Long, ByVal hObject As Long) As Long
Private Declare Function GetObject Lib "gdi32" Alias "GetObjectA" (ByVal hObject As Long, ByVal nCount As Long, lpObject As Any) As Long
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 CombineRgn Lib "gdi32" (ByVal hDestRgn As Long, ByVal hSrcRgn1 As Long, ByVal hSrcRgn2 As Long, ByVal nCombineMode As Long) As Long
Private Declare Function DeleteDC Lib "gdi32" (ByVal hDC As Long) As Long
Private Declare Function GetPixel Lib "gdi32" (ByVal hDC As Long, ByVal x As Long, ByVal y As Long) As Long
Public Sub DrawButton(Target As Object, ByVal ImageWidth As Integer, ByVal ImageHeight As Integer, ByVal PosX As Long, ByVal PosY As Long, Button As Integer)
Call BitBlt(Target.hDC, PosX, PosY, ImageWidth, ImageHeight, Picture1.hDC, 0, 0, SRCAND)
Call BitBlt(Target.hDC, PosX, PosY, ImageWidth, ImageHeight, Picture1.hDC, Button * ImageWidth, 0, SRCINVERT)
End Sub

Private Sub MinPressed()
Dim r As Long
Dim wp As WINDOWPLACEMENT
DrawButton Me, ImageWidth, ImageHeight, MinXPos, MinYPos, btMin
Me.*******
wp.Length = Len(wp)
r = GetWindowPlacement(Me.hwnd, wp)
wp.showCmd = SW_MINIMIZE
wp.Length = Len(wp)
r = SetWindowPlacement(Me.hwnd, wp)
End Sub

Private Function GetBitmapRegion(cPicture As StdPicture, cTransparent As Long)

Dim hRgn As Long, tRgn As Long
Dim x As Integer, y As Integer, X0 As Integer
Dim hDC As Long, BM As BITMAP
hDC = CreateCompatibleDC(0)
If hDC Then
SelectObject hDC, cPicture
GetObject cPicture, Len(BM), BM
hRgn = CreateRectRgn(0, 0, BM.bmWidth, BM.bmHeight)
For y = 0 To BM.bmHeight 'Form üzerindeki her pixel sütun
For x = 0 To BM.bmWidth 've her satirini teker teker incele
While x <= BM.bmWidth And GetPixel(hDC, x, y) <> cTransparent 'Eger pixelin renk degeri transparan
'olmasini istedigimiz renk degerine esitse
x = x + 1
Wend
X0 = x
While x <= BM.bmWidth And GetPixel(hDC, x, y) = cTransparent
x = x + 1
Wend
If X0 < x Then
tRgn = CreateRectRgn(X0, y, x, y + 1) 'Bu pixel icin gecici bir region yarat
CombineRgn hRgn, hRgn, tRgn, 4
DeleteObject tRgn 'ana regionla combine ettigimiz icin artik ihtiyacimiz yok
End If
Next x
Next y
GetBitmapRegion = hRgn
DeleteObject SelectObject(hDC, cPicture)
End If
DeleteDC hDC
End Function

Private Sub SetRegion()
If hRgn Then DeleteObject hRgn
hRgn = GetBitmapRegion(Me.Picture, RGB(255, 0, 255))
SetWindowRgn Me.hwnd, hRgn, True
End Sub

Private Sub Command1_Click()
Dim info As String
info = info & "Tam olarak yaptigimiz formun background resmini tarayarak,belirledigimiz renk degerleriyle karsilastirmak"
info = info & "ve bu degerleri formdan cikarmaktir." & vbCrLf & "Tabii ki resim ne kadar kücük olursa tarama islemi o kadar kisa surecektir." & vbCrLf & vbCrLf
info = info & "Minimize ve Close buttonlarini transparan yapmak icin ise BitBlt apisini kullanmak gerekir." & vbCrLf & "Bunun icin bir sprit'a ve bir mask'e "
info = info & "ihtiyacimiz var." & vbCrLf & "Sprite'i icin Transparan bolge siyah olmalidir.Mask içinse transparan olacak bolge beyaz diger bolgeler siyah olmalidir." & vbCrLf
info = info & "Daha sonra ilk once mask'i istedigimiz yere SRCAND'i kullanarak,sprite'i ise SRCINVERT 'i kullanarak BitBlt ile kopyalariz." & vbCrLf & vbCrLf
info = info & "Kontrolleri koyacagimiz bolgeler icin farkli bir renk kullanmaliyiz.(Ornek: Eger yesil bolgeler pembe olsaydi oraya koyacagimiz kontroller gorunmez olacakti)." & vbCrLf & vbCrLf
info = info & "Coded By Aycan Yerbozan,Graphics By Aycan Yerbozan,Original Concept By Aycan Yerbozan. CopyRight(c) 2000" & vbCrLf & vbCrLf
info = info & "E-mail: [email protected]"
MsgBox info, vbApplicationModal + vbInformation, "Bilgi"
End Sub
Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
Dim ShiftDown, AltDown, CtrlDown
Const vbKeyF4 = &H73
Const vbShiftMask = 1
Const vbCtrlMask = 2
Const vbAltMask = 4
ShiftDown = (Shift And vbShiftMask) > 0
AltDown = (Shift And vbAltMask) > 0
CtrlDown = (Shift And vbCtrlMask) > 0
If KeyCode = 115 Then 'F4
If AltDown Then
Set Form1 = Nothing
Set Picture1 = Nothing
Set Picture2 = Nothing
Unload Me
End If
End If
End Sub

Private Sub Form_Load()
Picture1.ScaleMode = 3
Me.ScaleMode = 3
MinXPos = 76
MinYPos = 10
CloseXPos = 54
CloseYPos = 0
MinDown = False
CloseDown = False
SetRegion
DrawButton Me, ImageWidth, ImageHeight, MinXPos, MinYPos, btMin
DrawButton Me, ImageWidth, ImageHeight, CloseXPos, CloseYPos, btClose
Me.*******
End Sub

Private Sub Form_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
If Button = 1 Then

MouseOverMin = (MinXPos <= x) And (x <= MinXPos + ImageWidth) And (MinYPos <= y) And (y <= MinYPos + ImageHeight)
MouseOverClose = (CloseXPos <= x) And (x <= CloseXPos + ImageWidth) And (CloseYPos <= y) And (y <= CloseYPos + ImageHeight)

If MouseOverMin Then
DrawButton Me, ImageWidth, ImageHeight, MinXPos, MinYPos, btMinDown
DrawButton Me, ImageWidth, ImageHeight, CloseXPos, CloseYPos, btClose
MinDown = True
Me.*******

ElseIf MouseOverClose Then
DrawButton Me, ImageWidth, ImageHeight, MinXPos, MinYPos, btMin
DrawButton Me, ImageWidth, ImageHeight, CloseXPos, CloseYPos, btCloseDown
CloseDown = True
Me.*******

Else
ReleaseCapture
Result& = SendMessage(Me.hwnd, WM_NCLBUTTONDOWN, HTCAPTION, 0&)
End If
End If

End Sub

Private Sub Form_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)

MouseOverMin = (MinXPos <= x) And (x <= MinXPos + ImageWidth) And (MinYPos <= y) And (y <= MinYPos + ImageHeight)
MouseOverClose = (CloseXPos <= x) And (x <= CloseXPos + ImageWidth) And (CloseYPos <= y) And (y <= CloseYPos + ImageHeight)

If Not MouseOverMin And Not MouseOverClose Then
DrawButton Me, ImageWidth, ImageHeight, MinXPos, MinYPos, btMin
DrawButton Me, ImageWidth, ImageHeight, CloseXPos, CloseYPos, btClose
Me.*******
ElseIf MouseOverMin And MinDown Then
DrawButton Me, ImageWidth, ImageHeight, MinXPos, MinYPos, btMinDown
DrawButton Me, ImageWidth, ImageHeight, CloseXPos, CloseYPos, btClose
Me.*******
ElseIf MouseOverMin Then
DrawButton Me, ImageWidth, ImageHeight, MinXPos, MinYPos, btMinOver
DrawButton Me, ImageWidth, ImageHeight, CloseXPos, CloseYPos, btClose
Me.*******
End If

If MouseOverClose And CloseDown Then
DrawButton Me, ImageWidth, ImageHeight, MinXPos, MinYPos, btMin
DrawButton Me, ImageWidth, ImageHeight, CloseXPos, CloseYPos, btCloseDown
Me.*******
ElseIf MouseOverClose Then
DrawButton Me, ImageWidth, ImageHeight, MinXPos, MinYPos, btMin
DrawButton Me, ImageWidth, ImageHeight, CloseXPos, CloseYPos, btCloseOver
Me.*******
End If

End Sub

Private Sub Form_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)

If Button = 1 Then
If Not MouseOverMin And Not MouseOverClose Then
DrawButton Me, ImageWidth, ImageHeight, MinXPos, MinYPos, btMin
DrawButton Me, ImageWidth, ImageHeight, CloseXPos, CloseYPos, btClose
MinDown = False
CloseDown = False
Me.*******
ElseIf MouseOverMin Then
DrawButton Me, ImageWidth, ImageHeight, MinXPos, MinYPos, btMinOver
DrawButton Me, ImageWidth, ImageHeight, CloseXPos, CloseYPos, btClose
MinDown = False
Me.*******
Call MinPressed
ElseIf MouseOverClose Then
DrawButton Me, ImageWidth, ImageHeight, MinXPos, MinYPos, btMin
DrawButton Me, ImageWidth, ImageHeight, CloseXPos, CloseYPos, btCloseOver
Me.*******
CloseDown = False
Unload Me
End If
End If
End Sub