#include once "windows.bi"
#include once "win/commctrl.bi"
#include once "vbcompat.bi"

#define rtl
#define instance getmodulehandle(0)
#define objFromHwnd(dlg) cast(PFrame,GetWindowLongPtr(dlg,GetClassLongPtr(dlg,gcl_cbwndextra)-4))
#define hbrDefault cast(hbrush,16)
#define crDefault LoadCursor(0,idc_arrow)
#define MainType "QForm"
const cr=chr(13)
const lf=chr(10)
const crlf=cr+lf

const cm_command=wm_app+1
const cm_notify=wm_app+2

type PObject as QObject ptr
type PFrame as QFrame ptr

common shared as PFrame creationdata

type QMessage
     dlg as hwnd
     msg as uint
     wparam as wparam
     lparam as lparam
     result as lresult
     sender as PObject
end type

#ifdef rtl
enum QELTypeKind
    tkUnknown,tkByte,tkShort,tkInteger,tkFloat,tkLong,tkString,tkZStringPtr,tkBool,tkAny,tkSet,tkEnum,tkMethod,tkType,tkVariant
end enum

type PELPropInfo as QELPropInfo ptr
type QELPropInfo
     as zstring ptr typename,name,value,editor
     as QELTypeKind typekind
end type

type QGeneric extends object
     declare abstract function GetProperties as zstring ptr
     declare abstract function GetPropertyInfo(n as string) as PELPropInfo
     declare abstract function GetProperty(n as string) as zstring ptr
     declare abstract function SetProperty(n as string,as zstring ptr) as boolean
     declare operator cast as any ptr
     as sub(as PObject,as PELPropInfo) onChange
end type
#endif

#ifdef rtl
type QObject extends qgeneric
#else
type QObject extends object
#endif
    public:
    as integer tag
    as string classname,classancestor,name
    declare operator cast as string
    declare operator cast as any ptr
    #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 QEvent as sub(byref as QObject)
type QCloseEvent as sub(byref as QObject,byref as integer=1)
type QCommandEvent as sub(byref as QObject,as integer,as integer,as hwnd)
type QMenuEvent as sub(byref as QObject,as integer)
type QMouseEvent as sub(byref as QObject,as integer,as integer,as integer,as integer)
type QMouseMoveEvent as sub(byref as QObject,as integer,as integer,as integer)
type QKeyEvent as sub(byref as QObject,as integer,as integer)
type QCharEvent as sub(byref as QObject,as byte)
type QMouseWheelEvent as sub(byref as QObject,as integer,as integer,as integer,as integer)
type QDataEvent as sub(byref as QObject,as hwnd,as copydatastruct ptr)

enum QComponentState
    csNormal,csDesign
end enum

type QComponent extends QObject
    protected:
    as integer fstate
    public:
    declare property State as integer
    declare property State (as integer)
end type

type QCustomFrame extends QObject
     declare abstract sub Dispatch(byref as QMessage)
     declare abstract sub Handler(byref as QMessage)
     declare abstract sub CreateHandle
     #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

#include once "classes.bas"

enum QControlAlign
    alNone,alLeft,alRight,alTop,alBottom,alClient
end enum

enum QWindowState
    wsNormal,wsMinimized,wsMaximized,wsHide
end enum

enum QControlStyle
    csDefault,csTransparent,csAcceptChild
end enum

enum QControlState
    csNormal,csStayOnTop,csCanCopy
end enum

type PFont as QFont ptr
type QFont extends QObject
    protected:
     as hwnd finterface
     as hfont fhandle
     as string ffacename
     as integer fsize
     as boolean fbold
     as boolean fitalic
     as boolean funderline
     as boolean fstrikeout
     declare sub CreateHandle
     public:
     declare property Handle as hfont
     declare property Handle (as hfont)
     declare property FaceName as string
     declare property FaceName(as string)
     declare property Size as integer
     declare property Size(as integer)
     declare property Bold as boolean
     declare property Bold(as boolean)
     declare property Italic as boolean
     declare property Italic(as boolean)
     declare property Underline as boolean
     declare property Underline(as boolean)
     declare property Strikeout as boolean
     declare property Strikeout(as boolean)
     declare property Interface as hwnd
     declare property Interface (as hwnd)
     declare operator cast as any ptr
     declare operator cast as hfont
     declare operator cast as string
     declare operator let( as hfont)
     declare operator let( as pfont)
     declare operator let( as string)
     declare sub updateinterface
     declare constructor
     declare destructor
     #ifdef RTL
     declare virtual function GetProperty(as string) as zstring ptr
     declare virtual function SetProperty(as string,as zstring ptr) as boolean
     declare virtual function GetProperties as zstring ptr
     declare virtual function GetPropertyInfo(as string) as PELPropInfo
     #endif
end type

type QCanvas extends QObject
end type

#include once "menus.bas"

type QFrame extends QCustomFrame
     protected:
     as ppopupmenu fpopupmenu
     as hbrush fbrush
     as colorref fcolor=getsyscolor(color_window)
     as QList fControls
     as hwnd fhandle,fparentwnd
     as PFrame fparent
     as integer fleft,ftop,fwidth,fheight,fid,fstyle,fexstyle,fclientwidth,fclientheight,foldz
     as string ftext,fhint
     as boolean fvisible,fenabled,ftabstop,fclipped,fgrouped,fshowhint
     as QFont ffont
     as integer fcursor
     as QControlStyle fcontrolstyle
     as QControlState fcontrolstate
     as QEvent fonpaint
     as QCanvas fcanvas
     as QControlAlign falign
     as integer fmodalresult
     as PFrame factive
     as rect fclientrect,fwindowrect
     as QWindowState fwindowstate
     declare sub Add(as PFrame)
     declare sub Remove(as PFrame)
     declare function indexof(as PFrame) as integer
     declare virtual sub Dispatch(byref as QMessage)
     declare virtual sub Handler(byref as QMessage)
     declare virtual sub CreateHandle
     declare sub RequestAlign
    public:
     declare sub FreeHandle
     declare sub SetFocus
     declare sub KillFocus
     declare sub BringToFront
     declare sub SendToBack
     declare sub Repaint
     declare sub Invalidate
     declare sub Refresh
     declare sub Update
     declare sub ScreenToClient(as point)
     declare sub ClientToScreen(as point)
     declare sub AdjustClient overload(as rect)
     declare sub AdjustClient overload(as integer,as integer,as integer,as integer)
     declare sub Click
     declare sub DblClick
     declare function IndexOfControl(as PFrame) as integer
     declare function Perform(as uint,as wparam,as lparam) as lresult
     declare sub SetBounds overload(as integer,as integer,as integer,as integer)
     declare sub SetBounds overload(as rect)
     declare property Font byref as QFont
     declare property Font(byref as QFont)
     declare property Controls byref as QList
     declare property ControlCount as integer
     declare property Control(as integer) byref as QFrame
     declare property id as integer
     declare property id(as integer)
     declare property ControlStyle as integer
     declare property ControlStyle(as integer)
     declare property ControlState as integer
     declare property ControlState(as integer)
     declare property Text as string
     declare property Text (as string)
     declare property Handle as hwnd
     declare property Handle (as hwnd)
     declare property WindowState as integer
     declare property WindowState (as integer)
     declare property Align as integer
     declare property Align (as integer)
     declare property Style as integer
     declare property Style (as integer)
     declare property ExStyle as integer
     declare property ExStyle (as integer)
     declare property Parent as PFrame
     declare property Parent (as PFrame)
     declare property ParentWnd as hwnd
     declare property ParentWnd (as hwnd)
     declare property Left as integer
     declare property Left (as integer)
     declare property Top as integer
     declare property Top (as integer)
     declare property Width as integer
     declare property Width (as integer)
     declare property Height as integer
     declare property Height (as integer)
     declare property ClientWidth as integer
     declare property ClientWidth( as integer)
     declare property ClientHeight as integer
     declare property ClientHeight( as integer)
     declare property ClientRect as rect
     declare property ClientRect( as rect)
     declare property WindowRect as rect
     declare property WindowRect( as rect)
     declare property Enabled as boolean
     declare property Enabled (as boolean)
     declare property Visible as boolean
     declare property Visible (as boolean)
     declare property ShowHint as boolean
     declare property ShowHint (as boolean)
     declare property Cursor as integer
     declare property Cursor(as integer)
     declare property Hint as string
     declare property Hint (as string)
     declare property Clipped as boolean
     declare property Clipped (as boolean)
     declare property Grouped as boolean
     declare property Grouped (as boolean)
     declare property TabStop as boolean
     declare property TabStop (as boolean)
     declare property onPaint as QEvent
     declare property onPaint (as QEvent)
     as QEvent onClick,onDblClick,onCreate,onDestroy
     as QDataEvent onData
     as QCommandEvent onCommand
     as QMenuEvent onMenu, onAccel
     as QMouseEvent onMouseDown,onMouseUp
     as QMouseMoveEvent onMouseMove
     as QKeyEvent onKeyDown,onKeyUp
     as QCharEvent onKeyPress
     as QMouseWheelEvent onMouseWheel
     declare operator cast as any ptr
     declare operator cast as string
     declare constructor
     declare destructor
     #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 PCustomForm as QCustomForm ptr
