Program Yapmak | Programcılık Hakkında Her Şey | VİSUAL BASİC 6.0 | C, C++ ve C# Yazılım Dilleri | VB.NET Yazılım Dili

Uc Boyutlu ve Rengarenk ProgressBar Yapimi

VB6'da .NET te olduğu gibi alternatif kontroller bulunmuyor. Bu kontrollerin VB'de nasıl hazırlandığını merak edenler için bol açıklamalı bir döküman.
".NET te bu tip kontroller hazır olarak var" diyeceksiniz.
Fakat ben biraz eski kafalı olduğumdan bu kontrollerin VB6'da
nasıl oluşturulduğunu anlatmak istiyorum. Ayrıca bu kontrolü
OCX olarak derleyip .NET te de kullanabilirsiniz.

- Bu döküman ve örnekte, VB6.0 da UserControl nesnesi kullanılarak
ProgressBar kontrolünün nasıl hazırlandığı incelenecek.
- ProgressBar'a özellikler ekleyip, ön ve arka plan renklerini
bu özellikler vasıtasıyla değiştireceğiz.
- Ayrıca event kullanımlarına ilişkin olarak, yapmakta olacağımız
kontrol nesnesine Click, MouseDown, MouseUp ve MouseMove olaylarını
ekleyeceğiz.


--------Figür-1--------

Hazırlık


Yapacağımız kontrol nesnesini EXE projesi içinde kullacağız.
Dilerseniz yeni bir ActiveControl projesinde OCX olarak
hazırlayabilirsiniz.

Öncelikle yeni bir EXE projesi açıp, projeye bir tane UserControl
ve iki tane Modul ekleyin. Ben, projede kullandığım objelere
aşağıdaki isimleri verdim. Döküman anlatımı süresince bu isimlerle
kullanacağım.


Form: Form1
UserControl: GBProgressBar
Module: mdlDrawing
Module: mdlRGBHSL


UserControl: GBProgressBar


UserControl nesnesinin ismini "GBProgressBar" olarak kullandık.
Bu kontrol nesnesi, Toolbar bölümünde varsayılan icon resmi
ile gözükecektir. Biz bu ikonu kendi hazırladığımız resimle
değiştireceğiz.

UserControl'un ScaleMode özelliğini pixel olarak tanımlayın ve AutoRedraw
özelliğini ise True yapın.

Mouse, Toolbardaki bu kontrol üzerine geldiğinde, hatırlatma
balonu çıkacak ve vermiş olduğunuz "GBProgressBar" ismi gözükecektir.

Toolbar'daki iconu değiştirmek için, UserControl nesnesinin "ToolboxBitmap"
özelliğine kendi hazırladığımız resmi seçeceğiz. Bu resim 16x15 pixel
boyutlarında olmalı ve "1, 15" koordinatlarındaki renk değeri maskeleme için
kullanılacaktır. Yani "x=1, y=15" koordinatlarındaki renk değeri siyah ise
bu resim içinde kullandığınız tüm siyah renkler maskelenecektir.

UserControl nesnesinin kod bölümüne geçelim ve bu kontrol içinde kullanacağımız
özellikleri saklayan değişkenleri tanımlayalım. Bu alanda "eProgressScrolling"
isimli bir enum olusturuyoruz. Enum ile ilgili açıklama dökümanın ilerleyen
bölümlerinde verilecektir.


' ProgressBar'ın görünüm değerleri
Public Enum eProgressScrolling
    pbScrollingStandard = 0
    pbScrollingSmooth = 1
End Enum

Dim m_nFaceColor    As OLE_COLOR ' önplan rengi
Dim m_nBackColor    As OLE_COLOR ' arkaplan rengi
Dim m_nMax          As Long ' maximum progress değeri
Dim m_nMin          As Long ' minimum progress değeri
Dim m_nValue        As Long ' progress in çalışma anındaki değeri
Dim m_bEnabled      As Boolean ' progress'in kullanılabilirlik değeri
Dim m_nScrolling    As eProgressScrolling ' görünümü


