Favorilerine Ekle | Giriş Sayfan Yap | Tavsiye Et

 

Kurs Tanıtım Sayfası | Süper Üye Kimdir? | Menü Tasarımı Konulu Örnek Ders
Kod İndir| Hazır Kodlar | Makaleler| İpuçları | VB .NET Kursu | Dersler | Forum | Alt Bölümler | Servisler
    Merhaba Misafir
    anasayfa » visual basic hazır kodlar » 2 Renkli 3D Label
Üye Girişi
Kullanıcı Adı:  
Şifre : 
Kaydet ?
Siteden tam olarak faydalanabilmek için üye olmalısınız.
Unuttuğunuz şifrenizi öğrenebilmek için kayıt sırasında verdiğiniz Hatırlatma Cevabı'nı bilmeniz gereklidir.
Şifre hatırlatma işlevini sadece 3 defa kullanma hakkınız vardır.
Kullanıcı adını ve şifresini unutan üyelere email ile yardım verilmez.

Aktivasyon Gelmedi mi?Aktivasyon mesajınız email adresinize gelmedi mi?
Buraya tıklayarak bir kez daha aktivasyon mesajı gönderilmesini sağlayabilirsiniz.
Lütfen email hesabınızın BULK ve SPAM klasörlerini de kontrol ediniz.
Rastgele Makale

Program install ...

Yazar: mecitkaya

Webmasterlar
Sitenize Ekleyin!
Sitenizde "Son Eklenen 10 Visual Basic Yazısı"'nı göstermek ve içeriğini zenginleştirmek için buraya tıklayınız.

Vbasicmaster.com'a link verin!
Aşağıdaki minik banneri sitenize eklemek için tıklayın!

Üye Sayısı:
Ziyaretçiler nerede?
Yayın № : 2254
Yayın Tar:09.03.2005
Yazar : kont mustafa
Hit :2998

Bu Yazarın Yazıları Sadece bu yazarın  göster
Bu Yazıyı Tavsiye Et

'Ocx i Forma alındığında Property deki
'Renk1 = Label In Sol taraftaki Rengi
'Renk2 = Label In Sag taraftaki Rengi
'Eğer 4 Köşe içIn 4 Ayrı Renk Tanımlanırsa
'4 Renkli Label Olur
'BorderStyle 0 = Düz, 1=Dışa Kabartma, 2=İçe Gömük
'Kalınlık = 0-10 Label In Kalınlığı
'KenarÇizgisi 1= Var, 0= Yok
'Yazı3D 0=Düz,1=Dışa Çıkık,2=İçe Gömük
'YazıRengi = SeçtiğIn Renk
'YazıYeri =0-8 Solüst,SolOrta,SolAlt,Orta,OrtaUst,
' OrtaAlt,SağÜst,SağOrta,SağAlt
'Diğer Olaylar Normal Label dekinin Aynı
'Eğer Bir Hatam varsa Affola Yanlız Haberim Ola Düzelteyim
'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ışaÇıkık = 1
İçeGömük = 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
AçıkMavi = 6
Beyaz = 7
End Enum

Public Enum P_YaziYeri
SolÜst = 0
SolOrta = 1
SolAlt = 2
ÜstOrta = 3
Orta = 4
AltOrta = 5
SagÜst = 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 KenarÇizgisi() As P_KenarCizgisi
KenarÇizgisi = Pm_KenarCizgisi
End Property

Public Property Let KenarÇizgisi(ByVal New_KenarCizgisi As _
P_KenarCizgisi)
Pm_KenarCizgisi = New_KenarCizgisi
UserControl_Resize
PropertyChanged "KenarÇizgisi"
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("KenarÇizgisi", _
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("KenarÇizgisi", 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




Bu sayfa için henüz yorum eklenmemiş.

© Hakan Ersöz 2000-2013| Üyelik Sözleşmesi | | Ödeme Bildirimi
Sitemizden yenilikleri hemen öğrenin, pop upları engelleyin, chat yapın... ToolBarımızı indirin:
Vasicmaster Toolbar'ı indirin