Visual Basic 6 ile Xp botonu yapmak

Xp boton stilinin kaynak kodu

İlk önce yeni bir proje açalım ve activex controlu secerek tamam tusuna basalım. Şimdi bu proje derlendiği zaman diğer uygulamalar gibi tek başına çalışan değilde , diğer programlar altında çalışan kücük uygulama olacaktır. Bu Yazıda XP butonunu yapacagız. ( xp kurulu olmasa bile buton sitili xp butonu gibi olacak)

Öncelikle Project1 olan proje ismini xpbuton olarak değiştirelim. Sonrada usercontrol1
olan control ismini buton olarak değiştirelim ve projeyi kaydedelim. Sonrada kontrol üstüne bir adet timer ekleyelim. Kod sayfasına çift tıklayarak kod görünümüne geçelim ve alttaki uzuncana kodu copy paste metodu ile koda yapıştıralım.

kod başlangıcı :

Option Explicit
'Mouse uzerinde iken gerek duyulan apiler
Private Declare Function WindowFromPoint Lib "user32" (ByVal xPoint As Long, ByVal yPoint As Long) As Long
Private Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
'Köşe ve kareyi çizmek için kullanılan api
Private Declare Function GetClientRect Lib "user32" (ByVal hWnd As Long, lpRect As RECT) 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 Declare Function FillRect Lib "user32" (ByVal hdc As Long, lpRect As RECT, ByVal hBrush As Long) As Long
Private Declare Function FrameRect Lib "user32" (ByVal hdc As Long, lpRect As RECT, ByVal hBrush As Long) As Long
Private Declare Function SetCapture Lib "user32" (ByVal hWnd As Long) As Long
'Çizgileri Çizmek İçin Kullanılan Apiler
Private Declare Function CreateSolidBrush Lib "gdi32" (ByVal crColor As Long) As Long
Private Declare Function SetPixel Lib "gdi32" (ByVal hdc As Long, ByVal X As Long, ByVal Y As Long, ByVal crColor As Long) As Long
Private Declare Function MoveToEx Lib "gdi32" (ByVal hdc As Long, ByVal X As Long, ByVal Y As Long, lpPoint As POINTAPI) As Long
Private Declare Function LineTo Lib "gdi32" (ByVal hdc As Long, ByVal X As Long, ByVal Y As Long) As Long
Private Declare Function CreatePen Lib "gdi32" (ByVal nPenStyle As Long, ByVal nWidth As Long, ByVal crColor As Long) As Long
Private Const PS_SOLID = 0
Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
Private Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal hObject As Long) 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 SetWindowRgn Lib "user32" (ByVal hWnd As Long, ByVal hRgn As Long, ByVal bRedraw As Long) As Long
Private Const RGN_DIFF = 4
'Birazda renk
Private Declare Function GetTextColor Lib "gdi32" (ByVal hdc As Long) As Long
Private Declare Function SetTextColor Lib "gdi32" (ByVal hdc As Long, ByVal crColor 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 Const DT_CALCRECT = &H400
Private Const DT_WORDBREAK = &H10
Private Const DT_CENTER = &H1
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

Public Event Click()
Public Event MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
Public Event MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
Public Event MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
Public Event KeyPress(KeyAscii As Integer)
Public Event KeyDown(KeyCode As Integer, Shift As Integer)
Public Event KeyUp(KeyCode As Integer, Shift As Integer)
Public Event MouseOver()
Public Event MouseOut()

Private rc As RECT
Private W As Long, H As Long
Private rgMain As Long, rgn1 As Long
Private isOver As Boolean
Private flgHover As Integer
Private flgFocus As Boolean
Private LastButton As Integer
Private LastKey As Integer
Private r As Long, l As Long, t As Long, b As Long
Private mEnabled As Boolean
Private mCaption As String
Private mForeHover As OLE_COLOR

Private Sub DrawButton()
Dim pt As POINTAPI, pen As Long, hpen As Long

With UserControl
'Sol Üst Köseyi Karalayalım
hpen = CreatePen(PS_SOLID, 1, RGB(122, 149, 168))
pen = SelectObject(.hdc, hpen)
MoveToEx .hdc, l, t + 1, pt
LineTo .hdc, l + 2, t
SelectObject .hdc, pen
DeleteObject hpen

hpen = CreatePen(PS_SOLID, 1, RGB(37, 87, 131))
pen = SelectObject(.hdc, hpen)
MoveToEx .hdc, l + 2, t, pt
LineTo .hdc, l, t + 2
SelectObject .hdc, pen
DeleteObject hpen
SetPixel .hdc, l, t + 2, RGB(37, 87, 131)
SetPixel .hdc, l + 1, t + 2, RGB(191, 206, 220)
SetPixel .hdc, l + 2, t + 1, RGB(192, 207, 221)

'Üzt Çizgiyi Çiziyoruz
hpen = CreatePen(PS_SOLID, 1, RGB(0, 60, 116))
pen = SelectObject(.hdc, hpen)
MoveToEx .hdc, l + 3, t, pt
LineTo .hdc, r - 2, t
SelectObject .hdc, pen
DeleteObject hpen

'Sağ Üst Köse inşaası
hpen = CreatePen(PS_SOLID, 1, RGB(37, 87, 131))
pen = SelectObject(.hdc, hpen)
MoveToEx .hdc, r - 2, t, pt
LineTo .hdc, r + 1, t + 3
SelectObject .hdc, pen
DeleteObject hpen

hpen = CreatePen(PS_SOLID, 1, RGB(122, 149, 168))
pen = SelectObject(.hdc, hpen)
MoveToEx .hdc, r - 1, t, pt
LineTo .hdc, r, t + 2
SetPixel .hdc, r, t + 1, RGB(122, 149, 168)
SetPixel .hdc, r - 2, t + 1, RGB(213, 223, 232)
SetPixel .hdc, r - 1, t + 2, RGB(191, 206, 219)
SelectObject .hdc, pen
DeleteObject hpen

'sağ Çizgi
hpen = CreatePen(PS_SOLID, 1, RGB(0, 60, 116))
pen = SelectObject(.hdc, hpen)
MoveToEx .hdc, r, t + 3, pt
LineTo .hdc, r, b - 3
SelectObject .hdc, pen
DeleteObject hpen

'Sağ alt köşe Çiziliyor
hpen = CreatePen(PS_SOLID, 1, RGB(37, 87, 131))
pen = SelectObject(.hdc, hpen)
MoveToEx .hdc, r, b - 3, pt
LineTo .hdc, r - 3, b
SelectObject .hdc, pen
DeleteObject hpen

hpen = CreatePen(PS_SOLID, 1, RGB(122, 149, 168))
pen = SelectObject(.hdc, hpen)
MoveToEx .hdc, r, b - 2, pt
LineTo .hdc, r - 2, b
SetPixel .hdc, r - 2, b - 2, RGB(177, 183, 182)
SetPixel .hdc, r - 1, b - 3, RGB(182, 189, 189)
SelectObject .hdc, pen
DeleteObject hpen

'Alt Çizgi
hpen = CreatePen(PS_SOLID, 1, RGB(0, 60, 116))
pen = SelectObject(.hdc, hpen)
MoveToEx .hdc, l + 3, b - 1, pt
LineTo .hdc, r - 2, b - 1
SelectObject .hdc, pen
DeleteObject hpen

'Sol alt çizgi
hpen = CreatePen(PS_SOLID, 1, RGB(37, 87, 131))
pen = SelectObject(.hdc, hpen)
MoveToEx .hdc, l, b - 3, pt
LineTo .hdc, l + 3, b
SelectObject .hdc, pen
DeleteObject hpen

hpen = CreatePen(PS_SOLID, 1, RGB(122, 149, 168))
pen = SelectObject(.hdc, hpen)
MoveToEx .hdc, l, b - 2, pt
LineTo .hdc, l + 2, b
SetPixel .hdc, l + 1, b - 3, RGB(191, 199, 202)
SetPixel .hdc, l + 2, b - 2, RGB(163, 174, 180)
SelectObject .hdc, pen
DeleteObject hpen

'Sol Çizgi

hpen = CreatePen(PS_SOLID, 1, RGB(0, 60, 116))
pen = SelectObject(.hdc, hpen)
MoveToEx .hdc, l, t + 3, pt
LineTo .hdc, l, b - 3
SelectObject .hdc, pen
DeleteObject hpen

End With<BR

TD Software