windows GUI wrapper ToolKit

Windows specific questions.
nastasa eodor
Posts: 65
Joined: Dec 18, 2018 16:37
Location: Germany, Hessdorf
Contact:

windows GUI wrapper ToolKit

Postby nastasa eodor » May 09, 2019 7:49

ok, see that code. i think with that FreeBasic become more powerfull like Lazarus and equal with Delphi. So i give you a start you made the rest.

Code: Select all

/'
   the wrapper is capable of allowing an unlimited number of inheritances,
   handling the limitations of the old wrappers.
   this code source and idea comes from the Vasile Eodor Nastasa
   mail: nastasa.eodor@gmail.com
   web: http://rqwork.xhost.ro or http://www.rqwork.de (under construction )
'/

#include once "windows.bi"

#define instance GetModuleHandle(null)

type PObject as TObject ptr
type PComponent as TComponent ptr
type PControl as TControl ptr
type PWinControl as TWinControl ptr
type PFrame as TFrame ptr

common shared as PWinControl CreationData

type TMessage
    Dlg      as hwnd
    msg      as uint
    wparam   as wparam
    lparam   as lparam
    result   as lresult
    Sender   as PControl
    Captured as PControl
end type

type TObject extends object
    as string classname,classancestor, name
    declare sub DoMessage(byref message as TMessage)'''do not use virtual directive is bug, i think inside of frreebasic the 'virtual list" leaks
    declare operator cast as any ptr
end type

type TComponent extends TObject
    declare operator cast as any ptr
end type

type TControl extends TComponent
    as hwnd fhandle,fparentwnd
    as integer fleft,ftop,fwidth,fheight,fexstyle,fstyle
    as string ftext
    as PControl fparent
    declare abstract sub Process(byref message as TMessage)
    declare abstract sub DefaultHandler(byref message as TMessage)
    declare operator cast as any ptr
end type

type TWinControl extends TControl
    declare static sub Register(as string,as string,as wndproc)
    declare virtual sub CreateHandle
    declare operator cast as any ptr
end type

type TFrame extends TWinControl
    declare virtual sub Process(byref message as TMessage)
    declare operator cast as any ptr
end type

type TForm extends TFrame
    declare static function WindowProc(as hwnd,as uint,as wparam,as lparam) as lresult
    declare virtual sub Process(byref message as TMessage)
    declare virtual sub DefaultHandler(byref message as TMessage)
    declare operator cast as any ptr
    declare constructor
end type

''tobject
sub TObject.DoMessage(byref message as TMessage)
    print "ok i do it, message no = ",message.msg
end sub

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

'''tcomponent
operator TComponent.cast as any ptr
    return @this
end operator

'''twincontrol
sub TWinControl.Register(iclassname as string,iclassancestor as string,iproc as wndproc)
    dim as wndclassex wcls
    dim as integer ret
    wcls.cbsize = sizeof(wcls)
    if iclassancestor <>"" then
        if getclassinfoex(0,iclassancestor,@wcls) = 0 then
            getclassinfoex(instance,iclassancestor,@wcls)
        end if
        if wcls.hbrbackground = 0 then wcls.hbrbackground = cast(hbrush,16)
        if wcls.hcursor = 0 then wcls.hcursor = loadcursor(0,idc_arrow)
    else
        wcls.hcursor = loadcursor(0,idc_arrow)
        wcls.hbrbackground = cast(hbrush,16)
    end if
    wcls.style or= cs_globalclass or cs_dblclks
    wcls.lpszclassname = strptr(iclassname)
    wcls.lpfnwndproc = iproc
    wcls.hinstance = instance
    wcls.cbwndextra += 4
    print registerClassex(@wcls),getlasterror, iclassname, iclassancestor
end sub

sub TWinControl.CreateHandle
    creationdata = this :print "parent is = ",iif(fparent,fparent->fhandle,0),iif(fparent,fparent->classname,"")," style = ",(fstyle and ws_child),&H40000000
    print CreateWindowEx(fexstyle,classname,ftext,fstyle,fleft,ftop,fwidth,fheight,iif(fparent,fparent->fhandle,0),0,instance,0),classname,getlasterror
    if isWindow(fhandle) then
        '''do something
    end if
end sub

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

'''tframe
sub TFrame.Process(byref message as TMessage)
    select case message.msg
    case wm_nccreate:
        dim as zstring*255 s
        dim as integer l = getclassname(fhandle,s,255)
        classname = left(s,l)
        SetWindowLongPtr(fhandle,GetClassLong(fhandle,gcl_cbwndextra)-4,cint(@this))
        creationdata = null
        message.result = 0
    case wm_paint:
        dim as wndclassex wcls
        wcls.cbsize = sizeof(wcls)
        dim as integer ret = getclassinfoex(0,classancestor,@wcls)
        if ret = 0 then ret = getclassinfoex(instance,classancestor,@wcls)
       if ret = 0 then
          dim as paintstruct ps
          beginpaint(fhandle,@ps)
          textout(ps.hdc,20,20,classname,len(classname))
          textout(ps.hdc,20,40,classancestor,len(classancestor))
          endpaint(fhandle,@ps)
        end if
        message.result = 0
    end select
end sub

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

'''tform
function TForm.WindowProc(dlg as hwnd,msg as uint,wparam as wparam,lparam as lparam) as lresult
    dim as PWinControl ctl = iif(creationdata,creationdata,cast(PWinControl,GetWindowLongPtr(dlg,GetClassLong(dlg,gcl_cbwndextra)-4)))
    dim as TMessage message = type(dlg,msg,wparam,lparam,0,ctl,0)
    if ctl then
        ctl->fhandle = dlg
        ctl->process(message)
        ctl->defaulthandler(message)
        return message.result
    else
        ctl = new tform
        ctl->fhandle = dlg
        ctl->process(message)
        ctl->defaulthandler(message)
        return message.result
    end if
    return message.result
end function

sub TForm.Process(byref message as TMessage)
    Base.Process(message)
    '''
    '''
    '''
end sub

sub TForm.DefaultHandler(byref message as TMessage)
    message.result = DefWindowProc(fhandle,message.msg,message.wparam,message.lparam)
end sub

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

constructor TForm
    classname = "tform"
    fstyle = ws_overlappedwindow or ws_visible
    fwidth = 400
    fheight = 350
end constructor

type iform extends tform
    declare virtual sub process(byref as tmessage)
    declare operator cast as any ptr
    declare constructor
end type

sub iform.process(byref message as tmessage)
    base.process(message)
    '''your processing messages here
end sub

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

constructor iform
    classname = "iform"
    classancestor = "tform"
end constructor

type zform extends iform
    declare virtual sub process(byref as tmessage)
    declare operator cast as any ptr
    declare constructor
end type

