Digital Rakam yazdırma


Form uzerinde 1 tane image nesnesi yerleştirin. ve ismini rakam yapın. sonra bunu 12 defa kopyalayın indexli olarak ve index numarası 0 olanı silin.form uzerine ayrıca 1 ad. imagelist (adı imglst olsun) , ve textbox ekleyin.
program kısmı bu kadar. şimdi paint te rakamlarınızı hazırlayın. tıpkı hesap makinesindeki gibi bir tanesini boş bırakın. ve 0 dan 9 kadar rakamlarınızı oluşturun. ve image liste bunları boş olan başta olmak uzere boş,0,1,2,3.. sırasında ekleyin. hepsi bukadar. programın calışan şeklini ve hazırladığım bmp formatındaki rakamları da zip dosyası olarak gonderiyorum. herkese iyi calışmalar.

Kod:
Private Sub Text1_Change() Dim SAYAC As Byte Dim SAYI, S As String If Text1 = "" Then For SAYAC = 1 To 12 RAKAM(SAYAC).Picture = IMGLST.ListImages(1).Picture Next SAYAC Exit Sub End If SAYI = Format(Text1.Text, "@@@@@@@@@@@@") For SAYAC = 1 To 12 S = Mid(SAYI, SAYAC, 1) If S = " " Then RAKAM(SAYAC).Picture = IMGLST.ListImages(1).Picture Else RAKAM(SAYAC).Picture = IMGLST.ListImages(CInt(S) + 2).Picture End If Next SAYAC End Sub
Forma İstenilen Şeklin Verilmesi!

Programımızı windowsun klasik form şeklinden kurtarmak, daha profesyonel bir gorunum sağlamak veya goruntu değişimi (skin) eklemek icin kullanabileceğimiz bir kac api fonksiyonu var.
Bu fonksiyonlar;
CreateEllipticRgn
CreatePolygonRgn

şeklindedir. Birinci fonksiyon Form'a dairesel şekiller vermek icin kullanılır. İkincisi ise istenilen koordinatlarda formu şekillendirir. Bu nedenle daha kullanışlı olan ikinci fonksiyonu değerlendirmeye alacağız.
"CreatePolygonRgn" fonksiyonu uc adet parametre alır. Bunlardan birincisi Form'un cizileceği koordinatları belirler. İkinci parametre kac adet koordinat belirlendiğini, ucuncu parametre ise cizim modunu belirler. Cizim modu genelde "1" değerini alır. Form'un koordinatları ise saat yonunde yatay ve dikey konumlar verilerek saptanır.
Formun şekillenmesi icin "CreatePolygonRgn" fonksiyonu Form'un "resize" olayına yazılmalıdır.
Bir ornek verelim;
1) Yeni bir proje başlatın,
2) Form'un resize olayına aşağıdaki kodu yazın,

