Hafta içi her gün 20:00 - 22:00 arası "DJ ÖZEL" ile "Keyf-i Müzik" programını dinlemek için TIKLAYINIZ

Hafta sonu 15:00 - 18:00 arası "DJ EMRE" ile "Müzik Ekspres" programını dinlemek için TIKLAYINIZ

Canlı yayını dinlemek için bilgisayarınızda WINAMP kurulu olmalıdır.WINAMP indirmek için TIKLAYINIZ
forumENA - Knight Online , KOXP

 

Visual basic kodları hemde bisürü***tnsezer***(Sürekli güncellenecektir)

Visual Basic içinde Visual basic kodları hemde bisürü***tnsezer***(Sürekli güncellenecektir) konusu , Kayan form basligi Güzel bir animasyon Kod: Dim Cl As Integer Dim at As Integer Public Function AniText(str As String, eff As Integer) As String Dim lop Cl = Len(str) ...







Geri Dön   forumENA - Knight Online , KOXP > Program , Programlama, İnternet > Programlama > Visual Basic

Visual basic kodları hemde bisürü***tnsezer***(Sürekli güncellenecektir) Visual basic kodları hemde bisürü***tnsezer***(Sürekli güncellenecektir)

KAYIT OL Yönetim Takımı Üye Listesi Tüm konuları okunmuş kabul et

Cevapla
2 / 3 Sayfa < 1 2 3 >

 

Konu Yönetim Seçenekleri Konu Gösterim Seçenekleri
Eski 19-04-2006, 17:09   #11 (permalink)
EN Afilli
 
tnsezer - ait Avatar
 
Üyelik Tarihi: 18-12-2005
Yaş: 21
Mesajlar: 1,231
Rep Gücü: 124
Rep Puanı: 7683
tnsezer Rütbe: +13tnsezer Rütbe: +13tnsezer Rütbe: +13tnsezer Rütbe: +13tnsezer Rütbe: +13tnsezer Rütbe: +13tnsezer Rütbe: +13tnsezer Rütbe: +13tnsezer Rütbe: +13tnsezer Rütbe: +13tnsezer Rütbe: +13
Post Devam

Kayan form basligi

Güzel bir animasyon

Kod:
Dim Cl As Integer

Dim at As Integer

Public Function AniText(str As String, eff As Integer) As String

Dim lop

Cl = Len(str) + 1

at = at + 1

If at >= Cl Then

at = 1

End If

Select Case eff

    Case 0          

        AniText = Mid(str, at) + Left(str, at)

    Case 1          

         AniText = Mid(str, (Cl - at)) + Left(str, (Cl - at))

    Case 2          

         AniText = Mid(str, (Cl - at)) + Left(str, (Cl - at)) + Mid(str, at) + Left(str, at)

    Case 3          

         AniText = Mid(str, at) + Left(str, at) + Mid(str, (Cl - at)) + Left(str, (Cl - at))

End Select

End Function



'Daha sonra bir forma timer yapıp bu timera aşağıdaki kodu pasteleyin.

Private Sub Timer1_Timer()

Form1.Caption = AniText("mail adresiniz ", 1)

End Sub

Vb de serbest çizgiler çizmek

Kod:
Dim Drawing As Boolean

Dim FHLastX As Long

Dim FHLastY As Long



Private Sub Picture1_MouseDown(Button As Integer, _

 Shift As Integer, X As Single, Y As Single)

    Drawing = True

    FHLastX = X

    FHLastY = Y



End Sub



Private Sub Picture1_MouseMove(Button As Integer, _

 Shift As Integer, X As Single, Y As Single)

    

    'Bu teknik bütün çizimlerde kullanılıyor

    Picture1.Line (FHLastX, FHLastY)-(X, Y)

    FHLastX = X

    FHLastY = Y



End Sub



Private Sub Picture1_MouseUp(Button As Integer, _

 Shift As Integer, X As Single, Y As Single)

    

    'çizimi bitir

    Drawing = False



End Sub

Not ortalama

> Gerekenler <



- 5 adet commandbutton

- 4 adet textbox

- 4 adet label

- 1 adet listbox



> İsimler i<



*Command Button'lar



"ortala"= command1

"ekle"=command2

"sil"=command3

"tümünü sil"=command4

"çıkış"=command5



*Textbox'lar



"1.not"=text1

"2not"=text2

"3not"=text3

"sonuc"=text4



*Label'ler



"label1"=1.not

"label2"=2.not

"label3"=3.not

"label4"=sonuç



*Listbox



"list1"





> Kod <

Kod:
Private Sub Command1_Click()

Text4 = (Val(Text2) + Val(Text2) + Val(Text3)) \ 3

Font.Bold = True

End Sub



Private Sub Command2_Click()

List1.AddItem Text4

End Sub



Private Sub Command3_Click()

List1.RemoveItem List1.ListIndex

End Sub



Private Sub Command4_Click()

List1.Clear

End Sub



Private Sub Command5_Click()