type QCustomForm extends QFrame
      protected:
      as PMainMenu fmainmenu
      as boolean fismodal
      as integer fmodalresult
      declare virtual sub Dispatch(byref as QMessage)
      declare virtual sub Handler(byref as QMessage)
      declare static function DlgProc(as hwnd,as uint,as wparam,as lparam) as lresult
      public:
      as integer ModalResult
      declare property MainMenu byref as QMainMenu
      declare property MainMenu (byref as QMainMenu)
      declare function ShowModal as integer
      declare sub Close
      declare static function Register(v as string="QForm") as integer
      declare operator cast as any ptr
      declare operator cast as string
      declare constructor
      declare destructor
      as QCloseEvent onClose
      #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 PApplication as QApplication ptr
type QApplication extends object
      protected:
      as boolean fterminated
      as QList fWindows
      declare sub UpdateWindowsList
      declare static function EnumWindowsProc(dlg as hwnd,as lparam) as boolean
      public:
      declare property WinList byref as QList
      declare property WindowCount as integer
      declare property Window(as integer) as hwnd
      declare property Terminated as boolean
      declare property Terminated (as boolean)
      declare sub Run
      declare sub Terminate
      declare sub Quit
      declare sub DoEvents
      declare operator cast as any ptr
      declare constructor
      declare destructor
      #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

common shared as PApplication iApplication
#define Application *(iApplication)

#include once "standards.bas"

/'Graphic'/
/' QFont '/
#ifdef RTL
function QFont.GetProperty(n as string) as zstring ptr
    if n="" then return 0
    select case lcase(trim(n))
    case "facename"
         dim as zstring ptr s=callocate(len(ffacename)+1)
         *s=ffacename+chr(0)
         return s
    case "size"
         dim as zstring ptr s=callocate(len(str(fsize))+1)
         *s=str(fsize)+chr(0)
         return s
    case "bold"
         dim as zstring ptr s=callocate(4)
         *s=str(fbold)
         return s
    case"italic"
         dim as zstring ptr s=callocate(4)
         *s=str(fitalic)
         return s
    case "underline"
         dim as zstring ptr s=callocate(4)
         *s=str(funderline)
         return s
    case "strikeout"
         dim as zstring ptr s=callocate(4)
         *s=str(fstrikeout)
         return s
    case "handle"
         dim as zstring ptr s=callocate(len(str(handle))+1)
         *s=str(handle)+chr(0)
         return s
    case else
         return Base.GetProperty(n)/''/
    end select
end function

function QFont.SetProperty(n as string,v as zstring ptr) as boolean
    if n="" then return 0
    select case lcase(trim(n))
    case "facename"
          this.facename=*v
          return facename<>""
    case "size"
          this.size=cast(integer,valint(str(*v)))
          return size>0
    case "bold"
          this.bold=cast(integer,valint(str(*v)))
          return bold
    case"italic"
          this.italic=cast(integer,valint(str(*v)))
          return italic
    case "underline"
          this.underline=cast(integer,valint(str(v)))
          return underline
    case "strikeout"
          this.strikeout=cast(integer,valint(str(v)))
          return strikeout
    case "handle"
          this.handle=cast(hfont,valint(*v))
          return handle>0
    case else
         return Base.SetProperty(n,v)/''/
    end select
end function

