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 30,30-500,500
 $H Windows.ph
declare a#,b#
declare Pic$,Handle&,Neu&
---------------------------------Diesen Pfad bitte anpassen!
Pic$=C:Dokumente und EinstellungenPascalDesktopBild.jpg
Handle&=create(hPic,-1,Pic$)--Liefert immer 32-Bit-Handle!
--BITMAPINFOHEADER-Struktur
--Nur benötigte Parameter wurden bezeichnet
struct bmpHEADER=Size&,Width&,Height&,Planes%,BitCount%,Compression&,SizeImage&,X#(24)
dim a#,bmpHEADER
a#.Size&=sizeof(a#)------------------Größe von BITMAPINFOHEADER
~GetDIBits(%hdc,Handle&,0,0,0,a#,0)--Dummy-Aufruf, um bmpHeader zu füllen (Rückgabe: 1=OK)
dim b#,a#.SizeImage&-----------------Bereich für Bildinformationen (Pixel) bereitstellen
~GetDIBits(%hdc,Handle&,0,a#.Height&,b#,a#,0)--Eigendliche Bilddaten aus Handle ermitteln
Neu&=~CreateDIBitmap(%hdc,a#,4,b#,a#,0)------Neue DIB mit geänderten Farben erzeugen
drawpic Neu&,10,10;0
dispose a#
dispose b#
waitkey

Def ZeroMemory(2) !KERNEL32,RtlZeroMemory
Def MoveMemory(3) !KERNEL32,RtlMoveMemory
Def WriteFile(5) !KERNEL32,WriteFile
Def CreateFile(7) !KERNEL32,CreateFileA
Def ReadFile(5) !KERNEL32,ReadFile
Def OpenFile(3) !KERNEL32,OpenFile
Def GetFileSizeAPI(2) !KERNEL32,GetFileSize
Def CloseHandle(1) !KERNEL32,CloseHandle
Def &SQLITE_OK           0/* Successful result */
Def &SQLITE_ERROR        1/* SQL error or missing database */
Def &SQLITE_INTERNAL     2/* Internal logic error in SQLite */
Def &SQLITE_PERM         3/* Access permission denied */
Def &SQLITE_ABORT        4/* Callback routine requested an abort */
Def &SQLITE_BUSY         5/* The database file is locked */
Def &SQLITE_LOCKED       6/* A table in the database is locked */
Def &SQLITE_NOMEM        7/* A malloc() failed */
Def &SQLITE_READONLY     8/* Attempt to write a readonly database */
Def &SQLITE_INTERRUPT    9/* Operation terminated by sqlite3_interrupt()*/
Def &SQLITE_IOERR       10/* Some kind of disk I/O error occurred */
Def &SQLITE_CORRUPT     11/* The database disk image is malformed */
Def &SQLITE_NOTFOUND    12/* NOT USED. Table or record not found */
Def &SQLITE_FULL        13/* Insertion failed because database is full */
Def &SQLITE_CANTOPEN    14/* Unable to open the database file */
Def &SQLITE_PROTOCOL    15/* NOT USED. Database lock protocol error */
Def &SQLITE_EMPTY       16/* Database is empty */
Def &SQLITE_SCHEMA      17/* The database schema changed */
Def &SQLITE_TOOBIG      18/* String or BLOB exceeds size limit */
Def &SQLITE_CONSTRAINT  19/* Abort due to constraint violation */
Def &SQLITE_MISMATCH    20/* Data type mismatch */
Def &SQLITE_MISUSE      21/* Library used incorrectly */
Def &SQLITE_NOLFS       22/* Uses OS features not supported on host */
Def &SQLITE_AUTH        23/* Authorization denied */
Def &SQLITE_FORMAT      24/* Auxiliary database format error */
Def &SQLITE_RANGE       25/* 2nd parameter to sqlite3_bind out of range */
Def &SQLITE_NOTADB      26/* File opened that is not a database file */
Def &SQLITE_ROW         100/* sqlite3_step() has another row ready */
Def &SQLITE_DONE        101/* sqlite3_step() has finished executing */
Def &SQLITE_OPEN_READONLY         $00000001
Def &SQLITE_OPEN_READWRITE        $00000002
Def &SQLITE_OPEN_CREATE           $00000004
Def &SQLITE_OPEN_DELETEONCLOSE    $00000008
Def &SQLITE_OPEN_EXCLUSIVE        $00000010
Def &SQLITE_OPEN_MAIN_DB          $00000100
Def &SQLITE_OPEN_TEMP_DB          $00000200
Def &SQLITE_OPEN_TRANSIENT_DB     $00000400
Def &SQLITE_OPEN_MAIN_JOURNAL     $00000800
Def &SQLITE_OPEN_TEMP_JOURNAL     $00001000
Def &SQLITE_OPEN_SUBJOURNAL       $00002000
Def &SQLITE_OPEN_MASTER_JOURNAL   $00004000
Def &SQLITE_OPEN_NOMUTEX          $00008000
Def &SQLITE_OPEN_FULLMUTEX        $00010000
Def &SQLITE_STATIC 0
Def &SQLITE_TRANSIENT -1
Declare Datei$
Declare hDLL&
Declare dll$
Declare DBName$
Declare hDB&
Declare Error&
Declare SQLCmd$
Declare Result&
Declare Titel$[]
Declare Titel$
Declare Titel&
Declare zKey$
Declare zBlob#
Declare nBlob&
Declare pnBlob&
Declare pzBlob#
Declare BWrite&
Declare FBuf#
Declare FHdl&
Declare FSize&
Window 0,0-1024,786
@Set(CallConv,CDECL)
dll$ = \sqlite3.dll
hDLL& = ImportDLL(dll$,_)
DBName$ = \TestDB3.db3
Print ---------
Error& = _sqlite3_open_v2(@Addr(DBName$),@Addr(hDB&),(&SQLITE_OPEN_READWRITE | &SQLITE_OPEN_CREATE),0)
Print @String$(_sqlite3_errmsg(hDB&),0)
Print ---------
SQLCmd$ = CREATE TABLE blobs(key TEXT PRIMARY KEY, value BLOB);
Error& = _sqlite3_exec(hDB&,@Addr(SQLCmd$),0,0,@Addr(Result&))
Print @String$(_sqlite3_errmsg(hDB&),0)
Print ---------
SQLCmd$ = INSERT INTO blobs(key, value) VALUES(?, ?);
Error& = _sqlite3_prepare_v2(hDB&,@Addr(SQLCmd$),-1,@Addr(Result&),0)
Print @String$(_sqlite3_errmsg(hDB&),0)
Print ---------
zKey$ = Bild
_sqlite3_bind_text(Result&,1,@Addr(zKey$),-1,&SQLITE_STATIC)
Print @String$(_sqlite3_errmsg(hDB&),0)
Print ---------
Datei$ = \Wasserlilien.jpg
Dim zBlob#,@FileSize(Datei$)
nBlob& = @BlockRead(Datei$,zBlob#,0,@FileSize(Datei$))
_sqlite3_bind_blob(Result&,2,zBlob#,@FileSize(Datei$),&SQLITE_TRANSIENT)
Print @String$(_sqlite3_errmsg(hDB&),0)
Dispose zBlob#
Print ---------
_sqlite3_step(Result&)
Print @String$(_sqlite3_errmsg(hDB&),0)
Print ---------
_sqlite3_finalize(Result&)
Print @String$(_sqlite3_errmsg(hDB&),0)
Print ---------
SQLCmd$ = SELECT value FROM blobs WHERE key = ?;
Error& = _sqlite3_prepare_v2(hDB&,@Addr(SQLCmd$),-1,@Addr(Result&),0)
Print @String$(_sqlite3_errmsg(hDB&),0)
Print ---------
zKey$ = Bild
_sqlite3_bind_text(Result&,1,@Addr(zKey$),-1,&SQLITE_STATIC)
Print @String$(_sqlite3_errmsg(hDB&),0)
Print ---------
_sqlite3_step(Result&)
Print @String$(_sqlite3_errmsg(hDB&),0)
Print ---------
pnBlob& = _sqlite3_column_bytes(Result&,0)
Datei$ = \Blob_Wasserlilien.jpg
Dim FBuf#,1024
String FBuf#,0 = Datei$ + @Chr$(0)
FHdl& = CreateFile(FBuf#,$40000000,0,0,$4,$80,0)
WriteFile(FHdl&,_sqlite3_column_blob(Result&,0),pnBlob&,@Addr(BWrite&),0)
CloseHandle(FHdl&)
Dispose FBuf#
Print ---------
_sqlite3_finalize(Result&)
Print @String$(_sqlite3_errmsg(hDB&),0)
Print ---------
Error& = _sqlite3_close(hDB&)
Print @String$(_sqlite3_errmsg(hDB&),0)
Print ---------
WaitInput
../../funktionsreferenzen/XProfan/freedll/'>FreeDLL hDLL&
Fin

 $H windows.ph
 $H Functions_GDIPLUS.ph
 $H GDIP_Imageging.ph
 $I GDIP_Helper.inc
---Für Header:
CoInitialize(=External(ole32,CoInitialize,;
CoUninitialize(=External(ole32,CoUninitialize,;
CreateStreamOnHGlobal(=External(ole32,CreateStreamOnHGlobal,;
GetHGlobalFromStream(=External(ole32,GetHGlobalFromStream,;
def CoInitialize(1) !ole32,CoInitialize
def CoUninitialize(0) !ole32,CoUninitialize
def CreateStreamOnHGlobal(3) !ole32,CreateStreamOnHGlobal
def GetHGlobalFromStream(2) !ole32,GetHGlobalFromStream

Proc SaveJpgToMem---------------------------------------SaveJpgToMem

    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#)

        --Original: ~GdipSaveImageToFile(Bitmap&,ADDR(newFile$),encoderCLSID#,encoderParameters#)
        CoInitialize(0)--------------------------------------------------
        declare IStream&
        CreateStreamOnHGlobal(0,1,addr(IStream&))
        ~GdipSaveImageToStream(Bitmap&,IStream&,encoderCLSID#,encoderParameters#)
        declare Global&,Mem&,Size&
        GetHGlobalFromStream(IStream&,addr(Global&))
        Mem&=~GlobalLock(Global&)
        Size&=~GlobalSize(Global&)
        dim PicData#,Size&---------------PicData# global deklariert
        MoveMemory(PicData#,Mem&,Size&)--MoveMemory definiert in GDIP_Helper.inc
        ~GlobalUnlock(Global&)
        ~GlobalFree(Global&)
        CoUninitialize()-------------------------------------------------
        result& = 1

    Endif

    Dispose encoder#
    Dispose encoderParameters#
    Dispose encoderCLSID#
    Return result&
    EndProc-------------------------------------------------------------
    Declare gdiplusToken&,ImageObject&,ImageWidth&,ImageHeight&,GraphicObject&
    Declare hPic&
    Declare imgThumb&
    Declare lngImage&
    Declare hBitmap&
    Window 0,0-500,500
    gdiplusToken& = InitGDIPlus()
    hPic&=create(hPic,-1,C:1TestBild.jpg)-----------------------Pfad anpassen!
    ~GdipCreateBitmapFromHBITMAP(hPic&,0,addr(lngImage&))
    ~GdipGetImageThumbnail(lngImage&,120,120,addr(imgThumb&),0,0)
    ~GdipCreateHBITMAPFromBitmap(imgThumb&,addr(hBitmap&),0)--Drei Parameter!!
    DrawPic hBitmap&,50,50;0
    declare PicData#--wird vor Ort jeweils passend dimensioniert
    SaveJpgToMem(imgThumb&,75)
    -----------------------------Test
    assign #1,C:1TestTest.jpg
    openrw #1
    blockwrite #1,PicData#,0,sizeof(PicData#)
    close #1
    WaitInput
    DeleteObject hPic&
    DeleteObject hBitmap&
    ~GdipDisposeImage(imgThumb&)
    ~GdipDisposeImage(lngImage&)
    ExitGDIPlus(gdiplusToken&pan>
    Fin