a = MsgBox("Çıkış yapmak istediniz.Emin misiniz?", vbQuestion + vbYesNo + vbDefaultButton2, "Çıkış")

If a = vbYes Then

MsgBox "Çıkış Yapıyorsunuz!!"

End

Else

a = vbNo

MsgBox "Çıkış İptal Edildi!!"

End If

End Sub



Private Sub Form_Load()

MsgBox "Bu programcık Dejavu tarafından yazılmıştır!"

End Sub
tnsezer isimli üyemiz çevrimdışıdır. (Offline)   Alıntı yaparak aynı kişiye cevapla
Eski 19-04-2006, 17:12   #12 (permalink)
EN Afilli
 
tnsezer - ait Avatar
 
Üyelik Tarihi: 18-12-2005
Yaş: 21
Mesajlar: 1,231
Rep Gücü: 124
Rep Puanı: 7683
tnsezer Rütbe: +13tnsezer Rütbe: +13tnsezer Rütbe: +13tnsezer Rütbe: +13tnsezer Rütbe: +13tnsezer Rütbe: +13tnsezer Rütbe: +13tnsezer Rütbe: +13tnsezer Rütbe: +13tnsezer Rütbe: +13tnsezer Rütbe: +13
Post Devam

Güzel bir yazi efekti

Kod:
Private Sub Command1_Click()

Dim x, y, i

form1.FontSize = 24

ForeColor = 0

x = CurrentX

y = CurrentY

For i = 1 To 400

Print "Malatya"

x = x + 1: y = y + 1

CurrentX = x

CurrentY = y

Next

ForeColor = &HFFFF&

Print "Malatya"

End Sub

Göz kirpan yazi

'Bir tane label yap özelliklerini kafana göre ayarla

'Bir tane timer yap onunda intervalını 250 yap

'aşağıdaki koduda timer'a pastele

'Sonra güle güle kullan hehehe

Kod:
Private Sub Timer1_Timer()

If Label1.Visible = True Then

Label1.Visible = False

Else

Label1.Visible = True

End If



End Sub

Tarih ve zaman ayarlama üzerine

'burada bir command yap ve aşağıdaki kodu pastele

'bu shell komutu harbiden güzel bir komut yaz shell'i programınızda windowsu ortaklaşa kullanın. hadi hayırlı olsun

Kod:
Private Sub Command1_Click()

Dim dblReturn As Double

dblReturn = Shell("rundll32.exe shell32.dll,Control_RunDLL timedate.cpl")

End Sub

Kronometre yada zaman sayaçi

'3 tane text box yapın

'1 tane label yapın

' 1 tane timer yapın

'4 tane command button yapın kodu pasteleyin.

Kod:
Dim Hours As Integer

Dim Minutes As Integer

Dim Seconds As Integer

Dim Time As Date

Private Sub Mydisplay()

'mydisplay programın can damarı

    Hours = Val(Text1.Text)

    Minutes = Val(Text2.Text)

    Seconds = Val(Text3.Text)

    Time = Time******(Hours, Minutes, Seconds)

    Label1.Caption = Format$(Time, "hh") & ":" & Format$(Time, "nn") & ":" & Format$(Time, "ss")

End Sub





Private Sub Command1_Click()

    Timer1.Enabled = True

    Command3.Enabled = False

End Sub



Private Sub Command2_Click()

    Timer1.Enabled = False

    Command3.Enabled = True

End Sub



Private Sub Command3_Click()

    Hours = 0

    Minutes = 0

    Seconds = 0

    Time = 0

    Text1.Text = " "

    Text2.Text = " "

    Text3.Text = " "

    Text1.SetFocus

End Sub



Private Sub Command4_Click()

    End

End Sub



Private Sub Form_Load()

'Formu ortalamak için

Form1.Top = (Screen.Height - Form1.Height) / 2

Form1.Left = (Screen.Width - Form1.Width) / 2

'Timer'ın intervalı

    Timer1.Interval = 1000

    Hours = 0

    Minutes = 0

    Seconds = 0

    Time = 0

End Sub



Private Sub Text1_Change()

Mydisplay

End Sub



Private Sub Text2_Change()

Mydisplay

End Sub



Private Sub Text3_Change()

Mydisplay

End Sub



Private Sub Timer1_Timer()

Timer1.Enabled = False

    If (Format$(Time, "hh") & ":" & Format$(Time, "nn") & ":" & Format$(Time, "ss")) <> "00:00:00" Then 'Counter to continue loop until 0

        Time = DateAdd("s", -1, Time)

        Label1.Visible = False

        Label1.Caption = Format$(Time, "hh") & ":" & Format$(Time, "nn") & ":" & Format$(Time, "ss")

        Label1.Visible = True

        Timer1.Enabled = True

    Else

        Timer1.Enabled = False

        Beep

        Beep

        Command3.Enabled = True

    End If

