XProfan

 $H \windows.ph
 $H \includes\Functions_GDIPLUS.ph
 $H \includes\GDIP_Imageging.ph
 $I \includes\GDIP_Helper.inc
Déclarer gdiplusToken&,ImageObject&,ImageWidth&,ImageHeight&,GraphicObject&
Déclarer hPic&
Déclarer imgThumb&
Déclarer lngImage&
Déclarer hBitmap&
Fenêtre 0,0-1024,786
Cls ~GetSysColor(~COLOR_3DFACE)
gdiplusToken& = InitGDIPlus()
hPic& = @Créer(hPic,-1,Bild.jpg)
~GdipCreateBitmapFromHBITMAP(hPic&,0,@Addr(lngImage&))
~GdipGetImageThumbnail(lngImage&,92,69,@Addr(imgThumb&),0,0)
~GdipCreateHBITMAPFromBitmap(imgThumb&,@Addr(hBitmap&))
DrawPic hBitmap&,50,50;0
ici bräuchte je eh bien quelque chose, quoi mir une Adresse ou bien Array et dessen Taille ermittelt !!!
WaitInput
DeleteObject hPic&
DeleteObject hBitmap&
~GdipDisposeImage(imgThumb&)
~GdipDisposeImage(lngImage&)
ExitGDIPlus(gdiplusToken&)
Fin

window 0,0-600,500
 $H windows.ph
--GDIPlus-Erweiterungen von Andreas Miethe
 $H Functions_GDIPLUS.ph
 $H GDIP_Imageging.ph
 $I GDIP_Helper.inc
--Funktionen aus shlwapi.dll unter XP (SP3) nur indirekt per Ordinal erreichbar
var shlwapi&=~GetModulehandle(shlwapi.dll)
var SHCreateMemStream&=~GetProcAddress(shlwapi&,12)
var IStream_Write&=~GetProcAddress(shlwapi&,212)
var IStream_Reset&=~GetProcAddress(shlwapi&,213)
var IStream_Size&= ~GetProcAddress(shlwapi&,214)
var IStream_Read&= ~GetProcAddress(shlwapi&,184)