İlk olarak, hazırladığımız UserControl'ü formunuza eklediğinizde
varsayılan değerleri "UserControl_Initialize" bölümünde belirtiyoruz.


Private Sub UserControl_Initialize()
    m_nMax = 100
    m_nFaceColor = vbGreen
    m_nBackColor = vbButtonFace
    m_nValue = 0
    m_nScrolling = pbScrollingStandard
End Sub


Bir de "UserControl_InitProperties" olayı vardır.
Bu olay "UserControl_Initialize" dan sonra çalışır ve "Ambient" kullanımına
izin verir. Sadece yazmakta olduğumuz "UserControl" nesnesi herhangi bir
forma eklendiğinde çalışır.

örn: Kontrolü forma eklediğimizde, kontrolün arkaplan renginin, form ile
aynı olmasını istiyorsak. Bu bölüme aşağıdaki kodlar eklenebilir.


Private Sub UserControl_InitProperties()
    'Bu işlem UserControl_Initialize da yapılamaz.
    m_nBackColor = Ambient.BackColor
End Sub


Yukarıda tanımlanan değişkenleri UserControl dışından kullanabilmemiz için
kontrole özellikler eklememiz gerekmektedir.


Public Property Get FaceColor() As OLE_COLOR
    FaceColor = m_nFaceColor
End Property
Public Property Let FaceColor(ByVal newVal As OLE_COLOR)
    m_nFaceColor = newVal
    Call DrawProgress
End Property

Public Property Get BackColor() As OLE_COLOR
    BackColor = m_nBackColor
End Property
Public Property Let BackColor(ByVal newVal As OLE_COLOR)
    m_nBackColor = newVal
    Call DrawProgress
End Property
*
*
*


Her özelliği değiştirdiğiminde kontrolü "DrawProgress" alt programı
ile tekrar çiziyoruz.


Private Sub DrawProgress()
    Dim nVal As Long
    
    UserControl.Cls
    nVal = (UserControl.ScaleWidth - 4)
    UserControl.BackColor = m_nBackColor
    If Ambient.UserMode Then
        nVal = ((UserControl.ScaleWidth - 4) / (m_nMax - m_nMin)) * (m_nValue - m_nMin)
    End If
    Call DrawDegrade(UserControl.hdc, 2, 2, nVal, (UserControl.ScaleHeight - 4), (UserControl.ScaleWidth - 4), m_nFaceColor, m_nScrolling)
    Call DrawEdgeEx(UserControl.hdc, 0, 0, UserControl.ScaleWidth, UserControl.ScaleHeight)
    If UserControl.AutoRedraw Then UserControl.Refresh
End Sub


Yukarıdaki kodda "Ambient.UserMode" değeri, uygulama çalıştırıldığında
"True" olur. Normalde kontrol forma eklendiğinde "Value" değerini maximum
olarak gösterip, progress'in tamamını çizerek kullanıcıya göstermek
amacıyla kullanılmıştır. Kodu kullanırken daha net anlayacaksınız.

UserControl'ün tüm kodları aşağıda sunulmuştur.

' Author: Gökhan ERDOĞDU
' Date  : 03.06.2009
' mail  : gokhan_erdogdu@yahoo.com
' Copyright © 2009 GBSoftware

Option Explicit

Public Enum eProgressScrolling
    pbScrollingStandard = 0
    pbScrollingSmooth = 1
End Enum

Dim m_nFaceColor    As OLE_COLOR
Dim m_nBackColor    As OLE_COLOR
Dim m_nMax          As Long
Dim m_nMin          As Long
Dim m_nValue        As Long
Dim m_bEnabled      As Boolean
Dim m_nScrolling    As eProgressScrolling

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)