End Sub
tnsezer isimli üyemiz çevrimdışıdır. (Offline)   Alıntı yaparak aynı kişiye cevapla
Eski 19-04-2006, 17:16   #13 (permalink)
EN Afilli
 
tnsezer - ait Avatar
 
Üyelik Tarihi: 18-12-2005
Yaş: 21
Mesajlar: 1,231
Rep Gücü: 124
Rep Puanı: 7683
tnsezer Rütbe: +13tnsezer Rütbe: +13tnsezer Rütbe: +13tnsezer Rütbe: +13tnsezer Rütbe: +13tnsezer Rütbe: +13tnsezer Rütbe: +13tnsezer Rütbe: +13tnsezer Rütbe: +13tnsezer Rütbe: +13tnsezer Rütbe: +13
Post Devam

Visual basic den autocad cizmek

Değerli arkadaşlar,

Sizlere VISUAL BASIC veya NOT DEFTERİ İle AUTOCAD’ e DXF formatında çizim Gönderme işini en kolay program yazarak anlatacağımı düşündüm ve aşağıdaki örnek programı hazırladım.



Visual Basic Programı içindeki açılamalar ile ne yapıldığını tek tek anlattım, Tabiî ki aynı kodları Notpac de yazmak için Print #1, ve “” tırnak işaretlerini çıkararak yazmanız gerektiğini hatırlatmama gerek varmı?



Öncelikle bazı konuları hatırlatayım. Autocad Dxf formatta kod yazmak için bazı temel prensipleri bilmemiz lazım. Dxf format üç ana guruptan oluşur.



HEADER Bölümü

Bu bölümde Autocad sistem değişkenlerini kendi isteğimize göre değiştireceksek bunların girişi yapılır, Yazma zorunluluğu yoktur.



TABLES Bölümü

Bu bölüm Autocad çizgi tipleri ve yazı stillerini kendi isteğimize göre değiştireceksek bunların girişi yapılır, Yazma zorunluluğu yoktur.



ENTITIES Bölümü

Bu bölüm Autocad çizim işlerini yaptırdığımız bölümdür ve asıl çizimi bu bölümde yaptırırız.



Bu her bölümde Autocad’ in her konu için yazmamamız gereken bazı özel kodları vardır. Bunlardan birkaç önemli olanını aşağıda program içinde örnek olarak tanımladım.



Örnek Olarak;

O yazılı ifadeden sonraki sırada Autocad komutu yer alır.

8 yazılı ifadeden sonraki sırada Layer adı yer alır.

10 YAzılı ifadeden sonraki sırada sağa/sola değer yer alır.

20 yazılı ifadeden sonraki sırada yukarı/aşağı değer yer alır.

30 yazılı ifadeden sonraki sırada h yükseklik değeri yer alır.

