Keskustelu: Ohjelmointikysymykset: VB.NET: NetWinFormsHelpSystem

'WindowsForms projekti(NetWinFormsHelpSystemTest)
'MainForm.vb
'Testi: Tee esim. wordilla joitain dokumentteja,
'joihin kirjoitat ohjetekstiä, liität joitain kuvia
'sekä lisäät http:// tai https:// -alkuisia hyperlinkkejä.
'(tallenna dokumentit RTF-muodossa, nimeä tyyliin
'helpdata0.rtf, helpdata1.rtf jne...)

'lisää projektiin tyhjä luokkamoduuli (HelpData.vb)
'klikkaa luokkamoduulin kuvaketta hiiren vasemmalla,
'valitse Add, New Dependent Item,
'ja valitse Empty Resource file (HelpData.resx)
'Tuplaklikka luomasi resurssitiedoston kuvaketta,
'klikkaa ylintä kenttä hiiren vasemmalla ja valites
'add files. Siirry siihen hakemistoon, johon tallensit
'luomasi .rtf-dokumentit, valitse ne kaikki, klikkaa
'avaa-painiketta ja tallenna projekti.

'
' Created by SharpDevelop.
' User: Nea Uusitalo
' Date: 14.11.2010
' Time: 20:07
'

Imports System.Resources
Imports System.Windows.Forms
Imports NetWinFormsHelpSystem

Public Partial Class MainForm

   Private MyHelpSystem As New HelpSystem

   Public Sub New()
      Me.InitializeComponent()
   End Sub

   Sub MainForm_Load(sender As Object, e As EventArgs)
      MyHelpSystem.frmHelp = Nothing
   End Sub

   Sub MainForm_KeyUp(sender As Object, e As KeyEventArgs)
      If e.KeyCode = 112 Then
         ShowHelp(0)
      End if
   End Sub

   Sub PictureBox1_Click(sender As Object, e As EventArgs)
      ShowHelp(0)
   End Sub

   Sub ShowHelp(mode As Integer)

      Dim resources As New ResourceManager(GetType(HelpData))
      Dim runTimeResourceSet As ResourceSet = _
      resources.GetResourceSet( _
      System.Globalization.CultureInfo.InstalledUICulture ,True, True)
      Dim resKeys(0) As String, cnt As Integer = -1

      For Each dictEntry As DictionaryEntry In runTimeResourceSet
           If (dictEntry.Value.GetType() Is GetType(Byte())) Then
              If dictEntry.Key.ToString.IndexOf("helpdata") > -1 Then
                 cnt += 1: ReDim Preserve resKeys(cnt)
                 resKeys(cnt) = dictEntry.Key.ToString
              End If
           End If
       Next

       If resKeys(0) <> String.Empty Then

          Dim ByteArray(resKeys.getUpperBound(0)) As Object

          For i As Integer = 0 To resKeys.getUpperBound(0)
             Dim Bytes As Byte() = CType( _
            resources.GetObject(resKeys(i)), Byte())
            ByteArray(i) = Ctype(Bytes, Object)
            Bytes = Nothing
          Next

          resources = Nothing

         MyHelpSystem.ShowHelp(ByteArray, mode, Me.Text + " - Help")

         ByteArray = Nothing

       End If

   End Sub

   Sub PictureBox1_MouseHover(sender As Object, e As EventArgs)
      PictureBox1.BorderStyle = Borderstyle.Fixed3D
   End Sub

   Sub PictureBox1_MouseLeave(sender As Object, e As EventArgs)
      PictureBox1.BorderStyle = Borderstyle.None
   End Sub

   Sub MainForm_FormClosing(sender As Object, e As FormClosingEventArgs)
      MyHelpSystem.FormClose
   End Sub

End Class

 'VBA-Projekti (UserForm1)
