home *** CD-ROM | disk | FTP | other *** search
/ Dan Appleman's Visual Bas…s Guide to the Win32 API / Dan.Applmans.Visual.Basic.5.0.Programmers.Guide.To.The.Win32.API.1997.Ziff-Davis.Press.CD / VB5PG32.mdf / vbpg32 / samples5 / ch06 / ex6a.frm (.txt) < prev    next >
Encoding:
Visual Basic Form  |  1997-02-16  |  12.8 KB  |  371 lines
  1. VERSION 5.00
  2. Begin VB.Form frmCh6 
  3.    Caption         =   "Ch.6 Extra Function Examples"
  4.    ClientHeight    =   3420
  5.    ClientLeft      =   2625
  6.    ClientTop       =   1680
  7.    ClientWidth     =   4575
  8.    LinkTopic       =   "Form1"
  9.    PaletteMode     =   1  'UseZOrder
  10.    ScaleHeight     =   228
  11.    ScaleMode       =   3  'Pixel
  12.    ScaleWidth      =   305
  13.    Begin VB.PictureBox picHolder 
  14.       Height          =   315
  15.       Index           =   2
  16.       Left            =   3240
  17.       Picture         =   "EX6A.frx":0000
  18.       ScaleHeight     =   285
  19.       ScaleWidth      =   405
  20.       TabIndex        =   16
  21.       Top             =   3060
  22.       Visible         =   0   'False
  23.       Width           =   435
  24.    End
  25.    Begin VB.PictureBox picHolder 
  26.       Height          =   315
  27.       Index           =   1
  28.       Left            =   2880
  29.       Picture         =   "EX6A.frx":0442
  30.       ScaleHeight     =   285
  31.       ScaleWidth      =   405
  32.       TabIndex        =   15
  33.       Top             =   3060
  34.       Visible         =   0   'False
  35.       Width           =   435
  36.    End
  37.    Begin VB.PictureBox picHolder 
  38.       Height          =   315
  39.       Index           =   0
  40.       Left            =   2580
  41.       Picture         =   "EX6A.frx":0884
  42.       ScaleHeight     =   285
  43.       ScaleWidth      =   405
  44.       TabIndex        =   14
  45.       Top             =   3060
  46.       Visible         =   0   'False
  47.       Width           =   435
  48.    End
  49.    Begin VB.Frame fraControlPanel 
  50.       Caption         =   "Control Panel:"
  51.       Height          =   1095
  52.       Left            =   60
  53.       TabIndex        =   7
  54.       Top             =   2100
  55.       Width           =   4395
  56.       Begin VB.HScrollBar scrDoubleClick 
  57.          Height          =   255
  58.          LargeChange     =   15
  59.          Left            =   840
  60.          Max             =   0
  61.          Min             =   -100
  62.          TabIndex        =   11
  63.          Top             =   480
  64.          Width           =   2415
  65.       End
  66.       Begin VB.PictureBox pctDoubleClick 
  67.          AutoSize        =   -1  'True
  68.          Height          =   510
  69.          Left            =   3360
  70.          Picture         =   "EX6A.frx":0CC6
  71.          ScaleHeight     =   480
  72.          ScaleWidth      =   480
  73.          TabIndex        =   10
  74.          Top             =   300
  75.          Width           =   510
  76.       End
  77.       Begin VB.Label lblDC1 
  78.          Caption         =   "Slow"
  79.          Height          =   195
  80.          Index           =   1
  81.          Left            =   840
  82.          TabIndex        =   13
  83.          Top             =   720
  84.          Width           =   375
  85.       End
  86.       Begin VB.Label lblDC1 
  87.          Caption         =   "Fast"
  88.          Height          =   195
  89.          Index           =   0
  90.          Left            =   2940
  91.          TabIndex        =   12
  92.          Top             =   720
  93.          Width           =   375
  94.       End
  95.       Begin VB.Label lblDoubleClick 
  96.          Caption         =   "0.75 ms"
  97.          Height          =   255
  98.          Left            =   180
  99.          TabIndex        =   9
  100.          Top             =   480
  101.          Width           =   615
  102.       End
  103.       Begin VB.Label Label1 
  104.          Caption         =   "Double Click Time:"
  105.          Height          =   195
  106.          Left            =   120
  107.          TabIndex        =   8
  108.          Top             =   240
  109.          Width           =   1515
  110.       End
  111.    End
  112.    Begin VB.Frame fraCursor 
  113.       Caption         =   "Cursor Options:"
  114.       Height          =   1935
  115.       Left            =   60
  116.       TabIndex        =   0
  117.       Top             =   60
  118.       Width           =   4395
  119.       Begin VB.PictureBox pctCursor 
  120.          ForeColor       =   &H000000FF&
  121.          Height          =   1575
  122.          Left            =   180
  123.          ScaleHeight     =   103
  124.          ScaleMode       =   3  'Pixel
  125.          ScaleWidth      =   155
  126.          TabIndex        =   4
  127.          Top             =   240
  128.          Width           =   2355
  129.          Begin VB.TextBox txtCaret 
  130.             Height          =   315
  131.             Left            =   60
  132.             TabIndex        =   5
  133.             Text            =   "Type in this text box"
  134.             Top             =   420
  135.             Width           =   2115
  136.          End
  137.          Begin VB.Label lblClipInfo 
  138.             Caption         =   "Click the picturebox to stop  cursor clipping."
  139.             Height          =   375
  140.             Left            =   60
  141.             TabIndex        =   6
  142.             Top             =   1080
  143.             Visible         =   0   'False
  144.             Width           =   2175
  145.          End
  146.       End
  147.       Begin VB.CommandButton cmdClip 
  148.          Caption         =   "&Clip Cursor"
  149.          Height          =   495
  150.          Left            =   2640
  151.          TabIndex        =   3
  152.          Top             =   1320
  153.          Width           =   1575
  154.       End
  155.       Begin VB.CommandButton cmdSetPos 
  156.          Caption         =   "Set Cursor &Position"
  157.          Height          =   495
  158.          Left            =   2640
  159.          TabIndex        =   2
  160.          Top             =   780
  161.          Width           =   1575
  162.       End
  163.       Begin VB.CommandButton cmdHide 
  164.          Caption         =   "&Hide Cursor"
  165.          Height          =   495
  166.          Left            =   2640
  167.          TabIndex        =   1
  168.          Top             =   240
  169.          Width           =   1575
  170.       End
  171.    End
  172. Attribute VB_Name = "frmCh6"
  173. Attribute VB_GlobalNameSpace = False
  174. Attribute VB_Creatable = False
  175. Attribute VB_PredeclaredId = True
  176. Attribute VB_Exposed = False
  177. Option Explicit
  178. ' Copyright 
  179.  1997 by Desaware Inc. All Rights Reserved
  180. Dim dl&, fCHidden&, fCClipped&, fTxtHidIt&
  181. '**********************************
  182. '**  Constant Definitions:
  183. #If Win32 Then
  184. Const EWX_LOGOFF = 0
  185. Const EWX_SHUTDOWN = 1
  186. Const EWX_REBOOT = 2
  187. Const EWX_FORCE = 4
  188. Const EWX_POWEROFF = 8
  189. Const VK_NUMLOCK = 90
  190. Const VK_SCROLL = 91
  191. Const VK_CAPITAL = 14
  192. Private Const VER_PLATFORM_WIN32_NT& = 2
  193. Private Const VER_PLATFORM_WIN32_WINDOWS& = 1
  194. Private Const SPIF_UPDATEINIFILE& = &H1
  195. Private Const SPIF_SENDWININICHANGE& = &H2
  196. #End If 'WIN32
  197. '**********************************
  198. '**  Type Definitions:
  199. #If Win32 Then
  200. Private Type POINTAPI
  201.     x As Long
  202.     Y As Long
  203. End Type
  204. Private Type RECT
  205.     Left As Long
  206.     Top As Long
  207.     Right As Long
  208.     Bottom As Long
  209. End Type
  210. 'Private Type SYSTEM_INFO
  211. '        dwOemID As Long
  212. '        dwPageSize As Long
  213. '        lpMinimumApplicationAddress As Long
  214. '        lpMaximumApplicationAddress As Long
  215. '        dwActiveProcessorMask As Long
  216. '        dwNumberOrfProcessors As Long
  217. '        dwProcessorType As Long
  218. '        dwAllocationGranularity As Long
  219. '        dwReserved As Long
  220. 'End Type
  221. Private Type SYSTEM_INFO
  222.         dwOemID As Long
  223.         dwPageSize As Long
  224.         lpMinimumApplicationAddress As Long
  225.         lpMaximumApplicationAddress As Long
  226.         dwActiveProcessorMask As Long
  227.         dwNumberOfProcessors As Long
  228.         dwProcessorType As Long
  229.         dwAllocationGranularity As Long
  230.         wProcessorLevel As Integer
  231.         wProcessorRevision As Integer
  232. End Type
  233. Private Type OSVERSIONINFO ' 148 bytes
  234.         dwOSVersionInfoSize As Long
  235.         dwMajorVersion As Long
  236.         dwMinorVersion As Long
  237.         dwBuildNumber As Long
  238.         dwPlatformId As Long
  239.         szCSDVersion As String * 128
  240. End Type
  241. #End If 'WIN32 Types
  242. '**********************************
  243. '**  Function Declarations:
  244. #If Win32 Then
  245. Private Declare Function ClientToScreen& Lib "user32" (ByVal hwnd As Long, lpPoint As POINTAPI)
  246. Private Declare Function ClipCursor& Lib "user32" (lpRect As RECT)
  247. Private Declare Function ClipCursorBynum& Lib "user32" Alias "ClipCursor" (ByVal lpRect As Long)
  248. Private Declare Function apiBeep& Lib "kernel32" Alias "Beep" (ByVal dwFreq As Long, ByVal dwDuration As Long)
  249. Private Declare Function ExitWindowsEx& Lib "user32" (ByVal uFlags As Long, ByVal dwReserved As Long)
  250. Private Declare Function GetComputerName& Lib "kernel32" Alias "GetComputerNameA" (ByVal lpBuffer As String, nSize As Long)
  251. Private Declare Function GetDoubleClickTime& Lib "user32" ()
  252. Private Declare Function GetKeyboardState& Lib "user32" (pbKeyState As Byte)
  253. Private Declare Function GetKeyState% Lib "user32" (ByVal nVirtKey As Long)
  254. Private Declare Function GetVersionEx& Lib "kernel32" Alias "GetVersionExA" _
  255.                         (lpVersionInformation As OSVERSIONINFO)
  256. Private Declare Sub GetSystemInfo Lib "kernel32" (lpSystemInfo As SYSTEM_INFO)
  257. Private Declare Function SetCaretBlinkTime& Lib "user32" (ByVal wMSeconds As Long)
  258. Private Declare Function SetKeyboardState& Lib "user32" (lppbKeyState As Byte)
  259. Private Declare Function SetCursorPos& Lib "user32" (ByVal x As Long, ByVal Y As Long)
  260. Private Declare Function SetDoubleClickTime& Lib "user32" (ByVal wCount As Long)
  261. Private Declare Function ShowCursor& Lib "user32" (ByVal bShow As Long)
  262. Private Declare Function ShowCaret& Lib "user32" (ByVal hwnd As Long)
  263. Private Declare Function HideCaret& Lib "user32" (ByVal hwnd As Long)
  264. Private Declare Function SystemParametersInfo& Lib "user32" Alias "SystemParametersInfoA" _
  265.     (ByVal fAction As Long, ByVal uiParam As Long, ByVal pvParam As Long, ByVal fWinIni As Long)
  266. #End If 'WIN32
  267. Private Sub cmdClip_Click()
  268.     Dim myRect As RECT, myPoint As POINTAPI
  269.     Select Case fCClipped&
  270.         Case True:
  271.             dl& = ClipCursorBynum&(0)
  272.             cmdClip.Caption = "&Clip Cursor"
  273.             lblClipInfo.Visible = False
  274.             fCClipped& = False
  275.             pctCursor.Refresh
  276.         Case False:
  277.             cmdSetPos_Click
  278.             myPoint.x = 0
  279.             myPoint.Y = 0
  280.             dl& = ClientToScreen&(pctCursor.hwnd, myPoint)
  281.             myRect.Top = myPoint.Y
  282.             myRect.Left = myPoint.x
  283.             myRect.Right = myRect.Left + pctCursor.ScaleWidth
  284.             myRect.Bottom = myRect.Top + pctCursor.ScaleHeight
  285.             dl& = ClipCursor&(myRect)
  286.             cmdClip.Caption = "Un-&Clip Cursor"
  287.             lblClipInfo.Visible = True
  288.             fCClipped& = True
  289.             pctCursor.DrawWidth = 2
  290.             pctCursor.Line (1, 1)-(pctCursor.ScaleWidth - 1, pctCursor.ScaleHeight - 1), , B
  291.             pctCursor.DrawWidth = 1
  292.     End Select
  293. End Sub
  294. Private Sub cmdHide_Click()
  295.     If cmdHide.Caption = "&Hide Cursor" Then
  296.         cmdHide.Caption = "&Show Cursor"
  297.         fCHidden& = ShowCursor&(0)
  298.     Else
  299.         cmdHide.Caption = "&Hide Cursor"
  300.         fCHidden& = ShowCursor&(1)
  301.     End If
  302. End Sub
  303. Public Sub cmdSetPos_Click()
  304.     Dim myPoint As POINTAPI
  305.     myPoint.x = 12
  306.     myPoint.Y = 12
  307.     dl& = ClientToScreen&(pctCursor.hwnd, myPoint)
  308.     dl& = SetCursorPos&(myPoint.x, myPoint.Y)
  309. End Sub
  310. Private Sub Form_Load()
  311.     Dim x&
  312.     x& = GetDoubleClickTime&()
  313.     lblDoubleClick = x& & " ms"
  314.     scrDoubleClick.Value = x& / -10
  315. End Sub
  316. Private Sub lblClipInfo_Click()
  317.     pctCursor_Click
  318. End Sub
  319. Private Sub pctCursor_Click()
  320.     If fCClipped& = True Then
  321.         dl& = ClipCursorBynum&(0)
  322.         cmdClip.Caption = "&Clip Cursor"
  323.         fCClipped& = False
  324.         pctCursor.Refresh
  325.         lblClipInfo.Visible = False
  326.     End If
  327. End Sub
  328. Private Sub pctCursor_MouseMove(Button As Integer, Shift As Integer, x As Single, Y As Single)
  329.     If fCHidden& = -1 And fTxtHidIt& Then 'Cursor is now hidden
  330.         fCHidden& = ShowCursor&(1)
  331.         fTxtHidIt& = False
  332.     End If
  333. End Sub
  334. Private Sub pctCursor_Paint()
  335.     pctCursor.Line (5, 5)-(20, 20)
  336.     pctCursor.Line (5, 20)-(20, 5)
  337.     If fCClipped& = True Then
  338.         With pctCursor
  339.             .DrawWidth = 2
  340.             pctCursor.Line (1, 1)-(.ScaleWidth - 1, .ScaleHeight - 1), , B
  341.             .DrawWidth = 1
  342.         End With
  343.     End If
  344. End Sub
  345. Private Sub pctDoubleClick_DblClick()
  346.     Static whichLight%
  347.     whichLight = whichLight + 1
  348.     If whichLight = 3 Then whichLight = 0
  349.     pctDoubleClick = picHolder(whichLight).Picture
  350. End Sub
  351. Private Sub scrDoubleClick_Change()
  352.     dl& = SetDoubleClickTime&(-1 * scrDoubleClick * 10)
  353.     lblDoubleClick = (-1 * scrDoubleClick * 10) & " ms"
  354. End Sub
  355. Private Sub scrDoubleClick_Scroll()
  356.     dl& = SetDoubleClickTime&(-1 * scrDoubleClick * 10)
  357.     lblDoubleClick = (-1 * scrDoubleClick * 10) & " ms"
  358. End Sub
  359. Private Sub txtCaret_KeyDown(KeyCode As Integer, Shift As Integer)
  360.     If fCHidden& = 0 Then 'Cursor is now shown
  361.         fTxtHidIt& = True
  362.         fCHidden& = ShowCursor&(0)
  363.     End If
  364. End Sub
  365. Private Sub txtCaret_MouseMove(Button As Integer, Shift As Integer, x As Single, Y As Single)
  366.     If fCHidden& = -1 And fTxtHidIt& Then 'Cursor is now hidden
  367.         fCHidden& = ShowCursor&(1)
  368.         fTxtHidIt& = False
  369.     End If
  370. End Sub
  371.