Ich möchte ein BMP-Image mit dem Fax wegschicken, dazu möchte ich das Image in das Faxformat TIFF -CCITT3 oder -CCITT4 konvertieren. Da das automatisch gehen soll, will ich nicht über Printertreiber, Word und so arbeiten.
Ich habe im englischen Forum folgenden Code von El_Choni gefunden. Er funktioniert soweit, aber leider nicht wenn man ganz unten die Faxkompression CCITT3 oder CCITT4 als Speicheroption auswählt.
Ich vermute mal, dass man vorher das geladene Bild in ein schwarz-weiss Format umwandeln muss, aber wie geht das?
Vielen Dank Lupo
PB 4.51, Win XP, Win7
Code: Alles auswählen
;; Code von El_Choni aus dem englischen Forum
#EncoderValueCompressionLZW = 2 ; funktioniert
#EncoderValueCompressionCCITT3 = 3 ; funktioniert nicht
#EncoderValueCompressionCCITT4 = 4 ; funktioniert nicht
#EncoderValueCompressionRle = 5 ; funktioniert nicht
#EncoderValueCompressionNone = 6 ; funktioniert
Structure ErrorCode
section.l
value.l
EndStructure
#WindowsError = 0
#ImageViewerError = 1
#GdiError = 2
Procedure Error(message.s, *code.ErrorCode, fatal.b)
Select *code\section
Case #ImageViewerError
CodeMessage$ = "ImageViewer error: unknown"
Case #GdiError
Select *code\value
Case 0
ErrorBuffer$ = Space(1024)
FormatMessage_(#FORMAT_MESSAGE_FROM_SYSTEM, 0, GetLastError_(), 0, ErrorBuffer$, Len(ErrorBuffer$), 0)
CodeMessage$ = ErrorBuffer$
Case 1
CodeMessage$ = "Generic error"
Case 2
CodeMessage$ = "Invalid parameter"
Case 3
CodeMessage$ = "Out of memory"
Case 4
CodeMessage$ = "Object busy"
Case 5
CodeMessage$ = "Insufficient buffer"
Case 6
CodeMessage$ = "Not implemented"
Case 7
ErrorBuffer$ = Space(1024)
FormatMessage_(#FORMAT_MESSAGE_FROM_SYSTEM, 0, GetLastError_(), 0, ErrorBuffer$, Len(ErrorBuffer$), 0)
CodeMessage$ = "Win32 Error: "+ErrorBuffer$
Case 8
CodeMessage$ = "Wrong state"
Case 9
CodeMessage$ = "Aborted"
Case 10
CodeMessage$ = "File not found"
Case 11
CodeMessage$ = "Value overflow"
Case 12
CodeMessage$ = "Access denied"
Case 13
CodeMessage$ = "Unknown image format"
Case 14
CodeMessage$ = "Font family not found"
Case 15
CodeMessage$ = "Font style not found"
Case 16
CodeMessage$ = "Not TrueType font"
Case 17
CodeMessage$ = "Unsupported Gdiplus version"
Case 18
CodeMessage$ = "Gdiplus not initialized"
Case 19
CodeMessage$ = "Property not found"
Case 20
CodeMessage$ = "Property not supported"
EndSelect
Default
ErrorBuffer$ = Space(1024)
FormatMessage_(#FORMAT_MESSAGE_FROM_SYSTEM, 0, GetLastError_(), 0, ErrorBuffer$, Len(ErrorBuffer$), 0)
CodeMessage$ = ErrorBuffer$
EndSelect
MessageRequester("Error", message+Chr(10)+Chr(10)+CodeMessage$, 0)
If fatal
End
EndIf
EndProcedure
Structure GdiplusStartupInput
GdiplusVersion.l
DebugEventCallback.l
SuppressBackgroundThread.l
SuppressExternalCodecs.l
EndStructure
; Structure CLSID
; Data1.l
; Data2.w[2]
; Data3.b[8]
; EndStructure
Structure MyGUID
Data1.l
Data2.w[2]
Data3.b[8]
EndStructure
Structure ImageCodecInfo
Clsid.CLSID ; Codec identifier.
FormatID.MyGUID ; File format identifier. GUIDs that identify various file formats (ImageFormatBMP, ImageFormatEMF, And the like) are defined in Gdiplusimaging.h.
CodecName.s ; WCHAR * Pointer To a null-terminated string that contains the codec name.
DllName.s ; WCHAR * Pointer To a null-terminated string that contains the path name of the DLL in which the codec resides. If the codec is not in a DLL, this pointer is NULL.
FormatDescription.s ; WCHAR * Pointer To a null-terminated string that contains the name of the file format used by the codec.
FilenameExtension.s ; WCHAR * Pointer To a null-terminated string that contains all file-name extensions associated with the codec. The extensions are separated by semicolons.
MimeType.s ; WCHAR * Pointer To a null-terminated string that contains the mime type of the codec.
Flags.l ; DWORD Combination of flags from the ImageCodecFlags enumeration.
Version.l ; DWORD Integer that indicates the version of the codec.
SigCount.l ; DWORD Integer that indicates the number of signatures used by the file format associated with the codec.
SigSize.l ; DWORD Integer that indicates the number of bytes in each signature.
SigPattern.l ; BYTE * Pointer To an array of bytes that contains the pattern For each signature.
SigMask.l ; BYTE * Pointer To an array of bytes that contains the mask For each signature.
EndStructure
#EncoderParameterValueTypeLong = 4
#EncoderValueCompressionLZW = 2
#EncoderValueCompressionCCITT3 = 3
#EncoderValueCompressionCCITT4 = 4
#EncoderValueCompressionRle = 5
#EncoderValueCompressionNone = 6
Structure EncoderParameter
Guid.MyGUID
NumberOfValues.l
Type.l
Value.l
EndStructure
Structure EncoderParameters
Count.l
Parameter1.EncoderParameter
; Parameter2.EncoderParameter
EndStructure
Global Gdiplus, gdiplusToken, bitmap, hbmReturn, encoderClsid, width, height, num, size
Global *GdiplusStartup, *GdiplusShutdown, *GdipSaveImageToFile, *GdipGetImageEncodersSize
Global *GdipGetImageEncoders, *GdipCreateBitmapFromHBITMAP
Procedure GdiStart()
Gdiplus = OpenLibrary(0, "GDIPLUS.DLL")
If Gdiplus
CoInitialize_(#Null)
*GdiplusStartup = GetFunction(0, "GdiplusStartup")
If *GdiplusStartup
gdpsi.GdiplusStartupInput
gdpsi\GdiplusVersion = 1
gdpsi\DebugEventCallback = 0
gdpsi\SuppressBackgroundThread = 0
gdpsi\SuppressExternalCodecs = 0
CallFunctionFast(*GdiplusStartup, @gdiplusToken, gdpsi, #Null)
If gdiplusToken
*GdipGetImageEncodersSize = GetFunction(0, "GdipGetImageEncodersSize")
*GdipGetImageEncoders = GetFunction(0, "GdipGetImageEncoders")
*GdipCreateBitmapFromHBITMAP = GetFunction(0, "GdipCreateBitmapFromHBITMAP")
*GdipSaveImageToFile = GetFunction(0, "GdipSaveImageToFile")
*GdiplusShutdown = GetFunction(0, "GdiplusShutdown")
If (*GdipGetImageEncodersSize And *GdipGetImageEncoders And *GdipCreateBitmapFromHBITMAP And *GdipSaveImageToFile And *GdiplusShutdown)=0
Gdiplus = 0
EndIf
Else
Gdiplus = 0
EndIf
Else
Gdiplus = 0
EndIf
Else
Gdiplus = 0
EndIf
ProcedureReturn Gdiplus
EndProcedure
Procedure GdiEnd()
If Gdiplus
CallFunctionFast(*GdiplusShutdown, gdiplusToken)
CoUninitialize_()
EndIf
EndProcedure
Procedure GetEncoderClsid(Format$, *Clsid)
Gerror.ErrorCode
result = 0
num = 0
size = 0
FormatWSize = (Len(Format$)*2)+2
*FormatW = CoTaskMemAlloc_(FormatWSize)
If *FormatW
If MultiByteToWideChar_(#CP_ACP, 0, @Format$, -1, *FormatW, Len(Format$)+1)
CallFunctionFast(*GdipGetImageEncodersSize, @num, @size)
If size
*ImageCodecInfoArray = CoTaskMemAlloc_(size)
If *ImageCodecInfoArray
result = CallFunctionFast(*GdipGetImageEncoders, num, size, *ImageCodecInfoArray)
If result=#S_OK
For j=0 To num-1
*pImageCodecInfo.ImageCodecInfo = *ImageCodecInfoArray+(SizeOf(ImageCodecInfo)*j);*ImageCodecInfoArray+((size/num)*j)
If CompareMemory(@*pImageCodecInfo\MimeType, *FormatW, FormatWSize)
PokeL(*Clsid, *pImageCodecInfo\Clsid)
result = j
EndIf
Next j
Else
ErrorMessage$ = "GdipGetImageEncoders() failed."
EndIf
CoTaskMemFree_(*pImageCodecInfo)
Else
Gerror\section = #WindowsError
Error("CoTaskMemAlloc_() failed.", Gerror, 0)
EndIf
Else
ErrorMessage$ = "GdipGetImageEncodersSize() failed."
EndIf
Else
Gerror\section = #WindowsError
Error("MultiByteToWideChar_() failed.", Gerror, 0)
EndIf
CoTaskMemFree_(*FormatW)
Else
Gerror\section = #WindowsError
Error("CoTaskMemAlloc_() failed.", Gerror, 0)
EndIf
If ErrorMessage$
Gerror\section = #GdiError
Gerror\value = result
Error(ErrorMessage$, Gerror, 0)
result = 0
EndIf
ProcedureReturn result
EndProcedure
Procedure GdiSave(File$, hbm, compression)
Gerror.ErrorCode
If GetEncoderClsid("image/tiff", @encoderClsid)
FileWSize = (Len(File$)*2)+2
*FileW = CoTaskMemAlloc_(FileWSize)
If *FileW
If MultiByteToWideChar_(#CP_ACP, 0, File$, -1, *FileW, Len(File$)+1)
If hbm
eP.encoderParameters
encoderParams = eP
eP\Count = 1 ; 2
CopyMemory(?EncoderCompression, eP\Parameter1\Guid, SizeOf(MyGUID))
eP\Parameter1\Type = #EncoderParameterValueTypeLong
eP\Parameter1\NumberOfValues = 1
eP\Parameter1\Value = @compression
bitmap = 0
result = CallFunctionFast(*GdipCreateBitmapFromHBITMAP, hbm, 0, @bitmap)
If result=#S_OK And bitmap
If FileSize(File$)
DeleteFile(File$)
EndIf
result = CallFunctionFast(*GdipSaveImageToFile, bitmap, *FileW, encoderClsid, encoderParams)
If result<>#S_OK
ErrorMessage$ = "GdipSaveImageToFile() failed."
EndIf
Else
ErrorMessage$ = "GdipCreateBitmapFromHBITMAP() failed."
EndIf
EndIf
Else
Gerror\section = #WindowsError
Error("MultiByteToWideChar_() failed.", Gerror, 0)
EndIf
CoTaskMemFree_(*FileW)
Else
Gerror\section = #WindowsError
Error("CoTaskMemAlloc_() failed.", Gerror, 0)
EndIf
Else
Gerror\section = #ImageViewerError
Error("GetEncoderCLSID() procedure failed.", Gerror, 0)
EndIf
If ErrorMessage$
Gerror\section = #GdiError
Gerror\value = result
Error(ErrorMessage$, Gerror, 0)
result = 0
Else
result = 1
EndIf
ProcedureReturn result
EndProcedure
Structure Seeker
StructureUnion
b.b
w.w
l.l
EndStructureUnion
EndStructure
Procedure Rev16(value.w)
ProcedureReturn ((value&$FF00)>>8)|((value&$FF)<<8)
EndProcedure
Procedure Rev32(value)
MOV eax, value
BSWAP eax
ProcedureReturn
EndProcedure
Procedure SetTIFFResolution(file$, dpi)
Gerror.ErrorCode
hFile = OpenFile(#PB_Any, file$)
If hFile
TIFFSize = Lof(hFile)
If TIFFSize>$9A
*TIFF = AllocateMemory(Lof(hFile))
ReadData(hFile, *TIFF, TIFFSize)
*TIFFSeek.Seeker = *TIFF
Select *TIFFSeek\w
Case 'MM'
dpi = Rev32(dpi)
*TIFFSeek+4
IFDOffset = Rev32(*TIFFSeek\l)
inch = Rev16(2)
den = Rev32(1)
rv = 1
Case 'II'
*TIFFSeek+4
IFDOffset = *TIFFSeek\l
inch = 2
den = 1
rv = 0
Default
Gerror\section = #ImageViewerError
Error("Not a TIFF file.", Gerror, 0)
CloseFile(hFile)
ProcedureReturn #False
EndSelect
*TIFFSeek = *TIFF+IFDOffset
If TIFFSize>IFDOffset+2
If rv:FieldCount = Rev16(*TIFFSeek\w):Else:FieldCount = *TIFFSeek\w:EndIf
If FieldCount
*TIFFSeek+2
For i=0 To FieldCount-1
If *TIFFSeek<*TIFF+TIFFSize-2
If rv:Tag = Rev16(*TIFFSeek\w):Else:Tag = *TIFFSeek\w:EndIf
Select Tag
Case 282 ; XResolution
*TagSeek.Seeker = *TIFFSeek+8
If rv:ValueOffset = Rev32(*TagSeek\l):Else:ValueOffset = *TagSeek\l:EndIf
If ValueOffset<=TIFFSize-8
PokeL(*TIFF+ValueOffset, dpi)
PokeL(*TIFF+ValueOffset+4, den)
xrelDone = 1
EndIf
Case 283 ; YResolution
*TagSeek = *TIFFSeek+8
If rv:ValueOffset = Rev32(*TagSeek\l):Else:ValueOffset = *TagSeek\l:EndIf
If ValueOffset<=TIFFSize-8
PokeL(*TIFF+ValueOffset, dpi)
PokeL(*TIFF+ValueOffset+4, den)
yrelDone = 1
EndIf
Case 296 ; ResolutionUnit
PokeW(*TIFFSeek+8, inch)
ruDone = 1
EndSelect
*TIFFSeek+12
EndIf
Next i
Else
Gerror\section = #ImageViewerError
Error("Field count not found.", Gerror, 0)
EndIf
If ruDone&yrelDone&xrelDone
FileSeek(hfile, 0)
WriteData(hFile,*TIFF, TIFFSize)
result = #True
Else
Gerror\section = #ImageViewerError
Error("Resolution fields not found.", Gerror, 0)
EndIf
Else
Gerror\section = #ImageViewerError
Error("Offset past end of file.", Gerror, 0)
EndIf
Else
Gerror\section = #ImageViewerError
Error("IFDOffset past end of file.", Gerror, 0)
EndIf
CloseFile(hFile)
ProcedureReturn result
Else
Gerror\section = #WindowsError
Error("Can't open file.", Gerror, 0)
EndIf
ProcedureReturn #False
EndProcedure
Procedure SaveTIFF(ImageID, file$, compression, dpi)
If GDISave(file$, ImageID, compression)
result = SetTIFFResolution(file$, dpi)
EndIf
ProcedureReturn result
EndProcedure
ImageFile$ = OpenFileRequester("Open image file", "", "Bitmap file (*.bmp)|*.bmp", 0)
If ImageFile$
hImage = LoadImage(0, ImageFile$)
TIFFFile$ = SaveFileRequester("Save TIFF file", Left(ImageFile$, Len(ImageFile$)-Len(GetExtensionPart(ImageFile$))-1)+".tiff", "TIFF image file (*.tiff;*.tif)|*.tiff;*.tif", 0)
If TIFFFile$
If GdiStart()
; compression = #EncoderValueCompressionLZW ; funktioniert
; compression = #EncoderValueCompressionCCITT3 ; funktioniert nicht
compression = #EncoderValueCompressionCCITT4 ; funktioniert nicht
; compression = #EncoderValueCompressionRle ; funktioniert nicht
; compression = #EncoderValueCompressionNone ; funktioniert
dpi = 150
Debug SaveTIFF(hImage, TIFFFile$, compression, dpi)
GdiEnd()
EndIf
EndIf
EndIf
DataSection
EncoderCompression:
Data.l $e09d739d
Data.w $ccd4, $44ee
Data.b $8e, $ba, $3f, $bf, $8b, $e4, $fc, $58
EndDataSection