/'
   This is GUI graphic unit in FreeBasic
   is suitable for windows operating system,
   but can be easely translated for Linux systems
   copyright (c)2021 vasile eodor nastasa
   http://www.rqwork.ro
   http://www.rqwork.de
   nastasa.eodor@gmail.com
   this version is number 11, is a stable release(GUI_V11)
'/

#include once "sysutils.bas"

#define clbtnface getsyscolor(color_btnface)
#define clwindow getsyscolor(color_window)
#define clwindowtext getsyscolor(color_windowtext)

type PPen as QPen ptr

type QPen extends QObject
    protected:
    as logpen flp
    as hpen fhandle
    as integer fstyle,fsize
    as colorref fcolor
    public:
    declare sub Create
    declare sub Destroy
    declare operator cast as any ptr
    declare constructor
    declare destructor
end type

type PBrush as QBrush ptr

type QBrush extends QObject
    protected:
    as logbrush flb
    as hbrush fhandle
    as integer fhatch
    as colorref fcolor
    public:
    declare sub Create
    declare sub Destroy
    declare property Handle as hbrush
    declare property Handle (as hbrush)
    declare property Color as colorref
    declare property Color (as colorref)
    declare operator cast as any ptr
    declare constructor
    declare destructor
end type

type QGraphic extends QObject
    protected:
    as any ptr fhandle
    public:
    declare abstract sub Create
    declare abstract sub LoadFromFile(as string)
    declare abstract sub SaveToFile(as string)
    declare abstract sub LoadFromResourceName(as string)
    declare abstract operator cast as any ptr
end type

type PPicture as QPicture ptr

type QPicture extends QGraphic
    protected:
    as string ffilename
    as integer fimagetype
    as boolean ftransparent
    as PCustomFrame finterface
    public:
    declare property Interface as PCustomFrame
    declare property Interface (as PCustomFrame)
    declare property Handle as any ptr
    declare property Handle (as any ptr)
    declare property FileName as string
    declare property FileName (as string)
    declare sub UpdateInterface
    declare virtual sub Create
    declare virtual sub LoadFromFile(as string)
    declare virtual sub SaveToFile(as string)
    declare virtual sub LoadFromResourceName(as string)
    declare virtual operator cast as any ptr
    declare constructor(as PCustomFrame=0)
    declare destructor
    as QEvent onChange
    #ifdef rtl
     declare virtual function GetProperties as zstring ptr
     declare virtual function GetPropertyInfo(as string) as PELPropInfo
     declare virtual function GetProperty(as string) as zstring ptr
     declare virtual function SetProperty(as string,as zstring ptr) as boolean
    #endif
end type

type QBitmap extends QPicture
    protected:
    as integer fformat
    as colorref ftransparentcolor,fcolor
    as integer fwidth,fheight
    public:
    declare property Handle as hbitmap
    declare property Handle (as hbitmap)
    declare virtual sub Create
    declare virtual operator cast as any ptr
    declare operator cast as hbitmap
    declare operator let(as hbitmap)
    declare operator cast as string
    declare operator let(as string)
    declare constructor
end type

type PIcon as QIcon ptr

type QIcon extends QBitmap
    public:
    declare property Handle as hicon
    declare property Handle (as hicon)
    declare virtual sub Create
    declare virtual operator cast as any ptr
    declare operator cast as hicon
    declare operator let(as hicon)
    declare operator cast as string
    declare operator let(as string)
    declare constructor
end type

type QCursor extends QIcon
    protected:
    as integer fhotspotx,fhotspoty
    public:
    declare property Handle as hcursor
    declare property Handle (as hcursor)
    declare virtual sub Create
    declare property HotSpotX as integer
    declare property HotSpotX (as integer)
    declare property HotSpotY as integer
    declare property HotSpotY (as integer)
    declare virtual operator cast as any ptr
    declare operator cast as hcursor
    declare operator let(as hcursor)
    declare operator cast as string
    declare operator let(as string)
    declare constructor
end type

/'QPen'/
sub QPen.Create
    Destroy
    flp.lopncolor=fcolor
    flp.lopnwidth=type(fsize,0)
    flp.lopnstyle=fstyle
    fhandle=createpenindirect(@flp)
end sub

sub QPen.Destroy
    if fhandle then
       deleteobject(fhandle)
       fhandle=0
    end if
end sub

operator QPen.cast as any ptr
    return @this
end operator

constructor QPen
    create
end constructor

destructor QPen
    destroy
end destructor

/'QBrush'/
sub QBrush.Create
    Destroy
    flb.lbcolor=fcolor
    flb.lbstyle=bs_solid
    flb.lbhatch=fhatch
    fhandle=createbrushindirect(@flb)