sub zform.process(byref message as tmessage)
    base.process(message)
    '''you processing messages here
end sub

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

constructor zform
    classname = "zform"
    classancestor = "iform"
end constructor

type cform extends zform
    declare virtual sub Process(byref message as TMessage)
    declare operator cast as any ptr
    declare constructor
end type

'''cform
sub cform.Process(byref message as TMessage)
    Base.Process(message)
    '''
    '''
    '''
end sub

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

constructor cform
    classname = "cform"
    classancestor = "zform"
    fstyle = ws_overlappedwindow or ws_visible
    fwidth = 250
    fheight = 150
end constructor

type aform extends cform
    declare virtual sub Process(byref message as TMessage)
    declare operator cast as any ptr
    declare constructor
end type

'''aform
sub aform.Process(byref message as TMessage)
    Base.Process(message)
    '''
    '''
    '''
end sub

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

constructor aform
    classname = "aform"
    classancestor = "cform"
    fstyle = ws_overlappedwindow or ws_visible
    fwidth = 550
    fheight = 100
end constructor

type TButton extends TFrame
    declare static function WindowProc(as hwnd,as uint,as wparam,as lparam) as lresult
    declare virtual sub Process(byref message as TMessage)
    declare virtual sub DefaultHandler(byref message as TMessage)
    declare operator cast as any ptr
    declare constructor
end type

'''TButton
function TButton.WindowProc(dlg as hwnd,msg as uint,wparam as wparam,lparam as lparam) as lresult
    dim as PWinControl ctl = iif(creationdata,creationdata,cast(PWinControl,GetWindowLongPtr(dlg,GetClassLong(dlg,gcl_cbwndextra)-4)))
    dim as TMessage message = type(dlg,msg,wparam,lparam,0,ctl,0)
    if ctl then
        ctl->fhandle = dlg
        ctl->process(message)
        ctl->defaulthandler(message)
        return message.result
    else
        ctl = new TButton
        ctl->fhandle = dlg
        ctl->process(message)
        ctl->defaulthandler(message)
        return message.result
    end if
    return message.result
end function

sub TButton.Process(byref message as TMessage)
    Base.Process(message)
    '''
    '''
    '''
end sub

sub TButton.DefaultHandler(byref message as TMessage)
    dim as wndclassex wcls
    wcls.cbsize = sizeof(wcls)
    if GetClassInfoEx(0,"Button",@wcls) then
       message.result = CallWindowProc(wcls.lpfnwndproc,fhandle,message.msg,message.wparam,message.lparam)
    else
       message.result = cint(@defwindowproc)
    end if
end sub

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

constructor TButton
    classname = "TButton"
    classancestor = "Button"
    fstyle = ws_child or ws_visible
    fwidth = 75
    fheight = 35
end constructor

type TmyButton extends TButton
    declare virtual sub Process(byref message as TMessage)
    declare operator cast as any ptr
    declare constructor
end type

'''TmyButton
sub TmyButton.Process(byref message as TMessage)
    Base.Process(message)
    '''
    '''
end sub

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

constructor TmyButton
    classname = "TmyButton"
    classancestor = "TButton"
    fstyle = ws_child or ws_visible
    fwidth = 75
    fheight = 35
end constructor

type TxButton extends TButton
    declare virtual sub Process(byref message as TMessage)
    declare operator cast as any ptr
    declare constructor
end type

'''TxButton
sub TxButton.Process(byref message as TMessage)
    Base.Process(message)
    '''
    '''
end sub

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

constructor TxButton
    classname = "TxButton"
    classancestor = "TmyButton"
    fstyle = ws_child or ws_visible
    fwidth = 75
    fheight = 35
end constructor


'''
dim shared as tform f
f.createhandle
dim shared as iform xf
xf.createhandle
dim shared as zform zf
zf.createhandle
dim shared as cform cf
cf.createhandle
dim shared as aform af
af.createhandle
dim shared as TButton B
b.ftext = b.classname
b.fleft = 120
B.fParent = f
B.createhandle
dim shared as TmyButton bb
bb.ftext = bb.classname
bb.fleft = 200
bb.fParent = f
bb.createhandle
dim shared as TxButton xb
xb.ftext = xb.classname
xb.fleft = 280
xb.fParent = f
xb.createhandle

'''create windows from scratch,no need com automation you can access the FreeBasic object via cbwndextra member
'''ex.
#define wObject(__hwnd__) *cast(PObject,getwindowlong(__hwnd__,getclasslong(__hwnd__,gcl_cbwndextra)-4))

var v1 = createwindowex(0,"tform","tform",ws_overlappedwindow or ws_visible,300,100,400,300,0,0,instance,0)
var v2 = createwindowex(0,"iform","iform",ws_overlappedwindow or ws_visible,320,120,400,300,0,0,instance,0)
var v3 = createwindowex(0,"zform","zform",ws_overlappedwindow or ws_visible,340,140,400,300,0,0,instance,0)
var v4 = createwindowex(0,"cform","cform",ws_overlappedwindow or ws_visible,300,100,400,300,0,0,instance,0)
var v5 = createwindowex(0,"aform","aform",ws_overlappedwindow or ws_visible,300,100,400,300,0,0,instance,0)
var v6 = createwindowex(0,"tbutton","Tbutton",ws_child or ws_visible,300,100,75,35,v5,0,instance,0)
var v7 = createwindowex(0,"tmybutton","Tmybutton",ws_child or ws_visible,300,139,75,35,v5,0,instance,0)
var v8 = createwindowex(0,"txbutton","Txbutton",ws_child or ws_visible,300,180,75,35,v5,0,instance,0)

messagebox 0, ("wobject 1 = " & @wObject(v1) & chr(10) & _
               "wobject 2 = " & @wObject(v2) & chr(10) & _
               "wobject 3 = " & @wObject(v3) & chr(10) & _
               "wobject 4 = " & @wObject(v4) & chr(10) & _
               "wobject 5 = " & @wObject(v5) & chr(10) & _
               "wobject 7 = " & @wObject(v6) & chr(10) & _
               "wobject 8 = " & @wObject(v7)),"gui toolkit",0


dim as msg m
dim as TMessage message
dim as PObject obj
while getmessage(@m,0,0,0)>0
    translatemessage(@m)
    dispatchmessage(@m)
    obj = cast(PObject,getwindowlong(m.hwnd,getclasslong(m.hwnd,gcl_cbwndextra)-4))
    message = type<TMessage>(m.hwnd,m.message,m.wparam,m.lparam,0,cast(PControl ptr,obj),0)
    if obj then obj->domessage(message)
wend


'''module constructor/destructor
'''each base class has a unique static window procedure
sub wrapper_initialization constructor
    TWinControl.Register("TForm","",@TForm.WindowProc)
    TWinControl.Register("iForm","TForm",@TForm.WindowProc)
    TWinControl.Register("zForm","iForm",@TForm.WindowProc)
    TWinControl.Register("cForm","zForm",@cForm.WindowProc)
    TWinControl.Register("aForm","cForm",@aForm.WindowProc)''it is same with tform.windowproc
    TWinControl.Register("TButton","Button",@TButton.WindowProc)
    TWinControl.Register("TmyButton","TButton",@TButton.WindowProc)
    TWinControl.Register("TxButton","TmyButton",@TButton.WindowProc)
