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 / articles / vbpj / source / evtprog2.frm (.txt) < prev    next >
Encoding:
Visual Basic Form  |  1996-01-29  |  7.7 KB  |  251 lines
  1. VERSION 4.00
  2. Begin VB.Form Form1 
  3.    Appearance      =   0  'Flat
  4.    BackColor       =   &H80000005&
  5.    Caption         =   "Architecting Event Driven Code"
  6.    ClientHeight    =   3900
  7.    ClientLeft      =   1095
  8.    ClientTop       =   1485
  9.    ClientWidth     =   5580
  10.    BeginProperty Font 
  11.       name            =   "MS Sans Serif"
  12.       charset         =   1
  13.       weight          =   700
  14.       size            =   8.25
  15.       underline       =   0   'False
  16.       italic          =   0   'False
  17.       strikethrough   =   0   'False
  18.    EndProperty
  19.    ForeColor       =   &H80000008&
  20.    Height          =   4305
  21.    Left            =   1035
  22.    LinkTopic       =   "Form1"
  23.    ScaleHeight     =   3900
  24.    ScaleWidth      =   5580
  25.    Top             =   1140
  26.    Width           =   5700
  27.    Begin VB.CommandButton Command7 
  28.       Appearance      =   0  'Flat
  29.       BackColor       =   &H80000005&
  30.       Caption         =   "Cancel Timer"
  31.       Height          =   435
  32.       Left            =   3060
  33.       TabIndex        =   7
  34.       Top             =   3360
  35.       Width           =   1755
  36.    End
  37.    Begin VB.Timer Timer1 
  38.       Enabled         =   0   'False
  39.       Interval        =   1
  40.       Left            =   180
  41.       Top             =   2940
  42.    End
  43.    Begin VB.CommandButton Command6 
  44.       Appearance      =   0  'Flat
  45.       BackColor       =   &H80000005&
  46.       Caption         =   "With Timer"
  47.       Height          =   435
  48.       Left            =   3060
  49.       TabIndex        =   6
  50.       Top             =   2880
  51.       Width           =   1755
  52.    End
  53.    Begin VB.CommandButton Command5 
  54.       Appearance      =   0  'Flat
  55.       BackColor       =   &H80000005&
  56.       Caption         =   "With DoEvents III"
  57.       Height          =   495
  58.       Left            =   3060
  59.       TabIndex        =   5
  60.       Top             =   2340
  61.       Width           =   1755
  62.    End
  63.    Begin VB.CommandButton Command4 
  64.       Appearance      =   0  'Flat
  65.       BackColor       =   &H80000005&
  66.       Caption         =   "With DoEvents II"
  67.       Height          =   495
  68.       Left            =   3060
  69.       TabIndex        =   4
  70.       Top             =   1800
  71.       Width           =   1755
  72.    End
  73.    Begin VB.CommandButton Command3 
  74.       Appearance      =   0  'Flat
  75.       BackColor       =   &H80000005&
  76.       Caption         =   "With DoEvents"
  77.       Height          =   495
  78.       Left            =   3060
  79.       TabIndex        =   3
  80.       Top             =   1260
  81.       Width           =   1755
  82.    End
  83.    Begin VB.CommandButton Command2 
  84.       Appearance      =   0  'Flat
  85.       BackColor       =   &H80000005&
  86.       Caption         =   "Escape Check"
  87.       Height          =   495
  88.       Left            =   3060
  89.       TabIndex        =   2
  90.       Top             =   720
  91.       Width           =   1755
  92.    End
  93.    Begin VB.CommandButton Command1 
  94.       Appearance      =   0  'Flat
  95.       BackColor       =   &H80000005&
  96.       Caption         =   "No DoEvents"
  97.       Height          =   495
  98.       Left            =   3060
  99.       TabIndex        =   1
  100.       Top             =   180
  101.       Width           =   1755
  102.    End
  103.    Begin VB.Label Label1 
  104.       Appearance      =   0  'Flat
  105.       BackColor       =   &H00FFFFFF&
  106.       Caption         =   "Label1"
  107.       BeginProperty Font 
  108.          name            =   "MS Sans Serif"
  109.          charset         =   1
  110.          weight          =   700
  111.          size            =   24
  112.          underline       =   0   'False
  113.          italic          =   0   'False
  114.          strikethrough   =   0   'False
  115.       EndProperty
  116.       ForeColor       =   &H80000008&
  117.       Height          =   675
  118.       Left            =   300
  119.       TabIndex        =   0
  120.       Top             =   420
  121.       Width           =   2295
  122.    End
  123. Attribute VB_Name = "Form1"
  124. Attribute VB_Creatable = False
  125. Attribute VB_Exposed = False
  126. Option Explicit
  127. ' With no events allowed, not only are further clicks
  128. ' not acted upon, but they are queued up for later - leaving
  129. ' to results confusing to the user.
  130. Private Sub Command1_Click()
  131.     Dim x&
  132.     For x& = 1 To LOOPCOUNT
  133.         If x& = 500 Then ToggleColor
  134.         label1.Caption = Str$(x&)
  135.         label1.Refresh
  136.     Next x&
  137. End Sub
  138. ' A classic DOS approach is to check for a key such as
  139. ' the escape key.  But this still allows queued events
  140. ' to pile up.
  141. Private Sub Command2_Click()
  142.     Dim x&
  143.     Dim EscapeKey%
  144.     ' Clear the current state
  145.     EscapeKey% = GetAsyncKeyState(VK_ESCAPE)
  146.     For x& = 1 To LOOPCOUNT
  147.         If x& = 500 Then ToggleColor
  148.         label1.Caption = Str$(x&)
  149.         label1.Refresh
  150.         EscapeKey% = GetAsyncKeyState(VK_ESCAPE)
  151.         If EscapeKey% And 1 Then Exit Sub
  152.     Next x&
  153. End Sub
  154. ' This time we place a DoEvents to allow events to be
  155. ' processed - but note the reentrancy problem!
  156. Private Sub Command3_Click()
  157.     Dim x&
  158.     For x& = 1 To LOOPCOUNT
  159.         label1.Caption = Str$(x&)
  160.         If x& = 500 Then ToggleColor
  161.         ' Note - we don't need the refresh any more
  162.         DoEvents
  163.     Next x&
  164. End Sub
  165. ' We can prevent reentrancy problems by disabling the form
  166. Private Sub Command4_Click()
  167.     Dim x&
  168.     ' The easy way is to disable the entire form
  169.     Form1.Enabled = False
  170.     ' Alternatively, you can disable each control
  171.     ' individually (it would look better)
  172.     For x& = 1 To LOOPCOUNT
  173.         label1.Caption = Str$(x&)
  174.         If x& = LOOPCOUNT Then ToggleColor
  175.         ' Note - we don't need the refresh any more
  176.         DoEvents
  177.     Next x&
  178.     ' And be sure to reenable the form when done
  179.     Form1.Enabled = True
  180. End Sub
  181. ' The disabling might look better if we do it one control
  182. ' at a time
  183. Private Sub Command5_Click()
  184.     Dim x&
  185.     Dim ctlnum%
  186.     ' Alternatively, you can disable each control
  187.     ' individually (it would look better)
  188.     For ctlnum% = 0 To Controls.Count - 1
  189.         If TypeOf Controls(ctlnum%) Is CommandButton Then
  190.             Controls(ctlnum%).Enabled = False
  191.         End If
  192.     Next ctlnum%
  193.     For x& = 1 To LOOPCOUNT
  194.         label1.Caption = Str$(x&)
  195.         If x& = LOOPCOUNT Then ToggleColor
  196.         ' Note - we don't need the refresh any more
  197.         DoEvents
  198.     Next x&
  199.     ' And be sure to reenable the controls when done
  200.     For ctlnum% = 0 To Controls.Count - 1
  201.         If TypeOf Controls(ctlnum%) Is CommandButton Then
  202.             Controls(ctlnum%).Enabled = True
  203.         End If
  204.     Next ctlnum%
  205.     Form1.Enabled = True
  206. End Sub
  207. Private Sub Command6_Click()
  208.     Dim di%
  209.     di% = PerformCount(0)
  210.     timer1.Enabled = True
  211. End Sub
  212. Private Sub Command7_Click()
  213.     timer1.Enabled = False
  214. End Sub
  215. ' This is a function designed to be reentrant without being
  216. ' recursive.
  217. ' mode is 0 to initialize the counter
  218. ' mode is 1 to continue counting
  219. ' Return value is 0 if counting is finished
  220. ' Return value is 1 to continue counting
  221. Private Function PerformCount%(mode As Integer)
  222.     Static counter&
  223.     Select Case mode
  224.         Case 0
  225.                 counter& = 0
  226.         Case 1
  227.                 counter& = counter& + 1
  228.     End Select
  229.     If counter& = LOOPCOUNT Then
  230.         ToggleColor
  231.         PerformCount% = 0
  232.     Else
  233.         PerformCount% = 1
  234.     End If
  235.     label1.Caption = Str$(counter&)
  236. End Function
  237. Private Sub Timer1_Timer()
  238.     Dim res%
  239.     res% = PerformCount(1)
  240.     ' Once the termination condition is reached, shut off
  241.     ' the timer
  242.     If res% = 0 Then timer1.Enabled = False
  243. End Sub
  244. Private Sub ToggleColor()
  245.     If label1.BackColor = QBColor(15) Then
  246.         label1.BackColor = QBColor(11)
  247.     Else
  248.         label1.BackColor = QBColor(15)
  249.     End If
  250. End Sub
  251.