'VBA-Projektiin referenssi: NET 4.0 WinForms HelpSystem
'(C:\WINDOWS\System32\NetWinFormsHelpSystem.tlb)
'Lomakkeelle Image-kontrolli
'(tuo Image-kontrolliin jokin kuva)
Private MyHelpSystem As New HelpSystem
Private hlpData() As Variant
Private hlpDataExists As Boolean

Private Sub UserForm_Activate()
   'Testi: Tee esim. wordilla muutama dokumentti,
   'joihin kirjoitat ohjetksti ja liität joitain kuvia.
   'tallenna dokumentit RTF-muodossa samaan kansioon
   'Missä VBA-Projektisi (esim. Testi.xls) sijaitsee.
   '(hyperlinkit eivät toimi VBA/VB6 ympäristöissä)
   Dim HelpFilePath As String
   HelpFilePath = Replace( _
   ThisWorkbook.FullName, ThisWorkbook.Name, "")

   Dim cnt As Integer
   cnt = -1
   'Listataan hakemistopolun kaikki .rtf -tiedostot...
   a = Dir(HelpFilePath + "*.rtf")
   Do While a <> ""
      ' kasvatetaan laskurin arvoa...
      cnt = cnt + 1
      'asetetaan/kasvatetaan taulukon ulottuvuutta...
      ReDim Preserve hlpData(cnt)
      'alustetaan tavu-taulukko
      Dim Bytes() As Byte
      'alustetaan merkkijono...
      Dim strFile As String
      'avataan hakemistopolun ja muutujan a muodostaman
      'tiedostopolun määrittämä tiedosto binaarimuodossa...
      Open HelpFilePath & a For Binary As #1
      'asetetaan merkkijonon arvoksi tiedoston
      'pituuden verran välilyönti-merkkejä
      strFile = Space(LOF(1))
      'luetaan tiedosto merkkijonomuuttujaan...
      Get #1, , strFile: Close #1
      'muunnetaan merkkijon tavu-taulukoksi
      Bytes = StrConv(strFile, vbFromUnicode)
      'tallennetaan tavu-taulukko variant
      'tyyppisen taulukkon laskurin cnt
      'arvon osoittaman indeksin arvoksi...
      hlpData(cnt) = Bytes
      a = Dir()
      'tyhjennetään merkkijono ja tavu-taulukko
      strFile = "": Erase Bytes
   Loop

   'asetetaan virheenkäsittely
   On Error Resume Next
   Dim upperbound As Integer
   upperbound = UBound(hlpData)
   'jos variant-taulukko ei sisällä
   'dataa aiheutuu virhe...
   If Err <> 0 Then
      'Nollataan Error-objekti...
      Err.Clear
      On Error GoTo 0
      'ja asetetaan boolean-muuttujan arvoksi False
      hlpDataExists = False
   Else
      'jos virhettä ei aiheutunut asetetaan
      'em. boolean-muuttujan arvoksi True
      hlpDataExists = True
   End If

End Sub

Private Sub Image1_MouseDown(ByVal Button As Integer, _
ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
   Image1.SpecialEffect = fmSpecialEffectSunken
End Sub

Private Sub Image1_MouseUp(ByVal Button As Integer, _
ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
   Image1.SpecialEffect = fmSpecialEffectRaised
   'Lähetetään lomakkeelle näppäinkoodi: 112
   SendKeys "{F1}"
End Sub

Private Sub UserForm_KeyUp(ByVal KeyCode As MSForms.ReturnInteger, _
ByVal Shift As Integer)
   'Jos Lomakkeen keycode = 112 ja boolean-muutujan
   'arvo on tosi niin kutsutaan ShowHelp-aliohjelmaa
   If KeyCode = 112 And hlpDataExists Then
   	ShowHelp
   End If
End Sub

Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
   MyHelpSystem.FormClose
End Sub

Sub ShowHelp()
   MyHelpSystem.ShowHelp hlpData, 0, Me.Caption + " - Help"
End Sub