Private Sub DrawProgress()
    Dim nVal As Long
    
    UserControl.Cls
    nVal = (UserControl.ScaleWidth - 4)
    UserControl.BackColor = m_nBackColor
    If Ambient.UserMode Then
        nVal = ((UserControl.ScaleWidth - 4) / (m_nMax - m_nMin)) * (m_nValue - m_nMin)
    End If
    Call DrawDegrade(UserControl.hdc, 2, 2, nVal, (UserControl.ScaleHeight - 4), (UserControl.ScaleWidth - 4), m_nFaceColor, m_nScrolling)
    Call DrawEdgeEx(UserControl.hdc, 0, 0, UserControl.ScaleWidth, UserControl.ScaleHeight)
    If UserControl.AutoRedraw Then UserControl.Refresh
End Sub

Private Sub UserControl_Click()
    If Not m_bEnabled Then Exit Sub
    RaiseEvent Click
End Sub

Private Sub UserControl_InitProperties()
    m_nBackColor = Ambient.BackColor
End Sub

Private Sub UserControl_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
    If Not m_bEnabled Then Exit Sub
    RaiseEvent MouseDown(Button, Shift, x, y)
End Sub
Private Sub UserControl_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
    If Not m_bEnabled Then Exit Sub
    RaiseEvent MouseMove(Button, Shift, x, y)
End Sub
Private Sub UserControl_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)
    If Not m_bEnabled Then Exit Sub
    RaiseEvent MouseUp(Button, Shift, x, y)
End Sub

Private Sub UserControl_Initialize()
    m_nMax = 100
    m_nFaceColor = vbGreen
    m_nBackColor = vbButtonFace
    m_nValue = 0
    m_nScrolling = pbScrollingStandard
End Sub

Private Sub UserControl_ReadProperties(PropBag As PropertyBag)
    m_nFaceColor = PropBag.ReadProperty("FaceColor", vbGreen)
    m_nBackColor = PropBag.ReadProperty("BackColor", vbButtonFace)
    m_nMax = PropBag.ReadProperty("Max", 100)
    m_nMin = PropBag.ReadProperty("Min", 0)
    m_nValue = m_nMin
    m_nScrolling = PropBag.ReadProperty("Scrolling", pbScrollingStandard)
    m_bEnabled = PropBag.ReadProperty("Enabled", True)
    Call DrawProgress
End Sub

Private Sub UserControl_WriteProperties(PropBag As PropertyBag)
    Call PropBag.WriteProperty("FaceColor", m_nFaceColor)
    Call PropBag.WriteProperty("BackColor", m_nBackColor)
    Call PropBag.WriteProperty("Max", m_nMax)
    Call PropBag.WriteProperty("Min", m_nMin)
    Call PropBag.WriteProperty("Scrolling", m_nScrolling)
    Call PropBag.WriteProperty("Enabled", m_bEnabled)
End Sub

Private Sub UserControl_Resize()
    Call DrawProgress
End Sub

Public Property Get FaceColor() As OLE_COLOR
    FaceColor = m_nFaceColor
End Property
Public Property Let FaceColor(ByVal newVal As OLE_COLOR)
    m_nFaceColor = newVal
    Call DrawProgress
End Property

Public Property Get BackColor() As OLE_COLOR
    BackColor = m_nBackColor
End Property
Public Property Let BackColor(ByVal newVal As OLE_COLOR)
    m_nBackColor = newVal
    Call DrawProgress
End Property

Public Property Get Max() As Long
    Max = m_nMax
End Property
Public Property Let Max(ByVal newVal As Long)
    If newVal > m_nMin Then
        m_nMax = newVal
        If m_nValue > m_nMax Then m_nValue = m_nMax
        Call DrawProgress
    Else
        VBA.Err.Raise 380, , "Invalid property value"
    End If
End Property

Public Property Get Min() As Long
    Min = m_nMin
