Solved

Writting a text string to a tiff file using GDI Plus

Posted on 2004-10-04
20
2,196 Views
Last Modified: 2013-11-19
Hello,
I am trying to writte a string text (Might be a page long) to a tiff file (CCITTG4 compression) using GDIPLUS. Basically, I should be able to specify the width, height, resolution and text font for the tif file. I also need the text wrapped properly at the end of the line on the tiff image. I am not sure where to start. Any help and source code in VB6 will be appreciated. Thanks in advance...
0
Comment
Question by:gfahd1
  • 11
  • 7
  • 2
20 Comments
 
LVL 32

Expert Comment

by:Erick37
ID: 12218326
0
 

Author Comment

by:gfahd1
ID: 12218473
I don't have a base file to start with, I need to create one on the fly and size it, then save it with the tiff encoding. When I draw the text. does it wrap without breaking the words at the end of the line? Samples will be appreciated. Thanks
0
 
LVL 32

Expert Comment

by:Erick37
ID: 12219822
Here is a very basic example of one way to easily get some text into a picture.
This example is based on the MS article here: http://support.microsoft.com/default.aspx?scid=kb;en-us;230502

This code generates a BMP image which can be converted to TIFF using the GDI+ library I pointed to above.

Create a new project and place 2 pictureboxes on the form, Picture1 and Picture2
Place a Textbox INSIDE Picture1
Place a command button on the form.
Set the borderstyles on the picturepoxes and textbox to 0 None.
set the Multiline property of the Textbox = True
You can set the Visible property of the Pictureboxes to False once you confirm that this is close to what you need.

Option Explicit
'
'On a form place:
'
'2 PictureBoxes: Picture1, Picture2
'Set both Borderstyle = 0 None
'
'Textbox: Text1 (INSIDE PICTURE1)
'Textbox1.Multiline = true
'Textbox1.Borderstyle = 0 None
'
Const MARGIN = 200 'twips
Private Const twipFactor = 1440
Private Const WM_PAINT = &HF
Private Const WM_PRINT = &H317
Private Const PRF_CLIENT = &H4&    ' Draw the window's client area.
Private Const PRF_CHILDREN = &H10& ' Draw all visible child windows.
Private Const PRF_OWNED = &H20&    ' Draw all owned windows.

Private Declare Function SendMessage Lib "user32" Alias _
   "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, _
   ByVal wParam As Long, ByVal lParam As Long) As Long


Private Sub Command1_Click()
'
'Make the image
'

    Dim h As Long, w As Long, r As Long

    'Set the textbox properties
    With Text1
    .FontName = "Courier New"
    .FontSize = 12
    .Text = "Lorem ipsum dolor sit amet, consetetur sadipscing elitr,  sed diam nonumy eirmod tempor invidunt ut labore et dolore magna aliquyam erat, sed diam voluptua. At vero eos et accusam et justo duo dolores et ea rebum. Stet clita kasd gubergren, no sea takimata sanctus est Lorem ipsum dolor sit amet. Lorem ipsum dolor sit amet, consetetur sadipscing elitr,  sed diam nonumy eirmod tempor invidunt ut labore et dolore magna aliquyam erat, sed diam voluptua. At vero eos et accusam et justo duo dolores et ea rebum. Stet clita kasd gubergren, no sea takimata sanctus est Lorem ipsum dolor sit amet. Lorem ipsum dolor sit amet, consetetur sadipscing elitr,  sed diam nonumy eirmod tempor invidunt ut labore et dolore magna aliquyam erat, sed diam voluptua. At vero eos et accusam et justo duo dolores et ea rebum. Stet clita kasd gubergren, no sea takimata sanctus est Lorem ipsum dolor sit amet."
    End With
   
    'Set the properties of the page (picturebox)
    With Picture1
   
    'set the page size
    .Width = ScaleX(4.25, vbInches, vbTwips)
    .Height = ScaleY(5.5, vbInches, vbTwips)
   
    'convert the pictureboc dimensions to pixels
    w = ScaleX(.ScaleWidth, vbTwips, vbPixels)
    h = ScaleY(.ScaleHeight, vbTwips, vbPixels)
   
    '.SetFocus
    Picture2.Width = .Width
    Picture2.Height = .Height
    Picture2.AutoRedraw = True
    r = SendMessage(.hwnd, WM_PAINT, Picture2.hDC, 0)
    r = SendMessage(.hwnd, WM_PRINT, Picture2.hDC, PRF_CHILDREN + PRF_CLIENT + PRF_OWNED)
    Picture2.Picture = Picture2.Image
    Picture2.AutoRedraw = False
   
    SavePicture Picture2.Picture, "c:\testimage.bmp"
   
    End With