Kod:
Private Sub Form_Resize() If WindowState vbMinimized Then Sekille Me End If End Sub
3) Projeye bir modul ekleyin,
4) Bu module aşağıdaki kodu yazın,
Kod:
Option Explicit Type Yerler X As Long Y As Long End Type Declare Function SetWindowRgn Lib "user32" _ (ByVal hwnd As Long, _ ByVal hRgn As Long, _ ByVal bRedraw As Long) As Long Declare Function CreatePolygonRgn Lib "gdi32" _ (lpPoint As Yerler, _ ByVal nCount As Long, _ ByVal nPolyFillMode As Long) As Long Dim Adet& Dim Konum() As Yerler Function Renk&(Nesne As Object, Kalinlik) Dim AnaRenk&, R&, G&, B&, Oran Oran = Kalinlik / 9 AnaRenk = RGB(140, 140, 140) B = AnaRenk 65536: AnaRenk = AnaRenk - B * 65536 G = AnaRenk 256: AnaRenk = AnaRenk - G * 256 R = AnaRenk R = R * Oran G = G * Oran B = B * Oran Renk = R + G * 256 + B * 65536 End Function Sub KenariBoya(Nesne As Object) Dim I%, Y%, DişRenk&, Kalinlik% Nesne.ScaleMode = 3 For Y = 18 To 1 Step -1 Kalinlik = Y Nesne.DrawWidth = Kalinlik Nesne.CurrentX = Konum(1).X Nesne.CurrentY = Konum(1).Y DişRenk = Renk(Nesne, Kalinlik) For I = 2 To Adet Nesne.Line -(Konum(I).X, Konum(I).Y), DişRenk Next Nesne.Line -(Konum(1).X, Konum(1).Y), DişRenk Next End Sub Sub Sekille(Nesne As Object) Adet = 20 Dim Gorunum& ReDim Konum(Adet) As Yerler Dim En%, Boy%, Ara%, Nokta% En = Nesne.ScaleX(Nesne.Width, vbTwips, vbPixels) Boy = Nesne.ScaleY(Nesne.Height, vbTwips, vbPixels) Ara = 10 'saat yonunde Nokta = Nokta + 1 Konum(Nokta).X = 0 Konum(Nokta).Y = Ara * 3 Nokta = Nokta + 1 Konum(Nokta).X = Ara Konum(Nokta).Y = Ara * 2 Nokta = Nokta + 1 Konum(Nokta).X = Ara Konum(Nokta).Y = Ara Nokta = Nokta + 1 Konum(Nokta).X = Ara * 2 Konum(Nokta).Y = Ara Nokta = Nokta + 1 Konum(Nokta).X = Ara * 3 Konum(Nokta).Y = 0 Nokta = Nokta + 1 Konum(Nokta).X = En - Ara * 3 Konum(Nokta).Y = 0 Nokta = Nokta + 1 Konum(Nokta).X = En - Ara * 2 Konum(Nokta).Y = Ara Nokta = Nokta + 1 Konum(Nokta).X = En - Ara Konum(Nokta).Y = Ara Nokta = Nokta + 1 Konum(Nokta).X = En - Ara Konum(Nokta).Y = Ara * 2 Nokta = Nokta + 1 Konum(Nokta).X = En Konum(Nokta).Y = Ara * 3 Nokta = Nokta + 1 Konum(Nokta).X = En Konum(Nokta).Y = Boy - Ara * 3 Nokta = Nokta + 1 Konum(Nokta).X = En - Ara Konum(Nokta).Y = Boy - Ara * 2 Nokta = Nokta + 1 Konum(Nokta).X = En - Ara Konum(Nokta).Y = Boy - Ara Nokta = Nokta + 1 Konum(Nokta).X = En - Ara * 2 Konum(Nokta).Y = Boy - Ara Nokta = Nokta + 1 Konum(Nokta).X = En - Ara * 3 Konum(Nokta).Y = Boy Nokta = Nokta + 1 Konum(Nokta).X = Ara * 3 Konum(Nokta).Y = Boy Nokta = Nokta + 1 Konum(Nokta).X = Ara * 2 Konum(Nokta).Y = Boy - Ara Nokta = Nokta + 1 Konum(Nokta).X = Ara Konum(Nokta).Y = Boy - Ara Nokta = Nokta + 1 Konum(Nokta).X = Ara Konum(Nokta).Y = Boy - Ara * 2 Nokta = Nokta + 1 Konum(Nokta).X = 0 Konum(Nokta).Y = Boy - Ara * 3 Gorunum = CreatePolygonRgn(Konum(1), Adet, 1) SetWindowRgn Nesne.hwnd, Gorunum, True KenariBoya Nesne End Sub
5) Projeyi calıştrın.

Ram olcer
Bir adet Timer ekleyin forma kopyalayın..

