VERSION 5.00
Object = "{EAB22AC0-30C1-11CF-A7EB-0000C05BAE0B}#1.1#0"; "shdocvw.dll"
Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "mscomctl.ocx"
Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0"; "COMDLG32.OCX"
Begin VB.UserControl ArmHTMLEdit 
   ClientHeight    =   5625
   ClientLeft      =   0
   ClientTop       =   0
   ClientWidth     =   6855
   ScaleHeight     =   5625
   ScaleWidth      =   6855
   Begin VB.Frame frm_HyperLink 
      Caption         =   "Hyperlink"
      Height          =   1575
      Left            =   1320
      TabIndex        =   2
      Top             =   2160
      Visible         =   0   'False
      Width           =   3495
      Begin VB.CommandButton cmd_Cancel 
         Caption         =   "Cancel"
         Height          =   375
         Left            =   2160
         TabIndex        =   6
         Top             =   1080
         Width           =   1215
      End
      Begin VB.CommandButton cmd_OK 
         Caption         =   "OK"
         Height          =   375
         Left            =   120
         TabIndex        =   5
         Top             =   1080
         Width           =   1215
      End
      Begin VB.TextBox txt_HyperLink 
         Height          =   375
         Left            =   120
         TabIndex        =   4
         Top             =   600
         Width           =   3255
      End
      Begin Project1.ArmCombobox cbo_HyperLink 
         Height          =   345
         Left            =   120
         TabIndex        =   3
         Top             =   240
         Width           =   3255
         _ExtentX        =   5741
         _ExtentY        =   609
      End
   End
   Begin MSComctlLib.ImageList img 
      Left            =   6120
      Top             =   1440
      _ExtentX        =   1005
      _ExtentY        =   1005
      BackColor       =   -2147483643
      ImageWidth      =   16
      ImageHeight     =   16
      MaskColor       =   12632256
      _Version        =   393216
      BeginProperty Images {2C247F25-8591-11D1-B16A-00C0F0283628} 
         NumListImages   =   6
         BeginProperty ListImage1 {2C247F27-8591-11D1-B16A-00C0F0283628} 
            Picture         =   "A_HTMLEd.ctx":0000
            Key             =   ""
         EndProperty
         BeginProperty ListImage2 {2C247F27-8591-11D1-B16A-00C0F0283628} 
            Picture         =   "A_HTMLEd.ctx":0112
            Key             =   ""
         EndProperty
         BeginProperty ListImage3 {2C247F27-8591-11D1-B16A-00C0F0283628} 
            Picture         =   "A_HTMLEd.ctx":0224
            Key             =   ""
         EndProperty
         BeginProperty ListImage4 {2C247F27-8591-11D1-B16A-00C0F0283628} 
            Picture         =   "A_HTMLEd.ctx":0336
            Key             =   ""
         EndProperty
         BeginProperty ListImage5 {2C247F27-8591-11D1-B16A-00C0F0283628} 
            Picture         =   "A_HTMLEd.ctx":0448
            Key             =   ""
         EndProperty
         BeginProperty ListImage6 {2C247F27-8591-11D1-B16A-00C0F0283628} 
            Picture         =   "A_HTMLEd.ctx":055A
            Key             =   ""
         EndProperty
      EndProperty
   End
   Begin MSComctlLib.Toolbar tlb 
      Align           =   1  'Align Top
      Height          =   420
      Left            =   0
      TabIndex        =   1
      Top             =   0
      Visible         =   0   'False
      Width           =   6855
      _ExtentX        =   12091
      _ExtentY        =   741
      ButtonWidth     =   609
      ButtonHeight    =   582
      Appearance      =   1
      ImageList       =   "img"
      _Version        =   393216
      BeginProperty Buttons {66833FE8-8583-11D1-B16A-00C0F0283628} 
         NumButtons      =   9
         BeginProperty Button1 {66833FEA-8583-11D1-B16A-00C0F0283628} 
            Object.ToolTipText     =   "Bold"
            ImageIndex      =   1
         EndProperty
         BeginProperty Button2 {66833FEA-8583-11D1-B16A-00C0F0283628} 
            Object.ToolTipText     =   "Italic"
            ImageIndex      =   2
         EndProperty
         BeginProperty Button3 {66833FEA-8583-11D1-B16A-00C0F0283628} 
            Object.ToolTipText     =   "Underline"
            ImageIndex      =   3
         EndProperty
         BeginProperty Button4 {66833FEA-8583-11D1-B16A-00C0F0283628} 
            Style           =   3
         EndProperty
         BeginProperty Button5 {66833FEA-8583-11D1-B16A-00C0F0283628} 
            Object.ToolTipText     =   "Hyperlink"
            ImageIndex      =   4
         EndProperty
         BeginProperty Button6 {66833FEA-8583-11D1-B16A-00C0F0283628} 
            Style           =   3
         EndProperty
         BeginProperty Button7 {66833FEA-8583-11D1-B16A-00C0F0283628} 
            Object.ToolTipText     =   "Undo"
            ImageIndex      =   5
         EndProperty
         BeginProperty Button8 {66833FEA-8583-11D1-B16A-00C0F0283628} 
            Style           =   3
         EndProperty
         BeginProperty Button9 {66833FEA-8583-11D1-B16A-00C0F0283628} 
            Object.ToolTipText     =   "Paste unformatted"
            ImageIndex      =   6
         EndProperty
      EndProperty
   End
   Begin MSComDlg.CommonDialog cmn_Dialog 
      Left            =   6120
      Top             =   960
      _ExtentX        =   847
      _ExtentY        =   847
      _Version        =   393216
   End
   Begin SHDocVwCtl.WebBrowser HTMLEdit 
      Height          =   4215
      Left            =   120
      TabIndex        =   0
      Top             =   1080
      Width           =   5775
      ExtentX         =   10186
      ExtentY         =   7435
      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