end sub

sub wrapper_finalization destructor
    unregisterclass("TForm",instance)
    unregisterclass("iForm",instance)
    unregisterclass("zForm",instance)
    unregisterclass("cForm",instance)
    unregisterclass("aForm",instance)
    unregisterclass("TButton",instance)
    unregisterclass("TmyButton",instance)
    unregisterclass("TxButton",instance)
end sub
Last edited by nastasa eodor on May 11, 2019 0:38, edited 4 times in total.
nastasa eodor
Posts: 65
Joined: Dec 18, 2018 16:37
Location: Germany, Hessdorf
Contact:

Re: windows GUI wrapper ToolKit

Postby nastasa eodor » May 10, 2019 16:26

so i paste the final working code...so who get old one please update
nastasa eodor
Posts: 65
Joined: Dec 18, 2018 16:37
Location: Germany, Hessdorf
Contact:

Re: windows GUI wrapper ToolKit

Postby nastasa eodor » May 12, 2019 8:12

look on it

Code: Select all

/'
   the wrapper is capable of allowing an unlimited number of inheritances,
   handling the limitations of the old wrappers.
   this code source and idea comes from the Vasile Eodor Nastasa
   if you want to use in comercial purposes please contact me
   mail: nastasa.eodor@gmail.com
   web: http://rqwork.xhost.ro or http://www.rqwork.de (under construction )
'/

#define debbug

#include once "windows.bi"

#define instance GetModuleHandle(null)

#define qObject(__ptr__) *cast(PObject,__ptr__)
#define wObject(__hwnd__) *cast(PObject,GetWindowLong(__hwnd__,GetClassLong(__hwnd__,GCL_CBWNDEXTRA)-4))

#define qComponent(__ptr__) *cast(PComponent,__ptr__)
#define wComponent(__hwnd__) *cast(PComponent,GetWindowLong(__hwnd__,GetClassLong(__hwnd__,GCL_CBWNDEXTRA)-4))

#define qControl(__ptr__) *cast(PControl,__ptr__)
#define wControl(__hwnd__) *cast(PControl,GetWindowLong(__hwnd__,GetClassLong(__hwnd__,GCL_CBWNDEXTRA)-4))

#define qWinControl(__ptr__) *cast(PWinControl,__ptr__)
#define wWinControl(__hwnd__) *cast(PWinControl,GetWindowLong(__hwnd__,GetClassLong(__hwnd__,GCL_CBWNDEXTRA)-4))

#define qFrame(__ptr__) *cast(PFrame,__ptr__)
#define wFrame(__hwnd__) *cast(PFrame,GetWindowLong(__hwnd__,GetClassLong(__hwnd__,GCL_CBWNDEXTRA)-4))

type PObject as TObject ptr
type PComponent as TComponent ptr
type PControl as TControl ptr
type PWinControl as TWinControl ptr
type PFrame as TFrame ptr

common shared as PWinControl CreationData

type TMessage
    Dlg      as hwnd
    msg      as uint
    wparam   as wparam
    lparam   as lparam
    result   as lresult
    Sender   as PControl
    Captured as PControl
end type

type TSizeConstraintsRecord
    as integer minWidth, minHeight, maxWidth, maxHeight
end type

type TSizeConstraints extends object
    protected:
    as integer fminWidth,fmaxwidth,fminHeight,fmaxheight
    as PControl fcontrol
    public:
    declare property minHeight as integer
    declare property minHeight(as integer)
    declare property maxHeight as integer
    declare property maxHeight(as integer)
    declare property minWidth as integer
    declare property minWidth(as integer)
    declare property maxWidth as integer
    declare property maxWidth(as integer)
    declare property Control as PControl
    declare property Control(as PControl)
    declare operator cast as any ptr
    declare operator cast as string
    declare operator Let(as TSizeConstraintsRecord)
    declare constructor(as integer=0,as integer=0,as integer=0,as integer=0,as PControl=null)
    declare destructor
end type

type TAnchorRecord
    as boolean aLeft,aTop,aRight,aBottom
end type

type TAnchor extends object
    protected:
    as boolean fleft,ftop,fright,fbottom
    as PControl fcontrol
    public:
    declare property Left as boolean
    declare property Left (as boolean)
    declare property Top as boolean
    declare property Top (as boolean)
    declare property Right as boolean
    declare property Right (as boolean)
    declare property Bottom as boolean
    declare property Bottom (as boolean)
    declare property Control as PControl
    declare property Control (as PControl)
    declare operator cast as any ptr
    declare operator cast as string
    declare operator let(as TAnchorRecord)
    declare constructor(as boolean=false,as boolean=false,as boolean=false,as boolean=false)
    declare destructor
end type

