home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Programming Tool Box
/
SIMS_2.iso
/
vb_code1
/
infocus
/
demo.frm
< prev
next >
Wrap
Text File
|
1994-04-07
|
21KB
|
643 lines
VERSION 2.00
Begin Form Form1
BackColor = &H00C0C0C0&
Caption = "Employee Information"
ClientHeight = 3660
ClientLeft = 1290
ClientTop = 1725
ClientWidth = 7095
Height = 4350
Icon = DEMO.FRX:0000
Left = 1230
LinkTopic = "Form1"
ScaleHeight = 3660
ScaleWidth = 7095
Top = 1095
Width = 7215
Begin PictureBox picEventInfo
BackColor = &H00C0C0C0&
BorderStyle = 0 'None
Height = 615
Left = 2760
ScaleHeight = 615
ScaleWidth = 3975
TabIndex = 25
TabStop = 0 'False
Top = 2520
Visible = 0 'False
Width = 3975
Begin Label lblEventCaption
Alignment = 1 'Right Justify
BackColor = &H00C0C0C0&
BackStyle = 0 'Transparent
Caption = "Event:"
Height = 255
Left = 0
TabIndex = 20
Top = 0
Width = 1095
End
Begin Label lblControlCaption
Alignment = 1 'Right Justify
BackColor = &H00C0C0C0&
BackStyle = 0 'Transparent
Caption = "Control:"
Height = 255
Left = 0
TabIndex = 21
Top = 240
Width = 1095
End
Begin Label lblEvent
BackColor = &H00C0C0C0&
BackStyle = 0 'Transparent
ForeColor = &H00000000&
Height = 255
Left = 1200
TabIndex = 22
Top = 0
Width = 2775
End
Begin Label lblControl
BackColor = &H00C0C0C0&
BackStyle = 0 'Transparent
ForeColor = &H00000000&
Height = 255
Left = 1200
TabIndex = 23
Top = 240
Width = 2775
End
End
Begin CheckBox chkShowEvents
BackColor = &H00C0C0C0&
Caption = "Show VB Events"
Height = 255
Left = 240
TabIndex = 24
TabStop = 0 'False
Top = 2520
Width = 1815
End
Begin TextBox txtZip
FontBold = -1 'True
FontItalic = 0 'False
FontName = "MS Sans Serif"
FontSize = 9.75
FontStrikethru = 0 'False
FontUnderline = 0 'False
Height = 360
Left = 3960
TabIndex = 18
Tag = "Enter the employee's zip code"
Top = 2040
Width = 1455
End
Begin TextBox txtState
FontBold = -1 'True
FontItalic = 0 'False
FontName = "MS Sans Serif"
FontSize = 9.75
FontStrikethru = 0 'False
FontUnderline = 0 'False
Height = 360
Left = 3240
TabIndex = 16
Tag = "Enter the employee's state"
Top = 2040
Width = 615
End
Begin TextBox txtCity
FontBold = -1 'True
FontItalic = 0 'False
FontName = "MS Sans Serif"
FontSize = 9.75
FontStrikethru = 0 'False
FontUnderline = 0 'False
Height = 360
Left = 240
TabIndex = 14
Tag = "Enter the employee's city"
Top = 2040
Width = 2895
End
Begin TextBox txtAddress
FontBold = -1 'True
FontItalic = 0 'False
FontName = "MS Sans Serif"
FontSize = 9.75
FontStrikethru = 0 'False
FontUnderline = 0 'False
Height = 360
Left = 240
TabIndex = 12
Tag = "Enter the employee's street address"
Top = 1440
Width = 5175
End
Begin InFocus InFocus1
Left = 240
Top = 2880
End
Begin TextBox txtLastName
FontBold = -1 'True
FontItalic = 0 'False
FontName = "MS Sans Serif"
FontSize = 9.75
FontStrikethru = 0 'False
FontUnderline = 0 'False
Height = 360
Left = 240
TabIndex = 0
Tag = "Enter the employee's last name"
Top = 840
Width = 2895
End
Begin PictureBox picButtonBar
Align = 1 'Align Top
BackColor = &H00C0C0C0&
BorderStyle = 0 'None
Height = 525
Left = 0
ScaleHeight = 525
ScaleWidth = 7095
TabIndex = 5
TabStop = 0 'False
Top = 0
Width = 7095
Begin CommandButton btnLocate
BackColor = &H00C0C0C0&
Caption = "&Locate"
FontBold = -1 'True
FontItalic = 0 'False
FontName = "MS Sans Serif"
FontSize = 9.75
FontStrikethru = 0 'False
FontUnderline = 0 'False
Height = 495
Left = 3240
TabIndex = 9
TabStop = 0 'False
Tag = "Locate a specific employee"
Top = 0
Width = 1095
End
Begin CommandButton btnSave
BackColor = &H00C0C0C0&
Caption = "&Save"
FontBold = -1 'True
FontItalic = 0 'False
FontName = "MS Sans Serif"
FontSize = 9.75
FontStrikethru = 0 'False
FontUnderline = 0 'False
Height = 495
Left = 2160
TabIndex = 8
TabStop = 0 'False
Tag = "Save any changes"
Top = 0
Width = 1095
End
Begin CommandButton btnDelete
BackColor = &H00C0C0C0&
Caption = "&Delete"
FontBold = -1 'True
FontItalic = 0 'False
FontName = "MS Sans Serif"
FontSize = 9.75
FontStrikethru = 0 'False
FontUnderline = 0 'False
Height = 495
Left = 1080
TabIndex = 7
TabStop = 0 'False
Tag = "Delete the current employee"
Top = 0
Width = 1095
End
Begin CommandButton btnAdd
BackColor = &H00C0C0C0&
Caption = "&Add"
FontBold = -1 'True
FontItalic = 0 'False
FontName = "MS Sans Serif"
FontSize = 9.75
FontStrikethru = 0 'False
FontUnderline = 0 'False
Height = 495
Left = 0
TabIndex = 6
TabStop = 0 'False
Tag = "Add a new employee"
Top = 0
Width = 1095
End
Begin Label Label1
BackStyle = 0 'Transparent
Caption = "InFocus Demo"
FontBold = -1 'True
FontItalic = 0 'False
FontName = "MS Sans Serif"
FontSize = 15
FontStrikethru = 0 'False
FontUnderline = -1 'True
Height = 375
Left = 4560
TabIndex = 11
Top = 120
Width = 2295
End
End
Begin TextBox txtFirstName
FontBold = -1 'True
FontItalic = 0 'False
FontName = "MS Sans Serif"
FontSize = 9.75
FontStrikethru = 0 'False
FontUnderline = 0 'False
Height = 360
Left = 3240
TabIndex = 1
Tag = "Enter the employee's first name and middle initial"
Top = 840
Width = 2175
End
Begin PictureBox picHelp
Align = 2 'Align Bottom
BackColor = &H00C0C0C0&
Height = 300
Left = 0
ScaleHeight = 270
ScaleWidth = 7065
TabIndex = 2
TabStop = 0 'False
Top = 3360
Width = 7095
Begin Label lblHelp
BackColor = &H00C0C0C0&
BackStyle = 0 'Transparent
FontBold = -1 'True
FontItalic = 0 'False
FontName = "MS Sans Serif"
FontSize = 9.75
FontStrikethru = 0 'False
FontUnderline = 0 'False
Height = 255
Left = 120
TabIndex = 3
Top = 0
Width = 6735
End
End
Begin Label lblZip
BackColor = &H00C0C0C0&
BackStyle = 0 'Transparent
Caption = "Zip Code:"
FontBold = -1 'True
FontItalic = 0 'False
FontName = "MS Sans Serif"
FontSize = 9.75
FontStrikethru = 0 'False
FontUnderline = 0 'False
Height = 255
Left = 3960
TabIndex = 19
Top = 1800
Width = 1335
End
Begin Label lblState
BackColor = &H00C0C0C0&
BackStyle = 0 'Transparent
Caption = "State:"
FontBold = -1 'True
FontItalic = 0 'False
FontName = "MS Sans Serif"
FontSize = 9.75
FontStrikethru = 0 'False
FontUnderline = 0 'False
Height = 255
Left = 3240
TabIndex = 17
Top = 1800
Width = 735
End
Begin Label lblCity
BackColor = &H00C0C0C0&
BackStyle = 0 'Transparent
Caption = "City:"
FontBold = -1 'True
FontItalic = 0 'False
FontName = "MS Sans Serif"
FontSize = 9.75
FontStrikethru = 0 'False
FontUnderline = 0 'False
Height = 255
Left = 240
TabIndex = 15
Top = 1800
Width = 1335
End
Begin Label lblAddress
BackColor = &H00C0C0C0&
BackStyle = 0 'Transparent
Caption = "Address:"
FontBold = -1 'True
FontItalic = 0 'False
FontName = "MS Sans Serif"
FontSize = 9.75
FontStrikethru = 0 'False
FontUnderline = 0 'False
Height = 255
Left = 240
TabIndex = 13
Top = 1200
Width = 1335
End
Begin Label lblLastName
BackColor = &H00C0C0C0&
BackStyle = 0 'Transparent
Caption = "Last Name:"
FontBold = -1 'True
FontItalic = 0 'False
FontName = "MS Sans Serif"
FontSize = 9.75
FontStrikethru = 0 'False
FontUnderline = 0 'False
Height = 255
Left = 240
TabIndex = 10
Top = 600
Width = 1335
End
Begin Label lblFirstName
BackColor = &H00C0C0C0&
BackStyle = 0 'Transparent
Caption = "First Name:"
FontBold = -1 'True
FontItalic = 0 'False
FontName = "MS Sans Serif"
FontSize = 9.75
FontStrikethru = 0 'False
FontUnderline = 0 'False
Height = 255
Left = 3240
TabIndex = 4
Top = 600
Width = 1335
End
Begin Menu mnuFile
Caption = "&File"
Begin Menu mnuFilePrint
Caption = "&Print..."
Shortcut = ^P
End
Begin Menu mnuFilePrintSetup
Caption = "Print &Setup..."
End
Begin Menu mnuFileSep1
Caption = "-"
End
Begin Menu mnuFileExit
Caption = "E&xit"
End
End
Begin Menu mnuEdit
Caption = "&Edit"
Begin Menu mnuEditUndo
Caption = "&Undo"
Shortcut = ^Z
End
Begin Menu mnuEditSep1
Caption = "-"
End
Begin Menu mnuEditCut
Caption = "Cu&t"
Shortcut = ^X
End
Begin Menu mnuEditCopy
Caption = "&Copy"
Shortcut = ^C
End
Begin Menu mnuEditPaste
Caption = "&Paste"
Shortcut = ^V
End
Begin Menu mnuEditDelete
Caption = "&Delete"
Shortcut = {DEL}
End
End
Begin Menu mnuHelp
Caption = "&Help"
Begin Menu mnuHelpContents
Caption = "&Contents"
End
Begin Menu mnuHelpSearch
Caption = "&Search for Help on..."
End
Begin Menu mnuHelpHelp
Caption = "&How to Use Help"
End
Begin Menu mnuHelpSep1
Caption = "-"
End
Begin Menu mnuHelpAbout
Caption = "&About Employee Information..."
End
End
End
Option Explicit
Declare Function WinHelp Lib "User" (ByVal hWnd As Integer, ByVal lpHelpFile As String, ByVal wCommand As Integer, dwData As Any) As Integer
Dim ctlFocus As Control
Sub btnAdd_Click ()
ctlFocus.SetFocus
DoEvents
lblHelp = "Adding a new employeee..."
End Sub
Sub btnAdd_MouseUp (Button As Integer, Shift As Integer, X As Single, Y As Single)
ctlFocus.SetFocus
End Sub
Sub btnDelete_Click ()
ctlFocus.SetFocus
DoEvents
lblHelp = "The employee has been deleted..."
End Sub
Sub btnDelete_MouseUp (Button As Integer, Shift As Integer, X As Single, Y As Single)
ctlFocus.SetFocus
End Sub
Sub btnLocate_Click ()
ctlFocus.SetFocus
DoEvents
lblHelp = "The employee has been located..."
End Sub
Sub btnLocate_MouseUp (Button As Integer, Shift As Integer, X As Single, Y As Single)
ctlFocus.SetFocus
End Sub
Sub btnSave_Click ()
ctlFocus.SetFocus
DoEvents
lblHelp = "Changes have been saved..."
End Sub
Sub btnSave_MouseUp (Button As Integer, Shift As Integer, X As Single, Y As Single)
ctlFocus.SetFocus
End Sub
Sub chkShowEvents_Click ()
picEventInfo.Visible = chkShowEvents
ctlFocus.SetFocus
End Sub
Sub chkShowEvents_MouseUp (Button As Integer, Shift As Integer, X As Single, Y As Single)
ctlFocus.SetFocus
End Sub
Sub Form_Load ()
Set ctlFocus = txtLastName
lblHelp = ctlFocus.Tag
End Sub
Sub InFocus1_FocusChange (ctlName As String, CtlIndex As Integer, CtlTag As String, CtlHwnd As Integer)
lblEvent = "FocusChange"
lblControl = ctlName
Select Case ctlName
Case "txtLastName"
Set ctlFocus = txtLastName
Case "txtFirstName"
Set ctlFocus = txtFirstName
Case "txtAddress"
Set ctlFocus = txtAddress
Case "txtCity"
Set ctlFocus = txtCity
Case "txtState"
Set ctlFocus = txtState
Case "txtZip"
Set ctlFocus = txtZip
End Select
lblHelp = CtlTag
End Sub
Sub InFocus1_MenuSelect (MenuText As String)
lblEvent = "MenuSelect"
lblControl = StripTabs(MenuText)
Select Case MenuText
Case "&File"
lblHelp = "Print, Printer Setup, Exit..."
Case "&Print..." & Chr(9) & "Ctrl+P"
lblHelp = "Print the current form"
Case "Print &Setup..."
lblHelp = "Select a printer or change printer settings"
Case "E&xit"
lblHelp = "Exit Employee Information"
Case "&Edit"
lblHelp = "Make editing changes to the current field"
Case "&Undo" & Chr(9) & "Ctrl+Z"
lblHelp = "Undo the last change"
Case "Cu&t" & Chr(9) & "Ctrl+X"
lblHelp = "Delete selected text and copy it to the clipboard"
Case "&Copy" & Chr(9) & "Ctrl+C"
lblHelp = "Copy selected text to the clipboard"
Case "&Paste" & Chr(9) & "Ctrl+V"
lblHelp = "Insert the contents of the clipboard"
Case "&Delete" & Chr(9) & "Del"
lblHelp = "Delete selected text"
Case "&Help"
lblHelp = "Receive detailed help"
Case "&Contents"
lblHelp = "Show the help table of contents"
Case "&Search for Help on..."
lblHelp = "Search for help on specific keywords"
Case "&How to Use Help"
lblHelp = "Instructions on using Windows Help"
Case "&About Employee Information..."
lblHelp = "Display version number and other information"
Case "[CANCEL]"
lblHelp = ctlFocus.Tag
Case "[SYSMENU]"
lblHelp = "Do stuff to the window"
Case "&Restore"
lblHelp = "Restore window to previous size"
Case "&Move"
lblHelp = "Move the window"
Case "&Size"
lblHelp = "Size the window"
Case "Mi&nimize"
lblHelp = "Reduce the window to an icon"
Case "Ma&ximize"
lblHelp = "Make the window full-screen"
Case "&Close" & Chr(9) & "Alt+F4"
lblHelp = "Close the window"
Case "S&witch To..." & Chr(9) & "Ctrl+Esc"
lblHelp = "Switch to another application"
Case "-"
lblHelp = "Are you pointing at a black line?"
Case Else
lblHelp = "No help available..."
End Select
End Sub
Sub InFocus1_MouseOver (ctlName As String, CtlIndex As Integer, CtlTag As String, CtlHwnd As Integer)
lblEvent = "MouseOver"
lblControl = ctlName
Select Case CtlHwnd
Case btnAdd.hWnd, btnDelete.hWnd, btnSave.hWnd, btnLocate.hWnd
lblHelp = CtlTag
Case Else
lblHelp = ctlFocus.Tag
End Select
End Sub
Sub mnuFileExit_Click ()
Unload Me
End Sub
Sub mnuHelpContents_Click ()
Dim ret As Integer
ret = WinHelp(Me.hWnd, App.Path & IIf(Right(App.Path, 1) = "\", "", "\") & "INFOCUS.HLP", 3, 0)
End Sub
Sub mnuHelpHelp_Click ()
Dim ret As Integer
ret = WinHelp(Me.hWnd, App.Path & IIf(Right(App.Path, 1) = "\", "", "\") & "INFOCUS.HLP", 4, 0)
End Sub
Sub mnuHelpSearch_Click ()
Dim ret As Integer, lpNullStr As Long
ret = WinHelp(Me.hWnd, App.Path & IIf(Right(App.Path, 1) = "\", "", "\") & "INFOCUS.HLP", 261, lpNullStr)
End Sub
Sub picButtonBar_GotFocus ()
ctlFocus.SetFocus
End Sub
Sub picEventInfo_GotFocus ()
ctlFocus.SetFocus
End Sub
Sub picHelp_GotFocus ()
ctlFocus.SetFocus
End Sub
Function StripTabs (arg As String)
Dim ret As String
Dim pos As Integer
ret = arg
pos = InStr(ret, Chr(9))
While pos > 0
Mid(ret, pos, 1) = " "
pos = InStr(ret, Chr(9))
Wend
StripTabs = ret
End Function