function QFont.GetProperties as zstring ptr '''published properties
    dim as string s="FaceName"+lf+"Size"+lf+"Bold"+lf+"Italic"+lf+"Underline"+lf+"Strikeout"+lf+"Handle"
    dim as zstring ptr zs=callocate(len(s)+1)
    *zs=s+chr(0)
    return zs
end function

function QFont.GetPropertyInfo(n as string) as PELPropInfo
    if n="" then return 0/''/
    select case lcase(trim(n))
    case "facename"
         dim as PELPropInfo Pif=new QELPropInfo
         Pif->name=callocate(len("facename")+1)
         *pif->name="facename"
         pif->value=callocate(len(facename)+1)
         *pif->value=facename
         pif->typekind=tkString
         return pif
    case "size"
         dim as PELPropInfo Pif=new QELPropInfo
         pif->name=callocate(len("size")+1)
         *pif->name="size"+chr(0)
         pif->value=callocate(len(str(size))+1)
         *pif->value=str(size)+chr(0)
         pif->typekind=tkInteger
         return pif
    case "bold","italic","underline","strikeout"
         dim as PELPropInfo Pif=new QELPropInfo
         pif->name=callocate(len(n)+1)
         *pif->name=n+chr(0)
         pif->value=callocate(len(*GetProperty(n))+1)
         *pif->value=*GetProperty(n)+chr(0)
         pif->typekind=tkBool
         return pif
    case "handle"
         dim as PELPropInfo Pif=new QELPropInfo
         pif->name=callocate(len("handle")+1)
         *pif->name="handle"+chr(0)
         pif->value=callocate(len(str(handle))+1)
         *pif->value=str(handle)+chr(0)
         pif->typename=callocate(len("hfont")+1)
         *pif->typename="hfont"+chr(0)
         pif->typekind=tkInteger
         return pif
    case else
         return Base.GetPropertyInfo(n)/''/
    end select
end function
#endif

sub QFont.CreateHandle
    if fhandle then deleteobject(fhandle)
    dim as hdc dc=GetDC(0)
    fhandle=createfont(-MulDiv(fsize, GetDeviceCaps(DC, LOGPIXELSY), 72),0,0,0,iif(fbold,700,400),fitalic,funderline,fstrikeout,default_charset,out_default_precis,clip_default_precis,default_pitch,0,ffacename)
    releaseDC(0,dc)
end sub

property QFont.Interface as hwnd
    return finterface
end property

property QFont.Interface (v as hwnd)
    finterface=v
    updateinterface
end property

property QFont.Handle as hfont
    return fhandle
end property

property QFont.Handle (v as hfont)
    dim  as logfont lf
    if v then
       if getobject(v,sizeof(lf),@lf) then
          ffacename=lf.lffacename
          fbold=iif(lf.lfwidth>400,true,false)
          fitalic=lf.lfitalic
          funderline=lf.lfunderline
          fstrikeout=lf.lfstrikeout
       end if
    end if
    fhandle=v
end property

property QFont.Size as integer
    dim as logfont lgf
    if getobject(fhandle,sizeof(lgf),@lgf) then
       dim as hdc dc=getdc(0)
       fsize=-MulDiv(72, lgf.lfheight, GetDeviceCaps(DC, LOGPIXELSY))
       releasedc(0,dc)
    end if /''/
    return fsize
end property

property QFont.Size (v as integer)
    fsize=v
    createhandle
end property

property QFont.FaceName as string
    if fhandle then
       dim as logfont lgf
       if getobject(fhandle,sizeof(lgf),@lgf) then
          ffacename=lgf.lffacename
       end if
    end if
    return ffacename
end property

property QFont.FaceName(v as string)
    ffacename=v
    CreateHandle
    updateinterface
end property

property QFont.Bold as boolean
    if fhandle then
       dim as logfont lgf
       if getobject(fhandle,sizeof(lgf),@lgf) then
          fbold=lgf.lfweight=700
       end if
    end if
    return fbold
end property

property QFont.Bold(v as boolean)
    fbold=v
    createhandle
    updateinterface
end property

property QFont.Italic as boolean
    if fhandle then
       dim as logfont lgf
       if getobject(fhandle,sizeof(lgf),@lgf) then
          fitalic=lgf.lfitalic
       end if
    end if
    return fitalic
end property

property QFont.Italic(v as boolean)
    fitalic=v
    createhandle
    updateinterface
end property

property QFont.Underline as boolean
    if fhandle then
       dim as logfont lgf
       if getobject(fhandle,sizeof(lgf),@lgf) then
          funderline=lgf.lfunderline
       end if
    end if
    return funderline
end property

property QFont.Underline(v as boolean)
    funderline=v
    createhandle
    updateinterface
end property

property QFont.Strikeout as boolean
    if fhandle then
       dim as logfont lgf
       if getobject(fhandle,sizeof(lgf),@lgf) then
          fstrikeout=lgf.lfstrikeout
       end if
    end if
    return fstrikeout
end property

property QFont.Strikeout(v as boolean)
    fstrikeout=v
    createhandle
    updateinterface
end property

sub QFont.updateinterface
    if iswindow(finterface) then
       sendMessage(interface,wm_setfont,cint(fhandle),true)
    end if
end sub

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

operator QFont.cast as hfont
    return fhandle
end operator

operator QFont.cast as string
    return ffacename
end operator

operator QFont.let(v as hfont)
    dim as logfont lgf
    if getobject(v,sizeof(lgf),@lgf) then
       if fhandle then deleteobject(fhandle)
       fhandle=createfontindirect(@lgf)
       ffacename=lgf.lffacename
       dim as hdc dc=getdc(0)
       fsize=-MulDiv(GetDeviceCaps(DC, LOGPIXELSY), 72, lgf.lfheight)
       releasedc(0,dc)
       updateinterface
    end if
end operator

operator QFont.let(v as pfont)
    dim as logfont lgf
    if getobject(v->fhandle,sizeof(lgf),@lgf) then
       if fhandle then deleteobject(fhandle)
       fhandle=createfontindirect(@lgf)
       ffacename=lgf.lffacename
       dim as hdc dc=getdc(0)
       fsize=-MulDiv(GetDeviceCaps(DC, LOGPIXELSY), 72, lgf.lfheight)
       releasedc(0,dc)
       updateinterface
    end if
end operator

operator QFont.let(v as string)
    ffacename=v
    CreateHandle
    updateinterface
end operator

constructor QFont
    ffacename="Tahoma"
    fsize=8
    createhandle
end constructor

destructor QFont
    if fhandle then deleteobject(fhandle)
end destructor

/'QGeneric'/
#ifdef rtl
operator QGeneric.cast as any ptr
   return @this
end operator
#endif

/'QObject'/
#ifdef rtl
      function QObject.GetProperties as zstring ptr
         dim as string s="ClassName"+lf+"ClassAncestor"+lf+"Name"+lf+"Tag"
         dim as zstring ptr ret=callocate(len(s)+1)
         *ret=s
         return ret
     end function

     function QObject.GetPropertyInfo(v as string) as PELPropInfo
         dim as PELPropInfo pif=new QELPropInfo
         if lcase(v)="classname" then
            dim as string s=classname
            pif->name=callocate(len(s)+1)
            *pif->name="classname"
            pif->value=callocate(len(s)+1)
            *pif->value=s
            pif->typekind=tkString
            return pif
         elseif lcase(v)="classancestor" then
            dim as string s=classancestor
            pif->name=callocate(len(s)+1)
            *pif->name="classancestor"
            pif->value=callocate(len(s)+1)
            *pif->value=s
            pif->typekind=tkString
            return pif
         elseif lcase(v)="name" then
            dim as string s=name
            pif->name=callocate(len(v)+1)
            *pif->name="name"
            pif->value=callocate(len(s)+1)
            *pif->value=s
            pif->typekind=tkString
            return pif
         elseif lcase(v)="tag" then
            dim as string s=str(tag)
            pif->name=callocate(len(v)+1)
            *pif->name="tag"
            pif->value=callocate(len(s)+1)
            *pif->value=s
            pif->typekind=tkInteger
            return pif
         end if
         return 0
     end function

     function QObject.GetProperty(v as string) as zstring ptr
         dim as string s=""
         if lcase(v)="classname" then
            dim as zstring ptr s=callocate(len(classname)+1)
            *s=classname
            return s
         elseif lcase(v)="classancestor" then
            dim as zstring ptr s=callocate(len(classancestor)+1)
            *s=classancestor
            return s
         elseif lcase(v)="name" then
            dim as zstring ptr s=callocate(len(name)+1)
            *s=name
            return s
         elseif lcase(v)="tag" then
            dim as zstring ptr s=callocate(len(str(tag))+1)
            *s=str(tag)
            return s
         end if
         return 0
     end function

     function QObject.SetProperty(n as string,v as zstring ptr) as boolean
         dim as string s=""
         if lcase(n)="classname" then
            s=classname
            classname=*v
            return (classname<>"")
         elseif lcase(n)="classancestor" then
            s=classancestor
            classancestor=*v
            return (classancestor<>"")
         elseif lcase(n)="name" then
            s=name
            name=*v
            return (name<>"")
         elseif lcase(n)="tag" then
            dim as integer i=valint(*v)
            tag=i
            return (tag>0)
         end if
         return 0
     end function
#endif

operator QObject.cast as string
     return "QObject"
end operator

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

/'QComponent'/
property QComponent.State as integer
    return fstate
end property

property QComponent.State (v as integer)
    fstate=v
end property

/'QCustomFrame'/
#ifdef rtl
      function QCustomFrame.GetProperties as zstring ptr
           return Base.GetProperties
      end function

      function QCustomFrame.GetPropertyInfo(n as string) as PELPropInfo
           return Base.GetPropertyInfo(n)
      end function

      function QCustomFrame.GetProperty(n as string) as zstring ptr
           return Base.GetProperty(n)
      end function

      function QCustomFrame.SetProperty(n as string,v as zstring ptr) as boolean
           return Base.SetProperty(n,v)
      end function
#endif

/'QFrame'/
property QFrame.Font byref as QFont
    return ffont
end property

property QFrame.Font(byref v as QFont)
    ffont=v
    v.interface=fhandle
end property

property QFrame.WindowState as integer
    if iswindow(fhandle) then
       if isiconic(fhandle) then
          fwindowstate=wsminimized
       elseif iszoomed(fhandle) then
          fwindowstate=wsmaximized
       elseif not iswindowvisible(fhandle) then
          fwindowstate=wshide
       else
          fwindowstate=wsnormal
       end if
    end if
    return fwindowstate
end property

property QFrame.WindowState (v as integer)
    fwindowstate=v
    select case v
    case wsnormal
         ShowWindow(fhandle,sw_normal)
    case wsminimized
         ShowWindow(fhandle,sw_minimize)
    case wsmaximized
         ShowWindow(fhandle,sw_maximize)
    case wsHide
         ShowWindow(fhandle,sw_hide)
    end select
end property

property QFrame.Align as integer
    return falign
end Property

property QFrame.Align(value as integer)
    falign = value
    if fparent then
       fparent->RequestAlign
       fParent->Repaint
    end if
end Property

property QFrame.ParentWnd as hwnd
    if iswindow(fhandle) then
       fparentwnd=GetParent(fhandle)
       if GetClassLongPtr(fparentwnd,gcl_cbwndextra)>0 then fparent=objFromHwnd(fparentwnd)
    end if
    return fparentwnd
end property

property QFrame.ParentWnd (v as hwnd)
    dim as hwnd saveParentWnd=fparentWnd
    dim as PFrame saveParent=objFromHwnd(saveParentWnd)
    fparentwnd=v
    if GetClassLongPtr(fparentwnd,gcl_cbwndextra)>0 then fparent=objFromHwnd(v)
    if saveparent then saveparent->remove(this)
    if fparent then fparent->add(this)
    if iswindow(fhandle) then
       SetParent(fhandle,v)
    else
       CreateHandle
    end if
end property

property QFrame.Parent as PFrame
    return fparent
end property

property QFrame.Parent (v as PFrame)
    dim as PFrame saveParent=fparent
    fparent=v
    if saveParent then saveParent->remove(this)
    if v then v->add(this)
    if iswindow(fhandle) then
       SetParent(fhandle,iif(v,v->fhandle,0))
    else
       if saveParent then saveParent->remove(this)
       if v then v->add(this)
       CreateHandle
    end if
end property

property QFrame.Style as integer
    if iswindow(fhandle) then fstyle=GetWindowLongPtr(fhandle,gwl_style)
    return fstyle
end property

property QFrame.Style (v as integer)
    fstyle=v
    if iswindow(fhandle) then
       SetWindowLongPtr(fhandle,gwl_style,v)
       SetWindowPos(fhandle,0,0,0,0,0,swp_noactivate or swp_nomove or swp_nosize or swp_nozorder or swp_framechanged)
       updateWindow(fhandle)
    end if
end property

property QFrame.ExStyle as integer
    if iswindow(fhandle) then fexstyle=GetWindowLongPtr(fhandle,gwl_exstyle)
    return fexstyle
end property

property QFrame.ExStyle (v as integer)
    fexstyle=v
    if iswindow(fhandle) then
       SetWindowLongPtr(fhandle,gwl_exstyle,v)
       SetWindowPos(fhandle,0,0,0,0,0,swp_noactivate or swp_nomove or swp_nosize or swp_nozorder or swp_framechanged)
       updateWindow(fhandle)
    end if
end property

property QFrame.Left as integer
    if isWindow(fHandle) then
       GetWindowRect(fHandle,@fclientrect)
       MapWindowPoints(0,GetParent(fHandle),cast(point ptr,@fclientrect),2)
       fleft=fclientrect.Left
    end if
    return fleft
end property

property QFrame.Left (v as integer)
    fleft=v
    if isWindow(fHandle) then
       MoveWindow(fHandle,fleft,ftop,fwidth,fheight,1)
       if fParent then fParent->RequestAlign
    end if
end property

property QFrame.Top as integer
    if isWindow(fHandle) then
       GetWindowRect(fHandle,@fclientrect)
       MapWindowPoints(0,GetParent(fHandle),cast(point ptr,@fclientrect),2)
       ftop=fclientrect.Top
    end if
    return ftop
end property

property QFrame.Top (v as integer)
    ftop=v
    if isWindow(fHandle) then
       MoveWindow(fHandle,fleft,ftop,fwidth,fheight,1)
       if fParent then fParent->RequestAlign
    end if
end property

property QFrame.Width as integer
    if isWindow(fHandle) then
       GetWindowRect(fHandle,@fclientrect)
       MapWindowPoints(0,GetParent(fHandle),cast(point ptr,@fclientrect),2)
       fwidth=fclientrect.Right-fclientrect.Left
    end if
    return fwidth
end property

property QFrame.Width (v as integer)
    fwidth=v
    if isWindow(fHandle) then
       MoveWindow(fHandle,fleft,ftop,fwidth,fheight,1)
       if fParent then fParent->RequestAlign
    end if
end property

property QFrame.Height as integer
    if isWindow(fHandle) then
       GetWindowRect(fHandle,@fclientrect)
       MapWindowPoints(0,GetParent(fHandle),cast(point ptr,@fclientrect),2)
       fheight=fclientrect.Bottom-fclientrect.Top
    end if
    return fheight
end property

property QFrame.Height (v as integer)
    fheight=v
    if isWindow(fHandle) then
       MoveWindow(fHandle,fleft,ftop,fwidth,fheight,1)
       if fParent then fParent->RequestAlign
    end if
end property

property QFrame.ClientWidth as integer
    if isWindow(fHandle) then
       GetClientRect(fHandle,@fClientRect)
       fClientWidth=fClientRect.Right
    end if
    return fclientwidth
end property

property QFrame.ClientWidth(v as integer)
end property

property QFrame.ClientHeight as integer
    if isWindow(fHandle) then
       GetClientRect(fHandle,@fClientRect)
       fClientHeight=fClientRect.Bottom
    end if
    return fclientheight
end property

property QFrame.ClientHeight(v as integer)
end property

property QFrame.ClientRect as rect
    if isWindow(fHandle) then GetClientRect(fHandle,@fclientrect)
    return fclientrect
end property

property QFrame.ClientRect(v as rect)
    fclientrect=v
    AdjustClient(v)
end property

property QFrame.WindowRect as rect
    if isWindow(fHandle) then GetWindowRect(fHandle,@fwindowrect)
    return fwindowrect
end property

property QFrame.WindowRect(v as rect)
end property

property QFrame.Enabled as boolean
     if isWindow(fHandle) then fEnabled=IsWindowEnabled(fHandle)
     return fEnabled
end property

property QFrame.Enabled (v as boolean)
    fEnabled=v
    if isWindow(fHandle) then EnableWindow(fHandle,fEnabled)
end property

property QFrame.Visible as boolean
    if isWindow(fHandle) then fVisible=IsWindowVisible(fHandle)
    return fVisible
end property

property QFrame.Visible (v as boolean)
    fVisible=v
    if isWindow(fHandle) then
       ShowWindow(fHandle,iif(v,sw_show,sw_hide))
       if not v then fwindowstate=wsHide else fwindowstate=wsNormal
    end if
end property

property QFrame.Text as string
    if isWindow(fHandle) then
       dim as integer i=GetWiNdowTextLength(fHandle)
       fText=space(i)+chr(0)
       GetWindowText(fHandle,fText,len(fText))
    end if
    return fText
end property

property QFrame.Text (v as string)
    fText=v
    if isWindow(fHandle) then SetWindowText(fHandle,fText)
end property

sub QFrame.Dispatch(byref m as QMessage)
    select case m.msg
    case wm_nccreate
           SetWindowLongPtr(m.dlg,GetClassLongPtr(m.dlg,gcl_cbwndextra)-sizeof(integer),cint(@this))
           creationdata=0
           m.result=0
     case wm_create
           ffont.interface=fhandle
           for i as integer=0 to fcontrols.count-1
                cast(PFrame,fcontrols.objects(i))->parent=this
           next
           m.result=0
     case wm_paint
           dim as wndclassex wcls
           wcls.cbsize=sizeof(wcls)
           if getclassinfoex(0,classancestor,@wcls)=0 then
               if getclassinfoex(instance,classancestor,@wcls)=0 then
                  dim as paintstruct ps
                  dim as hdc dc=beginpaint(fhandle,@ps)
                  fillrect(dc,@ps.rcpaint,fbrush)
                  if fonpaint then fonpaint(this)
                  endpaint(fhandle,@ps)
                  m.result=0
               else
                  if fonpaint then fonpaint(this)
               end if
           else
               if fonpaint then fonpaint(this)
           end if
           m.result=0
    case wm_destroy
         fhandle=0
         fmodalresult=m.wparam
         m.result=fmodalresult
    case wm_copydata
         dim as copydatastruct ptr cs=cast(copydatastruct ptr,m.lparam)
         dim as hwnd From=cast(hwnd,m.wparam)
         if ondata then ondata(this,From,cs)
         m.result=0
    case wm_showwindow,wm_initdialog
         'fcanvas.Control=m.dlg
         m.result=0
    case wm_size
         RequestAlign
         if fparent then fparent->RequestAlign
         m.result=0
    case wm_windowposchanged
         RequestAlign
         if fparent then fparent->RequestAlign
         m.result=0
    case wm_command
         if iswindow(cast(hwnd,m.lparam)) then
            SendMessage(cast(hwnd,m.lparam),cm_command,m.wparam,m.lparam)
         elseif m.lparam=0 then
            if onMenu then onMenu(this,m.wparam)
         elseif m.lparam=0 then
            if onAccel then onAccel(this,m.wparam)
         end if
         m.result=0
    case cm_command
         fid=loword(m.wparam)
         dim as integer code=hiword(m.lparam),fid=loword(m.wparam)
         if onCommand then onCommand(this,code,fid,cast(hwnd,m.lparam))
         m.result=0
    case wm_notify
         dim as lpnmhdr nm=cast(lpnmhdr,m.lparam)
         if nm then
            m.result=SendMessage(nm->hwndFrom,cm_notify,0,m.lparam)
         else
            m.result=0
         end if
    case cm_notify
         dim as lpnmhdr nm=cast(lpnmhdr,m.lparam)
         if (nm>0) then
            select case m.msg
            case nm_click
                 Click
                 m.result=0
            case nm_dblclk
                 DblClick
                 m.result=0
            end select
         else
            m.result=0
         end if
    case wm_parentnotify
         select case loword(m.wparam)
         case wm_create
              m.result=0
         case wm_destroy
              m.result=0
         case wm_lbuttondown
              m.result=0
         case wm_mbuttondown
              m.result=0
         case wm_rbuttondown
              m.result=0
         case wm_xbuttondown
              m.result=0
         end select
         m.result=0
    case wm_cancelmode
        if GetCapture = m.dlg then
            ReleaseCapture
            SendMessage(m.dlg,WM_LBUTTONUP,0,&HFFFFFFFF)
        end if
        m.result = 0
    case wm_setfocus
         if fParent then
            fParent->factive=this
         end if
         m.result=0
    case wm_killfocus
         if fParent then if this=fParent->factive then fParent->factive=0
         m.result=0
    case wm_lbuttondown
         if onMouseDown then onMouseDown(this,MK_LBUTTON,loword(m.lparam),hiword(m.lparam),m.wparam and &hffff)
         m.result=0
    case wm_lbuttonup
         if onMouseUp then onMouseUp(this,MK_LBUTTON,loword(m.lparam),hiword(m.lparam),m.wparam and &hffff)
         m.result=0
    case wm_rbuttondown
         if onMouseDown then onMouseDown(this,MK_RBUTTON,loword(m.lparam),hiword(m.lparam),m.wparam and &hffff)
         m.result=0
    case wm_rbuttonup
         if onMouseUp then onMouseUp(this,MK_RBUTTON,loword(m.lparam),hiword(m.lparam),m.wparam and &hffff)
         m.result=0
    case wm_mbuttondown
         if onMouseDown then onMouseDown(this,MK_MBUTTON,loword(m.lparam),hiword(m.lparam),m.wparam and &hffff)
         m.result=0
    case wm_mbuttonup
         if onMouseUp then onMouseUp(this,MK_MBUTTON,loword(m.lparam),hiword(m.lparam),m.wparam and &hffff)
         m.result=0
    case wm_mousemove
         if onMouseMove then onMouseMove(this,loword(m.lparam),hiword(m.lparam),m.wparam and &hffff)
         m.result=0
    case wm_char
         if onKeyPress then onKeyPress(this,cast(byte,m.wparam))
         m.result=0
    case wm_keydown
         if onKeyDown then onKeyDown(this,cast(word,m.wparam),m.wparam and &hffff)
         m.result=0
    case wm_keyup
         if onKeyUp then onKeyUp(this,cast(word,m.wparam),m.wparam and &hffff)
         m.result=0
    case wm_getdlgcode
         m.result=dlgc_wantallkeys
    end select
end sub

sub QFrame.Handler(byref m as QMessage)
    dim as wndclassex wcls
    wcls.cbsize=sizeof(wcls)
    if GetClassInfoEx(0,classancestor,@wcls) then
       m.result=CallWindowProc(wcls.lpfnwndproc,m.dlg,m.msg,m.wparam,m.lparam)
    elseif GetClassInfoEx(instance,classancestor,@wcls) then
       m.result=CallWindowProc(wcls.lpfnwndproc,m.dlg,m.msg,m.wparam,m.lparam)
    else
       m.result=DefWindowProc(m.dlg,m.msg,m.wparam,m.lparam)
    end if
end sub

sub QFrame.FreeHandle
    if iswindow(fhandle) then
       DestroyWindow(fhandle)
       fhandle=0
    end if
end sub

sub QFrame.CreateHandle
    FreeHandle
    creationdata=this
    CreateWindowEx(fexstyle,classname,ftext,fstyle,fleft,ftop,fwidth,fheight,iif(fparent,fparent->fhandle,fparentwnd),cast(hmenu,fid),instance,0)
    if iswindow(fhandle) then
       EnableWindow(fhandle,fenabled)
       select case fwindowstate
       case wsnormal
            ShowWindow(fhandle,iif(fvisible,sw_show,sw_hide))
       case wshide
            ShowWindow(fhandle,sw_hide)
       case wsminimized
            ShowWindow(fhandle,sw_minimize)
       case wsmaximized
            ShowWindow(fhandle,sw_maximize)
       end select
       SendMessage(fhandle,wm_setfont,cint(ffont.handle),1)
       UpdateWindow(fhandle)
    end if
end sub

sub QFrame.RequestAlign
     dim as PFrame ptr ListLeft, ListRight, Listtop, ListBottom, ListClient
     dim as integer i,LeftCount = 0, RightCount = 0, topCount = 0, BottomCount = 0, ClientCount = 0
     dim as integer ttop, btop, lLeft, rLeft
     dim as integer aLeft, atop, aWidth, aHeight
     if fControls.Count=0 then exit sub
     lLeft = 0
     rLeft = ClientWidth
     ttop  = 0
     btop  = ClientHeight
     for i = 0 to fControls.Count -1
         aleft = cast(PFrame,fcontrols.objects(i))->left
         atop = cast(PFrame,fcontrols.objects(i))->top
         awidth = cast(PFrame,fcontrols.objects(i))->width
         aheight = cast(PFrame,fcontrols.objects(i))->height
         select case cast(PFrame,fcontrols.objects(i))->Align
                case 1'alLeft
                    LeftCount += 1
                    ListLeft = reallocate(ListLeft,sizeof(PFrame)*LeftCount)
                    ListLeft[LeftCount -1] = cast(PFrame,fcontrols.objects(i))
                case 2'alRight
                    RightCount += 1
                    ListRight = reallocate(ListRight,sizeof(PFrame)*RightCount)
                    ListRight[RightCount -1] = cast(PFrame,fcontrols.objects(i))
                case 3'altop
                    topCount += 1
                    Listtop = reallocate(Listtop,sizeof(PFrame)*topCount)
                    Listtop[topCount -1] = cast(PFrame,fcontrols.objects(i))
                case 4'alBottom
                    BottomCount += 1
                    ListBottom = reallocate(ListBottom,sizeof(PFrame)*BottomCount)
                    ListBottom[BottomCount -1] = cast(PFrame,fcontrols.objects(i))
                case 5'alClient
                    ClientCount += 1
                    ListClient = reallocate(ListClient,sizeof(PFrame)*ClientCount)
                    ListClient[ClientCount -1] = cast(PFrame,fcontrols.objects(i))
          end select
     next i

   for i = 0 to topCount -1
      with *Listtop[i]
         if .fvisible then
            ttop += .Height
            .SetBounds(0,ttop - .Height,rLeft,.Height)
         end if
      end with
   next i
   'btop = ClientHeight
   for i = 0 to BottomCount -1
      with *ListBottom[i]
         if .fvisible then
            btop -= .Height
            .SetBounds(0,btop,rLeft,.Height)
         end if
      end with
   next i
   'lLeft = 0
   for i = 0 to LeftCount -1
      with *ListLeft[i]
         if .fvisible then
            lLeft += .Width
            .SetBounds(lLeft - .Width, ttop, .Width, btop - ttop)
         end if
      end with
   next i
   'rLeft = ClientWidth
   for i = 0 to RightCount -1
      with *ListRight[i]
         if .fvisible then
            rLeft -= .Width
            .SetBounds(rLeft, ttop, .Width, btop - ttop)
         end if
      end with
   next i
   for i = 0 to ClientCount -1
      with *ListClient[i]
         if .fvisible then
            .SetBounds(lLeft,ttop,rLeft - lLeft,btop - ttop)
         end if
      end with
   next i
    if ListLeft   then deallocate ListLeft
    if ListRight  then deallocate ListRight
    if Listtop    then deallocate Listtop
    if ListBottom then deallocate ListBottom
    if ListClient then deallocate ListClient
end sub

function QFrame.Perform(msg as uint,wparam as wparam,lparam as lparam) as lresult
    return SendMessage(fhandle,msg,wparam,lparam)
end function

sub QFrame.BringToFront
    if IsWindow(fhandle) then
        'dim as HWND Dlg = GetTopWindow(fhandle)
        'while ( Dlg )
        '    foldz += 1
        '    GetnextWindow( Dlg, GW_HWNDnext)
        'wend
        foldZ = IndexOf(@this)
        BringWindowToTop(fhandle)
    end if
end sub

sub QFrame.SendToBack
    if IsWindow(fhandle) then
        SetWindowPos(fhandle,cast(PFrame,fcontrols.objects(foldz))->fhandle, 0, 0 ,0 ,0, SWP_NOMOVE or SWP_NOACTIVATE or SWP_NOSIZE)
    end if
end sub

sub QFrame.SetFocus
    if IsWindow(fhandle) then .SetFocus(fhandle)
end sub

sub QFrame.KillFocus
    if IsWindow(fhandle) then Perform(WM_KILLFOCUS, 0, 0)
end sub

sub QFrame.Invalidate
    if IsWindow(fhandle) then InvalidateRect(fhandle, 0, 0)
end sub

sub QFrame.Repaint
    if IsWindow(fhandle) then RedrawWindow(fhandle, 0, 0, RDW_INTERNALPAINT)
end sub

sub QFrame.Refresh
    if IsWindow(fhandle) then RedrawWindow(fhandle, 0, 0, RDW_ERASE or RDW_INVALIDATE)
end sub

sub QFrame.Update
    if IsWindow(fhandle) then UpdateWindow(fhandle)
end sub

sub QFrame.ClientToScreen(byref p as point)
    if IsWindow(fhandle) then .ClientToScreen(fhandle,@p)
end sub

sub QFrame.ScreenToClient(byref p as point)
    if IsWindow(fhandle) then .ScreenToClient(fhandle,@p)
end sub

sub QFrame.SetBounds overload(x as integer,y as integer,cx as integer,cy as integer)
    fleft=x
    ftop=y
    fwidth=cx
    fheight=cy
    if iswindow(fhandle) then MoveWindow(fhandle,fleft,ftop,fwidth,fheight,1)
end sub

sub QFrame.SetBounds overload(v as rect)
    SetBounds(v.left,v.top,v.right,v.bottom)
end sub

sub QFrame.AdjustClient overload(v as rect)
    dim as integer borderX=GetSystemMetrics(sm_cxborder),borderY=GetSystemMetrics(sm_cyborder),captionY=GetSystemMetrics(sm_cycaption)
    v.bottom+=captionY+2*borderY
    v.right+=2*borderX
    SetBounds(fleft,ftop,v.right,v.bottom)
end sub

sub QFrame.AdjustClient overload(x as integer,y as integer,cx as integer,cy as integer)
    dim as rect r=type(x,y,cx,cy)
    AdjustClient(r)
end sub

sub QFrame.Click
    if onclick then onclick(this)
end sub

sub QFrame.DblClick
    if ondblclick then ondblclick(this)
end sub

property QFrame.ControlStyle as integer
    return fcontrolstyle
end property

property QFrame.ControlStyle(v as integer)
    fcontrolstyle=v
end property

property QFrame.ControlState as integer
    return fcontrolstate
end property

property QFrame.ControlState(v as integer)
    fcontrolstate=v
end property

property QFrame.Cursor as integer
    return fcursor
end property

property QFrame.Cursor(v as integer)
    fcursor=v
end property

property QFrame.Hint as string
    return fhint
end property

property QFrame.Hint (v as string)
    fhint=v
end property

property QFrame.ShowHint as boolean
    return fShowhint
end property

property QFrame.ShowHint (v as boolean)
    fShowhint=v
end property

property QFrame.Clipped as boolean
    return fclipped
end property

property QFrame.Clipped (v as boolean)
    fclipped=v
end property

property QFrame.Grouped as boolean
    return fGrouped
end property

property QFrame.Grouped (v as boolean)
    fGrouped=v
end property

property QFrame.TabStop as boolean
    return fTabStop
end property

property QFrame.TabStop(v as boolean)
    fTabStop=v
end property

property QFrame.id as integer
    return fid
end property

property QFrame.id(v as integer)
    fid=v
end property

property QFrame.onPaint as QEvent
    return fonpaint
end property

property QFrame.onPaint (v as QEvent)
    fonpaint=v
    invalidate
end property

property QFrame.Controls byref as QList
     return fcontrols
end property

property QFrame.ControlCount as integer
     return fcontrols.count
end property

property QFrame.Control(i as integer) byref as QFrame
     if i>-1 and i<fcontrols.count then return *cast(PFrame,fcontrols.objects(i))
end property

property QFrame.Handle as hwnd
     return fhandle
end property

property QFrame.Handle (v as hwnd)
end property

sub QFrame.Add(v as PFrame)
     if fcontrols.indexof(v)=-1 then
        fcontrols.add(v)
     end if
end sub

sub QFrame.Remove(v as PFrame)
     if fcontrols.indexof(v)>-1 then
        fcontrols.remove(fcontrols.indexof(v))
     end if
end sub

function QFrame.indexof(v as PFrame) as integer
     if v=0 then return -1
     return fcontrols.indexof(v)
end function

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

operator QFrame.cast as string
     return iif(classname<>"",classname,"QFrame")
end operator

constructor QFrame
     fenabled=1
     fvisible=1
     dim as logbrush lob
     lob.lbcolor=fcolor
     fbrush=createbrushindirect(@lob)
end constructor

destructor QFrame
     if fparent then fparent->remove(this)
     if fbrush then deleteobject(fbrush)
end destructor

#ifdef rtl
     type QItem
         as string name,kind
     end type

     redim shared tk(15) as QItem

     function EventToEventKind(v as string) as string
          tk(0).name="oncreate"
          tk(0).kind="QEvent"
          tk(1).name="ondestroy"
          tk(1).kind="QEvent"
          tk(2).name="onclick"
          tk(2).kind="QEvent"
          tk(3).name="ondblclick"
          tk(3).kind="QEvent"
          tk(4).name="onpaint"
          tk(4).kind="QEvent"
          tk(5).name="onmousedown"
          tk(5).kind="QMouseEvent"
          tk(6).name="onmouseup"
          tk(6).kind="QMouseEvent"
          tk(7).name="onmousemove"
          tk(7).kind="QMouseMoveEvent"
          tk(8).name="onmousewheel"
          tk(8).kind="QMouseWheelEvent"
          tk(9).name="onkeydown"
          tk(9).kind="QKeyEvent"
          tk(10).name="onkeyup"
          tk(10).kind="QKeyEvent"
          tk(11).name="onkeypress"
          tk(11).kind="QCharEvent"
          tk(12).name="oncommand"
          tk(12).kind="QCommandEvent"
          tk(13).name="onmenu"
          tk(13).kind="QMenuEvent"
          tk(14).name="onaccel"
          tk(14).kind="QMenuEvent"

         for i as integer=0 to ubound(tk)-1
             if lcase(v)=lcase(tk(i).name) then
                return tk(i).kind
             end if
         next
     end function

     function QFrame.GetProperties as zstring ptr
         dim as string v=*Base.GetProperties+lf+"Font"+lf+"Text"+lf+"Hint"+lf+"ControlStyle"+lf+"Cursor"+lf+"Align"+lf+"Parent"+lf+"ParentWnd"+lf+_
         "Style"+lf+"Exstyle"+lf+"Id"+lf+"Left"+lf+"Top"+lf+"Width"+lf+"Height"+lf+"Enabled"+lf+"Visible"+lf+"ShowHint"+lf+_
         "Clipped"+lf+"TabStop"+lf+"Grouped"+lf+"Control"+lf+"ControlCount"+lf+"ClientWidth"+lf+"ClientHeight"+lf+_
         "ClientRect"+lf+"Windowrect"+lf+"onCreate"+lf+"onDestroy"+lf+"onClick"+lf+"onDblClick"+lf+"onPaint"+lf+"onMouseDown"+lf+_
         "onMouseUp"+lf+"onMouseMove"+lf+"onMouseWheel"+lf+"onKeyDown"+lf+"onKeyPress"+lf+"onCommand"+lf+"onMenu"+lf+_
         "onAccel"
         dim as zstring ptr s=callocate(len(v)+1)
         *s=v
         return s
     end function

     function QFrame.GetPropertyInfo(v as string) as PELPropInfo
         if v="" then return 0
         dim as string index=""
         if instr("(",v)>0 then
            v=mid(v,1,instr("(",v)-1)
            index=mid(v,instr("(",v)+1,instr(")",v)-instr("(",v)-1)
         else
            index=""
         end if
         dim as PELPropInfo pif=0
         if pif=0 then pif=new QELPropInfo
         select case lcase(v)
             case "style","exstyle","id","left","top","width","height","align","controlcount","clientwidth","clientheight","controlstyle","controlstate","cursor"
             if lcase(v)="align" then
                 pif->typename=callocate(len("QAlign")+1)
                 *pif->typename="QAlign"
                 pif->name=callocate(len("alNone,alLeft,alRight,alTop,alBottom,alClient")+1)
                 *pif->name="alNone,alLeft,alRight,alTop,alBottom,alClient"
                 pif->TypeKind=tkInteger
                 return pif
             elseif lcase(v)="controlstyle" then
                 pif->typename=callocate(len("QControlStyle")+1)
                 *pif->typename="QControlStyle"
                 pif->name=callocate(len("csDefault,csAcceptChilds,csTransparent")+1)
                 *pif->name="csDefault,csAcceptChilds,csTransparent"
                 pif->TypeKind=tkInteger
                 return pif
             elseif lcase(v)="controlstate" then
                 pif->typename=callocate(len("QControlState")+1)
                 *pif->typename="QControlState"
                 pif->name=callocate(len("csDefault,csReplicatable,csDesign")+1)
                 *pif->name="csDefault,csReplicatable,csDesign"
                 pif->TypeKind=tkInteger
                 return pif
             elseif lcase(v)="cursor" then
                 pif->typename=callocate(len("QCursor")+1)
                 *pif->typename="QCursor"
                 pif->name=callocate(len("crNone,crArrow,crSize,crSizeNE,crSizeSE,crSizeNV,crSizeSV,crWait,crHand,crCross")+1)
                 *pif->name="crNone,crArrow,crSize,crSizeNE,crSizeSE,crSizeNV,crSizeSV,crWait,crHand,crCross"
                 pif->TypeKind=tkInteger
                 return pif
             else
                 pif->name=callocate(0)
                 *pif->name=""
                 pif->typename=callocate(len("unknown")+1)
                 *pif->typename="unknown"
                  pif->typekind=tkUnknown
                  return pif
             end if
             case "text","hint"
                  pif->typename=callocate(len("text")+1)
                 *pif->typename="text"
                  pif->typekind=tkstring
                  return pif
             case "clipped","tabstop","grouped","enabled","visible","showhint"
                  pif->typename=callocate(len("bool")+1)
                 *pif->typename="bool"
                  pif->name=callocate(len("False,True")+1)
                 *pif->name="False,True"
                  pif->typekind=tkBool
                  return pif
             case "clientrect","windowrect"
                  pif->typename=callocate(len("type")+1)
                 *pif->typename="type"
                  pif->name=callocate(len("rect")+1)
                 *pif->name="Rect"
                  pif->typekind=tktype
                  return pif
             case "control"
                  pif->typekind=tktype
                  dim as integer i=valint(index)
                  if i>-1 and i<fcontrols.count then
                     pif->name=callocate(len(v)+len(index)+3)
                     *pif->name=v+"("+index+")"+chr(0)
                     pif->value=callocate(len(str(fcontrols.objects(i))))
                     *pif->value=str(fcontrols.objects(i))
                     pif->typename=callocate(len("QFrame")+1)
                     *pif->typename="QFrame"
                  end if
             case "parent","font"
                   pif->typekind=tktype
                   select case lcase(v)
                          case "parent"
                              pif->name=callocate(len(iif(fparent,fparent->name,""))+1)
                              *pif->name=iif(fparent,fparent->name,"")
                              pif->typename=callocate(len("QFrame")+1)
                              *pif->typename="QFrame"
                          case "font"
                              pif->name=callocate(len(ffont.facename)+1)
                              *pif->name=ffont.facename
                              pif->typename=callocate(len("QFont")+1)
                              *pif->typename="QFont"
                              pif->Editor=callocate(len("FontEditor")+1)
                              *pif->Editor="FontEditor"+chr(0)
                   end select
                   return pif
             case "oncreate","ondestroy","onclick","ondblclick","onpaint","onmousedown",_
                  "onmouseup","onmousemove","onmousewheel","onkeydown","onkeypress","oncommand","onmenu",_
                  "onaccel"
                  pif->name=callocate(6)
                  *pif->name="Event"
                  pif->typename=callocate(len(EventToEventKind(v))+1)
                  *pif->typename=EventToEventKind(v)
                  pif->typekind=tkmethod
                  return pif
             case else
                  return Base.GetPropertyInfo(v)
             end select
     end function

    function QFrame.GetProperty(v as string) as zstring ptr
    dim as string index=""
         if instr("(",v)>0 then
            v=mid(v,1,instr("(",v)-1)
            index=mid(v,instr("(",v)+1,instr(")",v)-instr("(",v)-1)
         else
            index=""
         end if
    select case lcase(v)
    case "text"
         dim as zstring ptr s=callocate(len(ftext)+1)
         *s=text
         return s
    case "hint"
         dim as zstring ptr s=callocate(len(fhint)+1)
         *s=fhint
         return s
    case "controlstyle"
         dim as integer i=cint(fcontrolstyle)
         dim as zstring ptr s=callocate(4)
         *s=str(i)
         return s
    case "controlstate"
         dim as integer i=cint(fcontrolstate)
         dim as zstring ptr s=callocate(4)
         *s=str(i)
         return s
    case "cursor"
         dim as integer i=cint(fcursor)
         dim as zstring ptr s=callocate(4)
         *s=str(i)
         return s
    case "align"
         dim as integer i=cint(Align)
         dim as zstring ptr s=callocate(4)
         *s=str(i)
         return s
    case "parent"
         dim as integer i=cint(Parent)
         dim as zstring ptr s=callocate(4)
         *s=str(i)
         return s
    case "parentwnd"
         dim as integer i=cint(fParentWnd)
         dim as zstring ptr s=callocate(len(str(fparentwnd))+1)
         *s=str(i)
         return s
    case "style"
         dim as integer i=Style
         dim as zstring ptr s=callocate(4)
         *s=str(i)
         return s
    case "exstyle"
         dim as integer i=Exstyle
         dim as zstring ptr s=callocate(4)
         *s=str(i)
         return s
    case "id"
         dim as integer i=cint(fid)
         dim as zstring ptr s=callocate(4)
         *s=str(i)
         return s
    case "left"
         dim as integer i=left
         dim as zstring ptr s=callocate(4)
         *s=str(i)
         return s
    case "top"
         dim as integer i=top
         dim as zstring ptr s=callocate(4)
         *s=str(i)
         return s
    case "width"
         dim as integer i=width
         dim as zstring ptr s=callocate(4)
         *s=str(i)
         return s
    case "height"
         dim as integer i=height
         dim as zstring ptr s=callocate(4)
         *s=str(i)
         return s
    case "enabled"
         dim as integer i=enabled
         dim as zstring ptr s=callocate(4)
         *s=str(i)
         return s
    case "visible"
         dim as integer i=visible
         dim as zstring ptr s=callocate(4)
         *s=str(i)
         return s
    case "clipped"
         dim as integer i=clipped
         dim as zstring ptr s=callocate(4)
         *s=str(i)
         return s
    case "tabstop"
         dim as integer i=tabstop
         dim as zstring ptr s=callocate(4)
         *s=str(i)
         return s
    case "grouped"
         dim as integer i=cint(grouped)
         dim as zstring ptr s=callocate(4)
         *s=str(i)
         return s
    case "showhint"
         dim as integer i=cint(showhint)
         dim as zstring ptr s=callocate(4)
         *s=str(i)
         return s
    case "control"
         dim as integer i=valint(index)
         if i>-1 and i<fcontrols.count then
            dim as pframe f=fcontrols.objects(i)
            dim as integer ctrl=cint(f)
            dim as zstring ptr result=callocate(len(str(ctrl))+1)
            *result=str(ctrl)
            return result
         else
            return @"0"
         end if
    case "controlcount"
         dim as integer i=fcontrols.count
         dim as zstring ptr result=callocate(len(str(i))+1)
         *result=str(i)
         return result
    case "clientwidth"
         dim as integer i=clientwidth
         dim as zstring ptr s=callocate(4)
         *s=str(i)
         return s
    case "clientheight"
         dim as integer i=clientheight
         dim as zstring ptr s=callocate(4)
         *s=str(i)
         return s
    case "clientrect"
         dim as prect i=@fclientrect
         dim as zstring ptr s=callocate(4)
         *s=str(i)
         return s
    case "windowrect"
         dim as prect i=@fwindowrect
         dim as zstring ptr s=callocate(4)
         *s=str(i)
         return s
    case "font"
         dim as integer i=cint(@ffont)
         dim as zstring ptr s=callocate(4)
         *s=str(i)
         return s
    case "oncreate"
         dim as integer i=cint(oncreate)
         dim as zstring ptr s=callocate(4)
         *s=str(i)
         return s
    case "ondestroy"
         dim as integer i=cint(ondestroy)
         dim as zstring ptr s=callocate(4)
         *s=str(i)
         return s
    case "onclick"
         dim as integer i=cint(onclick)
         dim as zstring ptr s=callocate(4)
         *s=str(i)
         return s
    case "ondblclick"
         dim as integer i=cint(ondblclick)
         dim as zstring ptr s=callocate(4)
         *s=str(i)
         return s
    case "onpaint"
         dim as integer i=cint(onpaint)
         dim as zstring ptr s=callocate(4)
         *s=str(i)
         return s
    case "onmousedown"
         dim as integer i=cint(ondestroy)
         dim as zstring ptr s=callocate(4)
         *s=str(i)
         return s
    case "onmouseup"
         dim as integer i=cint(onmouseup)
         dim as zstring ptr s=callocate(4)
         *s=str(i)
         return s
    case "onmousemove"
         dim as integer i=cint(onmousemove)
         dim as zstring ptr s=callocate(4)
         *s=str(i)
         return s
    case "onmousewheel"
         dim as integer i=cint(onmousewheel)
         dim as zstring ptr s=callocate(4)
         *s=str(i)
         return s
    case "onkeydown"
         dim as integer i=cint(onkeydown)
         dim as zstring ptr s=callocate(4)
         *s=str(i)
         return s
    case "onkeypress"
         dim as integer i=cint(onkeypress)
         dim as zstring ptr s=callocate(4)
         *s=str(i)
         return s
    case "oncommand"
         dim as integer i=cint(oncommand)
         dim as zstring ptr s=callocate(4)
         *s=str(i)
         return s
    case "onmenu"
         dim as integer i=cint(onmenu)
         dim as zstring ptr s=callocate(4)
         *s=str(i)
         return s
    case "onaccel"
         dim as integer i=cint(onaccel)
         dim as zstring ptr s=callocate(4)
         *s=str(i)
         return s
    case else
         return Base.GetProperty(v)
    end select
    end function

    function QFrame.SetProperty(n as string,v as zstring ptr) as boolean
    dim as string index=""
         if instr("(",n)>0 then
            n=mid(n,1,instr("(",n)-1)
            index=mid(n,instr("(",n)+1,instr(")",n)-instr("(",n)-1)
         else
            index=""
         end if
    dim as zstring ptr zv=callocate(len(*v)+1)
    *zv=*v
    select case lcase(n)
    case "text"
         text=*zv
         return ftext<>""
    case "hint"
         hint=*v
         return hint<>""
    case "controlstyle"
         dim as integer i=valint(*v)
         controlstyle=i
         return controlstyle=qcontrolstyle.csdefault
    case "controlstate"
         dim as integer i=valint(*v)
         controlstate=i
         return controlstate=qcontrolstate.csnormal
    case "cursor"
         dim as integer i=valint(*v)
         cursor=i
         return cursor=crdefault/''/
    case "align"
         dim as integer i=valint(*v)
         align=i
         return align=alnone
    case "parent"
         dim as integer i=valint(*v)
         parent=cast(PFrame,i)
         return parent=0
    case "parentwnd"
         dim as integer i=valint(*v)
         parentwnd=cast(hwnd,i)
         return parentwnd=0 /''/
    case "style"
         dim as integer i=valint(*v)
         style=i
         return style=0
    case "exstyle"
         dim as integer i=valint(*v)
         exstyle=i
         return exstyle=0
    case "id"
         dim as integer i=valint(*v)
         id=i
         return id=0/''/
    case "left"
         dim as integer i=valint(*v)
         left=i
         return left=0
    case "top"
         dim as integer i=valint(*v)
         top=i
         return top=0
    case "width"
         dim as integer i=valint(*v)
         width=i
         return width=0
    case "height"
         dim as integer i=valint(*v)
         height=i
         return height=0
    case "enabled"
         dim as integer i=valint(*v)
         enabled=i
         return enabled=0
    case "visible"
         dim as integer i=valint(*v)
         visible=i
         return visible=0
    case "clipped"
         dim as integer i=valint(*v)
         clipped=i
         return clipped=0
    case "tabstop"
         dim as integer i=valint(*v)
         tabstop=i
         return tabstop=0
    case "grouped"
         dim as integer i=valint(*v)
         grouped=i
         return grouped=0
    case "control"
         dim as integer i=valint(index)
         if i>-1 and i<fcontrols.count then
            fcontrols.objects(i)=cast(any ptr,valint(*v))
            return (fcontrols.objects(i)>0)
         end if
         return 0
    case "controlcount"
         dim as integer i=0,x=*v
         for i=0 to x-1
             fcontrols.add(new QFrame)
         next
         return fcontrols.count
    case "clientwidth"
         dim as integer i=valint(*v)
         clientwidth=i
         return clientwidth=0
    case "clientheight"
         dim as integer i=valint(*v)
         clientheight=i
         return clientheight=0
    case "clientrect"
         dim as integer i=valint(*v)
         clientrect=*cast(prect,i)
         return (clientrect.left=0 and clientrect.top=0 and clientrect.right=0 and clientrect.bottom=0)
    case "windowrect"
         dim as integer i=valint(*v)
         windowrect=*cast(prect,i)
         return (windowrect.left=0 and windowrect.top=0 and windowrect.right=0 and windowrect.bottom=0)
    case "oncreate"
         dim as integer i=valint(*v)
         oncreate=cast(QEvent,i)
         return oncreate<>0
    case "ondestroy"
         dim as integer i=valint(*v)
         oncreate=cast(QEvent,i)
         return ondestroy<>0
    case "onclick"
         dim as integer i=valint(*v)
         onclick=cast(QEvent,i)
         return onclick<>0
    case "ondblclick"
         dim as integer i=valint(*v)
         ondblclick=cast(QEvent,i)
         return ondblclick<>0
    case "onpaint"
         dim as integer i=valint(*v)
         onpaint=cast(QEvent,i)
         return onpaint<>0
    case "onmousedown"
         dim as integer i=valint(*v)
         onmousedown=cast(QMouseEvent,i)
         return onmousedown<>0
    case "onmouseup"
         dim as integer i=valint(*v)
         onmouseup=cast(QMouseEvent,i)
         return onmouseup<>0
    case "onmousemove"
         dim as integer i=valint(*v)
         onmousemove=cast(QMouseMoveEvent,i)
         return onmousemove<>0
    case "onmousewheel"
         dim as integer i=valint(*v)
         onmousewheel=cast(QMouseWheelEvent,i)
         return onmousewheel<>0
    case "onkeydown"
         dim as integer i=valint(*v)
         onkeydown=cast(QKeyEvent,i)
         return onkeydown<>0
    case "onkeyup"
         dim as integer i=valint(*v)
         onkeyup=cast(QKeyEvent,i)
         return onkeyup<>0
    case "onkeypress"
         dim as integer i=valint(*v)
         onkeypress=cast(QCharEvent,i)
         return onkeypress<>0
    case "oncommand"
         dim as integer i=valint(*v)
         oncommand=cast(QCommandEvent,i)
         return oncommand<>0
    case "onmenu"
         dim as integer i=valint(*v)
         onmenu=cast(QMenuEvent,i)
         return onmenu<>0
    case "onaccel"
         dim as integer i=valint(*v)
         onaccel=cast(QMenuEvent,i)
         return onaccel<>0
    case else
         return Base.SetProperty(n,v)
    end select
    return 0
    end function
#endif

/'QCustomForm'/
property QCustomForm.MainMenu byref as QMainMenu
    if fmainmenu then
       return *(fmainmenu)
    else
       return *cast(pmainmenu,0)
    end if
end property

property QCustomForm.MainMenu (byref v as QMainMenu)
    fmainmenu=v
    if v then v.refresh(fhandle)
end property

function QCustomForm.ShowModal as integer
     for i as integer=0 to application.winlist.count-1
          if application.window(i)<>fhandle then enablewindow(application.window(i),0)
     next
     fvisible=showwindow(fhandle,sw_show)
     do
       application.doevents
     loop until application.terminated or (iswindow(fhandle)=0)
     for i as integer=0 to application.winlist.count-1
          if application.window(i)<>fhandle then enablewindow(application.window(i),1)
     next
     return fmodalresult
end function

sub QCustomForm.Close
    if iswindow(fhandle) then perform(wm_close,cint(modalresult),0)
end sub

sub QCustomForm.Handler(byref m as QMessage)
     Base.Handler(m)
end sub

sub QCustomForm.Dispatch(byref m as QMessage)
     base.Dispatch(m)
     select case m.msg
     case wm_create
          if fmainmenu then fmainmenu->refresh(fhandle)
          m.result=0
     case wm_close
          dim as integer action=1
          if onclose then onclose(this,action)
          select case action
          case 0:m.result=1
          case 1:m.result=0
          case 2:showwindow(fhandle,sw_hide):m.result=1
          case 3:showwindow(fhandle,sw_minimize):m.result=1
          case 4:showwindow(fhandle,sw_maximize):m.result=1
          case 5:showwindow(fhandle,sw_normal):m.result=1
          case else
               m.result=0
          end select
     end select
end sub

function QCustomForm.DlgProc(dlg as hwnd,msg as uint,wparam as wparam,lparam as lparam) as lresult
     dim as PFrame F=iif(creationdata,creationdata,cast(PFrame,GetWindowLongPtr(dlg,GetClassLongPtr(dlg,gcl_cbwndextra)-4)))
     dim as QMessage m=type(dlg,msg,wparam,lparam,0,F)
     if F then
        F->fhandle=dlg
        F->dispatch(m)
        if m.result=0 then F->handler(m)
        return m.result
     else
        F=new QCustomForm
        F->fhandle=dlg
        F->dispatch(m)
        if m.result=0 then F->handler(m)
        return m.result
     end if
     return m.result
end function

function QCustomForm.Register(v as string="QForm") as integer
     dim as wndclassex wcls
     wcls.cbsize=sizeof(wcls)
     wcls.cbwndextra+=sizeof(integer)
     wcls.lpfnwndproc=@dlgproc
     wcls.lpszclassname=strptr(v)
     wcls.hinstance=instance
     wcls.hcursor=LoadCursor(0,idc_arrow)
     return RegisterClassEx(@wcls)
end function

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

operator QCustomForm.cast as string
     return iif(classname<>"",classname,"QForm")
end operator

constructor QCustomForm
     classname="QForm"
     fstyle=ws_caption or ws_sysmenu or ws_sizebox or ws_minimizebox or ws_maximizebox
     fwidth=400
     fheight=250
end constructor

destructor QCustomForm
end destructor

#ifdef rtl
      function QCustomForm.GetProperties as zstring ptr
           return Base.GetProperties
      end function

      function QCustomForm.GetPropertyInfo(n as string) as PELPropInfo
           return Base.GetPropertyInfo(n)
      end function

      function QCustomForm.GetProperty(n as string) as zstring ptr
           return Base.GetProperty(n)
      end function

      function QCustomForm.SetProperty(n as string,v as zstring ptr) as boolean
           return Base.SetProperty(n,v)
      end function
#endif

/'QApplication'/
function QApplication.EnumWindowsProc(dlg as hwnd,w as lparam) as boolean
     if w>0 then
        with *cast(PList,w)
               .Add(dlg)
        end with
     end if
     return false
end function

sub QApplication.UpdateWindowsList
     fwindows.clear
     EnumThreadWindows(GetCurrentThreadId,cast(wndenumproc,@enumwindowsproc),cint(@fwindows))
end sub

property QApplication.WinList byref  as QList
     updatewindowsList
     return fwindows
end property

property QApplication.WindowCount as integer
     updatewindowsList
     return fwindows.count
end property

property QApplication.Window(i as integer) as hwnd
     updatewindowsList
     if i>-1 and i<fwindows.count then return  cast(hwnd,fwindows.objects(i))
     return 0
end property

property QApplication.Terminated as boolean
     return fterminated
end property

property QApplication.Terminated (v as boolean)
     dim as boolean state=fterminated
     fterminated=v
     if v then Terminate
end property

sub QApplication.Run
     dim as msg m
     fterminated=0
     while getmessage(@m,0,0,0)>0
            translatemessage(@m)
            dispatchmessage(@m)
     wend
end sub

sub QApplication.Terminate
     ExitProcess(0)
     fterminated=1
end sub

sub QApplication.Quit
     PostQuitMessage(0)
end sub

sub QApplication.DoEvents
     dim as msg m
     if peekmessage(@m,0,0,0,pm_remove)>0 then
        translatemessage(@m)
        dispatchmessage(@m)
     end if
end sub

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

constructor QApplication
end constructor

destructor QApplication
end destructor

#ifdef rtl
      function QApplication.GetProperties as zstring ptr
           return 0
      end function

      function QApplication.GetPropertyInfo(n as string) as PELPropInfo
           return 0
      end function

      function QApplication.GetProperty(n as string) as zstring ptr
           return 0
      end function

      function QApplication.SetProperty(n as string,v as zstring ptr) as boolean
           return 0
      end function
#endif


/'global'/
#ifdef rtl
function SetPropValue(o as PObject,p as zstring ptr,v as zstring ptr) as boolean export
     if o then
        return o->SetProperty(*p,v)
     else
        messageBox(0,"Can't SET property. Instance of object is empty.","SetPropValue",mb_iconinformation or mb_taskmodal or mb_applmodal or mb_topmost)
        return 0
     end if
end function

function GetPropValue(o as PObject,p as zstring ptr) as zstring ptr export
     if o then
        return o->GetProperty(*p)
     else
        messageBox(0,"Can't GET property. Instance of object is empty.","GetPropValue",mb_iconinformation or mb_taskmodal or mb_applmodal or mb_topmost)
        return 0
     end if
end function

function GetPropList(o as PObject) as zstring ptr export
     if o then
        if *o="QObject" then
            return o->GetProperties
        else
            messagebox(0,"Wrong QObject format.","GetPropList",mb_topmost or mb_applmodal or mb_taskmodal or mb_iconinformation)
        end if
     else
        messagebox(0,"Can''t get the proplist, instance of object are vide.","GetPropList",mb_topmost or mb_applmodal or mb_taskmodal or mb_iconinformation)
        return strptr("0")
     end if
end function

function GetPropInfo(o as PObject,n as zstring ptr) as PELPropInfo export
     if o then
        return o->GetPropertyInfo(*n)
     else
        messagebox(0,"Can''t get the property info, instance of object are vide.","GetPropInfo",mb_topmost or mb_applmodal or mb_taskmodal or mb_iconinformation)
        return 0
     end if
end function
#endif

function CreateForm(docked as hwnd=0) as PCustomForm export
     dim as PCustomForm Form=new QCustomForm
     if iswindow(docked) then
        SetParent(Form->Handle,docked)
        SetWindowLongPtr(Form->Handle,gwl_exstyle,GetWindowLongPtr(Form->Handle,gwl_exstyle) or ws_ex_transparent)
        dim as rect r
        GetClientRect(docked,@r)
        MoveWindow(Form->Handle,0,0,r.right,r.bottom,1)
     end if
     return Form
end function

sub gui_initialization constructor
     iApplication=new qapplication
     QCustomForm.Register
end sub

sub gui_finalization destructor
     delete iapplication
     unregisterclass("QForm",instance)
end sub