type TObject extends object
    protected:
    as string fclassname,fclassancestor, fname
    public:
    declare sub Free
    declare sub DoMessage(byref message as TMessage)'''do not use virtual directive is bug, i think inside of frreebasic the 'virtual list" leaks
    declare property ClassName as string
    declare property ClassName( as string)
    declare property ClassAncestor as string
    declare property ClassAncestor( as string)
    declare property Name as string
    declare property Name( as string)
    declare operator cast as any ptr
    declare operator cast as string
end type

type TComponent extends TObject
    protected:
    as PWinControl fowner
    as boolean fdesignmode
    as hwnd fhandle
    public:
    declare property Owner as PWinControl
    declare property Owner( as PWinControl)
    declare property DesignMode as boolean
    declare property DesignMode( as boolean)
    declare property Handle as hwnd
    declare property Handle( as hwnd)
    declare operator cast as any ptr
    declare constructor(as PWinControl=0)
    declare destructor
end type

type TControl extends TComponent
    private:
    as integer foldZ
    protected:
    as integer falign
    as boolean fenabled, fvisible
    as rect fclientrect
    as hwnd fparentwnd
    as integer fclientwidth,fclientheight,fleft,ftop,fwidth,fheight,fexstyle,fstyle,fcontrolcount,fcomponentcount
    as string ftext
    as PWinControl fparent
    as PComponent ptr fcomponents
    as PControl ptr fcontrols
    as TSizeConstraints ptr fsizeconstraints
    as TAnchor ptr fanchor
    declare virtual sub CreateHandle
    declare virtual sub FreeHandle
    declare sub AddComponent(as PComponent)
    declare sub RemoveComponent(as PComponent)
    declare sub AddControl(as PControl)
    declare sub RemoveControl(as PControl)
    public:
    declare function IndexOfComponent(as PComponent) as integer
    declare function IndexOfControl(as PControl) as integer
    declare sub InsertControl(value as PControl)
    declare sub InsertComponent(value as PComponent)
    declare sub RequestAlign
    declare sub SetBounds(as integer, as integer, as integer, as integer)
    declare function Perform(as uint,as wparam,as lparam) as lresult
    declare sub BringToFront
    declare sub SendToBack
    declare sub SetFocus
    declare sub KillFocus
    declare sub Invalidate
    declare sub Repaint
    declare sub Refresh
    declare sub ClientToScreen(byref as point)
    declare sub ScreenToClient(byref as point)
    declare abstract sub Process(byref message as TMessage)
    declare abstract sub DefaultHandler(byref message as TMessage)
    declare property SizeConstraints byref as TSizeConstraints
    declare property Anchor byref as TAnchor
    declare property ComponentCount as integer
    declare property ComponentCount( as integer)
    declare property Component(as integer)as PComponent
    declare property Component( as integer,as PComponent)
    declare property Control(as integer) as PControl
    declare property Control(as integer,as PControl)
    declare property ControlCount as integer
    declare property ControlCount( as integer)
    declare property Parent as PWinControl
    declare property Parent( as PWinControl)
    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 Text as string
    declare property Text( as string)
    declare property ExStyle as integer
    declare property ExStyle( as integer)
    declare property Style as integer
    declare property Style( 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 Enabled as boolean
    declare property Enabled( as boolean)
    declare property Visible as boolean
    declare property Visible( as boolean)
    declare property Align as integer
    declare property Align(as integer)
    declare operator cast as any ptr
    declare constructor
    declare destructor
end type

type TWinControl extends TControl
    protected:
    as boolean fgrouped, ftabstop
    public:
    declare static sub Register(as string,as string,as wndproc)
    declare operator cast as any ptr
end type

type TFrame extends TWinControl
    protected:
    declare virtual sub Process(byref message as TMessage)
    public:
    declare operator cast as any ptr
end type

type TForm extends TFrame
    protected:
    declare static function hWndProc(as hwnd,as uint,as wparam,as lparam) as lresult
    declare virtual sub Process(byref message as TMessage)
    declare virtual sub DefaultHandler(byref message as TMessage)
    public:
    declare static function WindowProc as wndproc
    declare operator cast as any ptr
    declare constructor
end type

'''tanchor
property TAnchor.Left as boolean
    return fleft
end property

property TAnchor.Left (value as boolean)
    fleft = value
    if fcontrol then fcontrol->requestAlign
end property

property TAnchor.Top as boolean
    return ftop
end property

property TAnchor.Top (value as boolean)
    ftop = value
    if fcontrol then fcontrol->requestAlign
end property

property TAnchor.Right as boolean
    return fright
end property

property TAnchor.Right(value as boolean)
    fright = value
    if fcontrol then fcontrol->requestAlign
end property

property TAnchor.Bottom as boolean
    return fbottom
end property

property TAnchor.Bottom (value as boolean)
    fbottom = value
    if fcontrol then fcontrol->requestAlign
end property

property TAnchor.Control as PControl
    return fcontrol
end property

property TAnchor.Control (value as PControl)
    fcontrol = value
    if fcontrol then fcontrol->requestAlign
end property

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

operator TAnchor.cast as string
    return "Left=" & fleft & "," & "Top=" & ftop & "," & "Width=" & fright & "," & "height=" & fbottom
end operator

operator TAnchor.let(rec as TAnchorRecord)
    left = rec.aleft
    top = rec.atop
    right = rec.aright
    bottom = rec.abottom
end operator

constructor TAnchor(ileft as boolean,itop as boolean,iright as boolean,ibottom as boolean)
    fleft = ileft
    ftop = itop
    fright = iright
    fbottom = ibottom
end constructor

destructor TAnchor
end destructor

'''sizeconstraints
property TSizeConstraints.minWidth as integer
    return fminWidth
end property

property TSizeConstraints.minWidth(value as integer)
    fminWidth = value
    if fcontrol then fcontrol->RequestAlign
end property

property TSizeConstraints.maxWidth as integer
    return fmaxwidth
end property

property TSizeConstraints.maxWidth(value as integer)
    fmaxWidth = value
    if fcontrol then fcontrol->RequestAlign
end property

property TSizeConstraints.minHeight as integer
    return fminHeight
end property

property TSizeConstraints.minHeight(value as integer)
    fminHeight = value
    if fcontrol then fcontrol->RequestAlign
end property

property TSizeConstraints.maxHeight as integer
    return fmaxHeight
end property

property TSizeConstraints.maxHeight(value as integer)
    fmaxHeight = value
    if fcontrol then fcontrol->RequestAlign
end property

property TSizeConstraints.Control as PControl
    return fcontrol
end property

property TSizeConstraints.Control(value as PControl)
    fcontrol = value
    if value then value->RequestAlign
end property

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

operator TSizeConstraints.cast as string
    return "minHeight=" & fminHeight & "," & "maxHeight=" & fmaxHeight & "," & "minWidth=" & fminWidth & "," & "maxWidth=" & fmaxWidth
end operator

operator TSizeConstraints.Let(value as TSizeConstraintsRecord)
   minWidth = value.minWidth
   minHeight = value.minHeight
   maxWidth = value.maxWidth
   maxHeight = value.maxHeight
end operator

constructor TSizeConstraints(imimWidth as integer=0,iminHeight as integer=0,imaxwidth as integer=0,imaxheight as integer=0,icontrol as PControl=null)
    fminwidth = imimWidth
    fminheight = iminHeight
    fmaxwidth = imaxwidth
    fmaxheight = imaxheight
    fcontrol = icontrol
end constructor

destructor TSizeConstraints
end destructor

''tobject
property TObject.ClassName as string
    return fclassname
end property

property TObject.ClassName(value as string)
    fclassname = value
end property

property TObject.ClassAncestor as string
    return fclassancestor
end property

property TObject.ClassAncestor(value as string)
    fclassancestor = value
end property

property TObject.Name as string
    return fname
end property

property TObject.Name(value as string)
    fname = value
end property

sub TObject.Free
    if IsWindow(qComponent(@this).handle) then DestroyWindow(qComponent(@this).handle)
    delete @this
end sub

sub TObject.DoMessage(byref message as TMessage)
    #ifdef debbug
       'print "message no = ",message.msg
    #endif
end sub

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

operator TObject.cast as string
    return fclassname
end operator

'''tcomponent
property TComponent.Owner as PWinControl
    return fowner
end property

property TComponent.Owner(value as PWinControl)
    fowner = value
    if fowner then fowner->insertComponent(@this)
end property

property TComponent.DesignMode as boolean
    return fdesignmode
end property

property TComponent.DesignMode(value as boolean)
    fdesignmode = value
end property

property TComponent.Handle as hwnd
    return fhandle
end property

property TComponent.Handle(value as hwnd)
end property

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

constructor TComponent(iowner as PWinControl)
    fowner = iowner
    if fowner then fowner->insertComponent(@this)
