Visual Basic İçin Hazır Kodlar - Turkish Forum / Board / Blog

Titreyen Form

Private Sub Form_Load() Timer1.Interval = 22 End Sub Private Sub Timer1_Timer() Form1.Top = Form1.Top + 50 Form1.Top = Form1.Top - 50 Form1.Left = Form1.Left - 50 Form1.Left = Form1.Top + 50 End Sub

Formu Yuvarlatma

 

Private Sub Form_Load() Dim hr&, dl& Dim usew&, useh& usew& = Me.Width / Screen.TwipsPerPixelX useh& = Me.Height / Screen.TwipsPerPixelY hr& = CreateEllipticRgn(55, -20, usew, useh) dl& = SetWindowRgn(Me.hWnd, hr, True) End Sub

Her Koseden Program Kapatma

Private Sub Cmd1çıkış_Click() Do Until Form1.Height = 405 And Form1.Width = 1680 Form1.Height = Form1.Height - 1 Form1.Width = Form1.Width - 1 Loop Unload Me End Sub Private Sub Form_Load() Form1.Caption = "Form Move" Form1.Height = 0 Form1.Width = 1680 Timer1.Interval = 200 Timer1.Enabled = True End Sub Private Sub Timer1_Timer() On Error Resume Next For x = 0 To Form1.Height + 2000 Form1.Height = x Next x For y = 100 To Form1.Width + 1500 Form1.Width = y Next y Timer1.Enabled = False End Sub

Yanip Sonen Label

 

Private Sub Command1_Click() For X = 1 To 5000: DoEvents: Next X label1.ForeColor = vbRed For X = 1 To 5000: DoEvents: Next X label1.ForeColor = vbBlue For X = 1 To 5000: DoEvents: Next X label1.ForeColor = vbGreen For X = 1 To 5000: DoEvents: Next X label1.ForeColor = vbRed End Sub Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single) For X = 1 To 5000: DoEvents: Next X label1.ForeColor = vbRed For X = 1 To 5000: DoEvents: Next X label1.ForeColor = vbBlue For X = 1 To 5000: DoEvents: Next X label1.ForeColor = vbGreen For X = 1 To 5000: DoEvents: Next X label1.ForeColor = vbRed End Sub Private Sub label1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single) For X = 1 To 5000: DoEvents: Next X label1.ForeColor = vbRed For X = 1 To 5000: DoEvents: Next X label1.ForeColor = vbBlue For X = 1 To 5000: DoEvents: Next X label1.ForeColor = vbGreen For X = 1 To 5000: DoEvents: Next X label1.ForeColor = vbRed

Etrafa Carpan Top

 

Private Sub Command1_Click() End End Sub Private Sub topa_Click() End Sub Private Sub xgeri_Timer() topa.Left = topa.Left - 100 If topa.Left < 0 Then xileri.Enabled = True xgeri.Enabled = False End If End Sub Private Sub xileri_Timer() topa.Left = topa.Left + 100 If topa.Left > 13000 Then xileri.Enabled = False xgeri.Enabled = True End If End Sub Private Sub ygeri_Timer() topa.top = topa.top - 100 If topa.top < 0 Then yileri.Enabled = True ygeri.Enabled = False End If End Sub Private Sub yileri_Timer() topa.top = topa.top + 100 If topa.top > 9000 Then yileri.Enabled = False ygeri.Enabled = True End If End Sub

Ctrl-Alt-Delete ve Ctrl-Esc tus kombinasyonlarinin calismasini iptal etme

 

Private Declare Function SystemParametersInfo Lib _ "user32" Alias "SystemParametersInfoA" (ByVal uAction _ As Long, ByVal uParam As Long, ByVal lpvParam As Any, _ ByVal fuWinIni As Long) As Long Sub CtrlAltDeleteKapat(Kapali As Boolean) Dim X As Long X = SystemParametersInfo(97, Kapali, CStr(1), 0) End Sub Ctrl-Alt-Delete kombinasyonunu kapatmak için: Call CtrlAltDeleteKapat(True) Ctrl-Alt-Delete kombinasyonunu açmak için: Call CtrlAltDeleteKapat(False)

Formu Yakip Söndürme

 

Private Sub Timer1_Timer() If Me.Visible = True Then Me.Visible = False Else Me.Visible = True End If End Sub Private Sub Command1_Click() Timer1.Interval = 1000 End Sub

Formu Kaydirma

 

Private Sub Command1_Click() Do Until Form1.Top = Screen.Height Form1.Top = Form1.Top + 1 Loop Unload Me End Sub

Ekran Koruyucu

 

Public Sub drawcircle() Dim red As Integer 'declare all varibles Dim blue As Integer Dim green As Integer Dim xPos As Integer Dim yPos As Integer red = 255 * Rnd 'randomize red color blue = 255 * Rnd 'randomize blue color green = 255 * Rnd 'randomize green color xPos = ScaleWidth / 2 yPos = ScaleHeight / 2 radius = ((yPos * 0.99) + 1) * Rnd Circle (xPos, yPos), radius, RGB(red, blue, green) End Sub Private Sub Timer1_Timer() Call drawcircle End Sub