End Property
Public Property Let Min(ByVal newVal As Long)
    If newVal < m_nMax Then
        m_nMin = newVal
        If m_nValue < m_nMin Then m_nValue = m_nMin
        Call DrawProgress
    Else
        VBA.Err.Raise 380, , "Invalid property value"
    End If
End Property

Public Property Get Value() As Long
    Value = m_nValue
End Property
Public Property Let Value(ByVal newVal As Long)
    If newVal >= m_nMin And newVal <= m_nMax Then
        m_nValue = newVal
        Call DrawProgress
    Else
        VBA.Err.Raise 380, , "Invalid property value"
    End If
End Property

Public Property Get Scrolling() As eProgressScrolling
    Scrolling = m_nScrolling
End Property
Public Property Let Scrolling(ByVal newVal As eProgressScrolling)
    m_nScrolling = newVal
    Call DrawProgress
End Property

Public Property Get Enabled() As Boolean
    Enabled = m_bEnabled
End Property
Public Property Let Enabled(ByVal newVal As Boolean)
    m_bEnabled = newVal
    Call DrawProgress
End Property


Module: mdlDrawing


Çizim işlemleri için kullandığımız fonksiyon ve api fonksiyonlarını
bu modülde tanımlıyoruz.

' Author: Gökhan ERDOĞDU
' Date  : 03.06.2009
' mail  : gokhan_erdogdu@yahoo.com
' Copyright © 2009 GBSoftware

Option Explicit

Private Const MAX_LUMINANCE = &HA0
Private Const MIN_LUMINANCE = &H3C
Private Const PROGRESS_PIE_WIDTH = 6

Private Const BDR_RAISEDOUTER = &H1
Private Const BDR_SUNKENOUTER = &H2
Private Const BDR_RAISEDINNER = &H4
Private Const BDR_SUNKENINNER = &H8

Private Const BDR_OUTER = &H3
Private Const BDR_INNER = &HC
Private Const BDR_RAISED = &H5
Private Const BDR_SUNKEN = &HA

Private Const EDGE_RAISED = (BDR_RAISEDOUTER Or BDR_RAISEDINNER)
Private Const EDGE_SUNKEN = (BDR_SUNKENOUTER Or BDR_SUNKENINNER)
Private Const EDGE_ETCHED = (BDR_SUNKENOUTER Or BDR_RAISEDINNER)
Private Const EDGE_BUMP = (BDR_RAISEDOUTER Or BDR_SUNKENINNER)

Private Const BF_LEFT = &H1
Private Const BF_TOP = &H2
Private Const BF_RIGHT = &H4
Private Const BF_BOTTOM = &H8

Private Const BF_TOPLEFT = (BF_TOP Or BF_LEFT)
Private Const BF_TOPRIGHT = (BF_TOP Or BF_RIGHT)
Private Const BF_BOTTOMLEFT = (BF_BOTTOM Or BF_LEFT)
Private Const BF_BOTTOMRIGHT = (BF_BOTTOM Or BF_RIGHT)
Private Const BF_RECT = (BF_LEFT Or BF_TOP Or BF_RIGHT Or BF_BOTTOM)

Private Const BF_DIAGONAL = &H10

' For diagonal lines, the BF_RECT flags specify the end point of the
' vector bounded by the rectangle parameter.
Private Const BF_DIAGONAL_ENDTOPRIGHT = (BF_DIAGONAL Or BF_TOP _
Or BF_RIGHT)
Private Const BF_DIAGONAL_ENDTOPLEFT = (BF_DIAGONAL Or BF_TOP Or BF_LEFT)
Private Const BF_DIAGONAL_ENDBOTTOMLEFT = (BF_DIAGONAL Or BF_BOTTOM _
Or BF_LEFT)
Private Const BF_DIAGONAL_ENDBOTTOMRIGHT = (BF_DIAGONAL Or BF_BOTTOM _
Or BF_RIGHT)