end constructor

destructor TComponent
end destructor

'''tcontrol
property TControl.ComponentCount as integer
    return fcomponentcount
end property

property TControl.ComponentCount(value as integer)
end property

property TControl.Component(index as integer) as PComponent
    if index>-1 and index<fcomponentcount then
        return fcomponents[index]
    end if
    return null
end property

property TControl.Component(index as integer, value as PComponent)
end property

function TControl.IndexOfComponent(value as PComponent) as integer
    for i as integer = 0 to fcomponentcount-1
        if fcomponents[i] = value then return i
    next
    return -1
end function

sub TControl.AddComponent(value as PComponent)
    if value <> 0 then 
        fcomponentcount += 1
        fcomponents = reallocate(fcomponents,sizeof(PComponent)*fcomponentcount)
        fcomponents[fcomponentcount-1] = value
    end if
end sub

sub TControl.RemoveComponent(value as PComponent)
    dim as integer i = IndexOfComponent(value)
    if i <>-1 then
        fcomponents[i] = null
        for i as integer = i+1 to fcomponentcount-1
            fcomponents[i-1] = fcomponents[i+1]
        next
        fcomponentcount -= 1
        fcomponents = reallocate(fcomponents,sizeof(PComponent)*fcomponentcount)
    end if     
end sub

sub TControl.InsertComponent(value as PComponent)
    if indexOfComponent(value) = -1 then AddComponent(value)
end sub

sub TControl.AddControl(value as PControl)
    if indexOfControl(value) = -1 then
        fcontrolcount += 1
        fcontrols = reallocate(fcontrols,sizeof(PControl)*fcontrolcount)
        fcontrols[fcontrolcount-1] = value
        AddComponent(@this)
    end if
end sub

sub TControl.RemoveControl(value as PControl)
    dim as integer i = IndexOfControl(value)
    if i <>-1 then
        fcontrols[i] = null
        for i as integer = i+1 to fcontrolcount-1
            fcontrols[i-1] = fcontrols[i+1]
        next
        fcontrolcount -= 1
        fcontrols = reallocate(fcontrols,sizeof(PControl)*fcontrolcount)
        RemoveComponent(value)
    end if     
end sub

function TControl.IndexOfControl(value as PControl) as integer
    for i as integer = 0 to fcontrolcount-1
        if fcontrols[i] = value then return i
    next
    return -1
end function

sub TControl.InsertControl(value as PControl)
    AddControl(value)
    if value then if value->fparent then value->fparent->requestAlign
end sub

sub TControl.SetBounds(ileft as integer, itop as integer, iwidth as integer, iheight as integer)
    fleft = ileft
    ftop = itop
    fwidth = iwidth
    fheight = iheight
    if IsWindow(fhandle) then MoveWindow(fhandle, fleft, ftop, fwidth, fheight, true)
end sub

sub TControl.RequestAlign
     dim as PControl 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 ControlCount = 0 then exit sub
     lLeft = 0
     rLeft = ClientWidth
     ttop  = 0
     btop  = ClientHeight
     for i = 0 to fControlCount -1
         aleft = fcontrols[i]->left
         atop = fcontrols[i]->top
         awidth = fcontrols[i]->width
         aheight = fcontrols[i]->height
         select case fcontrols[i]->Align
                case 1'alLeft
                    LeftCount += 1
                    ListLeft = reallocate(ListLeft,sizeof(PControl)*LeftCount)
                    ListLeft[LeftCount -1] = fcontrols[i]
                case 2'alRight
                    RightCount += 1
                    ListRight = reallocate(ListRight,sizeof(PControl)*RightCount)
                    ListRight[RightCount -1] = fcontrols[i]
                case 3'altop
                    topCount += 1
                    Listtop = reallocate(Listtop,sizeof(PControl)*topCount)
                    Listtop[topCount -1] = fcontrols[i]
                case 4'alBottom
                    BottomCount += 1
                    ListBottom = reallocate(ListBottom,sizeof(PControl)*BottomCount)
                    ListBottom[BottomCount -1] = fcontrols[i]
                case 5'alClient
                    ClientCount += 1
                    ListClient = reallocate(ListClient,sizeof(PControl)*ClientCount)
                    ListClient[ClientCount -1] = fcontrols[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)
                if .anchor.left then .SetBounds(aleft,ttop - .Height,rLeft,.Height)
                if .anchor.right then .SetBounds(aleft,ttop - .Height,rLeft,aheight)
         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
            ?.ClassName, 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

sub TControl.CreateHandle
    creationdata = this
    CreateWindowEx(fexstyle,classname,ftext,fstyle,fleft,ftop,fwidth,fheight,iif(fparent,fparent->fhandle,0),0,instance,0)
    if isWindow(fhandle) then
        Enablewindow(fhandle,fenabled)
        ShowWindow(fhandle,iif(fvisible,sw_show,sw_hide))
       
    end if
    refresh
end sub

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

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

sub TControl.SendToBack
    if IsWindow(fhandle) then
        SetWindowPos(fhandle,fcontrols[foldz]->handle, 0, 0 ,0 ,0, SWP_NOMOVE or SWP_NOACTIVATE or SWP_NOSIZE)
    end if
end sub

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

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

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

sub TControl.Repaint
    if IsWindow(fhandle) then RedrawWindow(fhandle, 0, 0, RDW_ERASE or RDW_INTERNALPAINT or RDW_INVALIDATE)
end sub

sub TControl.Refresh
    Repaint
    Invalidate
end sub

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

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

sub TControl.FreeHandle
    if IsWindow(fhandle) then
        DestroyWindow(fhandle)
        fhandle = 0
    end if
end sub

property TControl.Anchor byref as TAnchor
    return *fanchor
end property

property TControl.Align as integer
    return falign
end Property
       
property TControl.Align(value as integer)
    falign = value   
    if fparent then fparent->RequestAlign
end Property

property TControl.ControlCount as integer
    return fcontrolcount
end property

property TControl.ControlCount(value as integer)
    '''do nothing
end property

property TControl.Control(index as integer) as PControl
    if index>-1 and index<fControlCount then
       return fcontrols[index]
    end if
    return null
end property

