|
|
Oct 10, 2007
Set BMP file to Transparent
Measure the height and width of a string in VB.NET
Measure the height and width of a string in VB.NET
Use the Graphics.MeasureString method exposed by the PaintEventArgs parameter of a form or control's Paint event or the PrintPageEventArgs parameter of the PrintDocument object's PrintPage event.
MeasureString measures a string when drawn with a specified font and returns a SizeF structure which contains height and width values in pixels.
Private Sub Form1_Paint(ByVal sender As Object, _
ByVal e As System.Windows.Forms.PaintEventArgs) Handles MyBase.Paint
Dim myFont As New Font("Courier New", 8)
Dim myFontBold As New Font("Microsoft Sans Serif", 10, FontStyle.Bold)
Dim StringSize As New SizeF
StringSize = e.Graphics.MeasureString("How wide is this string?", myFont)
Debug.WriteLine("Height: " & StringSize.Height)
Debug.WriteLine("Width: " & StringSize.Width)
StringSize = e.Graphics.MeasureString("How wide is this string?", myFontBold)
Debug.WriteLine("Height: " & StringSize.Height)
Debug.WriteLine("Width: " & StringSize.Width)
End Sub
You can use MeasureString to calculate how many characters will fit within a specified StringFormat object. A StringFormat object encapsulates text layout information such as alignment and line spacing as well as font information.
Private Sub Form1_Paint(ByVal sender As Object, _
ByVal e As System.Windows.Forms.PaintEventArgs) Handles MyBase.Paint
Dim myFont As New Font("Courier New", 8)
Dim strString1 As String = "How wide is this string?"
Dim strString2 As String = "How much of this string will fit within strString1?"
Dim myFontBold As New Font("Microsoft Sans Serif", 10, FontStyle.Bold)
Dim StringSize As New SizeF
Dim LayoutArea As New SizeF
Dim NewStringFormat As New StringFormat
Dim intLinesFilled As Integer
Dim intCharactersFitted As Integer
'
' Measure string 1's height and width.
'
StringSize = e.Graphics.MeasureString(strString1, myFont)
'
' Create a StringFormat object specifying not to wrap text.
'
NewStringFormat.FormatFlags = StringFormatFlags.NoWrap
'
' Create a structure specifying the maximum layout area for the string. Set the
' width to the width of string 1 and the height to the textheight of the font used.
'
LayoutArea.Width = StringSize.Width
LayoutArea.Height = myFont.GetHeight(e.Graphics)
'
' See how many characters of string 2 fit within the layout area (width of string 1).
'
StringSize = e.Graphics.MeasureString(strString2, myFont, _
LayoutArea, NewStringFormat, intCharactersFitted, intLinesFilled)
Debug.WriteLine(intCharactersFitted)
End Sub
original source: http://www.thescarms.com/dotnet/MeasureString.aspx
Word Wrap Text
Word Wrap Text
The code listed below can be compiled as a class or can be added to a project. This code wraps text to a specified number of characters per line. It does this by using several api calls and a fixed width font. This method for wrapping text is much faster than any other code I have found on the internet. These are the necessary objects: one form called frmMain with txtbox on it called txtHidden, a module called modMainCode, and a class module called WordWrap
'modMainCode
Option Explicit
Public Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal msg As Long, ByVal wp As Long, lp As Any) As Long
Public Const EM_LINEINDEX = &HBB
Public Const EM_LINELENGTH = &HC1
Public Const EM_GETLINE = &HC4
Public Const EM_GETLINECOUNT = &HBA
Public Const EM_FMTLINES = &HC8
'frmMain
Option Explicit
Public intMaxLineLen As Integer
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal msg As Long, ByVal wp As Long, lp As Any) As Long
Private Const EM_LINEINDEX = &HBB
Private Const EM_LINELENGTH = &HC1
Private Const EM_GETLINE = &HC4
Private Const EM_GETLINECOUNT = &HBA
Private Const EM_FMTLINES = &HC8
'************************************************************************
'This sets up the textbox so it will wrap to the correct amount of
'characters
'************************************************************************
Private Sub SetUpRTB()
Dim lngIndex As Long
Dim intLength As Integer
intLength = 0
txtHidden.MultiLine = True
txtHidden.Font.Name = "Fixedsys"
txtHidden.Text = String(500, "W")
Do Until intLength = intMaxLineLen
txtHidden.Width = txtHidden.Width + 5
lngIndex = SendMessage(txtHidden.hWnd, _
EM_LINEINDEX, 1, 0)
intLength = SendMessage(txtHidden.hWnd , _
EM_LINELENGTH, lngIndex, 0)
Loop
txtHidden = ""
txtHidden.Visible = False
End Sub
Private Sub Form_Load()
SetUpRTB
End Sub
'WordWrap Class
Option Explicit
Public Function WordWrap(strText As String, intLineLen As Integer) As String
frmMain.intMaxLineLen = intLineLen
Load frmMain
WordWrap = GetText(strText)
End Function
'*************************************************************************************
'This function wraps a string by using apis and a textbox control(txtHidden)
'located on frmmain
'*************************************************************************************
Private Function GetText(strSource As String) As String
Dim lngCounter As Long
Dim lngLinecount As Long
Dim strHolder As String
Dim strLine As String
Dim lngCurrPos As Long, lngCurrPos2 As Long
Dim lngNextLen As Long
Dim lngtxtSize As Long
Dim intLength As Integer, intPrevLength As Integer
Dim lngCount As Long
Dim lngIndex As Long
Dim strBuf As String, strBufReplace As String
lngtxtSize = 65535 / ((2 / ((frmMain.intMaxLineLen + 1) / 2)) + 1)
strHolder = Space$(10000000)
lngNextLen = lngtxtSize
lngCurrPos = 1
lngCurrPos2 = 1
Do Until lngCurrPos >= Len(strSource)
If Len(strSource) - lngCurrPos < lngtxtSize Then
lngNextLen = Len(strSource) - lngCurrPos + 1
End If
frmMain.txtHidden = Mid(strSource, lngCurrPos, lngNextLen)
SendMessage frmMain.txtHidden.hWnd, EM_FMTLINES, True, 0
lngIndex = SendMessage(frmMain.txtHidden.hWnd, _
EM_LINEINDEX, 0, 0)
intLength = SendMessage(frmMain.txtHidden.hWnd, _
EM_LINELENGTH, lngIndex, 0)
If intLength + intPrevLength > frmMain.intMaxLineLen Then
strBuf = Space$(intLength + 1)
SendMessage frmMain.txtHidden.hWnd, EM_GETLINE, 0, ByVal strBuf
strBuf = Left$(strBuf, intLength)
strBufReplace = FixBuf(strBuf, intPrevLength)
frmMain.txtHidden = Replace$(frmMain.txtHidden, strBuf, strBufReplace, , 1)
SendMessage frmMain.txtHidden.hWnd, EM_FMTLINES, True, 0
End If
lngCount = SendMessage(frmMain.txtHidden.hWnd, _
EM_GETLINECOUNT, 0, 0)
lngIndex = SendMessage(frmMain.txtHidden.hWnd, _
EM_LINEINDEX, lngCount - 1, 0)
intPrevLength = SendMessage(frmMain.txtHidden.hWnd, _
EM_LINELENGTH, lngIndex, 0)
Mid$(strHolder, lngCurrPos2, Len(frmMain.txtHidden)) = frmMain.txtHidden
lngCurrPos2 = lngCurrPos2 + Len( frmMain.txtHidden)
lngCurrPos = lngCurrPos + lngNextLen
Loop
GetText = Replace$(Trim$(strHolder), vbCr & vbCr & vbLf, vbCrLf)
End Function
'****************************************************************************
'This function ensures that the first line of the text to be conconcatonated
'does not exceed the maximum line length when concatonated to the last line
'in the main string variable
'****************************************************************************
Private Function FixBuf(ByVal strText As String, intLen As Integer) As String
Dim intMaxLen As Integer
Dim i As Integer
Dim intlstSpace As Integer
intMaxLen = frmMain.intMaxLineLen - intLen
For i = 1 To intMaxLen
If Mid$(strText, i, 1) = Space$(1) Then
intlstSpace = i
End If
Next
If intlstSpace <> 0 Then
strText = Left$(strText, intlstSpace - 1) & vbCrLf & Right$(strText, Len(strText) - intlstSpace)
Else
strText = Left$(strText, intMaxLen) & vbCrLf & Right$(strText, Len(strText) - intMaxLen)
End If
FixBuf = strText
End Function
( orignal source: http://www.mredkj.com/vbquicktakes/WordWrap.html )
Get Textbox Line Count Using SendMessage Function In user32 Library
Get Textbox Line Count Using SendMessage Function In user32 Library
Const EM_GETLINECOUNT As Integer = &HBA
Declare Function SendMessage Lib "user32" Alias "SendMessageA" _
(ByVal hwnd As IntPtr, ByVal wMsg As Integer, ByVal wParam As Integer, _
ByVal lParam As Integer) As Integer
Trace.WriteLine(SendMessage(TextBox1.Handle, EM_GETLINECOUNT, 0, 0))
Const EM_GETLINECOUNT As Integer = &HBA
Declare Function SendMessage Lib "user32" Alias "SendMessageA" _
(ByVal hwnd As IntPtr, ByVal wMsg As Integer, ByVal wParam As Integer, _
ByVal lParam As Integer) As Integer
Trace.WriteLine(SendMessage(TextBox1.Handle, EM_GETLINECOUNT, 0, 0))
Oct 9, 2007
ADO.NET Overview
Imports System
Imports System.Data
Imports System.Data.SqlClient
namespace HowTo.Samples.ADONET
public class adooverview4
public shared sub Main()
Dim myadooverview4 as adooverview4
myadooverview4 = new adooverview4()
myadooverview4.Run()
end sub
public sub Run()
' Create a new Connection and SqlDataAdapter
Dim myConnection as SqlConnection
Dim mySqlDataAdapter as SqlDataAdapter
Dim workParam as SqlParameter
myConnection = new SqlConnection("server=(local)\NetSDK;Trusted_Connection=yes;database=northwind")
mySqlDataAdapter = new SqlDataAdapter("Select * from Region", myConnection)
' Restore database to it's original condition so sample will work correctly.
Cleanup()
' Build the insert Command
mySqlDataAdapter.InsertCommand = new SqlCommand("Insert into Region (RegionID, RegionDescription) VALUES (@RegionID, @RegionDescription)", myConnection)
workParam = mySqlDataAdapter.InsertCommand.Parameters.Add ("@RegionID", SqlDbType.Int)
workParam.SourceColumn = "RegionID"
workParam.SourceVersion = DataRowVersion.Current
workParam = mySqlDataAdapter.InsertCommand.Parameters.Add("@RegionDescription", SqlDbType.NChar, 50)
workParam.SourceVersion = DataRowVersion.Current
workParam.SourceColumn = "RegionDescription"
' Build the update command
mySqlDataAdapter.UpdateCommand = new SqlCommand("Update Region Set RegionDescription = @RegionDescription WHERE RegionID = @RegionID" , myConnection)
workParam = mySqlDataAdapter.UpdateCommand.Parameters.Add ("@RegionID", SqlDbType.Int)
workParam.SourceColumn = "RegionID"
workParam.SourceVersion = DataRowVersion.Original
workParam = mySqlDataAdapter.UpdateCommand.Parameters.Add("@RegionDescription", SqlDbType.NChar, 50)
workParam.SourceVersion = DataRowVersion.Current
workParam.SourceColumn = "RegionDescription"
Dim myDataSet as DataSet
myDataSet = new DataSet()
' Set the MissingSchemaAction property to AddWithKey because Fill will not cause primary key & unique key information to be retrieved unless AddWithKey is specified.
mySqlDataAdapter.MissingSchemaAction = MissingSchemaAction.AddWithKey
mySqlDataAdapter.Fill(myDataSet, "Region")
Dim myDataRow1 as DataRow
myDataRow1 = myDataSet.Tables("Region").Rows.Find(2)
myDataRow1(1) = "Changed this region desc"
Dim myDataRow2 as DataRow
myDataRow2 = myDataSet.Tables("Region").NewRow()
myDataRow2(0) = 901
myDataRow2(1) = "A new region"
myDataSet.Tables("Region").Rows.Add(myDataRow2)
try
mySqlDataAdapter.Update(myDataSet, "Region")
Console.Write("Updating DataSet succeeded!")
catch e as Exception
Console.Write(e.ToString())
end try
end sub
public sub Cleanup()
Dim myConnection as SqlConnection = new SqlConnection("server=(local)\NetSDK;Trusted_Connection=yes;database=northwind")
try
' Restore database to it's original condition so sample will work correctly.
myConnection.Open()
Dim CleanupCommand as SqlCommand = new SqlCommand("DELETE FROM Region WHERE RegionID = '901'", myConnection)
CleanupCommand.ExecuteNonQuery()
catch e as Exception
Console.Write(e.ToString())
finally
myConnection.Close()
end try
end sub
end class
end namespace
( original source: http://samples.gotdotnet.com/quickstart/util/srcview.aspx?path=/quickstart/howto/samples/adoplus/adooverview4/adooverview4.src )
Subscribe to:
Posts (Atom)