'Ocx i Forma alındığında Property deki
'Renk1 = Label in Sol taraftaki Rengi
'Renk2 = Label in Sag taraftaki Rengi
'Eğer 4 Koşe icin 4 Ayrı Renk Tanımlanırsa
'4 Renkli Label Olur
'BorderStyle 0 = Duz, 1=Dışa Kabartma, 2=İce Gomuk
'Kalınlık = 0-10 Label in Kalınlığı
'KenarCizgisi 1= Var, 0= Yok
'Yazı3D 0=Duz,1=Dışa Cıkık,2=İce Gomuk
'YazıRengi = Sectiğin Renk
'YazıYeri =0-8 Solust,SolOrta,SolAlt,Orta,OrtaUst,
' OrtaAlt,SağUst,SağOrta,SağAlt
'Diğer Olaylar Normal Label dekinin Aynı
'Eğer Bir Hatam varsa Affola Yanlız Haberim Ola Duzelteyim
'Aynı Ocx i Command Tuşu Gibide Kullanabilirsiniz tabiki Tuşun
'Basılı Durumunu ayarlayarak
'Hadi Kolay Gelsin

Public Enum P_BorderStyle
Normal = 0
DışaCıkık = 1
İceGomuk = 2
End Enum

Public Enum P_KenarCizgisi
Yok = 0
Var = 1
End Enum

Public Enum P_Renk
Siyah = 0
Kırmızı = 1
Yeşil = 2
Sarı = 3
Mavi = 4
Mor = 5
AcıkMavi = 6
Beyaz = 7
End Enum

Public Enum P_YaziYeri
SolUst = 0
SolOrta = 1
SolAlt = 2
UstOrta = 3
Orta = 4
AltOrta = 5
SagUst = 6
SagOrta = 7
SagAlt = 8
End Enum


Private Type GRADIENT_TRIANGLE
Vertex1 As Long
Vertex2 As Long
Vertex3 As Long
End Type
Private Type TRIVERTEX
X As Long
Y As Long
Red As Integer
Green As Integer
Blue As Integer
Alpha As Integer
End Type
Private Type GRADIENT_RECT
UpperLeft As Long
LowerRight As Long
End Type
Const GRADIENT_FILL_RECT_H As Long = &H0
Const GRADIENT_FILL_RECT_V As Long = &H1
Const GRADIENT_FILL_TRIANGLE As Long = &H2

Dim Pm_Value As Variant
Dim Pm_KenarCizgisi As Long
Dim Pm_Kalinlik As Integer, Pm_Boy As Integer, Pm_Yuk As Integer
Dim L_Yuk As Integer, L_Boy As Integer
Dim Pm_BorderStyle As Long
Dim Sol As Integer, Ust As Integer
Dim Genislik As Integer, Yukseklik As Integer
Dim TabanRengi As Long, P_YaziRengi As Long, DolumRengi As Long
Dim KoyuGolge As Long, AcikGolge As Long
Dim SonX As Integer, SonY As Integer, P_Yazı3D As Integer
Dim Rgb1r, Rgb1g, Rgb1b, Rgb2r, Rgb2g, Rgb2b
Dim Pm_YaziYeri As Variant

Event Click()
Event DblClick()
Event MouseDown(Button As Integer, Shift As Integer, _
X As Single, Y As Single)
Event MouseMove(Button As Integer, Shift As Integer, _
X As Single, Y As Single)
Event MouseUp(Button As Integer, Shift As Integer, _
X As Single, Y As Single)

Private Declare Function GradientFillTriangle Lib "msimg32" _
Alias "GradientFill" (ByVal hDC As Long, pVertex As TRIVERTEX, _
ByVal dwNumVertex As Long, pMesh As GRADIENT_TRIANGLE, _
ByVal dwNumMesh As Long, _
ByVal dwMode As Long) As Long

Private Declare Function GetPixel Lib "gdi32" (ByVal hDC As _
Long, ByVal X As Long, ByVal Y As Long) As Long

