Sonuçlar 1 to 2 of 2

Konu: Donanım (kaynak1.v.basic)

  1. #1

    Default Donanım (kaynak1.v.basic)

    Farenin Pozisyonunu Bulmak ve Değiştirmek

    (Modul)(General)(Declaration)



    Type PointApi

    X As Long

    Y As Long

    End Type



    Global FareXY As PointApi



    Declare Function GetCursorPos Lib "user32" (lpPoint As PointApi) As Long

    Declare Function SetCursorPos Lib "user32" (ByVal x As Long, _

    ByVal y As Long) As Long



    Private Sub Form_Click() ‘ Farenin yeri

    Z = GetCursorPos(PointApi)

    MsgBox "Fare Pozisyonu : (" & FareXY.Y & "," & FareXY.Y & ") "

    End Sub



    Private Sub Command1_Click() ‘ Farenin yerini değiştirmek

    X = Val(InputBox("X ?"))

    Y = Val(InputBox("Y ?"))

    Z = SetCursorPos(x, y)

    MsgBox "Fare Pozisyonu: (" & X & "," & Y & ")"

    End Sub


    Fare İmlecini Saklamak / Göstermek

    (General)(Declaration)

    Private Declare Function ShowCursor Lib "user32" (ByVal bShow As Long) As Long



    Private Sub Command1_Click()

    FImlec = ShowCursor(False) ' Fare imlecini saklar

    End Sub



    Private Sub Command2_Click()

    FImlec = ShowCursor(True) ' Fare imlecini gösterir

    End Sub


    Fare İmlecini Çalışma Anında Değiştirmek


    Text1.MousePointer = 99

    Text1.MouseIcon = LoadPicture("c:\bjk.ico")


    Sistemin Kaç Bit Renk Kullandığını Bulmak

    (General)(Declaration)

    Option Explicit

    Private Const BITSPIXEL = 12

    Private Declare Function GetDeviceCaps Lib "gdi32" (ByVal hdc As Long, _

    ByVal nIndex As Long) As Long



    Private Sub Form_Load()

    MsgBox "Format$(GetDeviceCaps(hdc, BITSPIXEL)) & "-bit renk kullanılıyor."

    End Sub




    Ekran Çözünürlüğünü Bulmak - I

    Private Sub Command1_Click()

    En = Screen.Width \ Screen.TwipsPerPixelX

    Boy = Screen.Height \ Screen.TwipsPerPixelY

    Ekran_Coz = En & "x" & Boy

    Print Ekran_Coz

    End Sub


    Ekran Çözünürlüğünü Bulmak – II




    (Modul)(General)(Declaration)



    Option Explicit

    Type RECT

    Left As Long

    Top As Long

    Right As Long

    Bottom As Long

    End Type

    Public Const SPI_GETWORKAREA& = 48

    Public Declare Function SystemParametersInfo Lib "user32" Alias _

    "SystemParametersInfoA" (ByVal uAction As Long, _

    ByVal uParam As Long, lpvParam As Any, ByVal fuWinIni As Long) As Long



    Private Sub Command1_Click()

    Dim rct As RECT

    Dim z As Long

    Dim msg As String

    z = SystemParametersInfo(SPI_GETWORKAREA, 0&, rct, 0&)

    msg = "Ekran Çözünürlüğü" & vbCrLf

    msg = msg & "Genişlik - " & rct.Right & vbCrLf

    msg = msg & "Yükseklik - " & rct.Bottom & vbCrLf & vbCrLf

    MsgBox msg

    End Sub


    Sürücü Tipini Bulmak

    (General)(Declaration)

    Option Explicit

    Private Declare Function GetDriveType Lib "kernel32" Alias _

    "GetDriveTypeA" (ByVal nDrive As String) As Long

    Private Const DRIVE_REMOVABLE = 2

    Private Const DRIVE_FIXED = 3

    Private Const DRIVE_REMOTE = 4

    Private Const DRIVE_CDROM = 5

    Private Const DRIVE_RAMDISK = 6



    Private Sub Form_Click()

    Dim i, drv, d$

    For i = 0 To 25

    d$ = Chr$(i + 65) & ":"

    drv = GetDriveType(d$)

    Select Case drv

    Case DRIVE_REMOVABLE

    Print d$ & " Disket Sürücü"

    Case DRIVE_FIXED

    Print d$ & " Sabit Disk"

    Case DRIVE_REMOTE

    Print d$ & " Ağ Sürücüsü"

    Case DRIVE_CDROM

    Print d$ & " CD_ROM Sürücü"

    Case DRIVE_RAMDISK

    Print d$ & " Ram Disk"

    End Select

    Next i

    End Sub


    CD Sürücünün Kapağını Açıp Kapatmak

    (General)(Declaration)

    Private Declare Function mciSendString Lib "winmm.dll" Alias "mciSendStringA" _

    (ByVal lpstrCommand As String, ByVal lpstrReturnString As String, _

    ByVal uReturnLength As Long, ByVal hwndCallback As Long) As Long



    Private Sub Command1_Click() ‘ Açmak

    retvalue = mciSendString("set CDAudio door open", returnstring, 127, 0)

    End Sub



    Private Sub Command2_Click() ‘ Kapatmak

    retvalue = mciSendString("set CDAudio door closed", returnstring, 127, 0)

    End Sub


    Sabit Disk Bilgileri – I

    (Modul)(General)(Declaration)

    Option Explicit

    Declare Function GetVolumeInformation Lib "kernel32" Alias _

    "GetVolumeInformationA" (ByVal lpRootPathName As String, ByVal _

    lpVolumeNameBuffer As String, ByVal nVolumeNameSize As Long, _

    lpVolumeSerialNumber As Long, lpMaximumComponentLength As Long, _

    lpFileSystemFlags As Long, ByVal lpFileSystemNameBuffer As String, _

    ByVal nFileSystemNameSize As Long) As Long



    Private Sub rgbGetVolumeInformationRDI(PathName$, _

    DrvVolumeName$, DrvSerialNo$)

    Dim r As Long

    Dim pos As Integer

    Dim HiWord As Long

    Dim HiHexStr As String

    Dim LoWord As Long

    Dim LoHexStr As String

    Dim VolumeSN As Long

    Dim MaxFNLen As Long

    Dim UnusedStr As String

    Dim UnusedVal1 As Long

    Dim UnusedVal2 As Long

    DrvVolumeName$ = Space$(14)

    UnusedStr$ = Space$(32)

    r& = GetVolumeInformation(PathName$, DrvVolumeName$, _

    Len(DrvVolumeName$), VolumeSN&, UnusedVal1&, _

    UnusedVal2&, UnusedStr$, Len(UnusedStr$))

    If r& = 0 Then Exit Sub

    pos% = InStr(DrvVolumeName$, Chr$(0))

    If pos% Then DrvVolumeName$ = Left$(DrvVolumeName$, pos% - 1)

    If Len(Trim$(DrvVolumeName$)) = 0 Then DrvVolumeName$ = "(no label)"

    HiWord& = GetHiWord(VolumeSN&) And &HFFFF&

    LoWord& = GetLoWord(VolumeSN&) And &HFFFF&

    HiHexStr$ = Format$(Hex(HiWord&), "0000")

    LoHexStr$ = Format$(Hex(LoWord&), "0000")

    DrvSerialNo$ = HiHexStr$ & "-" & LoHexStr$

    End Sub



    Function GetHiWord(dw As Long) As Integer

    If dw& And &H80000000 Then

    GetHiWord% = (dw& \ 65535) - 1

    Else

    GetHiWord% = dw& \ 65535

    End If

    End Function





    Function GetLoWord(dw As Long) As Integer

    If dw& And &H8000& Then

    GetLoWord% = &H8000 Or (dw& And &H7FFF&)

    Else

    GetLoWord% = dw& And &HFFFF&

    End If

    End Function





    Private Sub form_Click()

    Dim r As Long

    Dim PathName As String

    Dim DrvVolumeName As String

    Dim DrvSerialNo As String

    PathName$ = " C:\"

    rgbGetVolumeInformationRDI PathName$, DrvVolumeName$, DrvSerialNo$

    Print: Print " Sürücü", , ": "; UCase$(PathName$)

    Print: Print " Sürücü Etiketi", ": "; DrvVolumeName$

    Print: Print " Seri Numarası", ": "; DrvSerialNo$

    End Sub


    Sabit Disk Bilgileri - II



    (General)(Declaration)

    Private Declare Function GetDiskFreeSpace Lib "kernel32" Alias "GetDiskFreeSpaceA" _

    (ByVal lpRootPathName As String, lpSectorsPerCluster As Long, lpBytesPerSector As _

    Long, lpNumberOfFreeClusters As Long, lpTotalNumberOfClusters As Long) As Long



    Private Sub Form_click()

    Dim x As Long

    Dim sectorpercluster As Long

    Dim bytepersector As Long

    Dim freecluster As Long

    Dim totalcluster As Long

    x = GetDiskFreeSpace("c:\", sectorpercluster, bytepersector, _

    freecluster, totalcluster)

    Label1.Caption = sectorpercluster

    Label2.Caption = bytepersector

    Label3.Caption = freecluster

    Label4.Caption = totalcluster

    Label5.Caption = freecluster * sectorpercluster * _

    bytepersector / 1024 / 1024 & "MB"

    Label6.Caption = totalcluster * sectorpercluster * _

    bytepersector / 1024 / 1024 & "MB"

    End Sub


    Bellek Bilgilerini Öğrenmek

    (General)(declaration)

    Private Declare Sub GlobalMemoryStatus Lib "kernel32" (lpBuffer As MEMORYSTATUS)



    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 Sub Command2_Click()

    Dim bellek As MEMORYSTATUS

    GlobalMemoryStatus bellek

    Print "Toplam Bellek : " & bellek.dwTotalPhys / 1024 / 1024

    Print "Kullanılabilir Bellek : " & bellek.dwAvailPhys

    Print "Bellek Kullanımı : %" & bellek.dwMemoryLoad

    Print "Toplam Virtual Memory : " & bellek.dwTotalVirtual

    Print "Kullanılabilir Virtual Memory : " & bellek.dwAvailVirtual

    End Sub


    İşlemci İle İlgili Bilgileri Öğrenmek

    (General)(Declaration)

    Private Declare Sub GetSystemInfo Lib "kernel32" (lpSystemInfo As SYSTEM_INFO)

    Private Type SYSTEM_INFO

    dwOemID As Long

    dwPageSize As Long

    lpMinimumApplicationAddress As Long

    lpMaximumApplicationAddress As Long

    dwActiveProcessorMask As Long

    dwNumberOrfProcessors As Long

    dwProcessorType As Long

    dwAllocationGranularity As Long

    dwReserved As Long

    End Type



    Private Sub Command1_Click()

    Dim cpu As SYSTEM_INFO

    GetSystemInfo cpu

    Print "Cpu Tipi : " & cpu.dwProcessorType

    Print "Cpu Sayısı : " & cpu.dwNumberOrfProcessors

    End Sub



    Internet Bağlantısını Kontrol Etmek

    (Modul)(General)(Declaration)

    Public Declare Function RasEnumConnections Lib "RasApi32.dll" Alias _

    "RasEnumConnectionsA" (lpRasCon As Any, lpcb As Long, _

    lpcConnections As Long) As Long

    Public Declare Function RasGetConnectStatus Lib "RasApi32.dll" Alias _

    "RasGetConnectStatusA" (ByVal hRasCon As Long, _

    lpStatus As Any) As Long



    Public Const RAS95_MaxEntryName = 256 ' Bağlantı Değişkenleri

    Public Const RAS95_MaxDeviceType = 16

    Public Const RAS95_MaxDeviceName = 32



    Public Type RASCONN95 ' Bağlantı Bilgileri

    dwSize As Long

    hRasCon As Long

    szEntryName(RAS95_MaxEntryName) As Byte

    szDeviceType(RAS95_MaxDeviceType) As Byte

    szDeviceName(RAS95_MaxDeviceName) As Byte

    End Type



    Public Type RASCONNSTATUS95 ' Bağlantı Durumları

    dwSize As Long

    RasConnState As Long

    dwError As Long

    szDeviceType(RAS95_MaxDeviceType) As Byte

    szDeviceName(RAS95_MaxDeviceName) As Byte

    End Type





    Private Sub Timer1_Timer()

    If InternetDurumu = False Then

    ' İnternete bağlı olmadığını gösteren resim

    Image1.Visible = True

    ' İnternete bağlı olduğunu gösteren resim

    Image2.Visible = False

    End If

    If InternetDurumu = True Then

    ' İnternete bağlı olmadığını gösteren resim

    Image1.Visible = False

    ' İnternete bağlı olduğunu gösteren resim

    Image2.Visible = True

    End If

    End Sub


    Sistemde Ses Kartı Olup Olmadığını Kontrol Etmek

    (Modul)(General)(Declaration)

    Public Declare Function waveOutGetNumDevs Lib "winmm.dll" () As Long



    Private Sub Command1_Click()

    Dim i As Integer

    i = waveOutGetNumDevs()

    If i > 0 Then

    MsgBox " Sistemde Ses Kartı Bulunmaktadır ", vbInformation

    Else

    MsgBox " Sistemde Ses Kartı Bulunmamaktadır ", vbInformation

    End If

    End Sub

  2. #2

Similar Threads

  1. GSÜ-Donanım nedir? Günümüz donanım teknolojileri
    By Elektronik in forum Teknik yardım-Donanım Birimleri
    CEvaplar: 2
    Son Mesaj: 17-10-13, 02:32
  2. CEvaplar: 1
    Son Mesaj: 14-07-08, 19:51
  3. IFF-V.Basic-(kaynak1)
    By Elektronik in forum Visual Basic
    CEvaplar: 1
    Son Mesaj: 14-07-08, 19:46
  4. Choose-V.basic-(kaynak1)
    By Elektronik in forum Visual Basic
    CEvaplar: 1
    Son Mesaj: 14-07-08, 19:41
  5. Do While ... Loop-V.Basic-(kaynak1)
    By Elektronik in forum Visual Basic
    CEvaplar: 1
    Son Mesaj: 14-07-08, 19:36

Tags for this Thread

Bookmarks

Gönderme izinleri

  • Yeni Konu açamazsınız
  • Konulara cevap yazamazsınız.
  • Eklenti gönderemezsiniz.
  • Mesajlarınızı düzenleme izniniz yok.
  •