Kod:
Private Sub Form_Paint()

        DOSYA = "C:\YeniDosya.DXF"  ' YENİ DXF DOSYA ADI VERİYORUZ

        Open DOSYA For Output As #1 ' DOSYA AÇIYORUZ

                          

    ' ----- HEADER BÖLÜMÜ SİSTEM DEĞİŞKENLERİ GİRİŞİNİN BAŞLANGICI

    ' ----- [ Bu bölümün yazma zorunluluğu yoktur isteğe bağlıdır.]

     

    Print #1, 0          ' YAZMAYA BAŞLIYORUZ İLK KODUMUZ

    Print #1, "SECTION"

    Print #1, 2

    Print #1, "HEADER"   'HEADER BÖLÜMÜNÜ AÇTIK



    ' ----- ACAD DEĞİŞKENLERİNİ TANIMLIYORUZ

    ' ----- [ Bu bölümde istediğimiz kadar acad değişkenini tanımlayabiliriz. ]

    ' ----- Sistem değişkeni eğer Autocad' in kendi tanımladığı bir sayıyı istiyorsa

    ' ----- "70" kodunu bizim tanımladığımız bir sayıyı istiyorsa "40" kodunu giriyoruz

    '------ Ben 6 adet sistem değişkeni tanımladım.

    

    Print #1, 9

    Print #1, "$LUNITS" '

    Print #1, 70      ' SİSTEM DEĞİŞKENİ KENDİ BELİRLEDİĞİ DEĞER İÇİN 70 KODU KULLANILDI

    Print #1, 2       ' 1 FEN BİLİMLERİ [Ben 2 yi kullandım.]

                      ' 2 ONDALIK SİSTEM

                      ' 3 MÜHENDİSLİK

                      ' 4 MİMARİ

                      ' 5 KESİRLİ

    

    Print #1, 9

    Print #1, "$LUPREC"

    Print #1, 70      ' SİSTEM DEĞİŞKENİ KENDİ BELİRLEDİĞİ DEĞER İÇİN 70 KODU KULLANILDI

    Print #1, 2       ' VİRGÜLDEN SONRAKİ HANE SAYISI 2 [Siz istediğinizi girin.]





    Print #1, 9

    Print #1, "$AUNITS"

    Print #1, 70        ' SİSTEM DEĞİŞKENİ KENDİ BELİRLEDİĞİ DEĞER İÇİN 70 KODU KULLANILDI

    Print #1, 2         ' 0 ONDALIK DERECE [Ben 2 yi kullandım.]

                        ' 1 DERECE,DAKİKA,SANİYE

                        ' 2 AÇILAR GRAD ÇİNSİNDEN

                        ' 3 RADYAN

                        ' 4 TOPOGRAFİK

                             

    Print #1, 9

    Print #1, "$AUPREC"

    Print #1, 70       ' SİSTEM DEĞİŞKENİ KENDİ BELİRLEDİĞİ DEĞER İÇİN 70 KODU KULLANILDI

    Print #1, 4        ' AÇILARDA VİRGÜLDEN SONRAKİ HANE SAYISI 4



    Print #1, 9

    Print #1, "$ELEVATION"

    Print #1, 40        ' SİSTEM DEĞİŞKENİ KENDİ BELİRLEDİĞİ DEĞER İÇİN 40 KODU KULLANILDI

    Print #1, 0         ' GEÇERLİ ELEV YÜKSEKLİĞİ 0



    Print #1, 9

    Print #1, "$THICKNESS"

    Print #1, 40        ' SİSTEM DEĞİŞKENİ KENDİ BELİRLEDİĞİ DEĞER İÇİN 40 KODU KULLANILDI

    Print #1, 0         ' ÇİZİLECEK OBJELERİN 3.BOYUT YÜKSEKLİĞİ 0



    Print #1, 0

    Print #1, "ENDSEC"    ' ----- HEADER BÖLÜMÜ SİSTEM DEĞİŞKENLERİ GİRİŞİNİN SONU

    

   '***************************************************

   '***************************************************

   

    Print #1, 0             ' ----- TABLES BÖLÜMÜ BAŞLANGICI

    Print #1, "SECTION"     '------ ÇİZGİ TİPLERİ ve YAZI SİTİLLERİNİN GİRİŞ BÖLÜMÜ

    Print #1, 2             ' ----- [ Bu bölümün yazma zorunluluğu yoktur isteğe bağlıdır.]

    Print #1, "TABLES"

    

    

    Print #1, 0                 ' ÇİZGİ TİPLERİ BAŞLANGICI

    Print #1, "TABLE"

    Print #1, 2

    Print #1, "LTYPE"

    Print #1, 70

    Print #1, 2                 ' çizgi tablosu eleman sayısı ben 2 cizgi tipi tanımlıyorum.

    

    Print #1, 0                 '1 NCİ ÇİZGİ TİPİ

    Print #1, "LTYPE"

    Print #1, 2

    Print #1, "CONTINUOUS"      ' TANIMLANAN çİZGİ TİPİNİN ADI

    Print #1, 70

    Print #1, 0

    Print #1, 3

    Print #1, "SOLID LINE"      ' açıklayıcı yazı

    Print #1, 72

    Print #1, 65

    Print #1, 73

    Print #1, 0

    Print #1, 40

    Print #1, 0



    Print #1, 0                 '2 NCİ ÇİZGİ TİPİ

    Print #1, "LTYPE"

    Print #1, 2

    Print #1, "KISA_ÇİZGİ"      ' çizgi tipi adı

    Print #1, 70

    Print #1, 0

    Print #1, 3

    Print #1, "- - - - - "      ' açıklayıcı yazı

    Print #1, 72

    Print #1, 65

    Print #1, 73

    Print #1, 2

    Print #1, 40

    Print #1, 1

    Print #1, 49

    Print #1, 1

    Print #1, 49

    Print #1, -0.5





    Print #1, 0

    Print #1, "ENDTAB"             ' ÇİZGİ TİPLERİ SONU

    

    

    Print #1, 0                    ' YAZI STİLİ BAŞLANGICI

    Print #1, "TABLE"

    Print #1, 2

    Print #1, "STYLE"

    Print #1, 70

    Print #1, 1                    ' yazı tablosu eleman sayısı 1 stil var

    

    Print #1, 0                    ' YAZI STİLLERİ

    Print #1, "STYLE"

    Print #1, 2

    Print #1, "TÜRKÇE"             ' stil ismi

    Print #1, 70

    Print #1, 0

    Print #1, 40                   ' yazı yüksekliği

    Print #1, 1

    Print #1, 41                   ' yazı genişliği

    Print #1, 1

    Print #1, 50                   ' yazı açısı

    Print #1, 0

    Print #1, 71                   ' üretim işaretleri

    Print #1, 0

    Print #1, 42                   ' kullanılan son yükseklik

    Print #1, 2

    Print #1, 3

    Print #1, "Arial"              ' seçilen acad fontu "Arial" yazı fontunu

    Print #1, 4                    ' Autocad e TÜRKÇE olarak tanıtıyorum

    Print #1,

    

    Print #1, 0

    Print #1, "ENDTAB"             ' YAZI STİLİ SONU

    

    Print #1, 0

    Print #1, "ENDSEC"             ' ----- TABLES BÖLÜMÜ SONU

   

   

   

    Print #1, 0             ' ----- ENTITIES BAŞLANGICI ÇİZİM GİRİŞLERİ

    Print #1, "SECTION"     '------ ÇİZİME BAŞLIYORUZ

    Print #1, 2             ' Ben kolaylık olsun ve her çizgide ayrı ayrı kod yazmamak

    Print #1, "ENTITIES"    'için her komut için alt programlar hazıladım ve aşağıda

                            'onları çağırıyorum.



