Wer ist online?
Buchempfehlung
FreeBASIC-Chat
FreeBASIC-Nachrichten jetzt auch über Twitter erhalten. Follow us!fb:porticula NoPaste
inc\imagefunctions.bas
| Uploader: |  Eternal_Pain |
| Datum/Zeit: | 19.03.2014 04:38:16 |
Hinweis: Dieser Quelltext ist Bestandteil des Projekts Windows Easy Gui (WEG), zu dem es auf FreeBASIC-Portal.de eine Projektseite gibt.
'
'Jpg, Png, Gif, Bmp, Ico, Tif
'#Include once "windows.bi"
'#include once "win\gdiplus.bi"
'Namespace Globals
' Dim as ULONG_PTR gdiplusToken
'End Namespace
'Sub GDI_Plus_Init CONSTRUCTOR
' 'http://msdn.microsoft.com/en-us/library/windows/desktop/ms534077%28v=vs.85%29.aspx
' Using GDIPLUS
' Dim as GdiplusStartupInput gdiplusStartupInput 'The GdiplusStartupInput structure holds a block
'of arguments that are required by the GdiplusStartup
'function.
'.GdiplusVersion | Type: UINT32 | Specifies the version of GDI+. Must be 1.
' gdiplusStartupInput.GdiplusVersion = 1
' If (GdiplusStartup(@Globals.gdiplusToken, @gdiplusStartupInput, NULL) <> 0) Then
' ?"Fehler"
' End If
'End Sub
'Sub GDI_Plus_Close DESTRUCTOR
' Using GDIPLUS
' GdiplusShutdown(Globals.gdiplusToken)
'End Sub
Declare Function CreateCopy_GDIImage_As_WINImage(byref GDIImage as any ptr) as HBITMAP
Declare Function CreateCopy_GDIImage_As_FBImage(byref GDIImage as any ptr) as any ptr
Declare Function CreateCopy_WINImage_As_GDIImage(byref WINImage as HBITMAP) as any ptr
Declare Function CreateCopy_WINImage_As_FBImage(byref WINImage as HBITMAP) as any ptr
Declare Function CreateCopy_FBImage_As_GDIImage(byref FBImage as any ptr) as any ptr
Declare Function CreateCopy_FBImage_As_WINImage(byref FBImage as any ptr) as HBITMAP
Declare Function LoadFBImage(byval Filename as String) as any ptr
Declare Function LoadGDIImage(byval Filename as String) as any ptr
Declare Function LoadWINImage(byval Filename as String, byval BackColor as Integer = &h000000) as HBITMAP
Declare Function SaveGDIImage(byref GDIImage as any ptr, byval Filename as String, byval itype as String = "AUTO") as Integer
Declare Function SaveWINImage(byref WINImage as HBITMAP, byval Filename as String, byval itype as String = "AUTO") as Integer
Declare Function SaveFBImage(byref FBImage as any ptr, byval Filename as String, byval itype as String = "AUTO") as Integer
Declare Function GetRect_From_FBImage(byref FBImage as any ptr, byval fromX as Integer, byval fromY as Integer, byval iWidth as Integer, byval iHeight as Integer) as any ptr
Declare Function GetRect_From_GDIImage(byref GDIImage as any ptr, byval fromX as Integer, byval fromY as Integer, byval iWidth as Integer, byval iHeight as Integer) as any ptr
Declare Function GetRect_From_WINImage(byref WINImage as HBITMAP, byval fromX as Integer, byval fromY as Integer, byval iWidth as Integer, byval iHeight as Integer) as HBITMAP
Function GetRect_From_FBImage(byref FBImage as any ptr, byval fromX as Integer, byval fromY as Integer, byval iWidth as Integer, byval iHeight as Integer) as any ptr
Dim as any ptr CutImage = Imagecreate(iWidth, iHeight)
Dim as Integer rWidth, rHeight
Dim as Integer cWidth, cHeight
If FBImage Then
ImageInfo FBImage, rWidth, rHeight
cWidth=iWidth : cHeight=iHeight
If fromX+cWidth > rWidth Then cWidth = rWidth-fromX
If fromY+cHeight > rHeight Then cHeight = rHeight-fromY
Get FBImage,(fromX,fromY)-(fromX+cWidth-1,fromY+cHeight-1),CutImage
End If
return CutImage
End Function
Function GetRect_From_GDIImage(byref GDIImage as any ptr, byval fromX as Integer, byval fromY as Integer, byval iWidth as Integer, byval iHeight as Integer) as any ptr
Using GDIPLUS
Dim as GPBITMAP ptr CutImage
GdipCloneBitmapArea (fromX, fromY, iWidth, iHeight, 0, GDIImage , @CutImage)
Return CutImage
End Function
Function GetRect_From_WINImage(byref WINImage as HBITMAP, byval fromX as Integer, byval fromY as Integer, byval iWidth as Integer, byval iHeight as Integer) as HBITMAP
Using GDIPLUS
Dim as HBITMAP CutImage
Dim as GPBITMAP ptr TempImage1, TempImage2
GdipCreateBitmapFromHBITMAP(WINImage, NULL, @TempImage1)
GdipCloneBitmapArea (fromX, fromY, iWidth, iHeight, 0, TempImage1 , @TempImage2)
GdipCreateHBITMAPFromBitmap(TempImage2 ,@CutImage, 0)
GdipDisposeImage TempImage2
GdipDisposeImage TempImage1
Return CutImage
End Function
Function CreateCopy_GDIImage_As_FBImage(byref GDIImage as any ptr) as any ptr
Using GDIPLUS
Dim as any ptr FBImage, pixels
Dim as Integer w, h, pitch
Dim as BitmapData ImageData
Dim as UInteger ptr row
Dim as RECT rc
If GDIImage = 0 Then Return 0
GdipGetImageWidth(GDIImage, @w)
GdipGetImageHeight(GDIImage, @h)
rc = Type(0, 0, w-1, h-1)
FBImage = ImageCreate(w,h)
ImageInfo FBImage, ,,, pitch, pixels
GdipBitmapLockBits(GDIImage,Cast(Any Ptr,@rc),ImageLockModeRead ,PixelFormat32bppARGB, @ImageData) ' Lock
For y As Integer = 0 To h-1
row = pixels + y * pitch
For x As Integer = 0 To w-1
row[x] = cast(Integer Ptr,ImageData.Scan0)[x+y*w]
Next x
Next y
GdipBitmapUnlockBits(GDIImage,@ImageData) ' UnLock
GdipDisposeImage(GDIImage)
Return FBImage
End Function
Function CreateCopy_GDIImage_As_WINImage(byref GDIImage as any ptr) as HBITMAP
Using GDIPLUS
Dim as any ptr Temp1, Temp2
Dim as Integer w,h, BackColor = &hFF00FF
Dim as HBITMAP hhbitmap
If LOBYTE(LOWORD(GetVersion)) < 6 Then
GdipGetImageWidth(GDIImage, @w)
GdipGetImageHeight(GDIImage, @h)
GdipCreateBitmapFromScan0(w, h, NULL, PixelFormat32bppARGB, NULL, @Temp1)
GdipGetImageGraphicsContext(Temp1, @Temp2)
GdipGraphicsClear(Temp2, BackColor or &hff000000)
GdipDrawImageRectI(Temp2, GDIImage, 0, 0, w, h)
GdipCreateHBITMAPFromBitmap(Temp1, @hhbitmap, BackColor or &hff000000)
If Temp1 <> 0 Then GdipDisposeImage(Temp1)
If Temp2 <> 0 Then GdipDeleteGraphics(Temp2)
Else
GdipCreateHBITMAPFromBitmap(GDIImage ,@hhBitmap, BackColor or &hff000000)
End If
GdipDisposeImage(GDIImage)
Return hhbitmap
End Function
Function CreateCopy_WINImage_As_FBImage(byref WINImage as HBITMAP) as any ptr
Using GDIPLUS
Dim as GPBITMAP ptr Image = CreateCopy_WINImage_As_GDIImage(WINImage)
Dim as any ptr FBImage, pixels
Dim as Integer w, h, pitch
Dim as BitmapData ImageData
Dim as UInteger ptr row
Dim as RECT rc
GdipGetImageWidth(Image, @w)
GdipGetImageHeight(Image, @h)
rc = Type(0, 0, w-1, h-1)
FBImage = ImageCreate(w,h)
ImageInfo FBImage, ,,, pitch, pixels
GdipBitmapLockBits(Image,Cast(Any Ptr,@rc),ImageLockModeRead ,PixelFormat32bppARGB, @ImageData) ' Lock
For y As Integer = 0 To h-1
row = pixels + y * pitch
For x As Integer = 0 To w-1
row[x] = cast(Integer Ptr,ImageData.Scan0)[x+y*w]
Next x
Next y
GdipBitmapUnlockBits(Image,@ImageData) ' UnLock
GdipDisposeImage(Image)
Return FBImage
End Function
Function CreateCopy_WINImage_As_GDIImage(byref WINImage as HBITMAP) as any ptr
Using GDIPLUS
Dim as GPBITMAP ptr Image
GdipCreateBitmapFromHBITMAP(WINImage, NULL, @Image)
Return Image
End Function
Function CreateCopy_FBImage_As_WINImage(byref FBImage as any ptr) as HBITMAP
Using GDIPLUS
Dim as GPBITMAP ptr Image = CreateCopy_FBImage_As_GDIImage(FBImage)
Dim as any ptr Temp1, Temp2
Dim as Integer w,h, BackColor = &hFF00FF
Dim as HBITMAP hhbitmap
If LOBYTE(LOWORD(GetVersion)) < 6 Then
GdipGetImageWidth(Image, @w)
GdipGetImageHeight(Image, @h)
GdipCreateBitmapFromScan0(w, h, NULL, PixelFormat32bppARGB, NULL, @Temp1)
GdipGetImageGraphicsContext(Temp1, @Temp2)
GdipGraphicsClear(Temp2, BackColor or &hff000000)
GdipDrawImageRectI(Temp2, Image, 0, 0, w, h)
GdipCreateHBITMAPFromBitmap(Temp1, @hhbitmap, BackColor or &hff000000)
If Temp1 <> 0 Then GdipDisposeImage(Temp1)
If Temp2 <> 0 Then GdipDeleteGraphics(Temp2)
Else
GdipCreateHBITMAPFromBitmap(Image ,@hhBitmap, BackColor or &hff000000)
End If
GdipDisposeImage(Image)
Return hhbitmap
End Function
Function CreateCopy_FBImage_As_GDIImage(byref FBImage as any ptr) as any ptr
Using GDIPLUS
Dim as GPBITMAP ptr Image
Dim as any ptr pixels
Dim as Integer w, h, pitch
Dim as BitmapData ImageData
Dim as UInteger ptr row
Dim as RECT rc
If FBImage = 0 Then Return 0
ImageInfo FBImage, w, h,, pitch, pixels
rc = Type(0, 0, w-1, h-1)
GdipCreateBitmapFromScan0(w, h, NULL, PixelFormat32bppARGB, NULL, @Image)
GdipBitmapLockBits(Image,Cast(Any Ptr,@rc),ImageLockModeWrite ,PixelFormat32bppARGB,@ImageData) ' Lock
For y As Integer = 0 To h-1
row = pixels + y * pitch
For x As Integer = 0 To w-1
cast(Integer Ptr,ImageData.Scan0)[x+y*w] = IIf (row[x] = &hFFFF00FF,&h00000000,row[x])
Next x
Next y
GdipBitmapUnlockBits(Image,@ImageData) ' UnLock
Return Image
End Function
Function LoadFBImage(byval Filename as String) as any ptr
Using GDIPLUS
Dim as GPBITMAP ptr Image = LoadGDIImage(Filename)
Dim as any ptr FBImage, pixels
Dim as Integer w, h, pitch
Dim as BitmapData ImageData
Dim as UInteger ptr row
Dim as RECT rc
If Image = 0 Then Return 0
GdipGetImageWidth(Image, @w)
GdipGetImageHeight(Image, @h)
rc = Type(0, 0, w-1, h-1)
FBImage = ImageCreate(w,h)
ImageInfo FBImage, ,,, pitch, pixels
GdipBitmapLockBits(Image,Cast(Any Ptr,@rc),ImageLockModeRead ,PixelFormat32bppARGB, @ImageData) ' Lock
For y As Integer = 0 To h-1
row = pixels + y * pitch
For x As Integer = 0 To w-1
row[x] = cast(Integer Ptr,ImageData.Scan0)[x+y*w]
Next x
Next y
GdipBitmapUnlockBits(Image,@ImageData) ' UnLock
GdipDisposeImage(Image)
Return FBImage
End Function
Function LoadWINImage(byval Filename as String, byval BackColor as Integer = &h000000) as HBITMAP
Using GDIPLUS
Dim as GPBITMAP ptr Image = LoadGDIImage(Filename)
Dim as any ptr Temp1, Temp2
Dim as Integer w,h
Dim as HBITMAP hhbitmap
If LOBYTE(LOWORD(GetVersion)) < 6 Then
GdipGetImageWidth(Image, @w)
GdipGetImageHeight(Image, @h)
GdipCreateBitmapFromScan0(w, h, NULL, PixelFormat32bppARGB, NULL, @Temp1)
GdipGetImageGraphicsContext(Temp1, @Temp2)
GdipGraphicsClear(Temp2, BackColor or &hff000000)
GdipDrawImageRectI(Temp2, Image, 0, 0, w, h)
GdipCreateHBITMAPFromBitmap(Temp1, @hhbitmap, BackColor or &hff000000)
If Temp1 <> 0 Then GdipDisposeImage(Temp1)
If Temp2 <> 0 Then GdipDeleteGraphics(Temp2)
Else
GdipCreateHBITMAPFromBitmap(Image ,@hhBitmap, BackColor or &hff000000)
End If
GdipDisposeImage(Image)
Return hhbitmap
End Function
Function LoadGDIImage(byval Filename as String) as any ptr
Using GDIPLUS
Dim as GPBITMAP ptr Image
Dim as UInteger FLen = (Len(Filename)*2)+2
Dim as WString ptr wbuf = allocate(FLen)
MultiByteToWideChar(CP_ACP, 0, Filename, -1, wbuf, FLen)
GDIPLOADIMAGEFROMFILE( *wbuf, @Image)
Deallocate(wbuf)
Return Image
End Function
Function SaveFBImage(byref FBImage as any ptr, byval Filename as String, byval itype as String = "AUTO") as Integer
Using GDIPLUS
Dim as any ptr TempImage = CreateCopy_FBImage_As_GDIImage(FBImage)
Function = SaveGDIImage(TempImage, Filename, itype)
GdipDisposeImage(TempImage)
End Function
Function SaveWINImage(byref WINImage as HBITMAP, byval Filename as String, byval itype as String = "AUTO") as Integer
USING GDIPLUS
Dim as GPBITMAP ptr TempImage = CreateCopy_WinImage_As_GDIImage(WINImage)
Function = SaveGDIImage(TempImage, Filename, itype)
GdipDisposeImage(TempImage)
End Function
Function SaveGDIImage(byref GDIImage as any ptr, byval Filename as String, byval itype as String = "AUTO") as Integer
If GDIImage = 0 Then Return NOT(0)
Using GDIPLUS
Dim as String clssid, fileext
Dim as CLSID classID
Dim as Integer flen = (Len(Filename)*2)+2
Dim as WString Ptr wbuf
If itype="AUTO" Then
fileext = UCase(Right(Filename,4))
Else
fileext = UCase("." & itype)
End If
Select Case fileext
Case ".BMP"
clssid="{557CF400-1A04-11D3-9A73-0000F81EF32E}"
Case ".JPG","JPEG"
clssid="{557CF401-1A04-11D3-9A73-0000F81EF32E}"
Case ".GIF"
clssid="{557CF402-1A04-11D3-9A73-0000F81EF32E}"
Case ".TIF","TIFF"
clssid="{557CF405-1A04-11D3-9A73-0000F81EF32E}"
Case ".PNG"
clssid="{557CF406-1A04-11D3-9A73-0000F81EF32E}"
End Select
CLSIDFROMSTRING WSTR(clssid), @classID
wbuf = allocate(flen)
MultiByteToWideChar(CP_ACP, 0, Filename, -1, wbuf, flen)
IF (GDIPSAVEIMAGETOFILE(GDIImage, *wbuf, @classID , 0) <> 0) Then
Function = NOT(0)
Else
Function = 0
End If
deallocate(wbuf)
End Function