Saving an image

[procreator]

I got an error trying to save a file, so I searched this forum and found this topic:
post1023.html?hilit=error%20saving%20image#p1023

I tried the code below in my program, and got this error at the first statement after Dim: "Error '438': Object doesn't support this property or method"

Dim nClonedImage As New cImaging

nClonedImage = oGdImg.CreateClonedImageI(oGdImg.GetNativeImage)
oGdImg.CloseNativeImage
oGdImg.SetNativeImage (nClonedImage)

What am I doing wrong?

Thanks!

[Loïc]

Hi procreator.

The CreateClonedImageI() method returns a long image handle and not a cImaging object.

You have to replace this line:

Code: Select all

Dim nClonedImage As New cImaging

by this one:

Code: Select all

Dim nClonedImage As Long

Regards,

Loïc

[procreator]

I made the changes you said, but I now get an automation error when I try to save the image (see line below hightlighted in bold). "The object invoked has disconnected from its clients."

Any ideas? Thanks!

This is my code:

Private Sub cmdSaveImage_Click()
Dim ofsFileSys As New FileSystemObject
Dim nClonedImage As Long
Dim lStatus As Long

WriteTagstoImage
nClonedImage = oGdImg.CreateClonedImageI(oGdImg.GetNativeImage)
lStatus = oGdImg.CloseNativeImage
oGdImg.SetNativeImage (nClonedImage)

If ofsFileSys.FileExists(mstrFileName) Then
ofsFileSys.DeleteFile (mstrFileName)
End If

SaveGdImage mstrFileName
End Sub

Public Function SaveGdImage(strFN As String) As Boolean
Dim strOut As String
Dim iFnd As Integer
Dim lStatus As Long

On Error GoTo eh

iFnd = InStrRev(strFN, ".")
strOut = Left$(strFN, iFnd - 1)
lStatus = oGdImg.SaveAsTiff(strOut & ".tif ", CompressionNone)

SaveGdImage = True

Exit Function
eh:
MsgBox Error$ & " - (" & Err.Number & ")", , "SaveGdImage()"
SaveGdImage = False
End Function

[Loïc]

Hi procreator.

I think this line

Code: Select all

nClonedImage = oGdImg.CreateClonedImageI(oGdImg.GetNativeImage)

doesn't return a valid image handle. nClonedImage value is probably 0. In the GdPicture V4 this method can fail with indexed colors bitmap. In the next major V5 release, it will work on any kind of bitmap.
You can check the status of the component calling the GetStat() method after this line. It probably returns 60: https://www.gdpicture.com/references/gdp ... tatus.html

I suggest you to replace your line by this one:

Code: Select all

nClonedImage = oGdImg.CreateClonedImageArea(Imaging1.GetNativeImage, 1, 1, Imaging1.GetWidth, Imaging1.GetHeight)

Best regards,

Loïc Carrère

[procreator]

I modified my code as shown below:

Code: Select all

    Dim nClonedImage As Long
    Dim nOrigImage As Long
    Dim lStatus As Long
    
    nClonedImage = oGdImg.CreateClonedImageArea(oGdImg.GetNativeImage, 1, 1, oGdImg.GetWidth, oGdImg.GetHeight)
    lStatus = oGdImg.GetStat
    
    nOrigImage = oGdImg.GetNativeImage
    lStatus = oGdImg.GetStat
    
    If nClonedImage <> 0 Then
        lStatus = oGdImg.CloseImage(nOrigImage)
        oGdImg.SetNativeImage (nClonedImage)
        lStatus = oGdImg.GetStat
    End If

    If ofsFileSys.FileExists(mstrFileName) Then
        ofsFileSys.DeleteFile (mstrFileName)
    End If

    SaveGdImage mstrFileName
    cmdSaveImage.Enabled = False

I step through the program, and lStatus is 0 after each oGdImg.xxxx call (oGdImg is the GdPicture Imaging object). When I try to delete the file, I get a permission denied error, indicating that the original file name is still in use.

Again, my objective is to modify the image, then re-write it using the original file name.

Help!!

[Loïc]

Again, my objective is to modify the image, then re-write it using the original file name.

I didn't know. In this case I give you a better way to do that (working wil all type of pixel format):

Code: Select all

Dim hBitmap As Long
Dim nOrigImage As Long, nClonedImage As Long
Dim mstrFileName As String
Dim oGdImg As Object

Set oGdImg = CreateObject("gdpicturepro4.imaging")
mstrFileName = "d:\test.jpg"

nOrigImage = oGdImg.CreateImageFromFile(mstrFileName)

If nOrigImage <> 0 Then
   hBitmap = oGdImg.GetHBitmap
   If hBitmap <> 0 Then
      nClonedImage = oGdImg.CreateImageFromHBitmap(hBitmap)
      oGdImg.CloseImage (nOrigImage)
      Kill mstrFileName
      If oGdImg.SaveAsJpeg(mstrFileName) = 0 Then MsgBox "Saved as " & mstrFileName
      oGdImg.CloseImage (nClonedImage)
      oGdImg.DeleteHBitmap (hBitmap)
   End If
End If

[procreator]

I implemented the code you provided (above), changing the SaveAsJpeg line to SaveAsTiff:

Code: Select all

If oGdImg.SaveAsTiff(mstrFileName, 6) = 0 Then MsgBox "Saved as " & mstrFileName

The file size quadruples from 3,375kb to 13,502kb. The original file is 8bpp monochrome, the new file is 32-bit RGB. Why?

All I am trying to do is write tags to the original image and save it in the original format (8bpp mono). I would expect the file size to be only slightly larger than the original.

Thanks!

[Loïc]

Hi procreator,

The GetHBitmap method seems to convert your 8bpp bitmap to 32 bpp.

You can call the ConvertTo8BppGrayScale() method to get a 8bpp image again:

Code: Select all

nOrigImage = oGdImg.CreateImageFromFile(mstrFileName)

If nOrigImage <> 0 Then
   hBitmap = oGdImg.GetHBitmap
   If hBitmap <> 0 Then
      nClonedImage = oGdImg.CreateImageFromHBitmap(hBitmap)
      oGdImg.CloseImage (nOrigImage)
     if oGdImg.ConvertTo8BppGrayScale() = 0 then nClonedImage = oGdImg.GetNativeImage()
      Kill mstrFileName
      If oGdImg.SaveAsTiff(mstrFileName, 6) = 0 Then MsgBox "Saved as " & mstrFileName
      oGdImg.CloseImage (nClonedImage)
      oGdImg.DeleteHBitmap (hBitmap)
   End If
End If

However I think this code can be optimized using a temporary copy of the image source :

Code: Select all

Call FileCopy(mstrFileName, "~" & mstrFileName)
nOrigImage = oGdImg.CreateImageFromFile("~" & mstrFileName)
'Write your tags here
If oGdImg.SaveAsTiff(mstrFileName, 6) = 0 Then MsgBox "Saved as " & mstrFileName
oGdImg.CloseImage (nClonedImage)
Kill "~" & mstrFileName

Regards,

Loïc

[procreator]

Thanks!

The code above worked fine.