Private Function RgbParse(hDC As Long, X As Single, _
Y As Single) As String
Dim ColorMe As Long
ColorMe = GetPixel(hDC, X, Y)
Dim rgbRed, rgbGreen, rgbBlue As Long
rgbRed = Abs(ColorMe Mod &H100)
ColorMe = Abs(ColorMe \ &H100)
rgbGreen = Abs(ColorMe Mod &H100)
ColorMe = Abs(ColorMe \ &H100)
rgbBlue = Abs(ColorMe Mod &H100)
ColorMe = RGB(rgbRed, rgbGreen, rgbBlue)
RgbParse = "RGB(" & rgbRed & ", " & rgbGreen & ", " & _
rgbBlue & ")"
End Function

Private Sub RenkCiz()
Dim L_Gen, L_Yuk
Dim vert(4) As TRIVERTEX
Dim gTRi(1) As GRADIENT_TRIANGLE
ScaleMode = vbPixels
AutoRedraw = True
'Sol Ust
vert(0).X = SonX + Kalinlik + 1
vert(0).Y = SonY + Kalinlik + 1
vert(0).Red = Rgb1r
vert(0).Green = Rgb1g
vert(0).Blue = Rgb1b
vert(0).Alpha = 0&
'Sag Ust
vert(1).X = Genislik + Pm_Kalinlik + 1
vert(1).Y = SonY + 1
vert(1).Red = Rgb2r
vert(1).Green = Rgb2g
vert(1).Blue = Rgb2b
vert(1).Alpha = 0&
'Sag Alt
vert(2).X = Genislik + Pm_Kalinlik + 1
vert(2).Y = Yukseklik + Pm_Kalinlik + 1
vert(2).Red = Rgb2r
vert(2).Green = Rgb2g
vert(2).Blue = Rgb2b
vert(2).Alpha = 0&
'Sol Alt
vert(3).X = SonX + 1
vert(3).Y = Yukseklik + Pm_Kalinlik
vert(3).Red = Rgb1r
vert(3).Green = Rgb1g
vert(3).Blue = Rgb1b
vert(3).Alpha = 0&

gTRi(0).Vertex1 = 0
gTRi(0).Vertex2 = 1
gTRi(0).Vertex3 = 2

gTRi(1).Vertex1 = 0
gTRi(1).Vertex2 = 2
gTRi(1).Vertex3 = 3
GradientFillTriangle hDC, vert(0), 4, gTRi(0), 2, _
GRADIENT_FILL_TRIANGLE
If Label1.Height > Yukseklik Then
Label1.Height = Yukseklik
Label2.Height = Yukseklik
Else
Label1.AutoSize = True
Label2.AutoSize = True
End If
If Label1.Width > Genislik Then
Label1.Width = Genislik
Label2.Width = Genislik
Else
Label1.AutoSize = True
Label2.AutoSize = True
End If
LabelYaz
UserControl.Refresh

End Sub

Public Property Get Enabled() As Boolean
Enabled = Label1.Enabled
End Property

Public Property Let Enabled(ByVal New_Enabled As Boolean)
Label1.Enabled() = New_Enabled
Label2.Enabled = New_Enabled
UserControl.Enabled = New_Enabled
PropertyChanged "Enabled"
End Property

Private Sub Label1_Click()
RaiseEvent Click
End Sub

Private Sub Label1_DblClick()
RaiseEvent DblClick
End Sub

Private Sub Label1_MouseDown(Button As Integer, Shift As _
Integer,X As Single, Y As Single)
RaiseEvent MouseDown(Button, Shift, X, Y)
End Sub

Private Sub Label1_MouseMove(Button As Integer, Shift As _
Integer, X As Single, Y As Single)
RaiseEvent MouseMove(Button, Shift, X, Y)
End Sub

Private Sub Label1_MouseUp(Button As Integer, Shift As _
Integer, X As Single, Y As Single)
RaiseEvent MouseUp(Button, Shift, X, Y)
End Sub



Public Property Get KenarCizgisi() As P_KenarCizgisi
KenarCizgisi = Pm_KenarCizgisi
End Property

Public Property Let KenarCizgisi(ByVal New_KenarCizgisi As _
P_KenarCizgisi)
Pm_KenarCizgisi = New_KenarCizgisi
UserControl_Resize
PropertyChanged "KenarCizgisi"
End Property

Public Property Get BorderStyle() As P_BorderStyle
BorderStyle = Pm_BorderStyle
End Property

