Hewall

Öss puan hesaplama

Dim isim As String
Private Sub Command1_Click()
a = Val(Text1)
b = Val(Text2)
c = Val(Text3)
d = Val(Text4)
e = Val(Text5)
Select Case a
Case 1: a1 = 2.044
Case 2: a1 = 4.088
Case 3: a1 = 6.132
Case 4: a1 = 8.176
Case 5: a1 = 10.22
Case 6: a1 = 12.264
Case 7: a1 = 14.308
Case 8: a1 = 16.352
Case 9: a1 = 18.396
Case 10: a1 = 20.44
Case 11: a1 = 22.484
Case 12: a1 = 24.528
Case 13: a1 = 26.572
Case 14: a1 = 28.616
Case 15: a1 = 30.66
Case 16: a1 = 32.704
Case 17: a1 = 34.748
Case 18: a1 = 36.792
Case 19: a1 = 38.836
Case 20: a1 = 40.88
Case 21: a1 = 42.924
Case 22: a1 = 44.968
Case 23: a1 = 47.012
Case 24: a1 = 49.056
Case 25: a1 = 51.1
Case 26: a1 = 53.144
Case 27: a1 = 55.188
Case 28: a1 = 57.232
Case 29: a1 = 59.276
Case 30: a1 = 61.32
Case 31: a1 = 63.364
Case 32: a1 = 65.408
Case 33: a1 = 67.452
Case 34: a1 = 69.496
Case 35: a1 = 71.54
Case 36: a1 = 73.584
Case 37: a1 = 75.628
Case 38: a1 = 77.672
Case 39: a1 = 79.716
Case 40: a1 = 81.76
Case 41: a1 = 83.804
Case 42: a1 = 85.848
Case 43: a1 = 87.862
Case 44: a1 = 89.936
Case 45: a1 = 91.98
End Select
Select Case b
Case 1: b1 = 1.252
Case 2: b1 = 2.504
Case 3: b1 = 3.756
Case 4: b1 = 5.008
Case 5: b1 = 6.26
Case 6: b1 = 7.512
Case 7: b1 = 8.764
Case 8: b1 = 10.016
Case 9: b1 = 11.268
Case 10: b1 = 12.52
Case 11: b1 = 13.772
Case 12: b1 = 15.024
Case 13: b1 = 16.276
Case 14: b1 = 17.528
Case 15: b1 = 18.78
Case 16: b1 = 20.032
Case 17: b1 = 21.284
Case 18: b1 = 22.536
Case 19: b1 = 23.788
Case 20: b1 = 25.04
Case 21: b1 = 26.292
Case 22: b1 = 27.544
Case 23: b1 = 28.796
Case 24: b1 = 30.048
Case 25: b1 = 31.3
Case 26: b1 = 32.552
Case 27: b1 = 33.804
Case 28: b1 = 35.056
Case 29: b1 = 36.308
Case 30: b1 = 37.56
Case 31: b1 = 38.812
Case 32: b1 = 40.064
Case 33: b1 = 41.316
Case 34: b1 = 42.568
Case 35: b1 = 43.82
Case 36: b1 = 45.072
Case 37: b1 = 46.324
Case 38: b1 = 47.576
Case 39: b1 = 48.828
Case 40: b1 = 50.08
Case 41: b1 = 51.332
Case 42: b1 = 52.584
Case 43: b1 = 53.836
Case 44: b1 = 55.088
Case 45: b1 = 56.34
End Select
Select Case c
Case 1: c1 = 0.508
Case 2: c1 = 1.016
Case 3: c1 = 1.524
Case 4: c1 = 2.032
Case 5: c1 = 2.54
Case 6: c1 = 3.048
Case 7: c1 = 3.556
Case 8: c1 = 4.064
Case 9: c1 = 4.572
Case 10: c1 = 5.08
Case 11: c1 = 5.588
Case 12: c1 = 6.096
Case 13: c1 = 6.604
Case 14: c1 = 7.112
Case 15: c1 = 7.62
Case 16: c1 = 8.128
Case 17: c1 = 8.636
Case 18: c1 = 9.144
Case 19: c1 = 9.652
Case 20: c1 = 10.16
Case 21: c1 = 10.668
Case 22: c1 = 11.176
Case 23: c1 = 11.684
Case 24: c1 = 12.192
Case 25: c1 = 12.7
Case 26: c1 = 13.208
Case 27: c1 = 13.716
Case 28: c1 = 14.224
Case 29: c1 = 14.732
Case 30: c1 = 15.24
Case 31: c1 = 15.748
Case 32: c1 = 16.256
Case 33: c1 = 16.764
Case 34: c1 = 17.272
Case 35: c1 = 17.78
Case 36: c1 = 18.288
Case 37: c1 = 18.796
Case 38: c1 = 19.304
Case 39: c1 = 19.812
Case 40: c1 = 20.32
Case 41: c1 = 20.828
Case 42: c1 = 21.336
Case 43: c1 = 21.844
Case 44: c1 = 22.352
Case 45: c1 = 22.86
End Select
Select Case d
Case 1: d1 = 0.208
Case 2: d1 = 0.416
Case 3: d1 = 0.624
Case 4: d1 = 0.832
Case 5: d1 = 1.04
Case 6: d1 = 1.248
Case 7: d1 = 1.456
Case 8: d1 = 1.664
Case 9: d1 = 1.872
Case 10: d1 = 2.08
Case 11: d1 = 2.288
Case 12: d1 = 2.496
Case 13: d1 = 2.704
Case 14: d1 = 2.912
Case 15: d1 = 3.12
Case 16: d1 = 3.328
Case 17: d1 = 3.536
Case 18: d1 = 3.744
Case 19: d1 = 3.952
Case 20: d1 = 4.16
Case 21: d1 = 4.368
Case 22: d1 = 4.576
Case 23: d1 = 4.784
Case 24: d1 = 4.992
Case 25: d1 = 5.2
Case 26: d1 = 5.408
Case 27: d1 = 5.616
Case 28: d1 = 5.824
Case 29: d1 = 6.032
Case 30: d1 = 6.24
Case 31: d1 = 6.448
Case 32: d1 = 6.656
Case 33: d1 = 6.864
Case 34: d1 = 7.072
Case 35: d1 = 7.28
Case 36: d1 = 7.488
Case 37: d1 = 7.696
Case 38: d1 = 7.904
Case 39: d1 = 8.112
Case 40: d1 = 8.32
Case 41: d1 = 8.528
Case 42: d1 = 8.736
Case 43: d1 = 8.944
Case 44: d1 = 9.152
Case 45: d1 = 9.36
End Select
MsgBox isim & " ÖSS Sözel Puanın: " & (a1 + b1 + c1 + d1 + 119.425)
MsgBox "Öss Sözel Puan(Eklemeli): " & (a1 + b1 + c1 + d1 + 119.425 + e)
End Sub
Private Sub Command2_Click()
a = Val(Text1)
b = Val(Text2)
c = Val(Text3)
d = Val(Text4)
e = Val(Text5)
st = a * 1.505
ss = b * 0.543
sm = c * 1.714
sf = d * 0.21
MsgBox isim & " Öss Eşit Ağırlık Puanın: " & (st + ss + sm + sf + 121.215)
MsgBox "Öss Eşit Ağırlık Puanı(Eklemeli): " & (st + ss + sm + sf + 121.215 + e)
End Sub