end sub

sub QBrush.Destroy
    if fhandle then
       deleteobject(fhandle)
       fhandle=0
    end if
end sub

property QBrush.Handle as hbrush
    return fhandle
end property

property QBrush.Handle (v as hbrush)
    fhandle=v
end property

property QBrush.Color as colorref
    if fhandle then
       if getobject(fhandle,sizeof(flb),@flb) then
          fcolor=flb.lbcolor
       end if
    end if
    return fcolor
end property

property QBrush.Color (v as colorref)
    fcolor=v
    Create
end property

operator QBrush.cast as any ptr
    return @this
end operator

constructor QBrush
    fcolor=getsyscolor(color_window)
    create
end constructor

destructor QBrush
    destroy
end destructor

/'QPicture'/
sub QPicture.Create
    select case fimagetype
    case image_bitmap
         cast(QBitmap ptr,@this)->create
    case image_icon
         cast(QIcon ptr,@this)->create
    case image_cursor
         cast(QCursor ptr,@this)->create
    end select
    UpdateInterface
end sub

sub QPicture.LoadFromFile(v as string)
    ffilename=v
    if fhandle then deleteobject(fhandle)
    fhandle=LoadImage(0,v,fimagetype,0,0,lr_loadfromfile or lr_defaultsize or iif(ftransparent,lr_loadtransparent or lr_loadmap3dcolors,0))
    if onchange then onchange(this)
end sub

sub QPicture.SaveToFile(v as string)
end sub

sub QPicture.LoadFromResourceName(v as string)
    dim as zstring ptr restype=0
    if fhandle then deleteobject(fhandle)
    ffilename=v
    if fimagetype=image_bitmap then
       restype=rt_bitmap
    elseif fimagetype=image_icon then
       restype=rt_icon
    elseif fimagetype=image_cursor then
       restype=rt_cursor
    end if
    if findresource(0,v,restype) then
       fhandle=LoadImage(0,v,fimagetype,0,0,lr_defaultsize or iif(ftransparent,lr_loadtransparent or lr_loadmap3dcolors,0))
    elseif findresource(instance,v,restype) then
       fhandle=LoadImage(instance,v,fimagetype,0,0,lr_defaultsize or iif(ftransparent,lr_loadtransparent or lr_loadmap3dcolors,0))
    end if
    if onchange then onchange(this)
end sub

property QPicture.FileName as string
    return ffilename
end property

property QPicture.FileName (v as string)
    if lcase(v)<>lcase(filename) then
       ffilename=v
       select case lcase(extractfileext(v))
       case ".bmp":fimagetype=image_bitmap
       case ".ico":fimagetype=image_icon
       case ".cur":fimagetype=image_cursor
       end select
       if fileexists(v) then
          LoadFromFile(v)
       else
          LoadFromResourceName(v)
       end if
       if onchange then onchange(this)
    end if
end property

property QPicture.Interface as PCustomFrame
    return finterface
end property

property QPicture.Interface (v as PCustomFrame)
    finterface=v
    if v then v->UpdateControl
end property

property QPicture.Handle as any ptr
    return fhandle
end property

property QPicture.Handle (v as any ptr)
    fhandle=v
end property

sub QPicture.UpdateInterface
    if (finterface) then finterface->updatecontrol
end sub

operator QPicture.cast as any ptr
    return @this
end operator

constructor QPicture(V as PCustomFrame=0)
    finterface=v
end constructor

destructor QPicture
    if fhandle then deleteobject(fhandle)
end destructor