'önce girdiğimiz değerleri tanımlayalım.

      YüzeyAdı = "YENİ"

             Y = 0

             X = 0

             H = 0

       YarıÇap = 10

    başlangıçY = 10

    başlangıçX = 8

    başlangıçH = 50

        bitişY = 50

        bitişX = 80

        bitişH = 100

BaşlangıçAçısı = 0

    BitişAçısı = 126

YazıYüksekliği = 5

          yazı = "Merhaba AutoCad"

    

AcadNoktaCiz YüzeyAdı, Y, X, H

AcadDaireCiz YüzeyAdı, Y, X, H, YarıÇap

            Y = 40

            X = 60

AcadÇizgiÇiz2D YüzeyAdı, başlangıçY, başlangıçX, bitişY, bitişX

AcadÇizgiÇiz3D YüzeyAdı, başlangıçY, başlangıçX, başlangıçH, bitişY, bitişX, bitişH

AcadYayÇiz YüzeyAdı, Y, X, YarıÇap, BaşlangıçAçısı, BitişAçısı

AcadYazıYaz YüzeyAdı, Y, X, YazıYüksekliği, yazı

   

        ' ----- ENTITIES SONU  ve ÇİZİM GİRİŞLERİ SONU

        Print #1, 0

        Print #1, "ENDSEC"

        Print #1, 0

        Print #1, "EOF"

        Close           ' ***** DOSYA KAPANIŞI *****

        Print " [C:\YeniDosya.Dxf ] İSİMLİ DOSYA YARATILDI"

End Sub



'YUKARIDAKİ ÇİZİMLERİN ALTPROGRAMLARI;



'Nokta Çizmek [Point];

Public Sub AcadNoktaCiz(YüzeyAdı, Y, X, H)

    Print #1, 0

    Print #1, "POINT"

    Print #1, 8             ' yüzey adı

    Print #1, YüzeyAdı

    Print #1, 10            ' y değeri

    Print #1, Y

    Print #1, 20            ' x değeri

    Print #1, X

    Print #1, 30            ' z yüksekliği

    Print #1, H

End Sub



'Daire Çizmek [Circle];

Public Sub AcadDaireCiz(YüzeyAdı, Y, X, H, YarıÇap)

    Print #1, 0

    Print #1, "CIRCLE"

    Print #1, 8             ' yüzey adı

    Print #1, YüzeyAdı

    Print #1, 10            ' MERKEZ y değeri

    Print #1, Y

    Print #1, 20            ' MERKEZ x değeri

    Print #1, X

    Print #1, 30            ' MERKEZ z değeri

    Print #1, H

    Print #1, 40            ' daire yarı çapı

    Print #1, YarıÇap

End Sub



'3D Çizgi Çizmek [Line];

Public Sub AcadÇizgiÇiz3D(YüzeyAdı, başlangıçY, başlangıçX, başlangıçH, bitişY, bitişX, bitişH)

    Print #1, 0

    Print #1, "LINE"

    Print #1, 8             ' yüzey adı

    Print #1, YüzeyAdı

    Print #1, 10            ' y değeri

    Print #1, başlangıçY

    Print #1, 20            ' x değeri

    Print #1, başlangıçX

    Print #1, 30            ' x değeri

    Print #1, başlangıçH

    Print #1, 11            ' varış y değeri

    Print #1, bitişY

    Print #1, 21            ' varış x değeri

    Print #1, bitişX

    Print #1, 31            ' varış x değeri

    Print #1, bitişH

End Sub



'2D Çizgi Çizmek [Line];

Public Sub AcadÇizgiÇiz2D(YüzeyAdı, başlangıçY, başlangıçX, bitişY, bitişX)

    Print #1, 0

    Print #1, "LINE"

    Print #1, 8             ' yüzey adı

    Print #1, YüzeyAdı

    Print #1, 10            ' y değeri

    Print #1, başlangıçY

    Print #1, 20            ' x değeri

    Print #1, başlangıçX

    Print #1, 11            ' varış y değeri

    Print #1, bitişY

    Print #1, 21            ' varış x değeri

    Print #1, bitişX

End Sub



'Yay Çizmek [Arc];