property TControl.Control(index as integer,value as PControl)
    ''' do nothing
end property

property TControl.SizeConstraints byref as TSizeConstraints
    return *fsizeconstraints
end property

property TControl.Parent as PWinControl
    if IsWindow(fhandle) then
       fparent = WWinControl(fhandle).fParent
    end if
    return fparent
end property

property TControl.Parent(value as PWinControl)
    dim as PControl saveparent = fparent
    fparent = value
    if IsWindow(fhandle) then
        SetParent(fhandle,iif(parent,fparent->handle,0))
        if saveparent then saveparent->RemoveControl(@this)
        if fparent then fparent->AddControl(@this)
    else
        if fparent then fparent->AddControl(@this)
        qwinControl(@this).CreateHandle
    end if
end property

property TControl.Left as integer
    return fleft
end property

property TControl.Left(value as integer)
    fleft = value
    if IsWindow(fhandle) then MoveWindow(fhandle,fleft,ftop,fwidth,fheight,true)
end property

property TControl.Top as integer
    return ftop
end property

property TControl.Top(value as integer)
    ftop = value
    if IsWindow(fhandle) then MoveWindow(fhandle,fleft,ftop,fwidth,fheight,true)
end property

property TControl.Width as integer
    return fwidth
end property

property TControl.Width(value as integer)
    fwidth = value
    if IsWindow(fhandle) then MoveWindow(fhandle,fleft,ftop,fwidth,fheight,true)
end property

property TControl.Height as integer
    return fheight
end property

property TControl.Height(value as integer)
    fheight = value
    if IsWindow(fhandle) then MoveWindow(fhandle,fleft,ftop,fwidth,fheight,true)
end property

property TControl.Text as string
    return ftext
end property

property TControl.Text(value as string)
    ftext = value
    if IsWindow(fhandle) then SetWindowText(fhandle,value)
end property

property TControl.ExStyle as integer
    return fexstyle
end property

property TControl.ExStyle(value as integer)
    fexstyle = value
    if IsWindow(fhandle) then
        SetWindowlong(fhandle,GWL_EXSTYLE,fexstyle)
        SetWindowPos(fhandle, 0, 0, 0, 0, 0, SWP_NOACTIVATE or SWP_FRAMECHANGED or SWP_NOSIZE or SWP_NOMOVE or SWP_NOSIZE or SWP_NOZORDER)
        UpdateWindow(fhandle)
    end if   
end property

property TControl.Style as integer
    return fstyle
end property

property TControl.Style(value as integer)
    fstyle = value
    if IsWindow(fhandle) then
        SetWindowlong(fhandle,GWL_STYLE,fstyle)
        SetWindowPos(fhandle, 0, 0, 0, 0, 0, SWP_NOACTIVATE or SWP_FRAMECHANGED or SWP_NOSIZE or SWP_NOMOVE or SWP_NOZORDER)
        UpdateWindow(fhandle)
    end if   
end property

property TControl.Enabled as boolean
    if isWindow(fhandle) then
        fenabled = IsWindowEnabled(fhandle)
    end if
    return fenabled
end property

property TControl.Enabled(value as boolean)
    fenabled = value
    if IsWindow(fhandle) then EnableWindow(fhandle,fenabled)
end property

property TControl.Visible as boolean
    if isWindow(fhandle) then
        fvisible = IsWindowVisible(fhandle)
    end if
    return fvisible
end property

property TControl.Visible(value as boolean)
    fvisible = value
    if IsWindow(fhandle) then ShowWindow(fhandle,iif(fvisible,SW_SHOW,SW_HIDE))
end property

property TControl.ClientWidth as integer
    return fclientwidth
end property

property TControl.ClientWidth(value as integer)
end property

property TControl.ClientHeight as integer
    return fclientheight
end property

property TControl.ClientHeight(value as integer)
end property

property TControl.ClientRect as rect
    return fclientrect
end property

property TControl.ClientRect(value as rect)
end property

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

constructor TControl
    fvisible = true
    fenabled = true
    fsizeconstraints = new TSizeConstraints
    fsizeconstraints->control = this
    fanchor = new TAnchor
end constructor

destructor TControl
    if fparent then fparent->RemoveControl(@this)
    if fsizeconstraints then delete fsizeconstraints
    if fanchor then delete fanchor
end destructor

'''twincontrol
sub TWinControl.Register(iclassname as string,iclassancestor as string,iproc as wndproc)
    dim as wndclassex wcls
    dim as integer ret
    wcls.cbsize = sizeof(wcls)
    if iclassancestor <>"" then
        if getclassinfoex(0,iclassancestor,@wcls) = 0 then
            getclassinfoex(instance,iclassancestor,@wcls)
        end if
        if wcls.hbrbackground = 0 then wcls.hbrbackground = cast(hbrush,16)
        if wcls.hcursor = 0 then wcls.hcursor = loadcursor(0,idc_arrow)
    else
        wcls.hcursor = loadcursor(0,idc_arrow)
        wcls.hbrbackground = cast(hbrush,16)
    end if
    wcls.style or= cs_globalclass or cs_dblclks
    wcls.lpszclassname = strptr(iclassname)
    wcls.lpfnwndproc = iproc
    wcls.hinstance = instance
    wcls.cbwndextra += 4
    ret = registerClassex(@wcls)
end sub

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

'''tframe
sub TFrame.Process(byref message as TMessage)
    select case message.msg
    case wm_nccreate:
        dim as zstring*255 s
        dim as integer l = getclassname(fhandle,s,255)
        classname = left(s,l)
        SetWindowLongPtr(fhandle,GetClassLong(fhandle,gcl_cbwndextra)-4,cint(@this))
        creationdata = null
        fstyle = GetwindowLong(fhandle,GWL_STYLE)
        fexstyle = GetwindowLong(fhandle,GWL_EXSTYLE)
        message.result = 0
    case wm_paint:
        dim as wndclassex wcls
        wcls.cbsize = sizeof(wcls)
        dim as integer ret = getclassinfoex(0,classancestor,@wcls)
        if ret = 0 then ret = getclassinfoex(instance,classancestor,@wcls)
        if ret = 0 then
            dim as paintstruct ps
            beginpaint(fhandle,@ps)
            textout(ps.hdc,20,20,classname,len(classname))
            textout(ps.hdc,20,40,classancestor,len(classancestor))
            endpaint(fhandle,@ps)
        end if
        message.result = 0
    case wm_size:
        fclientrect = type<rect>(0,0,loword(message.lparam),hiword(message.lparam))
        fclientwidth = loword(message.lparam)
        fclientheight = hiword(message.lparam)
        if fcontrolcount>0 then RequestAlign
        message.result = 0
    case wm_getminmaxinfo:
        dim as minmaxinfo ptr mms = cast(minmaxinfo ptr,message.lparam)
        if sizeconstraints.minwidth>0 then mms->ptmintracksize.x = sizeconstraints.minwidth
        if sizeconstraints.minHeight>0 then mms->ptmintracksize.y = sizeconstraints.minHeight
        if sizeconstraints.maxwidth>0 then
            mms->ptmaxtracksize.x = sizeconstraints.maxwidth
            mms->ptmaxsize.x = sizeconstraints.maxwidth
        end if
        if sizeconstraints.maxheight>0 then
            mms->ptmaxtracksize.y = sizeconstraints.maxheight
            mms->ptmaxsize.y = sizeconstraints.maxheight
        end if
        message.result = 0
        exit sub
    case wm_windowposchanging:
        dim as windowpos ptr wps = cast(windowpos ptr,message.lparam)
        if (fstyle and ws_child) then
        if sizeconstraints.maxWidth>0 then wps->cx = sizeconstraints.maxWidth
        if sizeconstraints.maxHeight>0 then wps->cy = sizeconstraints.maxHeight
        exit sub
        end if
        message.result = 0
    case WM_MOUSEFIRST to WM_MOUSELAST:
        if (fstyle and ws_child) then
            if fdesignmode then
               message.result = 1
               exit sub
            end if
        else
            message.result = 0
        end if
    case WM_NCHITTEST:
        if (fstyle and ws_child) then
            if fdesignmode then
               message.result = HTTRANSPARENT
               exit sub
            end if
        else
           message.result = 0
        end if
    end select
    defaulthandler(message)
end sub

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

'''tform
function TForm.hWndProc(dlg as hwnd,msg as uint,wparam as wparam,lparam as lparam) as lresult
    dim as PWinControl ctl = iif(creationdata,creationdata,cast(PWinControl,GetWindowLongPtr(dlg,GetClassLong(dlg,gcl_cbwndextra)-4)))
    dim as TMessage message = type(dlg,msg,wparam,lparam,0,ctl,0)
    if ctl then
        ctl->fhandle = dlg
        ctl->process(message)
        return message.result
    else
        ctl = new tform
        ctl->fhandle = dlg
        ctl->process(message)
        return message.result
    end if
    return message.result