#ifdef rtl
      function QPicture.GetProperties as zstring ptr
           dim as string s=*Base.GetProperties+lf+"FileName"+lf+"Interface"+lf+"Handle"
           dim as zstring ptr zs=callocate(len(s)+1)
           *zs=s
           return zs
      end function

      function QPicture.GetPropertyInfo(n as string) as PELPropInfo
           if n="" then return 0
           dim as PELPropInfo pif=new QELPropInfo
           select case lcase(n)
           case "filename"
                pif->value=callocate(len(n)+1)
                *pif->value=n+chr(0)
                pif->typename=callocate(len("path")+1)
                *pif->typename="path"+chr(0)
                pif->typekind=tkString
                return pif
           case "interface"
                pif->value=callocate(len(n)+1)
                *pif->value=n+chr(0)
                pif->typename=callocate(len("interface")+1)
                *pif->typename="interface"+chr(0)
                pif->typekind=tkType
                return pif
           case "handle"
                pif->value=callocate(len(n)+1)
                *pif->value=n+chr(0)
                pif->typename=callocate(len("handle")+1)
                *pif->typename="handle"+chr(0)
                pif->typekind=tkInteger
                return pif
           end select
           return Base.GetPropertyInfo(n)
      end function

      function QPicture.GetProperty(n as string) as zstring ptr
           if n="" then return 0
           select case lcase(n)
           case "filename"
                dim as zstring ptr zs=callocate(len(ffilename)+1)
                *zs=ffilename+chr(0)
                return zs
           case "interface"
                dim as zstring ptr zs=callocate(len(str(interface))+1)
                *zs=str(interface)+chr(0)
                return zs
           case "handle"
                dim as zstring ptr zs=callocate(len(str(fhandle))+1)
                *zs=str(fhandle)+chr(0)
                return zs
           case else
                return Base.GetProperty(n)
           end select
           return 0
      end function

      function QPicture.SetProperty(n as string,v as zstring ptr) as boolean
           if n="" then return 0
           select case lcase(n)
           case "filename"
                filename=*v
                return ffilename<>""
           case "interface"
                interface=cast(PCustomFrame,valint(*v))
                return finterface>0
           case "handle"
                handle=cast(hwnd,valint(*v))
                return finterface>0
           case else
                return Base.SetProperty(n,v)
           end select
           return 0
      end function
#endif

/'QBitmap'/
property QBitmap.Handle as hbitmap
    return cast(hbitmap,fhandle)
end property

property QBitmap.Handle (v as hbitmap)
    fhandle=v
end property

sub QBitmap.Create
    dim as bitmap bm
    bm.bmwidth=24
    bm.bmheight=24
    fimagetype=image_bitmap
    fhandle=createbitmapindirect(@bm)
end sub

operator QBitmap.cast as hbitmap
    return cast(hbitmap,fhandle)
end operator

operator QBitmap.let(v as hbitmap)
    dim as bitmap bm
    if getobject(v,sizeof(bm),@bm) then
       fwidth=bm.bmwidth
       fheight=bm.bmheight
       fhandle=createbitmapindirect(@bm)
    end if
end operator

operator QBitmap.cast as string
    return ffilename
end operator

operator QBitmap.let(v as string)
    ffilename=v
    if fileexists(v) then
       this.LoadFromFile(v)
    else
       this.LoadFromResourceName(v)
    end if
end operator

operator QBitmap.cast as any ptr
   return @this
end operator

constructor QBitmap
    fimagetype=image_bitmap
end constructor

/'QIcon '/
property QIcon.Handle as hicon
    return cast(hicon,fhandle)
end property

property QIcon.Handle (v as hicon)
    fhandle=v
end property

sub QIcon.Create
end sub

operator QIcon.cast as any ptr
   return @this
end operator

operator QIcon.cast as hcursor
    return cast(hcursor,fhandle)
end operator

operator QIcon.let(v as hcursor)
end operator

operator QIcon.cast as string
    return ffilename
end operator

operator QIcon.let(v as string)
end operator

constructor QIcon
    fimagetype=image_icon
end constructor

/'QCursor'/
property QCursor.Handle as hcursor
    return cast(hcursor,fhandle)
end property

property QCursor.Handle (v as hcursor)
    fhandle=v
end property

sub QCursor.Create
end sub

property QCursor.HotSpotX as integer
    dim as iconinfo icif
    icif.ficon=false
    if getobject(fhandle,sizeof(icif),@icif) then
       fhotspotx=icif.xhotspot
    end if
    return fhotspotx
end property

property QCursor.HotSpotX (v as integer)
    dim as iconinfo icif
    icif.ficon=false
    fhotspotx=v
    if getobject(fhandle,sizeof(icif),@icif) then
       icif.xhotspot=v
    end if
end property

property QCursor.HotSpotY as integer
    dim as iconinfo icif
    icif.ficon=false
    if getobject(fhandle,sizeof(icif),@icif) then
       fhotspoty=icif.yhotspot
    end if
    return fhotspotx
end property

property QCursor.HotSpotY (v as integer)
    dim as iconinfo icif
    icif.ficon=false
    fhotspoty=v
    if getobject(fhandle,sizeof(icif),@icif) then
       icif.yhotspot=v
    end if
end property

operator QCursor.cast as any ptr
   return @this
end operator

operator QCursor.cast as hcursor
    return cast(hcursor,fhandle)
end operator

operator QCursor.let(v as hcursor)
end operator

operator QCursor.cast as string
    return ffilename
end operator

operator QCursor.let(v as string)
end operator

constructor QCursor
    fimagetype=image_cursor
end constructor