Private Const BF_MIDDLE = &H800        ' Fill in the middle
Private Const BF_SOFT = &H1000         ' For softer buttons
Private Const BF_ADJUST = &H2000       ' Calculate the space left over
Private Const BF_FLAT = &H4000         ' For flat rather than 3D borders
Private Const BF_MONO = &H8000         ' For monochrome borders

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

Private Declare Function DrawEdge Lib "user32" (ByVal hdc As Long, _
    qrc As RECT, ByVal edge As Long, ByVal grfFlags As Long) As Boolean

Private Declare Function SetPixel Lib "gdi32" _
    (ByVal hdc As Long, ByVal x As Long, _
     ByVal y As Long, ByVal crColor As Long) As Long


Public Function DrawEdgeEx(ByVal nDC As Long, ByVal nX As Long, ByVal nY As Long, ByVal nWidth As Long, ByVal nHeight As Long) As Boolean
    Dim rc1 As RECT
    rc1.Left = nX
    rc1.Right = nX + nWidth
    rc1.Top = nY
    rc1.Bottom = nY + nHeight
    DrawEdgeEx = DrawEdge(nDC, rc1, BDR_SUNKENOUTER, BF_RECT)
End Function

Public Sub DrawDegrade(ByVal nDC As Long, ByVal nX As Long, ByVal nY As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal nMaxWidth As Long, ByVal nColor As Long, ByVal nScrolling As eProgressScrolling)
    If nWidth <= 0 Or nHeight <= 0 Then Exit Sub
    
    Dim i As Long, j As Long, k As Long
    Dim nPieWidth As Long
    Dim nCntX As Long, nCntY As Long
    Dim nLum As Long
    Dim dScale As Double
    
    nPieWidth = nHeight * 3 / 4
    nCntX = nX + nWidth - 1
    nCntY = nY + nHeight - 1
    If nScrolling = pbScrollingStandard Then
        dScale = (MAX_LUMINANCE - MIN_LUMINANCE) / nHeight
        For i = nX To nCntX
            If ((nX - i) Mod (nPieWidth + 1)) = 0 Then
                For k = i To GetMin(i + nPieWidth - 1, nMaxWidth + 1)
                    For j = nY To nCntY
                        nLum = MIN_LUMINANCE + (nCntY - j) * dScale
                        Call SetPixel(nDC, k, j, GetAdjustLuma(nColor, nLum))
                    Next j
                Next k
            End If
        Next i
    Else
        dScale = (MAX_LUMINANCE - MIN_LUMINANCE) / nHeight
        For i = nX To nCntX
            For j = nY To nCntY
                nLum = MIN_LUMINANCE + (nCntY - j) * dScale
                Call SetPixel(nDC, i, j, GetAdjustLuma(nColor, nLum))
            Next j
        Next i
    End If
End Sub

Public Function GetMin(nVal1 As Long, nVal2 As Long) As Long
    GetMin = VBA.IIf(nVal1 > nVal2, nVal2, nVal1)
End Function

Public Function GetMax(nVal1 As Long, nVal2 As Long) As Long
    GetMax = VBA.IIf(nVal1 > nVal2, nVal1, nVal2)
End Function


Module: mdlRGBHSL


Renk için RGB, Hue, Luminance ve Saturation gibi değerleri kontrol ettiğimiz
api fonksiyonlarını bu modülde tanımlıyoruz.

' Author: Gökhan ERDOĞDU
' Date  : 03.06.2009
' mail  : gokhan_erdogdu@yahoo.com
' Copyright © 2009 GBSoftware

Option Explicit

Public Type RGBQUAD
    bB As Byte 'Blue
    bG As Byte 'Green
    bR As Byte 'Red
    bA As Byte 'Alpha
End Type

Public Type tHSL
    H As Long
    S As Long
    L As Long
End Type

Private Declare Function ColorAdjustLuma Lib "SHLWAPI.DLL" _
                        (ByVal clrRGB As Long, _
                         ByVal n As Long, _
                         ByVal fScale As Long) As Long
  

