Im trying to get the privatefontcollection to work. But so far its not working, not in the sense of an error, just the font seen on screen is MS Sans Serif and not the Font im trying to load. so far i have tried two diffrent methods and neither seem to have worked for me.
First i tried:
Public Function GetFontInstance(ByVal data() As Byte, ByVal Size As Single, ByVal Style As FontStyle) As Font
Dim result As Font
Try
Dim pfc = New PrivateFontCollection
'LOAD MEMORY POINTER FOR FONT RESOURCE
Dim FontPtr As System.IntPtr = Marshal.AllocCoTaskMem(data.Length)
'COPY THE DATA TO THE MEMORY LOCATION
Marshal.Copy(data, 0, FontPtr, data.Length)
'LOAD THE MEMORY FONT INTO THE PRIVATE FONT COLLECTION
pfc.AddMemoryFont(FontPtr, data.Length)
'FREE UNSAFE MEMORY
'Marshal.FreeCoTaskMem(FontPtr)
result = New Font(pfc.Families(0), Size, Style)
pfc.Families(0).Dispose()
pfc.Dispose()
Catch ex As Exception
'ERROR LOADING FONT. HANDLE EXCEPTION HERE
MsgBox("Error in [GetFontInstance()]" & vbCrLf & ex.Message)
result = New Font(FontFamily.GenericMonospace, 8)
End Try
Return result
End Function
i called this function from the Print SubRoutine:
Dim newFont As Font = GetFontInstance(My.Resources.OpenSans_Bold, 22, FontStyle.Bold)
e.Graphics.DrawString("Hello World", newFont, Brushes.Black, 50, 2)
but what i see in the printdocument print preview, is just MS Sans Serif type font. not the font i have loaded into my Resources.
I then tried this method:
Dim sAppPath As String
sAppPath = System.Windows.Forms.Application.StartupPath
Dim fcollect As New PrivateFontCollection()
fcollect.AddFontFile(sAppPath & "\OpenSans-Bold.ttf")
Dim OpenSansFont As New Font(fcollect.Families(0), 50, FontStyle.Bold)
e.Graphics.DrawString("Hello World", OpenSansFont, Brushes.Black, 50, 2)
again i got the same result
is there something I'm missing to get this to work. other questions asked about this seem to indicate this should just work.
I should mention that the end user will run the Application on a system admin locked PC, so the option to "install" the font wont be possible. Id need to make use of the font only while the application is running / when the subroutine gets called.
Related
There is a group somewhere in our organization that scans documents and converts them to PDFs. They then associate those PDFs with an "event" record and store them in a database. On demand, my application -- which uses Winnovative HTML to PDF v9.0.0.0 -- has to retrieve the PDFs associated with an event, place a header on the first page of each, and store them on the file system. This header is a TextElement.
On some PDFs, the header displays beautifully. On others, the header does not appear. However, when viewing the PDF, the header can be "highlighted" with the cursor and its text successfully copied, so the header is indeed present and properly positioned. (See the green arrow in the inserted image.)
I have identified two PDFs that were scanned by the same person thirty minutes apart and associated with the same event in the database. On one, the header is displayed; on the other, it is not. To investigate, I have set the BackColor of the TextElement to Crimson. The Text appears and doesn't appear as before, but the TextElement always appears bright red.
The properties of the two Document and PDFPage objects are identical, including the TransparencyEnabled property. This phenomenon is present in PDFs of all sorts of documents scanned by various people over time. And it's not just this header TextElement, but TextElements everywhere on the PDF (e.g. Page X of Y, watermarks). On a given PDF, if the Text of one is visible, the Text of all is visible, and vice versa.
I can find no pattern or explanation. What could be causing some PDFs to "hide" the Text (and only the Text) of all TextElements that I put on them while others don't?
Private Sub AddTitleToFirstPage(ByRef pdf As Document)
Dim headerSystemFont As New Font("Arial", 10)
Dim headerFont As PdfFont = pdf.Fonts.Add(headerSystemFont)
Dim headerTextElement As New TextElement(65, 20, "My Page Title", headerFont)
headerTextElement.TextAlign = HorizontalTextAlign.Center
headerTextElement.ForeColor = Color.DarkBlue
headerTextElement.BackColor = Color.Crimson
pdf.Pages(0).AddElement(headerTextElement)
End Sub
Friend Function UpdatePdfDoc(pdfBytes As Byte()) As Byte()
Dim bytes As Byte()
Using docStream As New MemoryStream(pdfBytes, 0, pdfBytes.Length)
Dim returnDoc As Document = New Document(docStream)
returnDoc.LicenseKey = WinnovativeLicenceKey
AddTitleToFirstPage(returnDoc)
bytes = returnDoc.Save()
docStream.Close()
End Using
Return bytes
End Function
Friend Function GetEventObjectPdfSource(scannedDocIds As List(Of String)) As Object
Dim scannedDocObjectPdfSourceList As New List(Of Byte())()
For Each scannedDocId As String In scannedDocIds
Dim scannedDocObjectPdfSource As Byte() = GetScannedDocBlobById(scannedDocId)
scannedDocObjectPdfSource = UpdatePdfDoc(scannedDocObjectPdfSource)
scannedDocObjectPdfSourceList.Add(scannedDocObjectPdfSource)
Next
Return scannedDocObjectPdfSourceList
End Function
Friend Function GetEventObjectPdf(eventId As String) As String
Dim pdfFileName As String = GetPDFFileName(eventId)
Dim scannedDocIds As List(Of String) = GetScannedDocumentsForEvent(eventId)
Dim objectPdfSourceList As List(Of Byte()) = CType(GetEventObjectPdfSource1(scannedDocIds), List(Of Byte()))
For Each objectPdfSource As Byte() In objectPdfSourceList
Using docStream As New MemoryStream(objectPdfSource, 0, objectPdfSource.Length)
Dim masterDoc As New Document(docStream)
masterDoc.LicenseKey = WinnovativeLicenceKey
Do While masterDoc.Bookmarks.Count > 0
masterDoc.Bookmarks.Remove(0)
Loop
Try
masterDoc.AutoCloseAppendedDocs = True
masterDoc.Save(pdfFileName)
Catch ex As Threading.ThreadAbortException
Threading.Thread.ResetAbort()
Finally
masterDoc.DetachStream()
masterDoc.Close()
End Try
docStream.Close()
End Using
Next
Return pdfFileName
End Function
Please forgive the clunky code. I didn't write it. I just inherited it.
I am allowing the use of themes in my application. So I create a font based on the user's choice of themes. However, I need to change the fontstyle from regular to bold, but I don't want to have to recreate the font.
I am doing it this way, because not all users will have the font installed on their machine. So I am embedding the font into the application.
For example: I may have a textbox assigned the font like this:
txtbox.font = theme_font
Is there a way to simply change the style to bold?
txtbox.font = theme_font.fontstyle.bold ' <-- this doesn't work
I call the font creation subroutine like this:
Public Shared theme_font = BerlinSans.GetInstance(theme_font_size, FontStyle.Regular)
And this is the subroutine being called:
Module BerlinSans
'PRIVATE FONT COLLECTION TO HOLD THE DYNAMIC FONT
Private _pfc As PrivateFontCollection = Nothing
Public ReadOnly Property GetInstance(ByVal Size As Single, ByVal style As FontStyle) As Font
Get
'IF THIS IS THE FIRST TIME GETTING AN INSTANCE
'LOAD THE FONT FROM RESOURCES
If _pfc Is Nothing Then LoadFont()
'RETURN A NEW FONT OBJECT BASED ON THE SIZE AND STYLE PASSED IN
Return New Font(_pfc.Families(0), Size, style)
End Get
End Property
Private Sub LoadFont()
Try
'INIT THE FONT COLLECTION
_pfc = New PrivateFontCollection
'LOAD MEMORY POINTER FOR FONT RESOURCE
Dim fontMemPointer As IntPtr = Marshal.AllocCoTaskMem(My.Resources.BRLNSR.Length)
'COPY THE DATA TO THE MEMORY LOCATION
Marshal.Copy(My.Resources.BRLNSR, 0, fontMemPointer, My.Resources.BRLNSR.Length)
'LOAD THE MEMORY FONT INTO THE PRIVATE FONT COLLECTION
_pfc.AddMemoryFont(fontMemPointer, My.Resources.BRLNSR.Length)
'FREE UNSAFE MEMORY
Marshal.FreeCoTaskMem(fontMemPointer)
Catch ex As Exception
'ERROR LOADING FONT. HANDLE EXCEPTION HERE
End Try
End Sub
End Module
You can use the Font(Font, FontStyle) constructor. Just pass it the old font and the new style you want to use and it'll copy the properties from the old font into the new one for you (apart from the style, of course).
txtbox.Font = New Font(theme_font, FontStyle.Bold)
I have a function that gets a screenshot, saves it, and returns the file name to the image. I'm using the Bitmap.Save method and I think I'm cleaning up after myself. It, however, works only once--if the user calls the routine another time I get a external exception with a very helpful "A generic error occurred in GDI+" message.
It can save to the directory that one time (permissions don't seem to be the problem). And, if I change the file name (with, say, a simple counter) it works all the time--just leaves a mess in the temp directory in my opinion.
I've read some MSDN articles that lead me to believe I think I'm leaving a lock on the file, but 'no idea what I'm doing incorrectly.
Here's the code:
Function GetImage()
Dim tempFile As String = Path.GetTempPath() & "Screen_Log.jpg"
Me.WindowState = FormWindowState.Normal
Me.Activate()
Me.Refresh()
Dim bmpScreenshot As Bitmap = New Bitmap(Width, Height, PixelFormat.Format32bppArgb)
Dim gfxScreenshot As Graphics = Graphics.FromImage(bmpScreenshot)
gfxScreenshot.CopyFromScreen(Me.Location.X, Me.Location.Y, 0, 0, Me.Size, CopyPixelOperation.SourceCopy)
' *** Works once, then crashes here.
bmpScreenshot.Save(tempFile, ImageFormat.Jpeg)
bmpScreenshot.Dispose()
gfxScreenshot.Dispose()
Return tempFile
End Function
Any suggestions?
-Gnerf
Bitmaps can be very sticky. Try this and see if it fixes the issue. Try without the GC part and see if the using block are enough - otherwise add the garbage collection calls.
Function GetImage() As String
Dim tempFile As String = Path.GetTempPath() & "Screen_Log.jpg"
Using bmpScreenshot As Bitmap = New Bitmap(Width, Height, PixelFormat.Format32bppArgb)
Using gfxScreenshot As Graphics = Graphics.FromImage(bmpScreenshot)
gfxScreenshot.CopyFromScreen(Me.Location.X, Me.Location.Y, 0, 0, Me.Size, CopyPixelOperation.SourceCopy)
bmpScreenshot.Save(tempFile, ImageFormat.Jpeg)
End Using
End Using
GC.Collect()
GC.WaitForPendingFinalizers()
GC.Collect()
Return tempFile
End Function
When using the axAcroPdfLib.AxAcroPDF control in my Windows Forms application, I'm not able to reload the same image. The image is initially loaded with the LoadFile() method.
Upon using the LoadFile() method again on the same path AFTER saving changes to the PDF, the control becomes blank (no PDF shown).
If I set the src property of the control to the path, I get a message saying the file does not begin with '%PDF-'. But it does. I opened it with Word and it clearly begins with %PDF-. It's not corrupt or locked either.
I've even tried closing, disposing, or setting it to Nothing, and then completely re-instantiating it as I did the first time it's loaded - no effect. The window closes and shows with the control blank.
Loading a different file via the above methods has the same effect - blank.
Using Windows 7 64-bit, VS 2010, VB.NET.
The code is below. For right now, I'm just trying to draw a simple line on it.
Private Sub _btnBarCode_Click(ByVal sender As Object, ByVal e As EventArgs) Handles _btnBarCode.Click
Dim pdfReader As iTextSharp.text.pdf.PdfReader = Nothing
Try
pdfReader = New iTextSharp.text.pdf.PdfReader(File.ReadAllBytes(_path))
Using fs As New FileStream(_path, FileMode.Create, FileAccess.Write)
Using pdfStamper = New iTextSharp.text.pdf.PdfStamper(pdfReader, fs)
Dim pdfPage As iTextSharp.text.pdf.PdfContentByte = pdfStamper.GetOverContent(1)
Using barCodeForm As New FBarCode
barCodeForm.Barcode = _barCode
If (barCodeForm.ShowDialog(Me) = DialogResult.OK) Then
Dim screenBarCode As Point = barCodeForm.Location
Dim clientBarCode As Point = Point.op_Subtraction(PointToClient(screenBarCode), New Point(0, 50)) '_pdfControl.Location '_imgView.Location
clientBarCode = New Point(10, 50)
Dim barcodeImg As New Bitmap(200, 50)
Using gc As Graphics = Graphics.FromImage(barcodeImg)
gc.DrawLine(Pens.Red, New Point(10, 10), New Point(20, 20))
'barCodeForm._barCode.DrawBarCode(gc, clientBarCode)
End Using
Dim convert As ImageConverter = New ImageConverter()
Dim bmpBytes As Byte() = DirectCast(convert.ConvertTo(barcodeImg, GetType(Byte())), Byte())
Dim thisImage As iTextSharp.text.Image = iTextSharp.text.Image.GetInstance(bmpBytes)
thisImage.SetAbsolutePosition(clientBarCode.X, clientBarCode.Y)
thisImage.SetDpi(72, 72)
pdfPage.AddImage(thisImage)
rdrAdobePdf.LoadFile(_path) 'Blank pdf
'rdrAdobePdf.src = _path '"Does not begin with '%PDF-' (even though it does)
'Me.Close()
'_myParent.ResetPdfViewer()
'ReloadPdfViewer(Me.Barcode)
End If
End Using
End Using
End Using
Catch ex As Exception
MessageBox.Show(ex.Message, "An error occurred.")
Return
Finally
If Not pdfReader Is Nothing Then pdfReader.Close()
End Try
End Sub
Any ideas what could be the problem here?
Problem was solved by getting the reloading code out of that click method. Putting it in another click method solved the problem - not sure why. The code I used just ran .LoadFile, then Form.Show() and Form.Activate().
I was following this: http://zerosandtheone.com/blogs/vb/archive/2009/11/20/vb-net-include-a-font-as-an-embedded-resource-in-your-application.aspx to allow my application to use a custom fonts in a labels. The problem with that is I can run the application on my computer (probably because I have this font installed), the problem appears when any other person run the compiled application on his computer; the following error from the exception catch appears: 53 File doesn't exists.
Where does this exception is located at?
I'm talking about the module I linked above:
'MATTHEW KLEINWAKS
'ZerosAndTheOne.com
'2009
'CUSTOM FONT LOADED DYNAMICALLY FROM A RESOURCE
Imports System.Drawing.Text
Imports System.Runtime.InteropServices
Module CustomFont
'PRIVATE FONT COLLECTION TO HOLD THE DYNAMIC FONT
Private _pfc As PrivateFontCollection = Nothing
Public ReadOnly Property GetInstance(ByVal Size As Single, _
ByVal style As FontStyle) As Font
Get
'IF THIS IS THE FIRST TIME GETTING AN INSTANCE
'LOAD THE FONT FROM RESOURCES
If _pfc Is Nothing Then LoadFont()
'RETURN A NEW FONT OBJECT BASED ON THE SIZE AND STYLE PASSED IN
Return New Font(_pfc.Families(0), Size, style)
End Get
End Property
Private Sub LoadFont()
Try
'INIT THE FONT COLLECTION
_pfc = New PrivateFontCollection
'LOAD MEMORY POINTER FOR FONT RESOURCE
Dim fontMemPointer As IntPtr = _
Marshal.AllocCoTaskMem( _
My.Resources.DIGITALDREAMNARROW.Length)
'COPY THE DATA TO THE MEMORY LOCATION
Marshal.Copy(My.Resources.DIGITALDREAMNARROW, _
0, fontMemPointer, _
My.Resources.DIGITALDREAMNARROW.Length)
'LOAD THE MEMORY FONT INTO THE PRIVATE FONT COLLECTION
_pfc.AddMemoryFont(fontMemPointer, _
My.Resources.DIGITALDREAMNARROW.Length)
'FREE UNSAFE MEMORY
Marshal.FreeCoTaskMem(fontMemPointer)
Catch ex As Exception
MessageBox.Show(& Err.Number & " " & Err.Description)
End Try
End Sub
End Module
precisely this:
Catch ex As Exception
MessageBox.Show(& Err.Number & " " & Err.Description)
End Try
Is showing the message box, containing the 53 File doesn't exists message.
I don't really know why does it happends, because it works on my computer without any problems... I would appreciate any help attempt!
Try using this code
''' <summary>Adds the specified font to the private font collection.</summary>
''' <param name="font">The font to be added.</param>
Public Sub AddFont(ByVal font As Byte())
If font Is Nothing Then Throw New ArgumentNullException("The font cannot be null.", "font")
If font.Length = 0 Then Throw New ArgumentException("The length of the font array cannot be 0.", "font")
Try
privateFonts.AddMemoryFont(Marshal.UnsafeAddrOfPinnedArrayElement(font, 0), font.Length)
Catch ex As Exception
'handle you exceptions here
End Try
End Sub
And add fonts to the collection this way
Private Sub LoadFont()
Try
'INIT THE FONT COLLECTION
privateFonts = New PrivateFontCollection
AddFont(My.Resources.DIGITALDREAMNARROW)
Catch
'
' the rest of your code
'
End Sub
Assuming you added the font resource as a file, it is going to be passed to the AddFont method as a byte array.
Needless to say, the AddFont method assumes you have an initialized PrivateFontCollection object called privateFonts which is accessible within the scope of the method.
Update
Since you're saying that my solution is not working, I've uploaded a sample project here. Download and see how to load and use private fonts from resources.