Private Sub Command3_Click()
a = Val(Text1)
b = Val(Text2)
c = Val(Text3)
d = Val(Text4)
e = Val(Text5)
st = a * 0.537
ss = b * 0.172
sm = c * 1.796
sf = d * 1.404
MsgBox isim & " Öss Sayısal Puanın: " & (st + ss + sm + sf + 124.001)
MsgBox "Öss Sayısal Puan(Eklemeli): " & (st + ss + sm + sf + 124.001 + e)
End Sub
Private Sub Command4_Click()
End
End Sub
Private Sub Command5_Click()
MsgBox "Sözel:119.425 T.M:121.215 Sayısal:124.001"
End Sub
Private Sub Command6_Click()
Text1 = ""
Text2 = ""
Text3 = ""
Text4 = ""
Text5 = ""
End Sub

Private Sub Form_Load()
isim = InputBox("İsminizi giriniz")
End Sub

Basit bir msn

Dim a As String
Private Sub Command1_Click()
ww.RemotePort = 808
ww.RemoteHost = Text1
ww.Connect
End Sub

Private Sub Command2_Click()
With ww
.LocalPort = 808
.Listen
End With
End Sub

Private Sub Command3_Click()
ww.SendData Text2
Label2 = "gönderildi"
End Sub


Private Sub ww_ConnectionRequest(ByVal requestID As Long)
ww.Close
ww.Accept requestID
End Sub

Private Sub ww_DataArrival(ByVal bytesTotal As Long)
ww.GetData a
Text3.Text = a
Label2 = "Alındı"
End Sub

Private Sub ww_Error(ByVal Number As Integer, Description As String, ByVal Scode As Long, ByVal Source As String, ByVal HelpFile As String, ByVal HelpContext As Long, CancelDisplay As Boolean)
MsgBox Description
End Sub

Fare ile Çizim
Private Sub Form_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)

Dim mx, my

mx = X
my = Y

PSet (X, Y) 'başlangıç koordinatını belirlek için nota koy


End Sub

Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)


Dim mx, my

'sağ tuşa basılı ise çenber ciz
If Button = vbRightButton Then Circle (mx, my), Abs(mx - X)
'sol tuşa basılı ise dikdört ciz
If Button = vbLeftButton Then Line (mx, my)-(X, Y), , B