Public Property Let BorderStyle(ByVal New_BorderStyle As _
P_BorderStyle)
Pm_BorderStyle = New_BorderStyle
UserControl_Resize
PropertyChanged "BorderStyle"
End Property

Public Property Get Kalınlık() As Integer
Kalınlık = Pm_Kalinlik
End Property

Public Property Let Kalınlık(ByVal New_Kalinlik As Integer)
Pm_Kalinlik = New_Kalinlik
If Pm_Kalinlik > 10 Then Pm_Kalinlik = 10
UserControl_Resize
PropertyChanged "Kalınlık"
End Property

Public Property Get Renk1() As P_Renk
Renk1 = TabanRengi
End Property

Public Property Let Renk1(ByVal New_Renk1 As P_Renk)
TabanRengi = New_Renk1
UserControl_Resize
PropertyChanged "Renk1"
End Property

Public Property Get Renk2() As P_Renk
Renk2 = DolumRengi
End Property

Public Property Let Renk2(ByVal New_Renk2 As P_Renk)
DolumRengi = New_Renk2
UserControl_Resize
PropertyChanged "Renk2"
End Property



Private Sub UserControl_Click()
RaiseEvent Click
End Sub

Private Sub UserControl_DblClick()
RaiseEvent DblClick
End Sub

Private Sub UserControl_InitProperties()
UserControl.ScaleMode = 3
Pm_KenarCizgisi = 0
Pm_BorderStyle = 0
Pm_Kalinlik = 0
Pm_Value = 0
Pm_YaziYeri = 1
TabanRengi = 7
P_YaziRengi = 0
DolumRengi = 1
P_Yazı3D = 0
Pm_Boy = UserControl.ScaleWidth
Pm_Yuk = UserControl.ScaleHeight
Label1.Caption = "2 Renkli Label"
Label2.Caption = "2 Renkli Label"
Set Label1.Font = Ambient.Font
Set Label2.Font = Ambient.Font
Label1.FontBold = False
Label2.FontBold = False
End Sub

Private Sub UserControl_MouseDown(Button As Integer, Shift As _
Integer, X As Single, Y As Single)
RaiseEvent MouseDown(Button, Shift, X, Y)
End Sub

Private Sub UserControl_MouseMove(Button As Integer, Shift As _
Integer, X As Single, Y As Single)
RaiseEvent MouseMove(Button, Shift, X, Y)
End Sub

Private Sub UserControl_MouseUp(Button As Integer, Shift As _
Integer, X As Single, Y As Single)
RaiseEvent MouseUp(Button, Shift, X, Y)
End Sub

Private Sub UserControl_Paint()
Ciz
RenkCiz
End Sub
Private Sub UserControl_ReadProperties(PropBag As PropertyBag)
Label1.Enabled = PropBag.ReadProperty("Enabled", True)
Label2.Enabled = PropBag.ReadProperty("Enabled", True)
UserControl.Enabled = PropBag.ReadProperty("Enabled", True)
Pm_KenarCizgisi = PropBag.ReadProperty("KenarCizgisi", _
Pm_KenarCizgisi)
Pm_BorderStyle = PropBag.ReadProperty("BorderStyle", _
Pm_BorderStyle)
Pm_Kalinlik = PropBag.ReadProperty("Kalınlık", Pm_Kalinlik)
DolumRengi = PropBag.ReadProperty("Renk2", DolumRengi)
TabanRengi = PropBag.ReadProperty("Renk1", TabanRengi)
Label2.Caption = PropBag.ReadProperty("Caption", _
Label2.Caption)
Label1.Caption = Label2.Caption
Set Label1.Font = PropBag.ReadProperty("Font", Ambient.Font)
Set Label2.Font = PropBag.ReadProperty("Font", Ambient.Font)
P_Yazı3D = PropBag.ReadProperty("Yazı3D", P_Yazı3D)
P_YaziRengi = PropBag.ReadProperty("YazıRengi", P_YaziRengi)
Pm_YaziYeri = PropBag.ReadProperty("YazıYeri", Pm_YaziYeri)
UserControl_Resize
End Sub