Public Sub AcadYayÇiz(YüzeyAdı, Y, X, YarıÇap, BaşlangıçAçısı, BitişAçısı)

    Print #1, 0

    Print #1, "ARC"

    Print #1, 8             ' yüzey adı

    Print #1, YüzeyAdı

    Print #1, 10            ' MERKEZ y değeri

    Print #1, Y

    Print #1, 20            ' MERKEZ x değeri

    Print #1, X

    Print #1, 40            ' YARI ÇAP

    Print #1, YarıÇap

    Print #1, 50            ' BAŞLANGIÇ AÇISI

    Print #1, BaşlangıçAçısı

    Print #1, 51            ' BİTİŞ AÇISI AÇISI

    Print #1, BitişAçısı

End Sub



'Yazı Yazmak [Text];

Public Sub AcadYazıYaz(YüzeyAdı, Y, X, YazıYüksekliği, yazı)

   'YAZILAR'

    Print #1, 0

    Print #1, "TEXT"

    Print #1, 8

    Print #1, YüzeyAdı           ' YÜZEY ADI

    Print #1, 10

    Print #1, Y                  ' Y DEĞERİ

    Print #1, 20

    Print #1, Y                  ' X DEĞERİ

    Print #1, 40

    Print #1, YazıYüksekliği     ' YAZI YÜKSEKLİĞİ

    Print #1, 1

    Print #1, yazı               ' YAZILACAK METİN

    Print #1, 7

    Print #1, "TÜRKÇE"           ' STİL İSMİ

    Print #1, 62

    Print #1, 10                 ' RENK NO (10 kırmızı)

End Sub

Yuvarlak form

'Önce bir commandbutton oluşturun

'Ve formun borderstyle'ını 0-none yapın

'Ardından bu kodu kullanın



'İhtiyacımız olan API'leri alalım

Kod:
Private Declare Function CreateEllipticRgn Lib "gdi32" (ByVal X1 As Long, ByVal Y1 As Long, _

ByVal X2 As Long, ByVal Y2 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 Sub Command1_Click()

On Error Resume Next 'Hata görmek istemiyorum



a = 0 'Bu a sayısı formun ne kadar her seferde ne kadar küçüleceğini gösteriyor

Do Until Form1.Height < 300

b = (Form1.Height * Form1.Width) / 1000000 'b sayısı formla orantılı küçülme için

a = a + b 'a sayısı artmalı ki formumuzun küçülmesi giderek hızlansın



'Bu satırlar yuvarlağın orantılı şekilde küçülmesi için. İyi anlamak için bunları çıkarıp deneyin

Form1.Top = Form1.Top + a / 2

Form1.Left = Form1.Left + a / 2

Form1.Height = Form1.Height - a 'Bu formun uzunluğunu azaltır

Form1.Width = Form1.Width - a 'Bu da genişliğini azaltır



'Bunlar formun yuvarlak olması için

Dim hr&, dl&

Dim usew&, useh&

usew& = Me.Width / Screen.TwipsPerPixelX

useh& = Me.Height / Screen.TwipsPerPixelY

hr& = CreateEllipticRgn(0, 0, usew, useh)

dl& = SetWindowRgn(Me.hWnd, hr, True)



DoEvents 'Çalış... Çalış... Çalış...

Loop

Unload Me 'Form kapansın

End Sub

Winamp yönetimi

'YAPILACAK İŞLEMLER



'1-Yeni bir proje oluşturun.

'2-Formunuza 3 tane Command buton 1 tane text ekleyin.

'(Command1 ve Command2 ve Command3 ve text1.text)

'3-Aşağıdaki kodu Formun General Declaration

'bölümüne yapıştırın.

Kod:
Private Sub Command1_Click()

a = PostMessage(GetWAHandle(), WM_WA_IPC, 0, IPC_DELETE)

End Sub



Private Sub Command2_Click()

Dim C As Long

C = PostMessage(GetWAHandle(), WM_WA_IPC, 1, 105)

MsgBox C

'For f = 1 To 1000

C = PostMessage(GetWAHandle(), WM_WA_IPC, 0, 102)

Text1.Text = C

Text1.Refresh

'Next

End Sub





Private Sub Command3_Click()

SendWACommand (WINAMP_VOLUMEDOWN)

End Sub



'*******************************************************

'4-Projenize Project Add Module New ile Module1 ekleyin.

'5-Aşağıdaki kodları Module1 in general 

'declarations bölümüne yapıştırın.



Public Const WM_COMMAND = &H111

Public Const WM_USER = &H400

Public Const WM_WA_IPC = WM_USER

Public Const IPC_GETVERSION = 0

Public Const IPC_PLAYFILE = 100

Public Const IPC_DELETE = 101

Public Const IPC_STARTPLAY = 102

Public Const IPC_CHDIR = 103

Public Const IPC_ISPLAYING = 104

Public Const IPC_GETOUTPUTTIME = 105

Public Const IPC_JUMPTOTIME = 106

Public Const IPC_WRITEPLAYLIST = 120

Public Const IPC_SETPLAYLISTPOS = 121

Public Const IPC_SETVOLUME = 122

Public Const IPC_SETPANNING = 123

Public Const IPC_GETLISTLENGTH = 124





Public Const WINAMP_OPTIONS_EQ = 40036

Public Const WINAMP_OPTIONS_PLEDIT = 40040

Public Const WINAMP_VOLUMEUP = 40058

Public Const WINAMP_VOLUMEDOWN = 40059

Public Const WINAMP_FFWD5S = 40060

Public Const WINAMP_REW5S = 40061

Public Const WINAMP_BUTTON1 = 40044

Public Const WINAMP_BUTTON2 = 40045

Public Const WINAMP_BUTTON3 = 40046

Public Const WINAMP_BUTTON4 = 40047

Public Const WINAMP_BUTTON5 = 40048

Public Const WINAMP_BUTTON1_SHIFT = 40144

Public Const WINAMP_BUTTON2_SHIFT = 40145

Public Const WINAMP_BUTTON3_SHIFT = 40146

Public Const WINAMP_BUTTON4_SHIFT = 40147

Public Const WINAMP_BUTTON5_SHIFT = 40148

Public Const WINAMP_BUTTON1_CTRL = 40154

Public Const WINAMP_BUTTON2_CTRL = 40155

Public Const WINAMP_BUTTON3_CTRL = 40156

Public Const WINAMP_BUTTON4_CTRL = 40157

Public Const WINAMP_BUTTON5_CTRL = 40158

Public Const WINAMP_PREVSONG = 40198

Public Const WINAMP_FILE_PLAY = 40029

Public Const WINAMP_OPTIONS_PREFS = 40012

Public Const WINAMP_OPTIONS_AOT = 40019

Public Const WINAMP_HELP_ABOUT = 40041



Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As Long) As Long

Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long