End Sub


Private Sub Picture1_Resize()
    'resize the textbox to fit the picturebox with some margin
    Text1.Move MARGIN, MARGIN, Picture1.ScaleWidth - (2 * MARGIN), Picture1.ScaleHeight - (2 * MARGIN)
End Sub

0
 

Author Comment

by:gfahd1
ID: 12237138
Erick37,
Your code above works, but my boss doesn't want me to use picture boxes. He wants me to work only with GDIPlus. To make it a bit easier, we can start with a blank CCITTG4 tiff file (8.5 X 11 at 300 DPI). But, we have to resize it up or down with different resolution. Any Code input on this will be appreciated.
0
 
LVL 1

Expert Comment

by:VBtorment
ID: 12240648
Thanks, and good luck :)
0
 

Author Comment

by:gfahd1
ID: 12241136
Hello,
I managed to load a tiff image and save it again. Now I need to write text to the image, change resolution and size before I save it. Any ideas? Thanks

My code so far is:

Option Explicit
Private m_image As GDIPBitmap
Private g_cDecoders As GDIPImageDecoderList
Private g_cEncoders As GDIPImageEncoderList

Private Const TIFF_COMP_CCITTG4 = 4

Private Sub cmdSave_Click()
    Dim cEncoders As GDIPImageEncoderList
    Dim cCodec As GDIPImageCodec
    Dim sFIle As String
    ' set parameters as required:
         Dim cParamList As GDIPEncoderParameterList
         Dim cParam As GDIPEncoderParameter
   
     Set g_cEncoders = New GDIPImageEncoderList
   
    sFIle = App.Path & "\blank3.jpg"

    Set cCodec = g_cEncoders.EncoderForMimeType("image/tiff")
   
    Set cParamList = m_image.Image.EncoderParameterList(cCodec.CodecCLSID)
    Set cParam = cParamList.ParameterForGuid(EncoderCompression)
    cParam.ValueCount = 1
    cParam.Value(1) = TIFF_COMP_CCITTG4

    Set cParam = cParamList.ParameterForGuid(EncoderColorDepth)
    cParam.ValueCount = 1
    cParam.Value(1) = 1
   
   
    ' Save the image using the specified codec:
    m_image.Image.Save sFIle, cCodec.CodecCLSID
   
    MsgBox "Saved"

End Sub

Private Sub Form_Load()
    Dim sFIle As String
    Dim g As GDIPGraphics
   
    On Error GoTo errorHandler
   
    If Not GDIPlusCreate Then
        MsgBox Err.Description
    End If
    Set m_image = New GDIPBitmap
   
   sFIle = App.Path & "\blank2.tif"
   
    m_image.Image.FromFile sFIle
   
   
    Me.Refresh
       
    Exit Sub

errorHandler:
    MsgBox Err.Description

End Sub

Private Sub Form_Paint()
    If Not (m_image Is Nothing) Then
      Dim lLeft As Long
      Dim lTop As Long
      Dim gfx As New GDIPGraphics
           
      lLeft = linSep.X1 \ Screen.TwipsPerPixelX
      lTop = linSep.Y2 \ Screen.TwipsPerPixelY + 4
     
      gfx.FromHDC Me.hdc
      gfx.DrawImagePointLv m_image.Image, lLeft, lTop
      gfx.Dispose
     
   End If