end function

function TForm.WindowProc as wndproc
    return @hWndProc
end function

sub TForm.Process(byref message as TMessage)
    Base.Process(message)
    '''
    '''
    '''
end sub

sub TForm.DefaultHandler(byref message as TMessage)
    message.result = DefWindowProc(fhandle,message.msg,message.wparam,message.lparam)
end sub

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

constructor TForm
    classname = "tform"
    fstyle = ws_overlappedwindow or ws_visible
    fwidth = 400
    fheight = 350
end constructor

type iform extends tform
    protected:
    declare virtual sub process(byref as tmessage)
    public:
    declare operator cast as any ptr
    declare constructor
end type

sub iform.process(byref message as tmessage)
    base.process(message)
    '''your processing messages here
end sub

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

constructor iform
    classname = "iform"
    classancestor = "tform"
end constructor

type zform extends iform
    protected:
    declare virtual sub process(byref as tmessage)
    public:
    declare operator cast as any ptr
    declare constructor
end type

sub zform.process(byref message as tmessage)
    base.process(message)
    '''you processing messages here
end sub

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

constructor zform
    classname = "zform"
    classancestor = "iform"
end constructor

type cform extends zform
    protected:
    declare virtual sub Process(byref message as TMessage)
    public:
    declare operator cast as any ptr
    declare constructor
end type

'''cform
sub cform.Process(byref message as TMessage)
    Base.Process(message)
    '''
    '''
    '''
end sub

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

constructor cform
    classname = "cform"
    classancestor = "zform"
    fstyle = ws_overlappedwindow or ws_visible
    fwidth = 250
    fheight = 150
end constructor

type aform extends cform
    protected:
    declare virtual sub Process(byref message as TMessage)
    public:
    declare operator cast as any ptr
    declare constructor
end type

'''aform
sub aform.Process(byref message as TMessage)
    Base.Process(message)
    '''
    '''
    '''
end sub

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

constructor aform
    classname = "aform"
    classancestor = "cform"
    fstyle = ws_overlappedwindow or ws_visible
    fwidth = 550
    fheight = 100
end constructor

type TButton extends TFrame
    protected:
    declare static function hWndProc(as hwnd,as uint,as wparam,as lparam) as lresult
    declare virtual sub Process(byref message as TMessage)
    declare virtual sub DefaultHandler(byref message as TMessage)
    public:
    declare static function WindowProc as wndproc
    declare operator cast as any ptr
    declare operator cast as hwnd
    declare constructor
end type

'''TButton
function TButton.hWndProc(dlg as hwnd,msg as uint,wparam as wparam,lparam as lparam) as lresult
    dim as PWinControl ctl = iif(creationdata,creationdata,cast(PWinControl,GetWindowLongPtr(dlg,GetClassLong(dlg,gcl_cbwndextra)-4)))
    dim as TMessage message = type(dlg,msg,wparam,lparam,0,ctl,0)
    if ctl then
        ctl->fhandle = dlg
        ctl->process(message)
        return message.result
    else
        ctl = new TButton
        ctl->fhandle = dlg
        ctl->process(message)
        return message.result
    end if
    return message.result
end function

sub TButton.Process(byref message as TMessage)
    Base.Process(message)
    '''
    '''
    '''
end sub

sub TButton.DefaultHandler(byref message as TMessage)
    dim as wndclassex wcls
    wcls.cbsize = sizeof(wcls)
    if GetClassInfoEx(0,"Button",@wcls) then
       message.result = CallWindowProc(wcls.lpfnwndproc,fhandle,message.msg,message.wparam,message.lparam)
    else
       'message.result = cint(@defwindowproc)
    end if
end sub

function TButton.WindowProc as wndproc
    return @TButton.hWndProc
end function

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

operator TButton.cast as hwnd
    return fhandle
end operator

constructor TButton
    classname = "TButton"
    classancestor = "Button"
    fstyle = ws_child or ws_visible
    fwidth = 75
    fheight = 35
end constructor

type TmyButton extends TButton
    protected:
    declare virtual sub Process(byref message as TMessage)
    public:
    declare operator cast as any ptr
    declare constructor
end type

'''TmyButton
sub TmyButton.Process(byref message as TMessage)
    Base.Process(message)
    '''
    '''
end sub

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

constructor TmyButton
    classname = "TmyButton"
    classancestor = "TButton"
    fstyle = ws_child or ws_visible  or bs_defpushbutton
    fwidth = 75
    fheight = 35
end constructor

type TxButton extends TButton
    protected:
    declare virtual sub Process(byref message as TMessage)
    public:
    declare operator cast as any ptr
    declare constructor
end type

'''TxButton
sub TxButton.Process(byref message as TMessage)
    Base.Process(message)
    '''
    '''
end sub

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

constructor TxButton
    classname = "TxButton"
    classancestor = "TmyButton"
    fstyle = ws_child or ws_visible
    fwidth = 75
    fheight = 35
end constructor

type TColorDialog extends TComponent
    declare operator cast as any ptr
end type

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


'''
dim shared as tform f
f.parent = 0
dim shared as iform xf
xf.parent = f
dim shared as zform zf
zf.parent = f
dim shared as cform cf
cf.parent = f
dim shared as aform af
af.parent = f
af.SizeConstraints.maxheight=300
af.SizeConstraints.minwidth=360

dim shared as TButton B
b.text = b.classname
b.left = 120
B.Parent = af
b.sizeconstraints.maxwidth = 55

dim shared as TmyButton bb
bb.text = bb.classname
bb.left = 200
bb.Parent = af