Private Declare Function ColorHLSToRGB Lib "SHLWAPI.DLL" _
                        (ByVal wHue As Long, _
                         ByVal wLuminance As Long, _
                         ByVal wSaturation As Long) As Long

Private Declare Sub ColorRGBToHLS Lib "SHLWAPI.DLL" _
                        (ByVal clrRGB As Long, _
                         ByRef wHue As Long, _
                         ByRef wLuminance As Long, _
                         ByRef wSaturation As Long)

Public Function Long2RGB(ByVal color1 As Long) As RGBQUAD
    With Long2RGB
        .bG = VBA.CByte((color1 - (color1 Mod 65536)) / 65535)
        color1 = (color1 Mod 65535)
        
        .bB = VBA.CByte((color1 - (color1 Mod 256)) / 255)
        color1 = (color1 Mod 255)
        
        .bR = VBA.CByte(color1)
    End With
End Function

Public Function RGB2Long(rgb1 As RGBQUAD)
    RGB2Long = VBA.RGB(rgb1.bR, rgb1.bG, rgb1.bB)
End Function

Public Function RGB2Grey(rgb1 As RGBQUAD) As Long
    Dim nColor As Long
    nColor = RGB2Long(rgb1)
    RGB2Grey = Long2Grey(nColor)
End Function

Public Function Long2Grey(nColor As Long, Optional ByRef nLuminance As Long)
    Dim HSL As tHSL
    Call ColorRGBToHLS(nColor, HSL.H, HSL.L, HSL.S)
    nLuminance = HSL.L
    Long2Grey = (nLuminance * 65536 + nLuminance * 256 + nLuminance)
End Function

Public Function Long2HSL(nColor As Long) As tHSL
    With Long2HSL
        Call ColorRGBToHLS(nColor, .H, .L, .S)
    End With
End Function

Public Function GetAdjustLuma(ByVal nColor As Long, ByVal newLuma As Long)
    Dim hsl1 As tHSL
    hsl1 = Long2HSL(nColor)
    GetAdjustLuma = ColorHLSToRGB(hsl1.H, newLuma, hsl1.S)
End Function


Form: Form1


Hazırlamış olduğumuz ProgressBar'ı test ettiğimiz form objesinin
AutoRedraw özelliğini True ve ScaleMode özelliğini ise Pixel olarak
tanımlayın. Aşağıda forma ait kodlar sunulmuştur.

' Author: Gökhan ERDOĞDU
' Date  : 03.06.2009
' mail  : gokhan_erdogdu@yahoo.com
' Copyright © 2009 GBSoftware

Option Explicit

Private Sub Form_Resize()
    Me.Cls
    Call DrawDegrade(Me.hdc, 0, 0, Me.ScaleWidth, Me.ScaleHeight, Me.ScaleWidth, &HC0E0FF, pbScrollingSmooth)
    Me.Refresh
End Sub

Private Sub Timer1_Timer()
    Dim nVal As Long
    Dim ctr1 As Variant
    
    Randomize
    For Each ctr1 In Me.Controls
        If TypeName(ctr1) = "GBProgressBar" Then
            nVal = ctr1.Value + (Rnd(999) * 5)
            If nVal <= ctr1.Max Then ctr1.Value = nVal
        End If
    Next ctr1
End Sub


Uygulamanın kaynak kodlarını indirmek için.
Tıklayınız

İyi çalışmalar.

Gökhan ERDOĞDU
Sincan Laptop tamiratı ile alakalı içeriklerin bulunduğu web siteden bilgilere ulaşabilirsiniz. Sincan'da laptop tamiratını en iyi yapan yerleri sorgulayabilirsiniz. Cihan KOÇ
=> Sen de ücretsiz bir internet sitesi kurmak ister misin? O zaman burayı tıkla! <=