End Sub

Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
    If Not m_image Is Nothing Then
      m_image.Dispose
   End If
   GDIPlusDispose
End Sub
0
 
LVL 1

Expert Comment

by:VBtorment
ID: 12242748
what references are u using ??
or dll ??

so i can  try it here...
0
 

Author Comment

by:gfahd1
ID: 12242852
I am using the GDI+ (GDIPLUS.TLB)  and the GDI PLUSWrapper(GDIPlusWrapper.dll). I can e-mail them to you if you don't find them.
Thanks
0
 
LVL 32

Accepted Solution

by:
Erick37 earned 500 total points
ID: 12251103
Hi gfahd1

I tried using the GDI+ Wrapper from vbAccelerator.com to print text to your TIFF file, but the wrapper kept crashing VB. I had to give up that approach.

However I found a good reference to the flat GDI+ api calls in a standard module from planetsourcecode.com.
There is a sample project here:
http://www.pscode.com/vb/scripts/ShowCode.asp?txtCodeId=37541&lngWId=1

I made a copy of the file "GDIPlus API.bas" and placed it in my project folder.  I then added the file to the project.  Now most of the GDI+ api calls and constants and types are declared for you.

The following code (modified from the sample at psc.com) opens a tiff file from disk as the blank image template.  The function DrawFormatText will print the wrapped text to the image.  Finally the image is saved back to disk.

The only thing left to do is figure out how to pass the encoderParams to the function which writes the TIFF to a file.  The function GdipSaveImageToFile errors out if I specify "EncoderCompression" as a parameter in the encoderParams structure.  So as it is now, the function is not passed any parameters.

Maybe someone else has some insight into this issue.

Here is the code so far... (remember to add the "GDIPlus API.bas" module to the project)

'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Option Explicit

Dim token As Long ' Needed to close GDI+