Kod:
Private Type MEMORYSTATUS dwLength As Long dwMemoryLoad As Long dwTotalPhys As Long dwAvailPhys As Long dwTotalPageFile As Long dwAvailPageFile As Long dwTotalVirtual As Long dwAvailVirtual As Long End Type Private Declare Sub GlobalMemoryStatus Lib "kernel32" (lpBuffer As MEMORYSTATUS) Private Sub Form_load() Timer1.Interval = 1000 End Sub Private Sub Timer1_Timer() Cls Dim m As MEMORYSTATUS GlobalMemoryStatus m Print "Bellek Kullanımı %:", m.dwMemoryLoad Print "Toplam RAM:", , m.dwTotalPhys / 1024 / 1024 & " MB" Print "Boş RAM:", , m.dwAvailPhys / 1024 / 1024 & "MB" End Sub

Programa Girişte Şifre İsteme

İlk once visual basic i acın.Form uzerine bi tane sifre adında textbox1 ve tamam adın da Command1 butonu eklleyin ve aşağıda ki kodu kopyalayın..


Kod:
Private Sub tamam_Click() if sifre.text="DAGARSLAN" then msgbox "Şifre Doğru Giriş Onaylandı",8,"Giriş Tamam" form2.show form1.hide else msgbox "Şifreyi Bilemediniz!!!",6,"Byes" end 'Programı Kapatıyozz end sub


Cok Basit Bir Animasyon Ornegi

'1-Arac cubuklarına sağ tuşla tıklayın

'2-Acılan menuden Components'i secin

'3-Gelen pencereden internet controllers'i secin

'4-Projeye ekleyin

'5-Oradanda formunuza ekleyin

'6-Forma eklediğiniz internet sayfası nesnesinin URL ozelliğine herhangi bir hareketli gif resminin adresini ("")cift tırnak işareti kullanmadan tam olarak yazınız.

'7-Eğer buraya kadar doğru yapmışiseniz Projeyi calıştırmadan Hareketli gif resmi aktif olacaktır.

'8-internet sayfası resminin tam uzerine 1 tane picturebox ekleyin

'7-internet sayfası nesnesine eklediğiniz hareketli animasyon resminin aynısını picturebox nesnesinin picture ozelliğini kullanarak ozellikler penceresinden ekleyin.

'8-resmin ilk hali picturebox nesnesinde belirecektir.

'9-İki tane commandbutton ekleyin

'10-Command1'in caption ozelliğini Oynat yapın

'11-Command2'nin caption ozelliğini durdur yapın

'12-internet sayfasının visible ozelliğini false yapın

'13-Aşağıdaki kodları ilgili yordamlara yazın veya kopyala yapıştır metodunu uygulayın





Kod:
Private Sub Command1_Click 'Oynat Butonu internetControl.visible=True Picture1.Visible=False End Sub Private Sub Command2_Click 'Oynat Butonu internetControl.visible =False Picture1.Visible=True End Sub

'Hepsi Bu Kadar Kolay Gelsin


Formu Elips Yapmak
Asagıdakileri oldugu gibi formun kod bolumune yazın :

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 Boolean) As Long Private Sub Form_load() Dim sekilhandle As Long Show ScaleMode = 3 sekilhandle = CreateEllipticRgn(0, 0, Form1.ScaleWidth, Form1.ScaleHeight) Call SetWindowRgn(Form1.hWnd, sekilhandle, True) End Sub
Programınızı C*RACK Programlarından Korunmak

Bu kod sadece sisteme yuklu olan Softice programının Hafızada yuklu olup olmadıgını kontrol ediyor.