Private Sub UserControl_WriteProperties(PropBag As PropertyBag)
Call PropBag.WriteProperty("Enabled", Label1.Enabled, True)
Call PropBag.WriteProperty("KenarCizgisi", Pm_KenarCizgisi,0)
Call PropBag.WriteProperty("BorderStyle", Pm_BorderStyle,0)
Call PropBag.WriteProperty("Kalınlık", Pm_Kalinlik, 0)
Call PropBag.WriteProperty("Renk2", DolumRengi, 0)
Call PropBag.WriteProperty("Renk1", TabanRengi, 0)
Call PropBag.WriteProperty("Caption", Label2.Caption, "")
Call PropBag.WriteProperty("Font", Label1.Font, Ambient.Font)
Call PropBag.WriteProperty("Yazı3D", P_Yazı3D, 0)
Call PropBag.WriteProperty("YazıRengi", P_YaziRengi, 0)
Call PropBag.WriteProperty("YazıYeri", Pm_YaziYeri, 0)
End Sub


Private Sub UserControl_Resize()
RgbBul
Pm_Boy = UserControl.ScaleWidth
Pm_Yuk = UserControl.ScaleHeight
UserControl_Paint
End Sub

Private Sub Ciz()
UserControl.ScaleMode = 3
KoyuGolge = &H818181
AcikGolge = &HE6E6E6
Sol = 0
Ust = 0
Genislik = Pm_Boy
Yukseklik = Pm_Yuk
Cls
If Pm_KenarCizgisi = Var Then
Line (Sol, Ust)-(Sol + Genislik - 1, Ust + Yukseklik - 1), _
YaziRengi, B
Sol = Sol + 1
Ust = Ust + 1
Genislik = Genislik - 2
Yukseklik = Yukseklik - 2
End If

If Pm_Kalinlik > 0 Then
Select Case Pm_BorderStyle
Case 1
For i = 0 To Pm_Kalinlik
Line (Sol + i, Ust + i)-(Sol + Genislik - i, _
Ust + i), AcikGolge
Line (Sol + i, Ust + i)-(Sol + i, Ust + _
Yukseklik - i), AcikGolge
Line (Sol + i, Ust + Yukseklik - 1 - i)-(Sol + _
Genislik - i, Ust + Yukseklik - 1 - i), KoyuGolge
Line (Sol + Genislik - 1 - i, Ust + Yukseklik - _
1 - i)-(Sol + Genislik - 1 - i, Ust + i), KoyuGolge
Next i
Genislik = Genislik - (Pm_Kalinlik * 2) - 1
Yukseklik = Yukseklik - (Pm_Kalinlik * 2) - 1
Sol = Sol + Pm_Kalinlik
Ust = Ust + Pm_Kalinlik
Case 2
For i = 0 To Pm_Kalinlik
Line (Sol + i, Ust + i)-(Sol + Genislik - i, _
Ust + i), KoyuGolge
Line (Sol + i, Ust + i)-(Sol + i, Ust + _
Yukseklik - i), KoyuGolge
Line (Sol + i, Ust + Yukseklik - 1 - i)-(Sol + _
Genislik - i, Ust + Yukseklik - 1 - i), AcikGolge
Line (Sol + Genislik - 1 - i, Ust + Yukseklik - _
1 - i)-(Sol + Genislik - 1 - i, Ust + i), AcikGolge
Next i
Genislik = Genislik - (Pm_Kalinlik * 2) - 1
Yukseklik = Yukseklik - (Pm_Kalinlik * 2) - 1
Sol = Sol + Pm_Kalinlik
Ust = Ust + Pm_Kalinlik
End Select
End If
SonX = Sol
SonY = Ust
End Sub

Private Sub RgbBul()

If TabanRengi = 0 Then Rgb1r = 0&: Rgb1g = 0&: Rgb1b = 0&
If DolumRengi = 0 Then Rgb2r = 0&: Rgb2g = 0&: Rgb2b = 0&

If TabanRengi = 1 Then Rgb1r = -256: Rgb1g = 0&: Rgb1b = 0&
If DolumRengi = 1 Then Rgb2r = -256: Rgb2g = 0&: Rgb2b = 0&

If TabanRengi = 2 Then Rgb1r = 0&: Rgb1g = -256: Rgb1b = 0&
If DolumRengi = 2 Then Rgb2r = 0&: Rgb2g = -256: Rgb2b = 0&

