home *** CD-ROM | disk | FTP | other *** search
/ Planet Source Code Jumbo …e CD Visual Basic 1 to 7 / 3_2004-2005.ISO / Data / Zips / Easy_Ballo18282312112004.psc / frmAbout.frm < prev    next >
Text File  |  2004-12-11  |  15KB  |  396 lines

  1. VERSION 5.00
  2. Begin VB.Form frmAbout 
  3.    BorderStyle     =   3  'Fixed Dialog
  4.    Caption         =   "About Easy Tool Tip Class"
  5.    ClientHeight    =   4485
  6.    ClientLeft      =   2340
  7.    ClientTop       =   1935
  8.    ClientWidth     =   7485
  9.    ClipControls    =   0   'False
  10.    Icon            =   "frmAbout.frx":0000
  11.    LinkTopic       =   "Form2"
  12.    MaxButton       =   0   'False
  13.    MinButton       =   0   'False
  14.    ScaleHeight     =   3095.626
  15.    ScaleMode       =   0  'User
  16.    ScaleWidth      =   7028.802
  17.    ShowInTaskbar   =   0   'False
  18.    Begin VB.TextBox websiteLabel 
  19.       Alignment       =   2  'Center
  20.       BackColor       =   &H8000000F&
  21.       BorderStyle     =   0  'None
  22.       BeginProperty Font 
  23.          Name            =   "Tahoma"
  24.          Size            =   12
  25.          Charset         =   0
  26.          Weight          =   700
  27.          Underline       =   0   'False
  28.          Italic          =   0   'False
  29.          Strikethrough   =   0   'False
  30.       EndProperty
  31.       ForeColor       =   &H00FF0000&
  32.       Height          =   405
  33.       Left            =   120
  34.       Locked          =   -1  'True
  35.       MouseIcon       =   "frmAbout.frx":1272
  36.       MousePointer    =   99  'Custom
  37.       MultiLine       =   -1  'True
  38.       TabIndex        =   7
  39.       TabStop         =   0   'False
  40.       Text            =   "frmAbout.frx":157C
  41.       Top             =   4080
  42.       Width           =   4815
  43.    End
  44.    Begin VB.TextBox EmailLabel 
  45.       Alignment       =   2  'Center
  46.       BackColor       =   &H8000000F&
  47.       BorderStyle     =   0  'None
  48.       BeginProperty Font 
  49.          Name            =   "Tahoma"
  50.          Size            =   12
  51.          Charset         =   0
  52.          Weight          =   700
  53.          Underline       =   0   'False
  54.          Italic          =   0   'False
  55.          Strikethrough   =   0   'False
  56.       EndProperty
  57.       ForeColor       =   &H00FF0000&
  58.       Height          =   375
  59.       Left            =   0
  60.       Locked          =   -1  'True
  61.       MouseIcon       =   "frmAbout.frx":158B
  62.       MousePointer    =   99  'Custom
  63.       MultiLine       =   -1  'True
  64.       TabIndex        =   6
  65.       TabStop         =   0   'False
  66.       Text            =   "frmAbout.frx":1895
  67.       Top             =   3720
  68.       Width           =   5055
  69.    End
  70.    Begin VB.TextBox Text2 
  71.       Alignment       =   2  'Center
  72.       Appearance      =   0  'Flat
  73.       BackColor       =   &H8000000F&
  74.       BorderStyle     =   0  'None
  75.       BeginProperty Font 
  76.          Name            =   "Tahoma"
  77.          Size            =   12
  78.          Charset         =   0
  79.          Weight          =   700
  80.          Underline       =   0   'False
  81.          Italic          =   0   'False
  82.          Strikethrough   =   0   'False
  83.       EndProperty
  84.       ForeColor       =   &H00004080&
  85.       Height          =   615
  86.       Left            =   120
  87.       MultiLine       =   -1  'True
  88.       TabIndex        =   5
  89.       TabStop         =   0   'False
  90.       Text            =   "frmAbout.frx":18B3
  91.       Top             =   3120
  92.       Width           =   4815
  93.    End
  94.    Begin VB.TextBox Text1 
  95.       Appearance      =   0  'Flat
  96.       BackColor       =   &H8000000F&
  97.       BorderStyle     =   0  'None
  98.       BeginProperty Font 
  99.          Name            =   "Tahoma"
  100.          Size            =   8.25
  101.          Charset         =   0
  102.          Weight          =   400
  103.          Underline       =   0   'False
  104.          Italic          =   0   'False
  105.          Strikethrough   =   0   'False
  106.       EndProperty
  107.       Height          =   2055
  108.       Left            =   2280
  109.       Locked          =   -1  'True
  110.       MultiLine       =   -1  'True
  111.       ScrollBars      =   2  'Vertical
  112.       TabIndex        =   4
  113.       TabStop         =   0   'False
  114.       Text            =   "frmAbout.frx":18DF
  115.       Top             =   840
  116.       Width           =   5055
  117.    End
  118.    Begin VB.PictureBox MarkPic 
  119.       AutoSize        =   -1  'True
  120.       ClipControls    =   0   'False
  121.       Height          =   2685
  122.       Left            =   120
  123.       ScaleHeight     =   1843.625
  124.       ScaleMode       =   0  'User
  125.       ScaleWidth      =   1411.69
  126.       TabIndex        =   1
  127.       TabStop         =   0   'False
  128.       Top             =   240
  129.       Width           =   2070
  130.    End
  131.    Begin VB.CommandButton cmdOK 
  132.       BackColor       =   &H00C0C0C0&
  133.       Cancel          =   -1  'True
  134.       Caption         =   "OK"
  135.       Default         =   -1  'True
  136.       BeginProperty Font 
  137.          Name            =   "MS Sans Serif"
  138.          Size            =   9.75
  139.          Charset         =   0
  140.          Weight          =   700
  141.          Underline       =   0   'False
  142.          Italic          =   0   'False
  143.          Strikethrough   =   0   'False
  144.       EndProperty
  145.       Height          =   945
  146.       Left            =   5640
  147.       MouseIcon       =   "frmAbout.frx":1AFC
  148.       MousePointer    =   99  'Custom
  149.       Picture         =   "frmAbout.frx":1E06
  150.       Style           =   1  'Graphical
  151.       TabIndex        =   0
  152.       Top             =   3360
  153.       Width           =   1260
  154.    End
  155.    Begin VB.Line Line1 
  156.       BorderColor     =   &H00808080&
  157.       BorderStyle     =   6  'Inside Solid
  158.       Index           =   1
  159.       X1              =   112.686
  160.       X2              =   6873.858
  161.       Y1              =   2070.653
  162.       Y2              =   2070.653
  163.    End
  164.    Begin VB.Label lblTitle 
  165.       Caption         =   "Easy Tool Tip Class"
  166.       BeginProperty Font 
  167.          Name            =   "Tahoma"
  168.          Size            =   9.75
  169.          Charset         =   0
  170.          Weight          =   700
  171.          Underline       =   0   'False
  172.          Italic          =   0   'False
  173.          Strikethrough   =   0   'False
  174.       EndProperty
  175.       ForeColor       =   &H00808000&
  176.       Height          =   360
  177.       Left            =   2280
  178.       TabIndex        =   2
  179.       Top             =   240
  180.       Width           =   4995
  181.    End
  182.    Begin VB.Line Line1 
  183.       BorderColor     =   &H00FFFFFF&
  184.       BorderWidth     =   2
  185.       Index           =   0
  186.       X1              =   112.686
  187.       X2              =   6873.858
  188.       Y1              =   2070.653
  189.       Y2              =   2070.653
  190.    End
  191.    Begin VB.Label lblVersion 
  192.       Caption         =   "Version 0.1.X (Development)"
  193.       Height          =   225
  194.       Left            =   2280
  195.       TabIndex        =   3
  196.       Top             =   600
  197.       Width           =   4995
  198.    End
  199. End
  200. Attribute VB_Name = "frmAbout"
  201. Attribute VB_GlobalNameSpace = False
  202. Attribute VB_Creatable = False
  203. Attribute VB_PredeclaredId = True
  204. Attribute VB_Exposed = False
  205.     '**************************************************************
  206.     '
  207.     '   My standard About form
  208.     '
  209.     '   Mark Mokoski
  210.     '   04-SEPT-2002
  211.     '
  212.     '   Based on standard MSDN About form, with custom addtions
  213.     '
  214.     '**************************************************************
  215.  
  216.     Option Explicit
  217.  
  218.     ' Reg Key Security Options...
  219.     Const READ_CONTROL = &H20000
  220.     Const KEY_QUERY_VALUE = &H1
  221.     Const KEY_SET_VALUE = &H2
  222.     Const KEY_CREATE_SUB_KEY = &H4
  223.     Const KEY_ENUMERATE_SUB_KEYS = &H8
  224.     Const KEY_NOTIFY = &H10
  225.     Const KEY_CREATE_LINK = &H20
  226.     Const KEY_ALL_ACCESS = KEY_QUERY_VALUE + KEY_SET_VALUE + _
  227.     KEY_CREATE_SUB_KEY + KEY_ENUMERATE_SUB_KEYS + _
  228.     KEY_NOTIFY + KEY_CREATE_LINK + READ_CONTROL
  229.                      
  230.     ' Reg Key ROOT Types...
  231.     Const HKEY_LOCAL_MACHINE = &H80000002
  232.     Const ERROR_SUCCESS = 0
  233.     Const REG_SZ = 1                         ' Unicode nul terminated string
  234.     Const REG_DWORD = 4                      ' 32-bit number
  235.  
  236.     Const gREGKEYSYSINFOLOC = "SOFTWARE\Microsoft\Shared Tools Location"
  237.     Const gREGVALSYSINFOLOC = "MSINFO"
  238.     Const gREGKEYSYSINFO = "SOFTWARE\Microsoft\Shared Tools\MSINFO"
  239.     Const gREGVALSYSINFO = "PATH"
  240.  
  241.     Private Declare Function RegOpenKeyEx Lib "advapi32" Alias "RegOpenKeyExA" (ByVal hKey As Long, ByVal lpSubKey As String, ByVal ulOptions As Long, ByVal samDesired As Long, ByRef phkResult As Long) As Long
  242.     Private Declare Function RegQueryValueEx Lib "advapi32" Alias "RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, ByRef lpType As Long, ByVal lpData As String, ByRef lpcbData As Long) As Long
  243.     Private Declare Function RegCloseKey Lib "advapi32" (ByVal hKey As Long) As Long
  244.  
  245.     'Create the Balloon tool tips
  246.     Dim EmailLabeltip              As New clsTooltips
  247.     Dim WebSiteLabelTip            As New clsTooltips
  248.  
  249.  
  250.  
  251.  
  252. Private Sub cmdOK_Click()
  253.  
  254.     Unload Me
  255.  
  256. End Sub
  257.  
  258. Private Sub emailLabel_Click()
  259.  
  260.     'Sample call:
  261.     'ShellExecute hWnd, vbNullString, "mailto:user@domain.com?body=hello%0a%0world", vbNullString, vbNullString, vbNormalFocus
  262.     ShellExecute hWnd, vbNullString, "mailto:markm@cmtelephone.com?Subject=Questions or Comments on WA1ZEK's DX Cluster Telnet Client Software.", vbNullString, vbNullString, vbNormalFocus
  263.   
  264.     'In order to be able to put carriage returns or tabs in your text,
  265.     'replace vbCrLf and vbTab with the following HEX codes:
  266.     '%0a%0d = vbCrLf
  267.     '%09 = vbTab
  268.     'These codes also work when sending URLs to a browser (GET, POST, etc.)
  269.    
  270.     
  271. End Sub
  272.  
  273.  
  274. Private Sub Form_Load()
  275.  
  276.     Me.Caption = "About " & App.Title
  277.     lblVersion.Caption = "Version " & App.Major & "." & App.Minor & "." & App.Revision
  278.     lblTitle.Caption = App.Title
  279.     MarkPic.Picture = LoadResPicture(101, 0)
  280.     
  281.     'Make the Balloon ToolTips
  282.     EmailLabeltip.CreateBalloon EmailLabel, "Click to send Email to" + vbCrLf + "Mark Mokoski WA1ZEK / VK2IFH", "Email", tipiconinfo
  283.     WebSiteLabelTip.CreateBalloon websiteLabel, "Click to send Browser to my Web Site", "Web Site", tipiconinfo
  284.     
  285. End Sub
  286.  
  287. Public Sub StartSysInfo()
  288.  
  289.     On Error GoTo SysInfoErr
  290.   
  291.     Dim SysInfoPath            As String
  292.     
  293.     ' Try To Get System Info Program Path\Name From Registry...
  294.  
  295.         If GetKeyValue(HKEY_LOCAL_MACHINE, gREGKEYSYSINFO, gREGVALSYSINFO, SysInfoPath) Then
  296.             ' Try To Get System Info Program Path Only From Registry...
  297.         ElseIf GetKeyValue(HKEY_LOCAL_MACHINE, gREGKEYSYSINFOLOC, gREGVALSYSINFOLOC, SysInfoPath) Then
  298.             ' Validate Existance Of Known 32 Bit File Version
  299.  
  300.                 If (Dir(SysInfoPath & "\MSINFO32.EXE") <> "") Then
  301.                     SysInfoPath = SysInfoPath & "\MSINFO32.EXE"
  302.             
  303.                     ' Error - File Can Not Be Found...
  304.                 Else
  305.                     GoTo SysInfoErr
  306.                 End If
  307.  
  308.             ' Error - Registry Entry Can Not Be Found...
  309.         Else
  310.             GoTo SysInfoErr
  311.         End If
  312.     
  313.     Call Shell(SysInfoPath, vbNormalFocus)
  314.     
  315.     Exit Sub
  316. SysInfoErr:
  317.     MsgBox "System Information Is Unavailable At This Time", vbOKOnly
  318.  
  319. End Sub
  320.  
  321. Public Function GetKeyValue(KeyRoot As Long, KeyName As String, SubKeyRef As String, ByRef KeyVal As String) As Boolean
  322.  
  323.     Dim i                      As Long                                           ' Loop Counter
  324.     Dim rc                     As Long                                          ' Return Code
  325.     Dim hKey                   As Long                                        ' Handle To An Open Registry Key
  326.     Dim KeyValType             As Long                                  ' Data Type Of A Registry Key
  327.     Dim tmpVal                 As String                                    ' Tempory Storage For A Registry Key Value
  328.     Dim KeyValSize             As Long                                  ' Size Of Registry Key Variable
  329.  
  330.     '------------------------------------------------------------
  331.     ' Open RegKey Under KeyRoot {HKEY_LOCAL_MACHINE...}
  332.     '------------------------------------------------------------
  333.  
  334.     rc = RegOpenKeyEx(KeyRoot, KeyName, 0, KEY_ALL_ACCESS, hKey) ' Open Registry Key
  335.     
  336.         If (rc <> ERROR_SUCCESS) Then GoTo GetKeyError          ' Handle Error...
  337.     
  338.     tmpVal = String$(1024, 0)                             ' Allocate Variable Space
  339.     KeyValSize = 1024                                       ' Mark Variable Size
  340.     
  341.     '------------------------------------------------------------
  342.     ' Retrieve Registry Key Value...
  343.     '------------------------------------------------------------
  344.     rc = RegQueryValueEx(hKey, SubKeyRef, 0, _
  345.     KeyValType, tmpVal, KeyValSize)    ' Get/Create Key Value
  346.                         
  347.         If (rc <> ERROR_SUCCESS) Then GoTo GetKeyError          ' Handle Errors
  348.     
  349.         If (Asc(Mid(tmpVal, KeyValSize, 1)) = 0) Then           ' Win95 Adds Null Terminated String...
  350.             tmpVal = Left(tmpVal, KeyValSize - 1)               ' Null Found, Extract From String
  351.         Else                                                    ' WinNT Does NOT Null Terminate String...
  352.             tmpVal = Left(tmpVal, KeyValSize)                   ' Null Not Found, Extract String Only
  353.         End If
  354.  
  355.     '------------------------------------------------------------
  356.     ' Determine Key Value Type For Conversion...
  357.     '------------------------------------------------------------
  358.  
  359.         Select Case KeyValType                                  ' Search Data Types...
  360.             Case REG_SZ                                             ' String Registry Key Data Type
  361.                 KeyVal = tmpVal                                     ' Copy String Value
  362.             Case REG_DWORD                                          ' Double Word Registry Key Data Type
  363.  
  364.                 For i = Len(tmpVal) To 1 Step -1                    ' Convert Each Bit
  365.                     KeyVal = KeyVal + Hex(Asc(Mid(tmpVal, i, 1)))   ' Build Value Char. By Char.
  366.                 Next
  367.  
  368.             KeyVal = Format$("&h" + KeyVal)                     ' Convert Double Word To String
  369.         End Select
  370.     
  371.     GetKeyValue = True                                      ' Return Success
  372.     rc = RegCloseKey(hKey)                                  ' Close Registry Key
  373.     Exit Function                                           ' Exit
  374.     
  375. GetKeyError:                      ' Cleanup After An Error Has Occured...
  376.     KeyVal = ""                                             ' Set Return Val To Empty String
  377.     GetKeyValue = False                                     ' Return Failure
  378.     rc = RegCloseKey(hKey)                                  ' Close Registry Key
  379.  
  380. End Function
  381.  
  382. Private Sub websiteLabel_Click()
  383.  
  384.     'Sample call:
  385.     'ShellExecute hWnd, vbNullString, "mailto:user@domain.com?body=hello%0a%0world", vbNullString, vbNullString, vbNormalFocus
  386.     ShellExecute hWnd, vbNullString, "http://www.rjillc.com", vbNullString, vbNullString, vbNormalFocus
  387.   
  388.     'In order to be able to put carriage returns or tabs in your text,
  389.     'replace vbCrLf and vbTab with the following HEX codes:
  390.     '%0a%0d = vbCrLf
  391.     '%09 = vbTab
  392.     'These codes also work when sending URLs to a browser (GET, POST, etc.)
  393.     
  394.     
  395. End Sub
  396.