Private Sub Form_Load()

    Dim sInFile As String 'The input file
    Dim sOutFile As String 'The output file
    Dim sText As String 'The string to draw
    Dim rcf As RECTF 'The rectangle to draw in
    Dim graphics As Long 'the graphics context
    Dim img As Long 'the pointer to the image
    Dim stat As GpStatus 'gdip api call return status code
   
    '// Tiff encoding variables
    Dim encoderCLSID As CLSID
    Dim encoderParams As EncoderParameters
    Dim lCompression As Long, lColorDepth As Long
    Dim encoderArray() As Byte '// now it's getting tricky
    Dim lngEP As Long ' Size of encoderParams variable/struct

    ' Load the GDI+ Dll
    Dim GpInput As GdiplusStartupInput
    GpInput.GdiplusVersion = 1
    If GdiplusStartup(token, GpInput) <> Ok Then
        MsgBox "Error loading GDI+!", vbCritical
        Unload Me
    End If
   
    '// Load up our test string
    sText = "Lorem ipsum dolor sit amet, consetetur sadipscing elitr,  sed diam nonumy eirmod tempor invidunt ut labore et dolore magna aliquyam erat, sed diam voluptua. At vero eos et accusam et justo duo dolores et ea rebum. Stet clita kasd gubergren, no sea takimata sanctus est Lorem ipsum dolor sit amet. Lorem ipsum dolor sit amet, consetetur sadipscing elitr,  sed diam nonumy eirmod tempor invidunt ut labore et dolore magna aliquyam erat, sed diam voluptua. At vero eos et accusam et justo duo dolores et ea rebum. Stet clita kasd gubergren, no sea takimata sanctus est Lorem ipsum dolor sit amet. Lorem ipsum dolor sit amet, consetetur sadipscing elitr,  sed diam nonumy eirmod tempor invidunt ut labore et dolore magna aliquyam erat, sed diam voluptua. At vero eos et accusam et justo duo dolores et ea rebum. Stet clita kasd gubergren, no sea takimata sanctus est Lorem ipsum dolor sit amet."

    On Error GoTo ERRHANDLER

    '// Set our filenames for testing
    sInFile = App.path & "\blank2.tif"
    sOutFile = App.path & "\blank3.tif"

    If Dir(sInFile) = "" Then Err.Raise 53
   
    '// Load the template file as our image
    Call GdipLoadImageFromFile(StrConv(sInFile, vbUnicode), img)
   
    '// Make the rect the size of the image
    Call GdipGetImageBounds(img, rcf, UnitPixel)
    '// adjust the rect for a margin
    rcf.Bottom = rcf.Bottom - 20
    rcf.Left = rcf.Left + 10
    rcf.Right = rcf.Right - 20
    rcf.Top = rcf.Top + 10

    '// Get the graphics associated with the image
    Call GdipGetImageGraphicsContext(img, graphics)
   
    '// Draw the text on the graphics context
    Call DrawFormatText(graphics, sText, rcf, "Courier New", 12, StringAlignment.StringAlignmentNear)
   
    '//Save the image
    ' Get the CLSID of the TIFF encoder
    Call GetEncoderClsid("image/tiff", encoderCLSID)
   
   
    '//*** DEAD CODE - ToDo: Figure out why this errors out ***
    'The size of the structure
    lngEP = Len(encoderParams)
    ' Make a byte array to hold the 2 member structure (we are setting 2 parameters)
    ReDim encoderArray(0 To (lngEP + Len(encoderParams.Parameter))) As Byte
   
    ' TIFF format requires encoder parameters.
    lCompression = EncoderValue.EncoderValueCompressionCCITT4
    lColorDepth = 1
   
    ' Setup the encoder paramters
    encoderParams.count = 2    ' Setting 2 elements in this Parameter array
   
    With encoderParams.Parameter
        .NumberOfValues = 1     ' Should be one
        .type = EncoderParameterValueTypeLong
        ' Set the GUID to EncoderCompression
        .GUID = DEFINE_GUID(EncoderCompression)
        .value = VarPtr(lCompression)  ' Remember: The value expects only pointers!
    End With
   
    ' Copy the data into the byte array
    CopyMemory encoderArray(0), encoderParams, lngEP

    With encoderParams.Parameter
        .NumberOfValues = 1     ' Should be one
        .type = EncoderParameterValueTypeLong
        ' Set the GUID to EncoderCompression
        .GUID = DEFINE_GUID(EncoderColorDepth)
        .value = VarPtr(lColorDepth)  ' Remember: The value expects only pointers!
    End With
   
    ' Copy the second parameter to the byte array at the right offset
    CopyMemory encoderArray(lngEP), encoderParams.Parameter, Len(encoderParams.Parameter)
    '//****END DEAD CODE****
   

    ' Save as a TIFF file.
    'stat = GdipSaveImageToFile(img, StrConv(sOutFile, vbUnicode), encoderCLSID, encoderArray(0))
   
    '// Do not send the encoderParams until I figure out how...
    stat = GdipSaveImageToFile(img, StrConv(sOutFile, vbUnicode), encoderCLSID, ByVal 0)
   
    ' See if it was created
    If stat = Ok Then
        MsgBox "Successfully saved " & sOutFile, vbInformation
    Else
        MsgBox "Error saving file! Status Code: " & stat, vbCritical
    End If


    '// Clean up
    Call GdipDeleteGraphics(graphics)
    Call GdipDisposeImage(img)
    Exit Sub

ERRHANDLER:
    MsgBox "Error: " & Err.Number & " - " & Err.description, vbCritical, App.Title
    End 'Just quit
End Sub

'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Private Sub Form_Unload(Cancel As Integer)
    ' Unload the GDI+ Dll
    Call GdiplusShutdown(token)