proc StreamRelease-------------------------------------StreamRelease

    var VTable&=long(IStream&,0 )
    var Method&=long(VTable&,8 )
    call(Method&,IStream&)
    endproc-------------------------------------------------------------

    proc StreamToMem-----------------------------------------StreamToMem

        declare Size&
        call(IStream_Size&,IStream&,addr(Size&))
        dim PicData#,Size&
        call(IStream_Reset&,IStream&)
        call(IStream_Read&,IStream&,PicData#,Size&)
        endproc-------------------------------------------------------------

        proc MemToStream-----------------------------------------MemToStream

            call(IStream_Reset&,IStream&)
            call(IStream_Write&,IStream&,PicData#,sizeof(PicData#))
            endproc-------------------------------------------------------------

            Proc SaveJpgToStream---------------------------------SaveJpgToStream

                --Modifizierte Variante der SaveAsJPG-Prozedur von Andreas Miethe
                Parameters Bitmap&,Quality&
                Declare encoderCLSID#,result&
                result& = 0
                Dim encoderCLSID#,16
                Declare encoderParameters#
                Declare wTemp$,encoder#
                wTemp$ = S2WS(~EncoderQuality)
                Dim encoder#,16
                IIDFromString(ADDR(wTemp$),encoder#)
                Dim encoderParameters#,32
                Long encoderParameters#,0 = 1
                MoveMemory(encoderParameters#+4,encoder#,16)
                Long encoderParameters#,20 = 1
                Long encoderParameters#,24 = ~EncoderParameterValueTypeLong
                Long encoderParameters#,28 = ADDR(Quality&)

                If GetEncoderCLSID(image/jpeg,encoderCLSID#)

                    call(IStream_Reset&,IStream&)
                    ~GdipSaveImageToStream(Bitmap&,IStream&,encoderCLSID#,encoderParameters#)
                    result& = 1

                Endif

                Dispose encoder#
                Dispose encoderParameters#
                Dispose encoderCLSID#
                Return result&
                EndProc-------------------------------------------------------------
                external(ole32,CoInitialize,0)--OLE initialisieren
                var Token&=InitGDIPlus()------------GDI+ initialisieren
                usermessages 16---------------------WM_CLOSE abfangen
                declare PicData#,IStream&--PicData# und IStream& global deklariert!
                IStream&=call(SHCreateMemStream&,0,0)--Stream erzeugen
                var Pic&=create(hPic,-1,C:1TestBild.jpg)--Demo-Bild (Pfad anpassen!)
                declare Image&,Thumb&
                ~GdipCreateBitmapFromHBITMAP(Pic&,0,addr(Image&))--------Image von Bitmap
                ~GdipGetImageThumbnail(Image&,250,250,addr(Thumb&),0,0)--Thumb von Image (Größe 250*250)
                ~GdipDisposeImage(Image&)--------------------------------Image freigeben
                deleteobject Pic&----------------------------------------Bitmap freigeben
                SaveJpgToStream(Thumb&,5)----Thumb als JPG (schlechte Qualität) nach IStream&
                StreamToMem()----------------JPG-Daten von IStream& nach PicData#
                var LoQuality$=char$(PicData#,0,sizeof(PicData#))--PicData# als String zwischenspeichern
                SaveJpgToStream(Thumb&,100)--Thumb als JPG (gute Qualität) nach IStream&
                StreamToMem()----------------JPG-Daten von IStream& nach PicData#
                var HiQuality$=char$(PicData#,0,sizeof(PicData#))--PicData# als String zwischenspeichern
                declare Handle&,Bmp&
                char PicData#,0=LoQuality$--Daten aus String nach PicData#
                MemToStream()---------------Daten von PicData# nach IStream&
                ~GdipLoadImageFromStream(IStream&,addr(Handle&))----Image aus IStream&
                ~GdipCreateHBITMAPFromBitmap(Handle&,addr(Bmp&),0)--Bitmap aus Image
                ~GdipDisposeImage(Handle&)--------------------------Image freigeben
                drawpic Bmp&,10,10;0--------------------------------Bitmap anzeigen
                deleteobject Bmp&-----------------------------------Bitmap freigeben
                char PicData#,0=HiQuality$--Daten aus String nach PicData#
                MemToStream()---------------Daten von PicData# nach IStream&
                ~GdipLoadImageFromStream(IStream&,addr(Handle&))----Image aus IStream&
                ~GdipCreateHBITMAPFromBitmap(Handle&,addr(Bmp&),0)--Bitmap aus Image
                ~GdipDisposeImage(Handle&)--------------------------Image freigeben
                drawpic Bmp&,270,10;0-------------------------------Bitmap anzeigen
                deleteobject Bmp&-----------------------------------Bitmap freigeben

                while 1

                    waitinput
                    case %umessage=16:break

                endwhile

                StreamRelease()---------------------Stream freigeben
                external(ole32,CoUninitialize)--OLE aus
                ExitGDIPlus(Token&)-----------------GDI+ aus

cls
long l=1024*1024
string s=mkstr$(0123456789,l)
print len(s)/1024/1024,MB
s=encode64(s)
print len(s)/1024/1024,MB
s=decode64(s)
print len(s)/1024/1024,MB
print mid$(s,1,20)
print mid$(s,len(s)-19,20)
waitkey
KompilierenMarqueSéparation
CLS
var L&=1024*1024
var S$=MKSTR$(0123456789,L&)
PRINT LEN(S$)/1024/1024,MB
S$=ENCODE64(S$)
PRINT LEN(S$)/1024/1024,MB
S$=DECODE64(S$)
PRINT LEN(S$)/1024/1024,MB
PRINT MID $(S$,1,20)
PRINT MID $(S$,LEN(S$)-19,20)
WAITKEY

window 30,30-500,500
 $H Windows.ph
declare bmi#,b#
declare Pic$,Handle&,Neu&,wert&,hwin&
Fenêtre 20,20-200,200
hWin& = Créer(Fenêtre, %hWnd, Test, 250, 20, 650,500)
Pic$=test.bmp
Handle&=create(hPic,-1,Pic$)
struct bmpHEADER=Size&,Width&,Height&,Planes%,BitCount%,Compression&,SizeImage&,X#(24)
dim bmi#,bmpHEADER
bmi#.Size&=sizeof(bmi#)------------------Taille de BITMAPINFOHEADER
~GetDIBits(%hdc,Handle&,0,0,0,bmi#,0)--Dummy-Aufruf, um bmpHeader trop füllen (Rückgabe: 1=OK)
imprimer sizeof(bmi#)
dim b#,bmi#.SizeImage&-----------------Bereich pour Bildinformationen (Pixel) bereitstellen
~GetDIBits(%hdc,Handle&,0,bmi#.Height&,b#,bmi#,0)--Eigendliche Bilddaten aus Handle ermitteln
Neu&=~CreateDIBitmap(%hdc,bmi#,4,b#,bmi#,0)------Neue DIB avec modifié Farben erzeugen
startpaint hwin&
drawpic Neu&,10,10;0
endpaint
wert&=bmi#.SizeImage&

whileloop 0,wert&,4

    imprimer byte(b#,&loop),byte(b#,&loop+1),byte(b#,&loop+2)
    sleep 10

endwhile