Declare Function PostMessage Lib "user32" Alias "PostMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long



Public Function GetWAHandle() As Long

GetWAHandle = FindWindow("Winamp v1.x", 0)

End Function



Public Sub SendWACommand(ByVal lCommand As Long)

SendMessage GetWAHandle, WM_COMMAND, lCommand, 0

End Sub



Public Sub SendWAMessage(ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long)

SendMessage GetWAHandle, wMsg, wParam, lParam

End Sub



Public Sub PostWAMessage(ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long)

PostMessage GetWAHandle, wMsg, wParam, lParam

End Sub
tnsezer isimli üyemiz çevrimdışıdır. (Offline)   Alıntı yaparak aynı kişiye cevapla
Eski 19-04-2006, 19:44   #14 (permalink)
EN Afacan
 
AsLı - ait Avatar
 
Üyelik Tarihi: 17-02-2006
Yer: SİWAS
Yaş: 19
Mesajlar: 179
Rep Gücü: 43
Rep Puanı: 897
AsLı Rütbe: +7AsLı Rütbe: +7AsLı Rütbe: +7AsLı Rütbe: +7AsLı Rütbe: +7AsLı Rütbe: +7AsLı Rütbe: +7
AsLı - MSN üzerinden mesaj gönder
Lightbulb

Bunlar Harİka Walla PaylaŞimin İÇİn TŞk....+rep
AsLı isimli üyemiz çevrimdışıdır. (Offline)   Alıntı yaparak aynı kişiye cevapla
Eski 21-11-2006, 00:01   #15 (permalink)
EN Açıkgözlü
 
Üyelik Tarihi: 20-11-2006
Mesajlar: 1
Rep Gücü: 0
Rep Puanı: 250
turgaysirtas Rütbe: +6turgaysirtas Rütbe: +6turgaysirtas Rütbe: +6
Tanımlı Cevap: Visual basic kodları hemde bisürü***tnsezer***(Sürekli güncellenecektir)

Olmuyor Yaaaa
turgaysirtas isimli üyemiz çevrimdışıdır. (Offline)   Alıntı yaparak aynı kişiye cevapla
Eski 15-04-2007, 09:19   #16 (permalink)
EN Afilli
 
r@nger - ait Avatar
 
Üyelik Tarihi: 26-10-2006
Yer: r@nger was here...
Mesajlar: 1,459
Rep Gücü: 62
Rep Puanı: 2207
r@nger Rütbe: +8r@nger Rütbe: +8r@nger Rütbe: +8r@nger Rütbe: +8r@nger Rütbe: +8r@nger Rütbe: +8r@nger Rütbe: +8r@nger Rütbe: +8r@nger Rütbe: +8r@nger Rütbe: +8r@nger Rütbe: +8
r@nger - MSN üzerinden mesaj gönder
Tanımlı Cevap: Visual basic kodları hemde bisürü***tnsezer***(Sürekli güncellenecektir)

Güzel bir paylaşım aradığımız herşeyi buluyoruz.

__________________
Geri döndüm
r@nger isimli üyemiz çevrimdışıdır. (Offline)   Alıntı yaparak aynı kişiye cevapla
Eski 07-05-2007, 01:20   #17 (permalink)
EN Açıkgözlü
 
