BitmapLockBits in VB6

IPuffer
02-04-2005, 04:01 AM
Ad: eXeption, 7 Aug 2004, 05:19 AM (http://www.visualbasicforum.com/showthread.php?t=182033)

Please put here code of function toColor and toARGB and the user type BitmapData
(with the "scan0ptr").

eXeption
02-06-2005, 03:13 AM
The complete GDI+ declarations are available as .bas file (ie. no class wrappers), from www.vbaccelerator.com in the gdi+ section.

IPuffer
02-07-2005, 05:14 AM
But there is missing type CLSID.
Does anybody know how in VB convert TIFF into monochrome BMP without using CLSID?

OnErr0r
02-07-2005, 07:22 AM
CLSID is just a type/structure. You will need a type library defining it or just define it in code.

If your TIFF image is color, you'll need to quantize (reduce) the colors to black and white. Normally that would mean the background color becomes white and anything else becomes black. Specifying the right encoder creates the image format you want when saving the file.

IPuffer
02-08-2005, 01:38 AM
I'm trying to add reference to the type library, but without a success

OnErr0r
02-08-2005, 09:29 AM
Project - References - Browse

IPuffer
02-10-2005, 03:29 AM
Sometimes it is added, sometimes not.

What I have to to release the picture?

I have this code:


Public Function CreateFromImage(tname As String) As Long
On Error GoTo eh:
Dim xwidth As Long, xheight As Long, xhdc As Long
Dim X As Long, Y As Long, z As Long, cc As Long
Dim p As StdPicture, Bmp As Long, q As Long
Dim xrgb() As RGBQUAD
Dim lRes As Long
Dim lGDIP As Long
Dim tSI As GdiplusStartupInput
Dim c As Long

If (Dir(tname) = "") Then
CreateFromImage = -1
MyErrDesc = "Neplatný soubor"
Exit Function
End If

tSI.GdiplusVersion = 1
lRes = GdiplusStartup(lGDIP, tSI)
If (lRes > 0) Then
MyErrDesc = "Nepodrařilo se inicializovat GDI+"
CreateFromImage = -1
Exit Function
End If
Set p = LoadPicture(tname)
xhdc = CreateCompatibleDC(0&)
GdipCreateBitmapFromFile StrPtr(tname), Bmp
GdipGetImageWidth Bmp, xwidth
GdipGetImageHeight Bmp, xheight
xwidth = ImageWidth(Bmp)
xheight = ImageHeight(Bmp)
xrgb = GetImageDIBits(xhdc, p.Handle, xwidth, xheight)
cc = CCreate(xwidth, xheight)
If (cc <> 0) Then
CreateFromImage = cc
Exit Function
End If
ReDim MyPixel(0 To xwidth - 1, 0 To xheight - 1)
For Y = 0 To xheight - 1
For X = 0 To xwidth - 1
z = (xwidth * Y) + X
c = RGB(xrgb(z).rgbRed, xrgb(z).rgbGreen, xrgb(z).rgbBlue)
setPixel X, Y, closer(c, vbBlack, vbWhite)
DoEvents
Next X
DoEvents
Next Y
ReDim xrgb(0)
CreateFromImage = 0
CloseHandle p.Handle
DeleteDC xhdc
GdiplusShutdown lGDIP
Set p = Nothing
Exit Function
eh:
GdiplusShutdown lGDIP
Set p = Nothing
CreateFromImage = Err.Number
End Function


after performing it the input file is still in use.
It isn't deleted even after destroying of the class, that use the entire file.

OnErr0r
02-10-2005, 08:25 AM
The bitmap is not released because you failed to call GdipDisposeImage. At least it's not in the posted code.

Btw, always use VB tags when posting code.

IPuffer
02-17-2005, 07:57 AM
Ad: "Add to project":
If the library is registered, it is added always.
-----------------------------
Does anybody knows, if i can use the function "GetDIBits" in combination with TIFFs?
I know it only with BMP (or JPG,...)

OnErr0r
02-17-2005, 08:08 AM
You can, if you create an hBitmap from the GDI+ bitmap. But, if you're using GDI+, you should consider using LockBits/UnlockBits instead.

IPuffer
02-24-2005, 04:57 AM
Please put here some example, how to´get pixel's color directly from TIFF.

OnErr0r
02-24-2005, 02:27 PM
Here's a bit of code to handle any image that GDI+ can open.

IPuffer
02-28-2005, 01:04 AM
I tried it and it was OK. I tried it in my own DLL and VB crashed on performing GdipBitmapGetPixel.
The Gdi+.tlb could't added to the project, so I created a module to define types, enums and declarations from the gdi+.tlb.
Does anybody knows another example, when it can crash?

Sometimes I use GetImageDIBits. How I can perform it with TIFFs to get right values? I get the right DC by CreateComaptibleDC.

Further I use this function:
Private Function GetImageDIBits(ByVal SourceDC As Long, ByVal SourceHandle As Long, Optional ByRef Width As Long, Optional ByRef Height As Long) As RGBQUAD()
Dim lonDC As Long, udtBMP As bitmap
Dim udtInfo As BITMAPINFO, udtData() As RGBQUAD

lonDC = CreateCompatibleDC(SourceDC)
GetObjectAPI SourceHandle, Len(udtBMP), udtBMP

With udtInfo.bmiHeader
.biBitCount = 32
.biPlanes = 1
.biSize = 40
.biWidth = udtBMP.bmWidth *****
.biHeight = udtBMP.bmHeight *****
ReDim udtData((.biWidth * .biHeight) - 1)
Width = .biWidth
Height = .biHeight
End With
GetDIBits lonDC, SourceHandle, 0, udtBMP.bmHeight, udtData(0), udtInfo, 0
DeleteDC lonDC

GetImageDIBits = udtData()
End Function

But the udtBMP is on the marked lines has a zero value (how to do get the nonzero value).

OnErr0r
02-28-2005, 09:54 AM
I tried it and it was OK. I tried it in my own DLL and VB crashed on performing GdipBitmapGetPixel.
The Gdi+.tlb could't added to the project, so I created a module to define types, enums and declarations from the gdi+.tlb.
Does anybody knows another example, when it can crash?


You're welcome. :p

There is no reason you shouldn't be able to add a type library reference in a dll. And, there are many many reasons that can cause unhandled errors when using APIs. This is one of the reasons I created my GDI+ tlb, and associated wrapper classes.

IPuffer
03-01-2005, 12:17 AM
I tried to add a type library reference, but id wasn't added

And what about udtBMP.bmWidth and udtBMP.bmHeight?

Please, does anybody knows the way to get pixels directly from tiff?

IPuffer
03-02-2005, 05:33 AM
And when you want to declare functions from GDIPlus,don't forget the ByVal Keyword in the declarations, when the parameters are passed by value.

EZ Archive Ads Plugin for vBulletin Copyright 2006 Computer Help Forum