If TabanRengi = 3 Then Rgb1r = -256: Rgb1g = -256: Rgb1b = 0&
If DolumRengi = 3 Then Rgb2r = -256: Rgb2g = -256: Rgb2b = 0&

If TabanRengi = 4 Then Rgb1r = 0&: Rgb1g = 0&: Rgb1b = -256
If DolumRengi = 4 Then Rgb2r = 0&: Rgb2g = 0&: Rgb2b = -256

If TabanRengi = 5 Then Rgb1r = -256: Rgb1g = 0&: Rgb1b = -256
If DolumRengi = 5 Then Rgb2r = -256: Rgb2g = 0&: Rgb2b = -256

If TabanRengi = 6 Then Rgb1r = 0&: Rgb1g = -256: Rgb1b = -256
If DolumRengi = 6 Then Rgb2r = 0&: Rgb2g = -256: Rgb2b = -256

If TabanRengi = 7 Then Rgb1r = -256: Rgb1g = -256: Rgb1b = -256
If DolumRengi = 7 Then Rgb2r = -256: Rgb2g = -256: Rgb2b = -256

End Sub

Public Property Get Caption() As String
Caption = Label1.Caption
End Property

Public Property Let Caption(ByVal New_Caption As String)
Label1.Caption = New_Caption
Label2.Caption = New_Caption
UserControl_Resize
PropertyChanged "Caption"
End Property

Public Property Get Font() As Font
Attribute Font.VB_UserMemId = -512
Set Font = Label1.Font
End Property

Public Property Set Font(ByVal New_Font As Font)
Set Label1.Font = New_Font
Set Label2.Font = New_Font
UserControl_Resize
PropertyChanged "Font"
End Property


Public Property Get Yazı3D() As P_BorderStyle
Yazı3D = P_Yazı3D
End Property

Public Property Let Yazı3D(ByVal New_Yazı3D As P_BorderStyle)
P_Yazı3D = New_Yazı3D
UserControl_Resize
PropertyChanged "Yazı3D"
End Property

Sub LabelYaz()
Label1.ForeColor = P_YaziRengi
Label2.ForeColor = vbWhite
L_Yuk = Label1.Height
L_Boy = Label1.Width
Select Case Pm_YaziYeri
Case 0
L_x = SonX: L_y = SonY
Case 1
L_x = SonX: L_y = SonY + (Yukseklik / 2) - (L_Yuk / 2)
Case 2
L_x = SonX: L_y = SonY + Yukseklik - L_Yuk
Case 3
L_x = SonX + (Genislik - L_Boy) / 2: L_y = SonY
Case 4
L_x = SonX + (Genislik - L_Boy) / 2: L_y = SonY + _
(Yukseklik - L_Yuk) / 2
Case 5
L_x = SonX + (Genislik - L_Boy) / 2: L_y = SonY + _
Yukseklik - L_Yuk
Case 6
L_x = SonX + Genislik - L_Boy: L_y = SonY
Case 7
L_x = SonX + Genislik - L_Boy: L_y = SonY + (Yukseklik - _
L_Yuk) / 2
Case 8
L_x = SonX + Genislik - L_Boy: L_y = SonY + Yukseklik - _
L_Yuk
End Select


If P_Yazı3D = 0 Then
Label1.Move L_x, L_y
Label2.Move L_x, L_y
ElseIf P_Yazı3D = 1 Then
Label1.Move L_x + 1, L_y + 1
Label2.Move L_x, L_y
ElseIf P_Yazı3D = 2 Then
Label1.Move L_x, L_y
Label2.Move L_x + 1, L_y + 1
End If


End Sub

Public Property Get YazıRengi() As OLE_COLOR
YazıRengi = P_YaziRengi
End Property

Public Property Let YazıRengi(ByVal New_YaziRengi As OLE_COLOR)
P_YaziRengi = New_YaziRengi
UserControl_Resize
PropertyChanged "YazıRengi"
End Property

Public Property Get YazıYeri() As P_YaziYeri
YazıYeri = Pm_YaziYeri
End Property

Public Property Let YazıYeri(ByVal New_YaziYeri As P_YaziYeri)
Pm_YaziYeri = New_YaziYeri
UserControl_Resize
PropertyChanged "YazıYeri"
End Property
__________________