Anasayfa > Kodlar > Visual Basic 6 ile Transparan(Şeffaf) frame yapmak

Visual Basic 6 ile Transparan(Şeffaf) frame yapmak


API Kullanarak Katmanlarımız Nasıl Transparan yapılır basit bir kod.

Transparan Frame

Grekli Malzemeler
1- frame1 adında bir frame
2- command1 adında bir button
3- kodu geliştirmek için hayalgücü 😀


Option Explicit

Private Const BDR_SUNKENOUTER = &H2
Private Const BDR_RAISEDINNER = &H4
Private Const DT_EDITCONTROL = &H2000&
Private Const EDGE_ETCHED = (BDR_SUNKENOUTER Or BDR_RAISEDINNER)
Private Const BF_BOTTOM = &H8
Private Const BF_LEFT = &H1
Private Const BF_RIGHT = &H4
Private Const BF_TOP = &H2
Private Const BF_RECT = (BF_LEFT Or BF_TOP Or BF_RIGHT Or BF_BOTTOM)
Private Const DT_LEFT = &H0
Private Const DT_TOP = &H0

Private Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type

Private Declare Function BitBlt Lib "gdi32" (ByVal hDCDest As Long, ByVal XDest As Long, ByVal YDest As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hDCSrc As Long, ByVal xSrc As Long, ByVal ySrc As Long, ByVal dwRop As Long) As Long
Private Declare Function GetDC Lib "user32" (ByVal hWnd As Long) As Long
Private Declare Function DrawText Lib "user32" Alias "DrawTextA" (ByVal hdc As Long, ByVal lpStr As String, ByVal nCount As Long, lpRect As RECT, ByVal wFormat As Long) As Long
Private Declare Function DrawCaption Lib "user32" (ByVal hWnd As Long, ByVal hdc As Long, pcRect As RECT, ByVal un As Long) As Long
Private Declare Function DrawEdge Lib "user32" (ByVal hdc As Long, qrc As RECT, ByVal edge As Long, ByVal grfFlags As Long) As Long
Private Declare Function SetRect Lib "user32" (lpRect As RECT, ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long

Private Sub Command1_Click()
'============================
Static blnTrans As Boolean
Dim MyRect As RECT
Dim X1&, Y1&, X2&, Y2&
Dim strText As String
Dim TempDC As Long

blnTrans = Not blnTrans 'transparanlığı ters çevir

With Frame1
If blnTrans Then
Me.Cls
Me.ScaleMode = vbPixels
X1 = .Left - 2
Y1 = .Top - 2
X2 = X1 + .Width + 4
Y2 = Y1 + .Height + 4
SetRect MyRect, X1, Y1, X2, Y2

SetRect MyRect, X1, Y1, X2, Y2
DrawEdge Me.hdc, MyRect, EDGE_ETCHED, BF_RECT

strText = .Caption
SetRect MyRect, X1 + 10, Y1 - 5, X2, Y2
DrawText Me.hdc, strText, Len(strText), MyRect, DT_LEFT Or DT_TOP

TempDC = GetDC(.hWnd)
BitBlt TempDC, 0, 0, .Width, .Height, .Parent.hdc, .Left, .Top, vbSrcCopy
Else
Me.Cls
.Refresh
End If
End With

End Sub

Private Sub Form_Load()
Me.AutoRedraw = True
End Sub

Private Sub Frame1_Click()
MsgBox "Transparan Frame'e Tıkladınız"
End Sub

 


TD Software


  1. Henüz yorum yapılmamış.
  1. No trackbacks yet.

Bir Cevap Yazın

Aşağıya bilgilerinizi girin veya oturum açmak için bir simgeye tıklayın:

WordPress.com Logosu

WordPress.com hesabınızı kullanarak yorum yapıyorsunuz. Log Out / Değiştir )

Twitter resmi

Twitter hesabınızı kullanarak yorum yapıyorsunuz. Log Out / Değiştir )

Facebook fotoğrafı

Facebook hesabınızı kullanarak yorum yapıyorsunuz. Log Out / Değiştir )

Google+ fotoğrafı

Google+ hesabınızı kullanarak yorum yapıyorsunuz. Log Out / Değiştir )

Connecting to %s

%d blogcu bunu beğendi: