vbAccelerator - Contents of code file: frmHtmlClient.frm

VERSION 5.00
Object = "{EAB22AC0-30C1-11CF-A7EB-0000C05BAE0B}#1.1#0"; "shdocvw.dll"
Begin VB.Form frmHtmlClient 
   Caption         =   "HTML Resource Demonstration"
   ClientHeight    =   6405
   ClientLeft      =   60
   ClientTop       =   450
   ClientWidth     =   7590
   Icon            =   "frmHtmlClient.frx":0000
   LinkTopic       =   "Form1"
   ScaleHeight     =   6405
   ScaleWidth      =   7590
   StartUpPosition =   3  'Windows Default
   Begin VB.CommandButton cmdPick 
      Caption         =   "..."
      Height          =   375
      Left            =   7080
      TabIndex        =   5
      Top             =   60
      Width           =   435
   End
   Begin VB.ListBox lstHtmlResources 
      BeginProperty Font 
         Name            =   "Tahoma"
         Size            =   8.25
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   840
      Left            =   1560
      TabIndex        =   4
      Top             =   480
      Width           =   5895
   End
   Begin VB.TextBox txtResourceDll 
      BeginProperty Font 
         Name            =   "Tahoma"
         Size            =   8.25
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   315
      Left            =   1560
      TabIndex        =   2
      Top             =   60
      Width           =   5475
   End
   Begin SHDocVwCtl.WebBrowser WebBrowser1 
      Height          =   4575
      Left            =   120
      TabIndex        =   0
      Top             =   1500
      Width           =   7335
      ExtentX         =   12938
      ExtentY         =   8070
      ViewMode        =   0
      Offline         =   0
      Silent          =   0
      RegisterAsBrowser=   0
      RegisterAsDropTarget=   1
      AutoArrange     =   0   'False
      NoClientEdge    =   0   'False
      AlignLeft       =   0   'False
      NoWebView       =   0   'False
      HideFileNames   =   0   'False
      SingleClick     =   0   'False
      SingleSelection =   0   'False
      NoFolders       =   0   'False
      Transparent     =   0   'False
      ViewID          =   "{0057D0E0-3573-11CF-AE69-08002B2E1262}"
      Location        =   ""
   End
   Begin VB.Label lblObjects 
      Caption         =   "&HTML Resources:"
      BeginProperty Font 
         Name            =   "Tahoma"
         Size            =   8.25
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   315
      Left            =   60
      TabIndex        =   3
      Top             =   480
      Width           =   1515
   End
   Begin VB.Label lblDll 
      Caption         =   "&Resource DLL:"
      BeginProperty Font 
         Name            =   "Tahoma"
         Size            =   8.25
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   255
      Left            =   60
      TabIndex        =   1
      Top             =   120
      Width           =   1395
   End
End
Attribute VB_Name = "frmHtmlClient"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

Private Sub pLoadResources(ByVal sFileName As String)
   lstHtmlResources.Clear

   Dim cL As New cLibrary
   On Error Resume Next
   cL.Filename = sFileName
   If (Err.Number <> 0) Then
      MsgBox Err.Description, vbExclamation
      Exit Sub
   End If
   On Error GoTo 0

   Dim cR As New cResources
   cR.hModule = cL.hModule
   cR.GetResourceTypes
   Dim i As Long
   Dim j As Long
   For i = 1 To cR.ResourceTypeCount
      If VarType(cR.ResourceType(i)) = vbLong Then
         If (cR.ResourceType(i) = 23) Then ' RT_HTML
            cR.GetResourceNames i
            For j = 1 To cR.ResourceNameCount(i)
               lstHtmlResources.AddItem cR.ResourceName(i, j)
            Next j
            Exit For
         End If
      End If
   Next i
   
   If (lstHtmlResources.ListCount > 0) Then
      lstHtmlResources.ListIndex = 0
   Else
      MsgBox "No HTML Resources found in the specified file.", vbInformation
   End If
   
   
End Sub

Private Sub cmdPick_Click()
Dim sFile As String
   If (mFileOpenSave.VBGetOpenFileName( _
      Filename:=sFile, _
      Filter:="Libraries (*.DLL)|*.DLL|Executables (*.EXE)|*.EXE|All Files
       (*.*)|*.*", _
      Owner:=Me.hWnd)) Then
      txtResourceDll.Text = sFile
      pLoadResources txtResourceDll.Text
   End If
End Sub

Private Sub Form_Load()
Dim sDll As String
   sDll = App.Path
   If (Right$(sDll, 1) <> "\") Then sDll = sDll & "\"
   sDll = sDll & "MyAppResourceDLL.dll"
   txtResourceDll.Text = sDll
   pLoadResources txtResourceDll.Text
End Sub

Private Sub Form_Resize()
   On Error Resume Next
   txtResourceDll.Width = Me.ScaleWidth - txtResourceDll.Left - cmdPick.Width -
    2 * Screen.TwipsPerPixelX
   cmdPick.Left = txtResourceDll.Left + txtResourceDll.Width +
    Screen.TwipsPerPixelX
   lstHtmlResources.Width = Me.ScaleWidth - lstHtmlResources.Left -
    Screen.TwipsPerPixelX
   WebBrowser1.Move Screen.TwipsPerPixelX, WebBrowser1.Top, Me.ScaleWidth - 2 *
    Screen.TwipsPerPixelX, Me.ScaleHeight - WebBrowser1.Top -
    Screen.TwipsPerPixelY
End Sub

Private Sub lstHtmlResources_Click()
Dim sRes As String
   sRes = lstHtmlResources.List(lstHtmlResources.ListIndex)
   sRes = "res://" & txtResourceDll.Text & "/" & sRes
   WebBrowser1.Navigate2 sRes
End Sub