Kod:
'MODULE Public Declare Function CreateFileNS Lib "kernel32" Alias "CreateFileA" (ByVal lpFileName As String, ByVal dwDesiredAccess As Long, ByVal dwShareMode As Long, ByVal lpSecurityAttributes As Long, ByVal dwCreationDisposition As Long, ByVal dwFlagsAndAttributes As Long, ByVal hTemplateFile As Long) As Long Public Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long Public Declare Function WriteFileNO Lib "kernel32" Alias "WriteFile" (ByVal hfile As Long, lpBuffer As Any, ByVal nNumberOfBytesToWrite As Long, lpNumberOfBytesWritten As Long, ByVal lpOverlapped As Long) As Long Public Const GENERIC_READ = &H80000000 Public Const GENERIC_WRITE = &H40000000 Public Const FILE_SHARE_READ = &H1 Public Const FILE_SHARE_WRITE = &H2 Public Const OPEN_EXISTING = 3 Public Const FILE_ATTRIBUTE_NORMAL = &H80 'Daha Sonra Bir Public Fonksiyon Yazıyoruz Bu da ; Public Function SoftICELoaded() As Boolean Dim hfile As Long, retval As Long hfile = CreateFileNS("\\.\SICE", GENERIC_WRITE Or GENERIC_READ, FILE_SHARE_READ Or FILE_SHARE_WRITE, 0, OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, 0) If hfile -1 Then ' SoftICE Bulundu. retval = CloseHandle(hfile) SoftICELoaded = True Else ' SoftICE Bulunamadı. SoftICELoaded = False End If End Function 'FORM Private Sub Form_Load() 'Son Olarak Bir Altprogram Kodu Daha Yazacağız If SoftICELoaded Then 'SoftICE Bulundu Mu ?MsgBox "SoftICE Yuklu Lutfen Kapatın", vbMsgBoxSetForeground + vbInformation, "SoftICE-Detector" End ' Eğer Bulunduysa Kapat End If MsgBox "SoftICE Hafızada Yuklu Değil", vbMsgBoxSetForeground + vbInformation, "SoftICE-Detector" 'Buraya Gitmek İstediğiniz Formu Yazın End Sub
Formlarınızı Saydam Oluşturmak


Kod:
Option Explicit Public Const GWL_EXSTYLE = -20 Public Const LWA_COLORKEY = &H1 Public Const LWA_ALPHA = &H2& Public Const WS_EX_LAYERED = &H80000 Public Const WS_EX_TRANSPARENT = &H20& Public Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As Long Public Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long Public Declare Function SetLayeredWindowAttributes Lib "user32" (ByVal hwnd As Long, ByVal crKey As Byte, ByVal bAlpha As Byte, ByVal dwFlags As Long) As Long Public Sub SaydamYap(frm As Form, SeffaflikDerecesi As Integer) Dim stil As Long stil = GetWindowLong(frm.hwnd, GWL_EXSTYLE) If (stil And WS_EX_LAYERED) = 0 Then SetWindowLong frm.hwnd, GWL_EXSTYLE, stil Or WS_EX_LAYERED SetLayeredWindowAttributes frm.hwnd, 0, SeffaflikDerecesi, LWA_ALPHA End If End Sub 'IN FORM Private Sub Form_Load() Call SaydamYap(Me, 50) End Sub

Titreyen Form

TİTREYEN FORM
Bu kodlarla visual basic icersinde bir formu titrek hale getirebilirsiniz

Oncelikle form'a bir adet Timer ve bir adet HscrollBar koyuyoruz.

Sonra timer nesnesinin properties kısmında interval değerini 10 yapıyoruz.

Timer nesnesiyle işimiz bittikten sonra scrollbar'ın properties kısmında max değerine kafamıza gore bir sayı atıyoruz (cok ucmamak lazım ben 500 yaptım). Min değerini ise 0 yapın.

Kod kısmına gelince...



Kod:
Private Sub Form_Load() sY = 100 End Sub Private Sub HScroll1_Change() sY = HScroll1.Value End Sub Private Sub HScroll1_Scroll() sY = HScroll1.Value End Sub Private Sub Timer1_Timer() If tt = True Then Me.Top = Me.Top + sY Me.Left = Me.Left + sY tt = False Else Me.Top = Me.Top - sY Me.Left = Me.Left - sY tt = True End If End Sub

(BU KODLAR VB 6.0 İCİN GECERLİDİR VB 2008 DE SORUNLAR CIKABİLİR)

ALINDI DEĞİL ALIN TERİ...
__________________