End Sub
Private Sub Form_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)

Dim mx, my

mx = X
my = Y

PSet (X, Y) 'başlangıç koordinatını belirlek için nota koy


End Sub

Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)


Dim mx, my

'sağ tuşa basılı ise çenber ciz
If Button = vbRightButton Then Circle (mx, my), Abs(mx - X)
'sol tuşa basılı ise dikdört ciz
If Button = vbLeftButton Then Line (mx, my)-(X, Y), , B


End Sub

Private Sub Form_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)

Dim mx, my

mx = X
my = Y

PSet (X, Y) 'başlangıç koordinatını belirlek için nota koy


End Sub

Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)


Dim mx, my

'sağ tuşa basılı ise çenber ciz
If Button = vbRightButton Then Circle (mx, my), Abs(mx - X)
'sol tuşa basılı ise dikdört ciz
If Button = vbLeftButton Then Line (mx, my)-(X, Y), , B


End Sub


basit ses ayar programı

'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

Girilen sayının Faktöriyelini Verir

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


CPU Markasını,Modelini,ve MHZ Registry den Okumak

Set Reg = CreateObject("Wscript.Shell")

MsgBox "CPU " & Reg.RegRead("HKEY_LOCAL_MACHINE\Hardware\Descripti on\System\CentralProcessor\0\ProcessorNameString")

Bu Anahtarda İşlemci İle İlgili Diğer Bilgileride Bula Bilirsin

Bir Ip Ucu Daha
HKEY_LOCAL_MACHINE\HARDWARE\DESCRIPTION\System\

Anahtarı Altındaki Değerlerden Bios Bilgilerinide Bula Bilirsin

Hangi Program Çalışıyor?
--------- Generals Declarations altına kopyalanacak bölüm ----
Option Explicit

Const MAX_PATH = 260
Const TH32CS_SNAPPROCESS = 2&

Private Type PROCESSENTRY32
lSize As Long
lUsage As Long
lProcessId As Long
lDefaultHeapId As Long
lModuleId As Long
lThreads As Long
lParentProcessId As Long
lPriClassBase As Long
lFlags As Long
sExeFile As String * MAX_PATH
End Type

Private Declare Sub CloseHandle Lib "kernel32" (ByVal hPass As Long)

Private Declare Function CreateToolhelpSnapshot Lib "kernel32" _
Alias "CreateToolhelp32Snapshot" (ByVal lFlags As Long, _
ByVal lProcessId As Long) As Long

Private Declare Function ProcessFirst Lib "kernel32" _
Alias "Process32First" (ByVal hSnapshot As Long, _
uProcess As PROCESSENTRY32) As Long

Private Declare Function ProcessNext Lib "kernel32" _
Alias "Process32Next" (ByVal hSnapshot As Long, _
uProcess As PROCESSENTRY32) As Long
-------Generals Declarations Sonu ----------------------------

----- Form Load içine kopyalanacak bölüm ------------------

Private Sub Form_Load()
Dim sExeName As String
Dim sPid As String
Dim sParentPid As String
Dim lSnapShot As Long
Dim r As Long
Dim uProcess As PROCESSENTRY32

lSnapShot = CreateToolhelpSnapshot(TH32CS_SNAPPROCESS, 0&)
If lSnapShot <> 0 Then
With grdProcs
.Clear
.Rows = 1
.TextMatrix(0, 0) = "Module Name"
.TextMatrix(0, 1) = "Process Id"
.TextMatrix(0, 2) = "Parent" & vbCrLf & "Process"
.TextMatrix(0, 3) = "Threads"
.RowHeight(0) = 400
.ColWidth(0) = 4200
.ColWidth(1) = 950
.ColWidth(2) = 950
.ColWidth(3) = 775
.ColAlignment(0) = flexAlignLeftBottom
.ColAlignment(1) = flexAlignLeftBottom
.ColAlignment(2) = flexAlignLeftBottom
.ColAlignment(3) = flexAlignLeftBottom

uProcess.lSize = Len(uProcess)
r = ProcessFirst(lSnapShot, uProcess)

Do While r
sExeName = Left(uProcess.sExeFile, InStr(1, uProcess.sExeFile, vbNullChar) - 1)
sPid = Hex$(uProcess.lProcessId)
sParentPid = Hex$(uProcess.lParentProcessId)
.AddItem sExeName & vbTab & sPid & vbTab & _
sParentPid & vbTab & CStr(uProcess.lThreads)
r = ProcessNext(lSnapShot, uProcess)
Loop
CloseHandle (lSnapShot)
End With
End If
End Sub
(Form üzerine 1 adet msflexgrid koyun ve adını grdProcs olarak değiştirin. Programı çalıştırdığınızda o anda sistemde aktif olan programları görebilirsiniz.)

JvX

saol bilgi için..........

hancher

kodlar için tşk .

wolf_57

paylaşım için teşekkurler