End
Attribute VB_Name = "ArmHTMLEdit"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Option Explicit

Private Const C_SEP As String = "ой"

Public Event ToolbarButtonClick(Button As MSComctlLib.Button, ByRef lb_Result As Boolean)

Private mb_DocComplete As Boolean
Private mb_HTMLChanged As Boolean

Public Event Edited()

Public Function Load_A_Com() As Boolean
  
  Call cbo_HyperLink.Load_A_Com
  Load_A_Com = Navigate("about:blank")
  mb_HTMLChanged = False
End Function

Public Function Unload_A_Com() As Boolean

  Call cbo_HyperLink.Unload_A_Com
  Unload_A_Com = True
End Function

Public Property Let ReadOnly(ab_Value As Boolean)
Dim lo_Doc As HTMLDocument
  
  Set lo_Doc = HTMLEdit.Document
  If Not (lo_Doc Is Nothing) Then
    lo_Doc.designMode = IIf(ab_Value, "Off", "On")
  End If
End Property

Public Property Get ReadOnly() As Boolean
Dim lo_Doc As HTMLDocument
  
  Set lo_Doc = HTMLEdit.Document
  If lo_Doc Is Nothing Then
    ReadOnly = True
  Else
    ReadOnly = StrComp(lo_Doc.designMode, "On") <> 0
  End If
End Property

Public Property Let HTMLTextInner(as_Text As String)
Dim lo_Doc As HTMLDocument
  
  Set lo_Doc = HTMLEdit.Document
  lo_Doc.body.innerHTML = as_Text
End Property

Public Property Get HTMLTextInner() As String
Dim lo_Doc As HTMLDocument
  
  Set lo_Doc = HTMLEdit.Document
  If Not (lo_Doc Is Nothing) Then
    HTMLTextInner = lo_Doc.body.innerHTML
  End If
End Property

Public Function Navigate(as_URL As String) As Boolean
  
  mb_DocComplete = False
  HTMLEdit.Navigate (as_URL)
  While (Not mb_DocComplete)
    DoEvents
  Wend
  mb_HTMLChanged = False
End Function

Public Function SetSelectedTextAsBold()
Dim lo_Doc As HTMLDocument

  Set lo_Doc = HTMLEdit.Document
  Call lo_Doc.execCommand("bold")
End Function

Public Function SetSelectedTextAsItalic()
Dim lo_Doc As HTMLDocument

  Set lo_Doc = HTMLEdit.Document
  Call lo_Doc.execCommand("italic")
End Function

Public Function SetSelectedTextAsUnderline()
Dim lo_Doc As HTMLDocument

  Set lo_Doc = HTMLEdit.Document
  Call lo_Doc.execCommand("underline")
End Function

Public Function SetSelectedTextAsHyperLink(Optional as_HRef As String = "")
Dim lo_Doc As HTMLDocument

  Set lo_Doc = HTMLEdit.Document
  If as_HRef = "" Then
    Call lo_Doc.execCommand("createlink", True)
  Else
    Call lo_Doc.execCommand("createlink", False, as_HRef)
  End If
End Function

Public Function SetSelectedTextAsNormal()
Dim lo_Doc As HTMLDocument

  Set lo_Doc = HTMLEdit.Document
  Call lo_Doc.execCommand("RemoveFormat")
End Function

Public Function SaveToFile(Optional as_FileName As String = "")
Dim lo_Doc As HTMLDocument

  Set lo_Doc = HTMLEdit.Document
  If as_FileName = "" Then
    Call lo_Doc.execCommand("saveas", True)
  Else
    Call lo_Doc.execCommand("saveas", False, as_FileName)
  End If
End Function

Public Function OpenFile(Optional as_FileName As String = "") As Boolean
Dim ls_FileName As String

  If as_FileName = "" Then
    Call cmn_Dialog.ShowOpen
    ls_FileName = cmn_Dialog.FileName
  Else
    ls_FileName = as_FileName
  End If
  If ls_FileName <> "" Then
    Call HTMLEdit.Navigate(ls_FileName)
  End If
End Function

Public Function Undo()
Dim lo_Doc As HTMLDocument

  Set lo_Doc = HTMLEdit.Document
  Call lo_Doc.execCommand("undo")
