'///////////////////////////////////////////////////////////////////////////////
'//
'// Project Name : COM IPicture.inc for RapidQ
'// Version      : 2.04.2006.20 UPDATED
'// Author       : Don67geo@Yahoo.com
'// Date         : April 20th, 2006
'//
'///////////////////////////////////////////////////////////////////////////////
$typecheck ON

$ifndef IPICTURE_INC
$define IPICTURE_INC

' Sharing the same Inherited IUnknown.Release method
$define IStream_Release IUnknown_Release
$define IPicture_Release IUnknown_Release

'___enum__VTABLE_OFFSETS
const IUnknown_Release   = 8
const IPicture_GetWidth  = 24
const IPicture_GetHeight = 28
const IPicture_Render    = 32


declare function GetDeviceCaps lib "gdi32" alias "GetDeviceCaps" _
    (hdc as long, nIndex as long) as long
declare function CreateStreamOnHGlobal lib "ole32" alias _
    "CreateStreamOnHGlobal" (hGlobal as long, _
    fDeleteOnRelease as integer,ppStream as long) as long
declare sub OleLoadPicture lib "oleaut32" alias "OleLoadPicture" _
    (ppStream as long, lSize as long, fRunmode as integer, _
    riid as long, ppPic as long)
Declare Function GetDC Lib "user32" alias "GetDC" _
    (hwnd As Long) As Long
Declare Function ReleaseDC Lib "user32" alias "ReleaseDC" _
    (hwnd As Long) As Long
Declare Function GlobalAlloc Lib "kernel32" alias "GlobalAlloc" _
    (wFlags As Long, dwBytes As Long) As Long
Declare sub GlobalFree Lib "kernel32" alias "GlobalFree" _
    (hMem As Long)

dim hFile as QMemoryStream


function MakePicture as long
    deflng ppStream=0
    deflng ppPic=0
    defint hGlobal=0
    defint lSize=hFile.size
    result=0
    if lSize=0 then exit function
    hGlobal=GlobalAlloc(0,lSize)
    memcpy(hGlobal,hFile.pointer,lSize)
    hFile.clear
    deflng hr=CreateStreamOnHGlobal(hGlobal,1,varptr(ppStream))

    'IID_IPicture {7BF80980-BF32-101A-8BBB-00AA00300CAB}
    defint IID_IPicture(0 to 3) = _
           { _
             &h7BF80980, _
             &h101ABF32, _
             &hAA00BB8B, _
             &hAB0C3000, _
           }
    if (ppStream) then
       OleLoadPicture(ppStream,lSize,0,_
                      varptr(IID_IPicture(0)),varptr(ppPic))
       ComCall(IStream_Release,ppStream)
    end if
    result=ppPic
end function

function IPicture_CreateFromFile(fname as string) as long
    result = 0
    deflng ppStream=0
    deflng ppPic=0
    defint hGlobal=0
    dim hDisk as QFileStream
        hDisk.Open(fname,0)
        hFile.CopyFrom(hDisk,0)
    hDisk.close
    result=MakePicture
end function

function IPicture_CreateFromResource(ResNum as Long) as long
    result = 0
    hFile.ExtractRes(ResNum)
    result=MakePicture
end function
$endif 'IPICTURE_INC