dmuratyuksel - ait Avatar
 
Üyelik Tarihi: 07-05-2007
Mesajlar: 5
Rep Gücü: 0
Rep Puanı: 250
dmuratyuksel Rütbe: +6dmuratyuksel Rütbe: +6dmuratyuksel Rütbe: +6
Tanımlı Cevap: Visual basic kodları hemde bisürü***tnsezer***(Sürekli güncellenecektir)

Sağl Arkadaşim
dmuratyuksel isimli üyemiz çevrimdışıdır. (Offline)   Alıntı yaparak aynı kişiye cevapla
Eski 07-05-2007, 16:08   #18 (permalink)
EN Açıkgözlü
 
Üyelik Tarihi: 07-05-2007
Mesajlar: 1
Rep Gücü: 0
Rep Puanı: 250
zikxi Rütbe: +6zikxi Rütbe: +6zikxi Rütbe: +6
Tanımlı Cevap: Visual basic kodları hemde bisürü***tnsezer***(Sürekli güncellenecektir)

lisede okuyan yeğenime basit bir stok programı lazım nerden bulabilirim acaba?
zikxi isimli üyemiz çevrimdışıdır. (Offline)   Alıntı yaparak aynı kişiye cevapla
Eski 27-07-2007, 22:33   #19 (permalink)
EN Açıkgözlü
 
Üyelik Tarihi: 07-06-2007
Mesajlar: 1
Rep Gücü: 0
Rep Puanı: 250
zagasoft89 Rütbe: +6zagasoft89 Rütbe: +6zagasoft89 Rütbe: +6
Tanımlı Cevap: Visual basic kodları hemde bisürü***tnsezer***(Sürekli güncellenecektir)

açil bişi isticem ben nasıl açılışta programın başlamasını saglıcam ama yazdıgınz gibi sorma olayı olmadan tıkladıgınızada direk kendini start-up programı olarak kaydedecek her eçılışta çıkacak lüten yardım...
zagasoft89 isimli üyemiz çevrimdışıdır. (Offline)   Alıntı yaparak aynı kişiye cevapla
Eski 28-07-2007, 20:07   #20 (permalink)
EN Afilli
 
erkan_rapper - ait Avatar
 
Üyelik Tarihi: 27-01-2007
Yer: im 4 duvar arası
Mesajlar: 1,007
Rep Gücü: 40
Rep Puanı: 721
erkan_rapper Rütbe: +7erkan_rapper Rütbe: +7erkan_rapper Rütbe: +7erkan_rapper Rütbe: +7erkan_rapper Rütbe: +7erkan_rapper Rütbe: +7erkan_rapper Rütbe: +7
Tanımlı Cevap: Visual basic kodları hemde bisürü***tnsezer***(Sürekli güncellenecektir)

aga müthiş bişey bunlar ya

__________________
http://img231.imageshack.us/img231/2157/adszefu2zh9.jpg
http://w3.wikifortio.com/node-fs/dow...4.gif[/IMG Açtığınız konulara " Etiket & Tag " eklemeyi unutmayın !!!

Mesajınızda:


-> Mail Adresinizi verirseniz,
-> Konuyla alakasız yorum yaparsanız / Konuyla alakasız bir soru sorarsanız,
-> Amaçsız, içinde paylaşım olmayan, saçma konular açarsanız,
-> Üstüste mesaj yazarsanız ( Flood yapmakda denir),
-> Küfür ederseniz,
-> Konuyla alakasız bir başlık atarsanız,
-> Mesajınızın tamamını büyük harfler veya puntolar kullanarak yazarsanız,

Mesajınız SİLİNİR ayrıca siz BANLANIRSINIZ.
erkan_rapper isimli üyemiz çevrimdışıdır. (Offline)   Alıntı yaparak aynı kişiye cevapla
Cevapla
2 / 3 Sayfa < 1 2 3 >

« Önceki Konu | Sonraki Konu »
Konu Yönetim Seçenekleri
Konu Gösterim Seçenekleri
Normal şekilde göster Normal şekilde göster

Yetkileriniz
Yeni konu açamazsınız
You may not post replies
Mesajınıza dosya ekleyemezsiniz
Mesaj düzenleme yapamazsın
BB code is Açık
[IMG] Kodları Açık
HTML-Kodları Kapalı
Trackbacks are Kapalı
Pingbacks are Kapalı
Refbacks are Kapalı









| fx15 | neyapak | Doğum | Oyunlar |
forumENA sistem saati: 19:38

İletişim - forumENA - Knight Online , KOXP - Arşiv - forumENA Kuralları - Yukarı Git

Powered by vBulletin Version 3.7.4
Copyright ©2000 - 2008, Jelsoft Enterprises Ltd.
Content Relevant URLs by vBSEO 3.2.0
-------------------------------------------------------------------------
Türkçeleştirme izmirlinihat tarafından yapılmaktadır
forumENA sitesi ENAhosting© tarafından barındırılmaktadır