End Function

Public Function CreateStyleSheet(as_FileName As String) As Boolean
Dim lo_Doc As HTMLDocument

  Set lo_Doc = HTMLEdit.Document
  'MsgBox lo_Doc.ReadyState
  If Not (lo_Doc Is Nothing) Then
    Call WaitForDocComplete(lo_Doc)
    Call lo_Doc.CreateStyleSheet(as_FileName, 1)
    CreateStyleSheet = True
  End If
End Function

Property Let ToolBarVisible(ab_Value As Boolean)
  If Not ReadOnly Then
    tlb.Visible = ab_Value
    Call UserControl_Resize
    If ab_Value Then
      RaiseEvent Edited
    End If
  End If
End Property

Property Get ToolBarVisible() As Boolean
  ToolBarVisible = tlb.Visible
End Property

Property Get HTMLChanged() As Boolean
  HTMLChanged = mb_HTMLChanged
End Property

Private Function PasteUnformatted()
Dim ls_Text As String

  If Clipboard.GetFormat(vbCFText) Then
    ls_Text = Clipboard.GetText(vbCFText)
    Call Clipboard.Clear
    Call Clipboard.SetText(ls_Text)
    Call HTMLEdit.ExecWB(OLECMDID_PASTE, OLECMDEXECOPT_DODEFAULT)
  End If
End Function

Private Sub cmd_Cancel_Click()
  frm_HyperLink.Visible = False
End Sub

Private Sub cmd_OK_Click()
  
  If cbo_HyperLink.SelectedItem Is Nothing Then
    Call SetSelectedTextAsHyperLink(txt_HyperLink.Text)
  Else
    Call SetSelectedTextAsHyperLink("#" & cbo_HyperLink.SelectedItem.Key)
  End If
  frm_HyperLink.Visible = False
End Sub

Private Sub HTMLEdit_DocumentComplete(ByVal pDisp As Object, URL As Variant)
  mb_DocComplete = True
End Sub

Private Sub HTMLEdit_GotFocus()
  ToolBarVisible = True
End Sub

Private Sub HTMLEdit_LostFocus()
  ToolBarVisible = False
End Sub

Private Sub tlb_ButtonClick(ByVal Button As MSComctlLib.Button)
Dim lb_Result As Boolean

  lb_Result = True
  RaiseEvent ToolbarButtonClick(Button, lb_Result)
  If lb_Result Then
    Select Case Button.Index
    Case 1
      Call SetSelectedTextAsBold
    Case 2
      Call SetSelectedTextAsItalic
    Case 3
      Call SetSelectedTextAsUnderline
    Case 5
      Call ShowHyperLink
    Case 7
      Call Undo
    Case 9
      Call PasteUnformatted
    End Select
    mb_HTMLChanged = True
  End If
End Sub

Private Sub ShowHyperLink()
  ToolBarVisible = False
  txt_HyperLink.Text = "http:\\"
  Set cbo_HyperLink.SelectedItem = Nothing
  cbo_HyperLink.Text = ""
  frm_HyperLink.top = 0
  frm_HyperLink.left = (Width - frm_HyperLink.Width) / 2
  frm_HyperLink.Visible = True
End Sub

Private Sub WaitForDocComplete(ao_Doc As HTMLDocument)

  While StrComp(ao_Doc.ReadyState, "complete", vbTextCompare) <> 0
    DoEvents
  Wend
End Sub

Public Property Let HyperLinks(av_Value As Variant)
Dim ll_Index As Long

  If IsArray(av_Value) Then
    Call cbo_HyperLink.Clear
    For ll_Index = 0 To UBound(av_Value)
      Call cbo_HyperLink.AddItem(Array(av_Value(ll_Index, 0), av_Value(ll_Index, 1)))
    Next
  End If
End Property

Private Sub txt_HyperLink_Change()
  
  Set cbo_HyperLink.SelectedItem = Nothing
End Sub

Private Sub UserControl_Resize()
  tlb.top = 0
  HTMLEdit.left = 0
  HTMLEdit.Width = Width
  If ToolBarVisible Then
    HTMLEdit.top = tlb.top + tlb.Height
    HTMLEdit.Height = Height - HTMLEdit.top
  Else
    HTMLEdit.top = 0
    HTMLEdit.Height = Height
  End If
End Sub


Public Sub SetLabels(ByVal as_Labels As String)

    On Error GoTo onError

    Dim la_Labels As Variant
    la_Labels = Split(as_Labels, C_SEP)
    
    frm_HyperLink.Caption = la_Labels(0)
    cmd_OK.Caption = la_Labels(1)
    cmd_cancel.Caption = la_Labels(2)

    Exit Sub
    
onError:

End Sub


Public Property Let Charset(ByVal al_Charset As Long)
    
    frm_HyperLink.Font.Charset = al_Charset
    cmd_OK.Font.Charset = al_Charset
    cmd_cancel.Font.Charset = al_Charset
    
End Property

