I'm trying to set up a small extension of WebBrowser control as an HtmlTextBox, with limited formatting possibilities. It works for basic formatting (bold, italic, underline). But I also wanted to allow indentation in one single level, and ideally call this in a "toggle" fashion.
I noticed that when I run Document.ExecCommand("Indent", False, Nothing) it converts the <p> element into a <blockquote> element, which is exactly what I need. But a second call to the same command just adds to the indent margin, but I want to make it so that, if cursor is already inside a <blockquote> element, it will perform an "outdent" instead.
For that, I tried to query Document.ActiveElement before performing my action, but this returns always the whole <body> element, and not the specific block element in which cursor rests at that moment.
How could I accomplish that?
This is my code:
Public Class HtmlTextBox
Inherits WebBrowser
Public Sub New()
WebBrowserShortcutsEnabled = False
IsWebBrowserContextMenuEnabled = False
DocumentText = "<html><body></body></html>"
If Document IsNot Nothing Then
Dim doc = Document.DomDocument
If doc IsNot Nothing Then
doc.designMode = "On"
If Me.ContextMenuStrip Is Nothing Then
AddHandler Document.ContextMenuShowing, Sub(sender As Object, e As HtmlElementEventArgs) Application.DoEvents()
End If
End If
End If
End Sub
Private Sub HtmlTextBox_PreviewKeyDown(sender As Object, e As PreviewKeyDownEventArgs) Handles Me.PreviewKeyDown
If e.Control Then
If e.KeyData.HasFlag(Keys.B) OrElse e.KeyData.HasFlag(Keys.N) Then BoldToggle()
If e.KeyData.HasFlag(Keys.I) Then ItalicToggle()
If e.KeyData.HasFlag(Keys.S) OrElse e.KeyData.HasFlag(Keys.U) Then UnderlineToggle()
If e.KeyData.HasFlag(Keys.M) Then BlockQuoteToggle()
End If
End Sub
Public Sub BoldToggle()
Document.ExecCommand("Bold", False, Nothing)
End Sub
Public Sub ItalicToggle()
Document.ExecCommand("Italic", False, Nothing)
End Sub
Public Sub UnderlineToggle()
Document.ExecCommand("Underline", False, Nothing)
End Sub
Public Sub BlockQuoteToggle()
If Document.ActiveElement.TagName.ToLower = "blockquote" Then
Document.ExecCommand("Outdent", False, Nothing)
Else
Document.ExecCommand("Indent", False, Nothing)
End If
End Sub
End Class
The method ElementAtSelectionStart is designed to return the element containing the start of the current selection. This code is for a WebBrowser control in edit mode. Hopefully it will work for your needs.
Public Class mshtmlUtilities
Public Enum C_Bool
[False] = 0
[True] = 1
End Enum
Public Shared Function ElementAtSelectionStart(ByVal wb As System.Windows.Forms.WebBrowser) As System.Windows.Forms.HtmlElement
Dim el As System.Windows.Forms.HtmlElement = Nothing
If wb IsNot Nothing AndAlso _
wb.Document IsNot Nothing AndAlso _
DirectCast(wb.Document.DomDocument, mshtml.IHTMLDocument2).designMode.Equals("on", StringComparison.InvariantCultureIgnoreCase) Then
Dim doc As mshtml.IHTMLDocument2 = DirectCast(wb.Document.DomDocument, mshtml.IHTMLDocument2)
Dim sel As mshtml.IHTMLSelectionObject = DirectCast(doc.selection, mshtml.IHTMLSelectionObject)
Select Case sel.type.ToLowerInvariant
Case "text"
Dim rng As mshtml.IHTMLTxtRange = DirectCast(sel.createRange(), mshtml.IHTMLTxtRange)
rng.collapse(True)
el = MakeWinFormHTMLElement(rng.parentElement, wb)
Case "control"
Dim rng As mshtml.IHTMLControlRange = DirectCast(sel.createRange(), mshtml.IHTMLControlRange)
el = MakeWinFormHTMLElement(rng.item(0).parentElement, wb)
Case "none"
Dim ds As mshtml.IDisplayServices = DirectCast(doc, mshtml.IDisplayServices)
Dim caret As mshtml.IHTMLCaret = Nothing
ds.GetCaret(caret)
Dim pt As mshtml.tagPOINT
caret.GetLocation(pt, C_Bool.False)
el = wb.Document.GetElementFromPoint(New Point(pt.x, pt.y))
End Select
End If
Return el
End Function
Private Shared Function MakeWinFormHTMLElement(ByVal el As mshtml.IHTMLElement, ByVal wb As System.Windows.Forms.WebBrowser) As System.Windows.Forms.HtmlElement
Dim shimInfo As Reflection.PropertyInfo = wb.GetType.GetProperty("ShimManager", Reflection.BindingFlags.NonPublic Or Reflection.BindingFlags.Instance)
Dim shimManager As Object = shimInfo.GetValue(wb, Nothing)
Dim ciElement As Reflection.ConstructorInfo() _
= wb.Document.Body.GetType().GetConstructors(Reflection.BindingFlags.Instance Or Reflection.BindingFlags.NonPublic)
Return CType(ciElement(0).Invoke(New Object() {shimManager, el}), HtmlElement)
End Function
End Class
Related
I'm using VBA in access to open up a protected word template, fill in the data, and then re-protect it.... this way, if the database system goes down, the word template can still be used manually in its protected state.
I have just started using VBA and in this line:
If ActiveDocument.ProtectionType <> wdNoProtection Then
ActiveDocument.Unprotect Password:=""
End If
I'm concerned that whilst running the code in access, that if the user opens up another word document and makes it the focus, that it will occidentally get protected instead of the other. How do I keep active focus on the document I'm writing to... or do I need to reference my document somehow using WordApp.protect (or something similar that works)
Private Sub Command0_Click()
Dim WordApp As Word.Application
Dim strDatabasePath As String
Dim strTemplatePath As String
Dim strTemplate As String
Dim strJobTitle As String
Dim strFile As String
strFile1 = "testcoc.dotx"
strFile2 = "testcoc-private.dotx"
strDatabasePath = CurrentProject.Path & "\"
strTemplatePath = "\templates\"
strTemplate = strDatabasePath & strTemplatePath & strFile2
On Error Resume Next
Set WordApp = GetObject(, "Word.Application")
If Err.Number <> 0 Then
Set WordApp = CreateObject("Word.Application")
End If
On Error GoTo ErrHandler
WordApp.Visible = True
WordApp.WindowState = wdWindowStateMaximize
WordApp.Documents.Add Template:=strTemplate, NewTemplate:=True
'strJobTitle = DLookup("JobTitle", "Job", "JobNum = " & [JobType])
strJobTitle = DLookup("JobTitle", "Job", "JobNum = 'J0456'")
With WordApp.Selection
'Unprotect the file
If ActiveDocument.ProtectionType <> wdNoProtection Then
ActiveDocument.Unprotect Password:=""
End If
.Goto what:=wdGoToBookmark, Name:="bm_0_4"
.TypeText strJobTitle
End With
'Reprotect the document.
'If ActiveDocument.ProtectionType = wdNoProtection Then
'ActiveDocument.Protect _
'Type:=wdAllowOnlyFormFields, NoReset:=True, Password:=""
'End If
DoEvents
WordApp.Activate
Set WordApp = Nothing
Exit Sub
ErrHandler:
Set WordApp = Nothing
End Sub
Thank You
I haven't tried this but WordApp.Documents.Add Template:=strTemplate, NewTemplate:=True does return the new document. So I would do something like
Dim doc as Word.Document
Set doc = WordApp.Documents.Add(Template:=strTemplate, NewTemplate:=True)
and reference doc throughout my code instead of ActiveDocument. It seems like doing that should get help you avoid the particular situation you're concerned about.
I'm using List(Of T) to contains my database field (invoice_id and item_id) and want to display it in DataGridView. First, I declare each of them as a class and then add them to my list then display it in DataGridView but when I compile it, the program is not responding.
My guess is that my database source is too large, because when I change the source (database field), it worked nicely. So how do I solve this List(Of T) capacity issues?
This is my code:
Sub view()
Dim msql2 As String
msql2 = "select invoice_id, item_id from detail"
Dim arayD As New List(Of INVOICE)
CMD2 = New MySqlCommand(msql2, conn.konek)
Try
Dim res = CMD2.ExecuteReader()
Dim INVO As INVOICE = Nothing
While res.Read()
INVO = New INVOICE
With INVO
.invoice_id = hasil2.GetString("invoice_id")
.item_id = hasil2.GetString("item_id")
End With
arayD.Add(INVO)
End While
dgv.DataSource = arayD
Catch ex As Exception
MessageBox.Show("ERROR")
End Try
End Sub
Public Class INVOICE
Private _kodeF As Integer
Public Property invoice_id() As Integer
Get
Return _kodeF
End Get
Set(ByVal value As Integer)
_kodeF = value
End Set
End Property
Private _kodeBrg As String
Public Property item_id() As String
Get
Return _kodeBrg
End Get
Set(ByVal value As String)
_kodeBrg = value
End Set
End Property
End Class
if you want a fast solution then add the following line inside your While Loop :
While res.Read()
Application.DoEvents()
...
End While
Or use a BackgroundWorker as the following:
Private WithEvents bgWorker As New System.ComponentModel.BackgroundWorker
Private arayD As New List(Of INVOICE)
Sub view()
bgWorker.RunWorkerAsync()
End Sub
Private Sub bgWorker_DoWork(sender As Object, e As System.ComponentModel.DoWorkEventArgs) Handles bgWorker.DoWork
Dim dReader As DataReader
Using YourConnection
Using YourCommand
YourConnection.Open()
dReader = YourCommand.ExecuteReader()
If dReader.HasRows Then
While dReader.Read
arayD.Add(New INVOICE With {
.invoice_id = hasil2.GetString("invoice_id"),
.item_id = hasil2.GetString("item_id")
}
)
End While
End If
End Using
End Using
End Sub
Private Sub bgWorker_RunWorkerCompleted(sender As Object, e As System.ComponentModel.RunWorkerCompletedEventArgs) Handles bgWorker.RunWorkerCompleted
MsgBox("Ready to go")
dgv.DataSource = arayD
End Sub
Also you can get the count of the result and use it with a progressbar.
I have a Subform/Subreport control displayed on a Form in an Access 2010 database, and I use it to display both Forms and Reports. I have a few event handlers in which I need to know whether a Report is currently loaded into the Subform/Subreport control, or if it's a Form that's loaded. I have tried all of the following to no avail.
Any of the following conditions
If IsEmpty(NavigationSubform.Form) Then '...
If IsNull(NavigationSubform.Form) Then '...
If IsOject(NavigationSubform.Form) Then '...
If NavigationSubform.Form Is Nothing Then '...
If NavigationSubform.Form Is Null Then '...
If Nz(NavigationSubform.Form) Then '...
If (Not NavigationSubform.Form) = -1 Then '... This is a trick I use to check for uninitialized arrays
Results in
Run-time error '2467':
The expression you entered refers to an object that is closed or doesn't exist.
Is there some way that I can check whether a Subform/Subreport control currently has a Form or Report loaded without intentionally causing an error?
I don't believe that there is a way to reliably perform the check without error trapping, so you may want to wrap the code in a Public Function and put it into a regular VBA Module:
Public Function CheckSubformControlContents(ctl As SubForm) As String
Dim obj As Object, rtn As String
rtn = "None"
On Error Resume Next
Set obj = ctl.Form
If Err.Number = 0 Then
rtn = "Form"
Else
On Error Resume Next
Set obj = ctl.Report
If Err.Number = 0 Then
rtn = "Report"
End If
End If
Set obj = Nothing
On Error GoTo 0
CheckSubformControlContents = rtn
End Function
Then your form code can simply call CheckSubformControlContents(Me.NavigationSubform).
Here are two functions that work in Access 2013 for determining if a name is a Report or a Form.
Once that is determined the IsLoaded function of AllForms or AllReports can be used. Note that dbs is an object and rpt or frm are AccessObjects not forms or reports
Public Function IsForm(FormName As String) As Boolean
Dim dbs As Object
Dim frm As AccessObject
Set dbs = Application.CurrentProject
IsForm = False
For Each frm In Application.CurrentProject.AllForms
If frm.Name = FormName Then
IsForm = True
Exit For
End If
Next frm
Set frm = Nothing
Set dbs = Nothing
End Function
Public Function IsReport(ReportName As String) As Boolean
Dim dbs As Object
Dim rpt As AccessObject
Set dbs = Application.CurrentProject
IsReport = False
For Each rpt In Application.CurrentProject.AllReports
If rpt.Name = ReportName Then
IsReport = True
Exit For
End If
Next rpt
Set rpt = Nothing
Set dbs = Nothing
End Function
Here is a program that uses the above functions:
Public Sub EnumerateTaggedControls(ReportName As String, MyTag As String)
Dim dbs As Object
Dim rpt As Report
Dim frm As Form
Dim col As Controls
Dim ctl As Control
Dim left As Integer
Dim top As Integer
Dim width As Integer
Dim height As Integer
Dim tag As String
Dim i As Integer
Const format1 As String = "0000 "
Set dbs = Application.CurrentProject
If IsForm(ReportName) Then
If dbs.AllForms(ReportName).IsLoaded Then
DoCmd.OpenForm ReportName, acViewDesign
Set frm = Forms(ReportName)
Set col = frm.Controls
End If
Else
If dbs.AllReports(ReportName).IsLoaded Then
DoCmd.OpenReport ReportName, acViewDesign
Set rpt = Reports(ReportName)
Set col = rpt.Controls
Else
Debug.Print ReportName & " is not a loaded form or report."
Exit Sub
End If
End If
Set dbs = Nothing
Debug.Print Tab(53); "Left Top Width Height"
For Each ctl In col
With ctl
left = .Properties("Left")
top = .Properties("Top")
width = .Properties("Width")
height = .Properties("Height")
tag = Nz(.Properties("Tag"), vbNullString)
If MyTag = "" Then
i = 1
Else
i = InStr(1, tag, MyTag)
End If
If i > 0 Then
Debug.Print .Name & ">"; Tab(33); tag; Tab(53); Format(left, format1) & Format(top, format1) & Format(width, format1) & Format(height, format1)
End If
End With
Next ctl
Debug.Print "====================================================="
Set ctl = Nothing
Set rpt = Nothing
Set col = Nothing
Set frm = Nothing
End Sub
I hope this meets your requirements.
I'm trying to get the InnerHtml of a child of a child of an element. Here is what I have:
If doc.GetElementById("ctl00_cphBanner_MenuRedesign_BannerAlertsAndOptionsLoginView_BannerAlertsAndOptions_Authenticated_FriendsBubble") IsNot Nothing Then
Dim el As HtmlElement = doc.GetElementById("ctl00_cphBanner_MenuRedesign_BannerAlertsAndOptionsLoginView_BannerAlertsAndOptions_Authenticated_FriendsBubble")
inboxTxt.Text = el.Children(1).Children(0).InnerHtml.ToString
End If
And this is the error I'm receiving:
"Object reference not set to an instance of an object."
How do I fix this?
Edit: When I removed the "Try" function, the error was shown here:
If doc.GetElementById("ctl00_cphBanner_MenuRedesign_BannerAlertsAndOptionsLoginView_BannerAlertsAndOptions_Authenticated_FriendsBubble") IsNot Nothing Then
You are making the assumption that your doc object has a value. Try checking if it is nothing also, before you check for child elements.
If Not IsNothing(doc) Then
If Not IsNothing(doc.GetElementById("ctl00_cphBanner_MenuRedesign_BannerAlertsAndOptionsLoginView_BannerAlertsAndOptions_Authenticated_FriendsBubble")) Then
Dim el As HtmlElement = doc.GetElementById("ctl00_cphBanner_MenuRedesign_BannerAlertsAndOptionsLoginView_BannerAlertsAndOptions_Authenticated_FriendsBubble")
inboxTxt.Text = el.Children(1).Children(0).InnerHtml.ToString
End If
End If
Updated Code. This Works but does not return your HtmlElement
Public Class Form1
Private Sub Form1_Load(sender As System.Object, e As System.EventArgs) Handles MyBase.Load
wb.Navigate("http://www.roblox.com/user.aspx?id=3659905")
End Sub
Private Sub Form1_MouseClick(sender As Object, e As System.Windows.Forms.MouseEventArgs) Handles Me.MouseClick
Dim doc As HtmlDocument = wb.Document
If Not IsNothing(doc) Then
Dim el As HtmlElement = doc.GetElementById("ctl00_cphBanner_MenuRedesign_BannerAlertsAndOptionsLoginView_BannerAlertsAndOptions_Authenticated_FriendsBubble")
If el IsNot Nothing Then
inboxTxt.Text = el.Children(1).Children(0).InnerHtml.ToString
Else
inboxTxt.Text = "No Data"
End If
End If
End Sub
End Class
Most likely, at least one of the expressions el.Children(1), el.Children(1).Children(0), or el.Children(1).Children(0).InnerHtml results in null/Nothing. Check each of those, in order, to make sure you actually have a value.
I am new to programming in c# and visual basic. I am using visual studio 2010 and I am trying to retrieve some data from a mysql database. Installed using wamp.
I have already set connection to the database by going to 'Project', 'Application Properties', 'Settings'.
I have this error "'mAuto1' is not declared. It may be inaccessible due to its protection level" and I cant seem to solve it.
The code below is for a simple retrieve:
Public Class Form1
Private procAuto As CALCOM.Auto
Private Function Connect_To_Database() As Boolean
Dim mErrorNumQuery As Long
Dim mReturn As Boolean
procAuto = New CALCOM.Auto
procAuto.Connect(mErrorNumQuery)
If mErrorNumQuery = 0 Then
mReturn = True
Else
mReturn = False
End If
Connect_To_Database = mReturn
End Function
Private Function Get_Weight_By_TicketNumber(ByVal mTicketNumber As String, ByRef mAuto1 As Long, ByRef mAuto2 As Long, ByRef mTotalWeight As Long) As Boolean
Dim mErrorNumQuery As Long
Dim mXtr As New CALCOM.xTr
Dim mRec As ADODB.Recordset
Dim mReturn As Boolean
mRec = mXtr.GetList("Select Auto1,Auto2,TotalWeight From txticket Where TicketCode = '" & mTicketNumber & "'", , , mErrorNumQuery)
If mErrorNumQuery = 0 Then
mReturn = True
If mRec.RecordCount <> 0 Then
mRec.MoveFirst()
mRec.MoveFirst()
mAuto1 = mRec.Fields("Auto1").Value
mAuto2 = mRec.Fields("Auto2").Value
mTotalWeight = mRec.Fields("TotalWeight").Value
End If
Else
mReturn = False
End If
Get_Weight_By_TicketNumber = mReturn
End Function
Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click
Label1.Text = mAuto1 <--------------------problem here
End Sub
End Class
This program was just a test to see if I can display results of a mysql query on a form label. I wanted to display results on the click of a button
How do I fix the error? Any help appreciated.
The mAuto1 variant is a local one at Get_Weight_By_TicketNumber function, you can't use it outside the function. If you want, declare a class-level variant and set it to the value of mAuto1.