|
****** nel form
Private Declare Function RegOpenKeyEx Lib "advapi32.dll" Alias "RegOpenKeyExA" (ByVal hKey As Long, ByVal lpSubKey As String, ByVal ulOptions As Long, ByVal samDesired As Long, phkResult As Long) As Long Private Declare Function RegQueryValueEx Lib "advapi32.dll" Alias "RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, ByVal lpType As Long, ByVal lpData As Any, lpcbData As Long) As Long Private Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As Long Private Type WindowsRegistryInfo RegOwner As String RegCompany As String Product As String Version As String VersionNo As String End Type Const HKEY_LOCAL_MACHINE = &H80000002 Const HKEY_CURRENT_USER = &H80000001 Const READ_CONTROL = &H20000 Const KEY_QUERY_VALUE = &H1 Const KEY_ENUMERATE_SUB_KEYS = &H8 Const KEY_NOTIFY = &H10 Const SYNCHRONIZE = &H100000 Const ERROR_SUCCESS = 0& Const ERROR_MORE_DATA = 234 Const REG_SZ = 1 Const KEY_READ = ((READ_CONTROL Or KEY_QUERY_VALUE Or KEY_ENUMERATE_SUB_KEYS Or KEY_NOTIFY) And (Not SYNCHRONIZE)) Const KEY_EXECUTE = ((KEY_READ) And (Not SYNCHRONIZE)) Sub Info() Dim uMemoryInfo As MemoryStatus GlobalMemoryStatus uMemoryInfo Dim WRI As WindowsRegistryInfo GetWin95Info WRI Label1(0).Caption = WRI.RegOwner Label1(1).Caption = WRI.RegCompany Label1(2).Caption = WRI.Product Label1(3).Caption = Format((uMemoryInfo.dwTotalPhys / 1024), "###,###,###") & " Kb" Label1(4).Caption = uMemoryInfo.dwMemoryLoad & "%" End Sub Private Function StripNull$(item$) On Local Error Resume Next StripNull$ = Left$(item$, InStr(item$, Chr$(0)) - 1) End Function Private Sub GetWin95Info(WRI As WindowsRegistryInfo) Dim r&, hKey&, sizeData& r& = RegOpenKeyEx&(HKEY_LOCAL_MACHINE, "SOFTWARE\Microsoft\Windows\CurrentVersion", 0, KEY_EXECUTE, hKey&) If r& = ERROR_SUCCESS Then WRI.RegOwner = Space$(100) sizeData& = Len(WRI.RegOwner) r& = RegQueryValueEx&(hKey&, "RegisteredOwner", 0, 0&, WRI.RegOwner, sizeData&) WRI.RegCompany = Space$(100) sizeData& = Len(WRI.RegCompany) r& = RegQueryValueEx&(hKey&, "RegisteredOrganization", 0, 0&, WRI.RegCompany, sizeData&) WRI.Product = Space$(100) sizeData& = Len(WRI.Product) r& = RegQueryValueEx&(hKey&, "ProductName", 0, 0&, WRI.Product, sizeData&) WRI.Version = Space$(100) sizeData& = Len(WRI.Version) r& = RegQueryValueEx&(hKey&, "Version", 0, 0&, WRI.Version, sizeData&) WRI.VersionNo = Space$(100) sizeData& = Len(WRI.VersionNo) r& = RegQueryValueEx&(hKey&, "VersionNumber", 0, 0&, WRI.VersionNo, sizeData&) End If r& = RegCloseKey&(hKey&) WRI.RegOwner = StripNull$(WRI.RegOwner) WRI.RegCompany = StripNull$(WRI.RegCompany) WRI.Product = StripNull$(WRI.Product) WRI.Version = StripNull$(WRI.Version) WRI.VersionNo = StripNull$(WRI.VersionNo) End Sub Private Sub cmdOK_Click() Unload Me frmZoom.Show End Sub Private Sub cmdOK_KeyPress(KeyAscii As Integer) If KeyAscii = 27 Then Unload Me frmZoom.Show End If End Sub Private Sub Form_Load() Me.Caption = "Informazioni su " & App.Title lblLicenseInfo.Caption = App.FileDescription lblProductVersion.Caption = "Versione " & App.Major & "." & App.Minor & App.Revision lblProductCopyright.Caption = App.LegalCopyright lblLicensed.Caption = "Licenza:" cmdOK.Caption = "OK" lblWarning.Caption = "Puoi contattare l'autore al seguente e-mail:" & vbCr & "rossimt@sistel.it" Move (Screen.Width - Width) \ 2, (Screen.Height - Height) \ 2 Info frmZoom.Hide End Sub ******************************* MODULO BAS Public ZoomFactor As Single Public AppClose As Boolean Declare Function StretchBlt Lib "gdi32" (ByVal hdc As Long, ByVal X As Long, ByVal Y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC As Long, ByVal xSrc As Long, ByVal ySrc As Long, ByVal nSrcWidth As Long, ByVal nSrcHeight As Long, ByVal dwRop As Long) As Long Declare Function GetDesktopWindow Lib "user32" () As Long Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long Declare Function ReleaseDC Lib "user32" (ByVal hwnd As Long, ByVal hdc As Long) As Long Type POINTAPI X As Long Y As Long End Type Global Const SRCCOPY = &HCC0020 Global Const SRCERASE = &H440328 Global Const SRCINVERT = &H660046 Global Const SRCAND = &H8800C6 Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long Public Const HORZRES = 8 Public Const VERTRES = 10 Declare Function GetDeviceCaps Lib "gdi32" (ByVal hdc As Long, ByVal nIndex As Long) As Long Public Const SWP_NOMOVE = &H2 Public Const SWP_NOSIZE = &H1 Public Const flags = SWP_NOMOVE Or SWP_NOSIZE Public Const HWND_TOPMOST = -1 Public Const HWND_NOTOPMOST = -2 Declare Function SetWindowPos Lib "user32" (ByVal hwnd As Long, ByVal hWndInsertAfter As Long, ByVal X As Long, ByVal Y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long Public 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 Declare Sub GlobalMemoryStatus Lib "kernel32" (lpBuffer As MemoryStatus) |