dim shared as TxButton xb
xb.text = xb.classname
xb.left = 280
xb.Parent = af


dim shared as tcolorDialog cd
cd.owner = af

print qobject(@xb)
print af.sizeconstraints


'''create windows from scratch,no need com automation you can access the FreeBasic object via cbwndextra member
'''ex.
'''#define wObject(__hwnd__) *cast(PObject,getwindowlong(__hwnd__,getclasslong(__hwnd__,gcl_cbwndextra)-4))

var v1 = createwindowex(0,"tform","tform",ws_overlappedwindow or ws_visible,300,100,400,300,f.handle,0,instance,0)
var v2 = createwindowex(0,"iform","iform",ws_overlappedwindow or ws_visible,320,120,400,300,f.handle,0,instance,0)
var v3 = createwindowex(0,"zform","zform",ws_overlappedwindow or ws_visible,340,140,400,300,f.handle,0,instance,0)
var v4 = createwindowex(0,"cform","cform",ws_overlappedwindow or ws_visible,300,100,400,300,f.handle,0,instance,0)
var v5 = createwindowex(0,"aform","aform",ws_overlappedwindow or ws_visible,300,100,400,300,f.handle,0,instance,0)
var v6 = createwindowex(0,"tbutton","Tbutton",ws_child or ws_visible,300,100,75,35,v5,0,instance,0)
var v7 = createwindowex(0,"tmybutton","Tmybutton",ws_child or ws_visible,300,139,75,35,v5,0,instance,0)
var v8 = createwindowex(0,"txbutton","Txbutton",ws_child or ws_visible,300,180,75,35,v5,0,instance,0)

messagebox 0, ("wobject 1 = " & @wObject(v1) & chr(10) & _
               "wobject 2 = " & @wObject(v2) & chr(10) & _
               "wobject 3 = " & @wObject(v3) & chr(10) & _
               "wobject 4 = " & @wObject(v4) & chr(10) & _
               "wobject 5 = " & @wObject(v5) & chr(10) & _
               "wobject 7 = " & @wObject(v6) & chr(10) & _
               "wobject 8 = " & @wObject(v7)),"gui toolkit",0
               
(af.sizeconstraints) = type<TSizeConstraintsRecord>(75,180,360,500)

print af.controlcount,af.componentcount
af.designmode = true
for i as integer = 0 to af.controlcount-1
   af.control(i)->DesignMode = true
next
xb.align = 1
bb.align=4

dim as msg m
dim as TMessage message
dim as PObject obj
while getmessage(@m,0,0,0)>0
    translatemessage(@m)
    dispatchmessage(@m)
    obj = cast(PObject,getwindowlong(m.hwnd,getclasslong(m.hwnd,gcl_cbwndextra)-4))
    message = type<TMessage>(m.hwnd,m.message,m.wparam,m.lparam,0,cast(PControl ptr,obj),0)
    if obj then obj->domessage(message)
wend


'''module constructor/destructor
sub wrapper_initialization constructor
    TWinControl.Register("TForm","",TForm.WindowProc)
    TWinControl.Register("iForm","TForm",TForm.WindowProc)
    TWinControl.Register("zForm","iForm",TForm.WindowProc)
    TWinControl.Register("cForm","zForm",cForm.WindowProc)
    TWinControl.Register("aForm","cForm",aForm.WindowProc)
    TWinControl.Register("TButton","Button",TButton.WindowProc)
    TWinControl.Register("TmyButton","TButton",TButton.WindowProc)
    TWinControl.Register("TxButton","TmyButton",TButton.WindowProc)
end sub

sub wrapper_finalization destructor
    unregisterclass("TForm",instance)
    unregisterclass("iForm",instance)
    unregisterclass("zForm",instance)
    unregisterclass("cForm",instance)
    unregisterclass("aForm",instance)
    unregisterclass("TButton",instance)
    unregisterclass("TmyButton",instance)
    unregisterclass("TxButton",instance)
end sub

Xusinboy Bekchanov
Posts: 72
Joined: Jul 26, 2018 18:28

Re: windows GUI wrapper ToolKit

Postby Xusinboy Bekchanov » May 13, 2019 4:37

nastasa eodor wrote:look on it

Code: Select all

/'
   the wrapper is capable of allowing an unlimited number of inheritances,
   handling the limitations of the old wrappers.
   this code source and idea comes from the Vasile Eodor Nastasa
   if you want to use in comercial purposes please contact me
   mail: nastasa.eodor@gmail.com
   web: http://rqwork.xhost.ro or http://www.rqwork.de (under construction )
'/

The previous versions are compliant with the GPL license, so I published them to the github with this license:
readme.txt wrote:freeware

free to modify/change but you must share your changes with
rest of group.

if you are suggestions or bug reports please let me
know.

I did not take anything from the new versions.
Last edited by Xusinboy Bekchanov on May 13, 2019 4:56, edited 1 time in total.
nastasa eodor
Posts: 65
Joined: Dec 18, 2018 16:37
Location: Germany, Hessdorf
Contact:

Re: windows GUI wrapper ToolKit

Postby nastasa eodor » May 14, 2019 20:34

Xusinboy Bekchanov wrote:
nastasa eodor wrote:look on it

Code: Select all

/'
   the wrapper is capable of allowing an unlimited number of inheritances,
   handling the limitations of the old wrappers.
   this code source and idea comes from the Vasile Eodor Nastasa
   if you want to use in comercial purposes please contact me
   mail: nastasa.eodor@gmail.com
   web: http://rqwork.xhost.ro or http://www.rqwork.de (under construction )
'/

The previous versions are compliant with the GPL license, so I published them to the github with this license:
readme.txt wrote:freeware

free to modify/change but you must share your changes with
rest of group.

if you are suggestions or bug reports please let me
know.

I did not take anything from the new versions.

it is ok man...you can get anything you want...permission granted to you always ok?
Xusinboy Bekchanov
Posts: 72
Joined: Jul 26, 2018 18:28

Re: windows GUI wrapper ToolKit

Postby Xusinboy Bekchanov » May 15, 2019 3:32

nastasa eodor wrote:it is ok man...you can get anything you want...permission granted to you always ok?

The law is the same for everyone, so I will not take anything from the new versions. Do you confirm license of old versions from your readme.txt?
nastasa eodor
Posts: 65
Joined: Dec 18, 2018 16:37
Location: Germany, Hessdorf
Contact:

Re: windows GUI wrapper ToolKit

Postby nastasa eodor » May 15, 2019 12:32

Xusinboy Bekchanov wrote:
nastasa eodor wrote:it is ok man...you can get anything you want...permission granted to you always ok?

The law is the same for everyone, so I will not take anything from the new versions. Do you confirm license of old versions from your readme.txt?

yes i confirm same type of license like in old readme.txt, so the #%$@ law are respected now...

Return to “Windows”

Who is online

Users browsing this forum: No registered users and 1 guest