End Sub

'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Private Sub DrawFormatText(graphics As Long, _
                            ByVal str As String, _
                            rcLayout As RECTF, _
                            ByVal sFontName As String, _
                            ByVal lFontSize As Long, _
                            ByVal Justification As StringAlignment)

   Dim brush As Long, pen As Long
   Dim fontFam As Long, curFont As Long, strFormat As Long
   
   ' Initializations
   Call GdipCreateSolidFill(Colors.Black, brush) ' Create a brush to draw the text with
   ' Create a font family object to allow use to create a font
   ' We have no font collection here, so pass a NULL for that parameter
   Call GdipCreateFontFamilyFromName(StrConv(sFontName, vbUnicode), 0, fontFam)
   ' Create the font from the specified font family name
   ' >> Note that we have changed the drawing Unit from pixels to points!!
   Call GdipCreateFont(fontFam, lFontSize, FontStyle.FontStyleRegular, GpUnit.UnitPoint, curFont)
   ' Create the StringFormat object
   ' We can pass NULL for the flags and language id if we want
   Call GdipCreateStringFormat(0, 0, strFormat)
   
   ' Left align each line of text
   Call GdipSetStringFormatAlign(strFormat, Justification)
   
   ' Draw the block of text (top to bottom) in the rectangle.
   Call GdipSetStringFormatLineAlign(strFormat, StringAlignment.StringAlignmentNear)
   
   ' Draw the string within the boundary
   str = StrConv(str, vbUnicode)
   Call GdipDrawString(graphics, str, -1, curFont, rcLayout, strFormat, brush)
   
   ' Create a pen and draw the boundary around the text (uncomment 3 lines to show)
   '''Call GdipCreatePen1(Black, 1, UnitPixel, pen)
   '''Call GdipDrawRectangles(graphics, pen, rcLayout, 1)
   '''Call GdipDeletePen(pen)
   
   ' Cleanup
   Call GdipDeleteStringFormat(strFormat)
   Call GdipDeleteFont(curFont)     ' Delete the font object
   Call GdipDeleteFontFamily(fontFam)  ' Delete the font family object
   Call GdipDeleteBrush(brush)
End Sub





0
 

Author Comment

by:gfahd1
ID: 12251764
Erick37,
The encoder in your example worked fine for me without crashing VB. I uncomented this line:
stat = GdipSaveImageToFile(img, StrConv(sOutFile, vbUnicode), encoderCLSID, encoderArray(0))
And comented: '    stat = GdipSaveImageToFile(img, StrConv(sOutFile, vbUnicode), encoderCLSID, ByVal 0).

But, this gets me exactly where I was in my code above (Previous Post).  You text is not being wriiten to the new tiff file. (Unless it is a white text. I have a white backgound template tiff).

I also still need to resize the new tiff  and modify the resolution. When I set the resolution: GdipBitmapSetResolution img, 200, 200 I get a status error of 7 when saving the new image.

The .bas library is nice to have.

Thanks again for your help, I hope we canm solve it soon. As I said, the encoding is working fine for me.

0
Free Trending Threat Insights Every Day

Enhance your security with threat intelligence from the web. Get trending threat insights on hackers, exploits, and suspicious IP addresses delivered to your inbox with our free Cyber Daily.

 
LVL 32

Expert Comment

by:Erick37
ID: 12252081
Error code 7 means "Win32_Error" and that's what I get when I try to save the file using the encoderParams info.

I have saved blank2.tif as a 4.25" x 5.5" blank tiff file.  After the program runs, blank3.tif contains the image of blank2.tif with black text printed on the page.  It works here as long as I don't send the encoderParams info.

I wouldn't try setting the resolution until you can see the text on the final image.  Besides, GdipBitmapSetResolution sets the res of a bitmap, not an image.

I'm just learnig all of this now, so I'm struggling to absorb it all.
0
 

Author Comment

by:gfahd1
ID: 12252185
My blank2.tif is 8.5 X 11. The location of the text might be off. I will play with it to see if I can get it right. As for the image resize and resolution, I have to keep working on this. Thanks
0
 

Author Comment

by:gfahd1
ID: 12252211
Setting the resolution of the image returns OK ( stat = GdipBitmapSetResolution(img, 300, 300))
But saving it fails with error 7: stat = GdipSaveImageToFile(img, StrConv(sOutFile, vbUnicode), encoderCLSID, encoderArray(0))

0
 

Author Comment

by:gfahd1
ID: 12252470
I am getting error 3 (OutOfMemory) when I call stat = GdipGetImageGraphicsContext(img, graphics).
graphics is being returned as 0, so I think that is why the text is not being written to the tiff page. Any ideas why I am getting this error?
Thanks
0
 
LVL 32

Expert Comment

by:Erick37
ID: 12252867
I don't know where you are in the code.  If you remove the GdipBitmapSetResolution line and use
stat = GdipSaveImageToFile(img, StrConv(sOutFile, vbUnicode), encoderCLSID, ByVal 0) '<< don't pass in encoderParams
do you get any output?

The text fails to print on my computer if I insert GdipBitmapSetResolution in the code.
0
 

Author Comment

by:gfahd1
ID: 12253039
I removed GdipBitmapSetResolution  from my code.
If I don't pass in any encoders, I get a large image with no Text.
If I pass in the encoder, I get a smaller tiff(same size image as the original tiff file) with no text also.

So, the answer  to your question above is yes, I do get an output with large image and no text. Regardless of what I do, stat = GdipGetImageGraphicsContext(img, graphics) is failing with error 3 (OutOfMemory), and that is why I don't get text written to the image.

So, i have 2 problems right now:
1. GdipGetImageGraphicsContext(img, graphics) is not working  (returning graphics=0) and stat =3
2. GdipBitmapSetResolution  works fine when I call it, but error 7 occurs saving the image.

Thanks
0
 
LVL 32

Expert Comment

by:Erick37
ID: 12357784
Hi gfahd1

Do you still need help with this?
0
 

Author Comment

by:gfahd1
ID: 12357869
Erick37,
I still couldn't get it working. I defenitly need to get back on it soon. Do you have anything new?
Thanks
0
 

Author Comment

by:gfahd1
ID: 12547529
Erick37,
I am still didn't get it to work. I am trying to get working in VB.NET(Having problem saving it in CCITT4 compression):
http://www.experts-exchange.com/Programming/Programming_Languages/Dot_Net/VB_DOT_NET/Q_21190177.html
You deserve the points for all your help above. Thanks
0
 
LVL 32

Expert Comment

by:Erick37
ID: 12547714
I could not set the TIFF encoder compression on my machine,  not sure why, perhaps I do not have the correct encoders installed.

Thanks for the 'A'

I'll post an update If I find out anything new.
0

Featured Post

How to improve team productivity

Quip adds documents, spreadsheets, and tasklists to your Slack experience
- Elevate ideas to Quip docs
- Share Quip docs in Slack
- Get notified of changes to your docs
- Available on iOS/Android/Desktop/Web
- Online/Offline

Join & Write a Comment

The debugging module of the VB 6 IDE can be accessed by way of the Debug menu item. That menu item can normally be found in the IDE's main menu line as shown in this picture.   There is also a companion Debug Toolbar that looks like the followin…
If you need to start windows update installation remotely or as a scheduled task you will find this very helpful.
Get people started with the utilization of class modules. Class modules can be a powerful tool in Microsoft Access. They allow you to create self-contained objects that encapsulate functionality. They can easily hide the complexity of a process from…
In this Micro Tutorial viewers will learn the basic shortcuts and functions of Illustrator. The viewer will learn about the paintbrush tool, anchor points, font sizing, and more.

747 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

10 Experts available now in Live!

Get 1:1 Help Now