'///////////////////////////////////////////////////////////////////////////////
'//
'// Project Name : IPicture COM Demo 2 for RapidQ
'// Version      : 2.04.2006.20 UPDATED
'// Author       : Don67geo@Yahoo.com
'// Date         : April 20th, 2006
'//
'///////////////////////////////////////////////////////////////////////////////
$typecheck on

$resource MY_JPG as "IPicture_Demo.jpg"

$include "COMUtils.inc"
$include "Ipicture.inc"

declare sub paintpic
declare sub loadres
declare sub menuexit

deflng lpPic
defint srcWidth,srcHeight
defint dstWidth,dstHeight
dim rt(4) as long


create me as qform
    borderstyle    = 3
    caption        = "IPicture Demo"
    center
    onpaint        = paintpic
    onshow         = loadres
end create

'create IPicture interface
lpPic=IPicture_CreateFromResource(RESOURCE(MY_JPG))

me.showmodal

' clean up the mess
if lpPic then ComCall(IPicture_Release,lpPic)
end

sub loadres
    if lpPic then
        ' get picture dimension
        ComCall(IPicture_GetHeight,lpPic,varptr(srcHeight))
        ComCall(IPicture_GetWidth,lpPic,varptr(srcWidth))

        ' converting HIMETRIC to pixel value
        defint hdc=GetDC(me.handle)
        dstHeight=(srcHeight*GetDeviceCaps(hdc,90))\2540
        dstWidth=(srcWidth*GetDeviceCaps(hdc,88))\2540
        ReleaseDC(me.handle)

        ' set window to fit the picture
        me.clientheight = dstHeight
        me.clientwidth  = dstWidth
   
        ' painting rectangle
        rt(0)=0
        rt(1)=0
        rt(2)=me.clientwidth
        rt(3)=me.clientheight
   
        ' if it is bigger than desktop size
        if me.top+me.height>screen.height then _
                       me.height=screen.height-me.top
        if me.left+me.width>screen.width then _
                        me.width=screen.width-me.left
        me.repaint
    end if
end sub

sub paintpic
    ' background surface color
    me.fillrect(0,0,me.clientwidth,me.clientheight,&hFFFFFF)

    ' render the picture to surface
    defint hdc=GetDC(me.handle)
    if lpPic then _
           ComCall(IPicture_Render,lpPic,hdc,0,0,_
                        dstWidth,dstHeight,0,srcHeight, _
                            srcWidth,-srcHeight,varptr(rt(0)))
    ReleaseDC(me.handle)
end sub

sub menuexit
    me.close
end sub
