Welcome, Guest
You have to register before you can post on our site.

Username
  

Password
  





Search Forums

(Advanced Search)

Forum Statistics
» Members: 27
» Latest member: sosyezig
» Forum threads: 7
» Forum posts: 7

Full Statistics

Online Users
There are currently 7 online users.
» 0 Member(s) | 7 Guest(s)

Latest Threads
enable external extension
Forum: night build
Last Post: rqwork_de
07-06-2020, 04:41 AM
» Replies: 0
» Views: 13
pre alpha BUILD 100
Forum: night build
Last Post: rqwork_de
07-04-2020, 03:28 PM
» Replies: 0
» Views: 17
FORM DESIGNER AND GUI WRA...
Forum: Kogaion & gui wrapper
Last Post: rqwork_de
06-19-2020, 12:03 PM
» Replies: 0
» Views: 35
DLL CONTROLS
Forum: Kogaion & gui wrapper
Last Post: rqwork_de
06-19-2020, 11:38 AM
» Replies: 0
» Views: 31
my old work for thoose wh...
Forum: User
Last Post: rqwork_de
05-31-2020, 09:26 AM
» Replies: 0
» Views: 84
Rad-Ide is here
Forum: Kogaion
Last Post: rqwork_de
05-31-2020, 08:04 AM
» Replies: 0
» Views: 97
Welcome
Forum: RqWork7 -Kogaion
Last Post: rqwork_de
05-28-2020, 06:46 AM
» Replies: 0
» Views: 117

 
  enable external extension
Posted by: rqwork_de - 07-06-2020, 04:41 AM - Forum: night build - No Replies

has build in the capabilities to add external plugins



Attached Files Thumbnail(s)
       
Print this item

  pre alpha BUILD 100
Posted by: rqwork_de - 07-04-2020, 03:28 PM - Forum: night build - No Replies

go to http://rqwork.de/Kogaion_rad_ide_night_build.zip

Print this item

  FORM DESIGNER AND GUI WRAPPER
Posted by: rqwork_de - 06-19-2020, 12:03 PM - Forum: Kogaion & gui wrapper - No Replies

Code:
/'
  Simple Designer. Educational purposes.
  (c)2013 Nastase Eodor
  nastasa.eodor@gmail.com
  http://rqwork.xhost.ro
'/

#include once "windows.bi"

#define instance GetModuleHandle(0)

type PDesigner as TDesigner ptr

type TWindowList
    Count  as integer
    Child  as HWND ptr
end type

type TDesigner extends Object
    private:
      declare static function HookChildProc(hDlg as HWND, uMsg as UINT, wParam as WPARAM, lParam as LPARAM) as LRESULT
      declare static function HookDialogProc(hDlg as HWND, uMsg as UINT, wParam as WPARAM, lParam as LPARAM) as LRESULT
      declare static function DotWndProc(hDlg as HWND, uMsg as UINT, wParam as WPARAM, lParam as LPARAM) as LRESULT
      FPopupMenu     as HMENU
      FActive        as boolean'integer
      FStepX         as integer
      FStepY         as integer
      FShowGrid      as Boolean
      FChilds        as TWindowList
      FDialog        as HWND
      FClass         as string
      FGridBrush     as HBRUSH
      FDotColor      as integer
      FDotBrush      as HBRUSH
      FSnapToGrid    as Boolean
      FDown          as Boolean
      FCanInsert     as Boolean
      FCanMove       as Boolean
      FCanSize       as Boolean
      FBeginX        as integer
      FBeginY        as integer
      FNewX          as integer
      FNewY          as integer
      FEndX          as integer
      FEndY          as integer
      FLeft          as integer
      FTop           as integer
      FWidth         as integer
      FHeight        as integer
      FSelControl    as HWND
      FOverControl   as HWND
      FDotIndex      as integer
      FDots(7)       as HWND
      FStyleEx       as integer
      FStyle         as integer
      FID            as integer
    protected:
      declare static function EnumChildsProc(hDlg as HWND, lParam as LPARAM) as Boolean
      declare        function IsDot(hDlg as HWND) as integer
      declare        sub RegisterDotClass
      declare        sub CreateDots(Parent as HWND)
      declare        sub DestroyDots
      declare        sub HideDots
      declare        sub MoveDots(Control as HWND)
      declare        sub CreateControl(AClassName as string, AName as string, AText as string, AParent as HWND, x as integer,y as integer, cx as integer, cy as integer)
      declare        function ControlAt(Parent as HWND,X as integer,Y as integer) as HWND
      declare        sub DrawGrid(DC as HDC, R as RECT)
      declare static function HookChilds(Dlg as hwnd,lParam as lparam) as boolean
      declare static function UnHookChilds(Dlg as hwnd,lParam as lparam) as boolean
      declare        sub Hook
      declare        sub UnHook
      declare        sub GetChilds(Parent as HWND = 0)
      declare        sub UpdateGrid
      declare        sub PaintGrid
      declare        sub ClipCursor(hDlg as HWND)
      declare        sub DrawBox(R as RECT)
      declare        sub DrawBoxs(R() as RECT)
      declare        sub DeleteControl(hDlg as HWND)
      declare        sub Clear
      declare        function GetClassAcceptControls(AClassName as string) as Boolean
      declare        sub MouseDown(X as integer, Y as Integer, Shift as integer)
      declare        sub MouseUp(X as integer, Y as Integer, Shift as integer)
      declare        sub MouseMove(X as integer, Y as Integer, Shift as integer)
      declare        sub KeyDown(Key as word, Shift as integer)
      crArrow        as HCURSOR = LoadCursor(0, IDC_ARROW)
      crHandPoint    as HCURSOR = LoadCursor(0, IDC_HAND)
      crCross        as HCURSOR = LoadCursor(0, IDC_CROSS)
      crSize         as HCURSOR = LoadCursor(0, IDC_SIZEALL)
      crSizeNESW     as HCURSOR = LoadCursor(0, IDC_SIZENESW)
      crSizeNS       as HCURSOR = LoadCursor(0, IDC_SIZENS)
      crSizeNWSE     as HCURSOR = LoadCursor(0, IDC_SIZENWSE)
      crSizeWE       as HCURSOR = LoadCursor(0, IDC_SIZEWE)
    public:
      OnChangeSelection  as sub(ByRef Sender as TDesigner, Control as HWND)
      OnDeleteControl    as sub(ByRef Sender as TDesigner, Control as HWND)
      OnModified         as sub(ByRef Sender as TDesigner, Control as HWND)
      OnInsertControl    as sub(ByRef Sender as TDesigner, ByRef ClassName as string, Control as HWND)
      OnInsertingControl as sub(ByRef Sender as TDesigner, ByRef AClass as string, ByRef AStyleEx as integer, AStyle as integer, ByRef AID as integer)
      OnMouseMove        as sub(ByRef Sender as TDesigner, X as integer, Y as integer, ByRef Over as HWND)
      declare            function ClassExists() as Boolean
      declare static     function GetClassName(hDlg as HWND) as string
      declare            sub HookControl(Control as HWND)
      declare            sub UnHookControl(Control as HWND)
      declare property Dialog as HWND
      declare property Dialog(value as HWND)
      declare property Active as Boolean
      declare property Active(value as Boolean)
      declare property ChildCount as integer
      declare property ChildCount(value as integer)
      declare property Child(index as integer) as HWND
      declare property Child(index as integer,value as HWND)
      declare property StepX as integer
      declare property StepX(value as integer)
      declare property StepY as integer
      declare property StepY(value as integer)
      declare property DotColor as integer
      declare property DotColor(value as integer)
      declare property SnapToGrid as Boolean
      declare property SnapToGrid(value as Boolean)
      declare property ShowGrid as Boolean
      declare property ShowGrid(value as Boolean)
      declare property ClassName as string
      declare property ClassName(value as string)
      declare operator cast as any ptr
      declare constructor(hDlg as HWND)
      declare destructor
end type

function TDesigner.EnumChildsProc(hDlg as HWND, lParam as LPARAM) as Boolean
    if lParam then
        with *cast(TWindowList ptr, lParam)
            .Count = .Count + 1
            .Child = reallocate(.Child, .Count * sizeof(HWND))
            .Child[.Count-1] = hDlg
        end with
    end if  
    return true
end function


sub TDesigner.GetChilds(Parent as HWND = 0)
    FChilds.Count = 0
    FChilds.Child = callocate(0)
    EnumChildWindows(iif(Parent, Parent, FDialog), cast(WNDENUMPROC, @EnumChildsProc), cint(@FChilds))
end sub

sub TDesigner.ClipCursor(hDlg as HWND)
     dim as RECT R
     if IsWindow(hDlg) then
         GetClientRect(hDlg, @R)
         MapWindowPoints(hDlg, 0,cast(POINT ptr, @R), 2)
         .ClipCursor(@R)
     else
         .ClipCursor(0)
     end if
end sub

sub TDesigner.DrawBox(R as RECT)
     dim as HDC Dc = GetDCEx(FDialog, 0, DCX_PARENTCLIP or DCX_CACHE or DCX_CLIPSIBLINGS)
     dim as HBRUSH Brush = GetStockObject(NULL_BRUSH)
     dim as HBRUSH PrevBrush = SelectObject(Dc, Brush)
     SetROP2(Dc, R2_NOT)
     Rectangle(Dc, R.Left, R.Top, R.Right, R.Bottom)
     SelectObject(Dc, PrevBrush)
     ReleaseDc(FDialog, Dc)
end sub

sub TDesigner.DrawBoxs(R() as RECT)
    '''for future implementation of multiselect suport
    for i as integer = 0 to ubound(R)
        DrawBox(R(i))
    next  
end sub

function TDesigner.GetClassAcceptControls(AClassName as string) as Boolean
    '''for future implementation of classbag struct
    return false
end function

sub TDesigner.Clear
    GetChilds
    for i as integer = FChilds.Count -1 to 0 step -1
        DestroyWindow(FChilds.Child[i])
    next
    HideDots
end sub

function TDesigner.ClassExists() as Boolean
    dim as WNDCLASSEX wcls
    wcls.cbSize = sizeof(wcls)
    return (FClass <> "") and (GetClassInfoEx(0, FClass, @wcls) or GetClassInfoEx(instance, FClass, @wcls))
end function

function TDesigner.GetClassName(hDlg as HWND) as string
    dim as string s = space(255)
    dim as integer L = .GetClassName(hDlg, s, Len(s))
    return trim(Left(s, L))
end function  

function TDesigner.ControlAt(Parent as HWND,X as integer,Y as integer) as HWND
    dim as RECT R
    GetChilds(Parent)
    for i as integer = 0 to FChilds.Count -1
        if IsWindowVisible(FChilds.Child[i]) then
           GetWindowRect(FChilds.Child[i], @R)
           MapWindowPoints(0, Parent, cast(POINT ptr, @R) ,2)
           if (X > R.Left and X < R.Right) and (Y > R.Top and Y < R.Bottom) then
              return FChilds.Child[i]
           end If
        end if
    next i
    return Parent
end function

sub TDesigner.CreateDots(Parent as HWND)
    for i as integer = 0 to 7
        FDots(i) = CreateWindowEx(WS_EX_TOPMOST, "DOT", "",WS_POPUP or WS_CHILD or WS_CLIPSIBLINGS or WS_CLIPCHILDREN, 0, 0, 6, 6, Parent, 0, instance, 0)
        if IsWindow(FDots(i)) then
            SetWindowLong(FDots(i), 0, cint(@this))
        end if  
    next i
end sub

sub TDesigner.DestroyDots
    for i as integer = 7 to 0 step -1
        DestroyWindow(FDots(i))
    next i
end sub

sub TDesigner.HideDots
    for i as integer = 0 to 7
        ShowWindow(FDots(i), SW_HIDE)
    next i
end sub

sub TDesigner.MoveDots(Control as HWND)
    dim as RECT R
    dim as POINT P
    dim as integer iWidth, iHeight
    if IsWindow(Control) then
       if Control <> FDialog then
           GetWindowRect(Control, @R)
           iWidth  = R.Right  - R.Left
           iHeight = R.Bottom - R.Top
           P.x     = R.Left
           P.y     = R.Top
           ScreenToClient(GetParent(Control), @P)
           for i as integer = 0 to 7
               SetParent(FDots(i), GetParent(Control))
               SetProp(FDots(i),"@@@Control", Control)
           next i
           SetWindowPos(FDots(0), HWND_TOP, P.X-3, P.Y-3, 0, 0, SWP_NOSIZE OR SWP_SHOWWINDOW)
           SetWindowPos(FDots(1), HWND_TOP, P.X+iWidth/2-3, P.Y-3, 0, 0, SWP_NOSIZE OR SWP_SHOWWINDOW)
           SetWindowPos(FDots(2), HWND_TOP, P.X+iWidth-3, P.Y-3, 0, 0, SWP_NOSIZE OR SWP_SHOWWINDOW)
           SetWindowPos(FDots(3), HWND_TOP, P.X+iWidth-3, P.Y + iHeight/2-3, 0, 0, SWP_NOSIZE OR SWP_SHOWWINDOW)
           SetWindowPos(FDots(4), HWND_TOP, P.X+iWidth-3, P.Y + iHeight-3, 0, 0, SWP_NOSIZE OR SWP_SHOWWINDOW)
           SetWindowPos(FDots(5), HWND_TOP, P.X+iWidth/2-3, P.Y + iHeight-3,0, 0, SWP_NOSIZE OR SWP_SHOWWINDOW)
           SetWindowPos(FDots(6), HWND_TOP, P.X-3, P.Y + iHeight-3, 0, 0, SWP_NOSIZE OR SWP_SHOWWINDOW)
           SetWindowPos(FDots(7), HWND_TOP, P.X-3, P.Y + iHeight/2-3, 0, 0, SWP_NOSIZE OR SWP_SHOWWINDOW)
       else
          HideDots
       end If
    else
       HideDots
    end if
end sub

function TDesigner.IsDot(hDlg as HWND) as integer
     dim as string s
     s = GetClassName(hDlg)
     if UCase(s) = "DOT" then
        for i as integer = 0 to 7
           if FDots(i) = hDlg then return i
        next i
    end If
    return -1
end function

sub TDesigner.MouseDown(X as integer, Y as Integer, Shift as integer)
    dim as POINT P
    dim as RECT R
    FDown   = true
    FBeginX = iif(FSnapToGrid,(X\FStepX)*FStepX,X)
    FBeginy = iif(FSnapToGrid,(Y\FStepY)*FStepY,y)
    FEndX   = FBeginX
    FEndY   = FBeginY
    FNewX   = FBeginX
    FNewY   = FBeginY
    HideDots
    ClipCursor(FDialog)
    FSelControl = ControlAt(FDialog, X, Y)
    FDotIndex   = IsDot(FOverControl)
    if FDotIndex <> -1 then
        FCanInsert  = false
        FCanMove    = false
        FCanSize    = true
        if not IsWindow(FSelControl) then
            FSelControl = GetProp(FDots(FDotIndex),"@@@Control")
        end if  
        BringWindowToTop(FSelControl)
        GetWindowRect(FSelControl, @R)
        P.X     = R.Left
        P.Y     = R.Top
        FWidth  = R.Right - R.Left
        FHeight = R.Bottom - R.Top
        ScreenToClient(GetParent(FSelControl), @P)
        FLeft   = P.X
        FTop    = P.Y
        select case FDotIndex
        case 0: SetCursor(crSizeNWSE)
        case 1: SetCursor(crSizeNS)
        case 2: SetCursor(crSizeNESW)
        case 3: SetCursor(crSizeWE)
        case 4: SetCursor(crSizeNWSE)
        case 5: SetCursor(crSizeNS)
        case 6: SetCursor(crSizeNESW)
        case 7: SetCursor(crSizeWE)
        end select
        SetCapture(FDialog)
   else
        if FSelControl <> FDialog then
           BringWindowToTop(FSelControl)
           if ClassExists then
               FCanInsert = true
               FCanMove   = false
               FCanSize   = false
               SetCursor(crCross)
           else
               FCanInsert = false
               FCanMove   = true
               FCanSize   = false
               SetCursor(crSize) :SetCapture(FDialog)
               if OnChangeSelection then OnChangeSelection(this, FSelControl)
               GetWindowRect(FSelControl, @R)
               P.X     = R.Left
               P.Y     = R.Top
               FWidth  = R.Right - R.Left
               FHeight = R.Bottom - R.Top
               ScreenToClient(GetParent(FSelControl), @P)
               FLeft   = P.X
               FTop    = P.Y
           end if
        else
           HideDots
           FCanInsert = iif(ClassExists, true, false)
           FCanMove   = 0
           FCanSize   = 0
           if FCanInsert then
               SetCursor(crCross)
           else
              if OnChangeSelection then OnChangeSelection(this, FSelControl)
           end if
       end if
    end if  
end sub

sub TDesigner.MouseMove(X as integer, Y as Integer, Shift as integer)
    dim as POINT P
    FNewX = iif(FSnapToGrid,(X\FStepX)*FStepX,X)
    FNewY = iif(FSnapToGrid,(Y\FStepY)*FStepY,Y)
    if FDown then
       if FCanInsert then
           SetCursor(crCross)
           DrawBox(type<RECT>(FBeginX, FBeginY, FNewX, FNewY))
           DrawBox(type<RECT>(FBeginX, FBeginY, FEndX, FEndY))
       end if
       if FCanSize then
          select case FDotIndex
          case 0: MoveWindow(FSelControl, FLeft + (FNewX - FBeginX), FTop + (FNewY - FBeginY), FWidth - (FNewX - FBeginX), FHeight - (FNewY - FBeginY), true)
          case 1: MoveWindow(FSelControl, FLeft, FTop + (FNewY - FBeginY),FWidth ,FHeight - (FNewY - FBeginY), true)
          case 2: MoveWindow(FSelControl, FLeft, FTop + (FNewY - FBeginY),FWidth + (FNewX - FBeginX) , FHeight - (FNewY - FBeginY), true)
          case 3: MoveWindow(FSelControl, FLeft, FTop, FWidth + (FNewX - FBeginX), FHeight, true)
          case 4: MoveWindow(FSelControl, FLeft, FTop, FWidth + (FNewX - FBeginX), FHeight + (FNewY - FBeginY), true)
          case 5: MoveWindow(FSelControl, FLeft, FTop, FWidth ,FHeight + (FNewY - FBeginY), true)
          case 6: MoveWindow(FSelControl, FLeft + (FNewX - FBeginX), FTop, FWidth - (FNewX - FBeginX), FHeight + (FNewY - FBeginY), true)
          case 7: MoveWindow(FSelControl, FLeft - (FBeginX - FNewX), FTop, FWidth + (FBeginX - FNewX), FHeight, true)
          end Select
       end If
       if FCanMove then
          if FBeginX <> FEndX Or FBeginY <> FEndY then
              MoveWindow(FSelControl, FLeft + (FNewX - FBeginX), FTop + (FNewY - FBeginY), FWidth, FHeight, true)
          end if
       end if
    else
       P = type(X, Y)
       FOverControl = ChildWindowFromPoint(FDialog, P)
       if OnMouseMove then OnMouseMove(this, X, Y, FOverControl)
       dim as integer Id = IsDot(FOverControl)
       if Id <> -1 then
          select case Id
          case 0 : SetCursor(crSizeNWSE)
          case 1 : SetCursor(crSizeNS)
          case 2 : SetCursor(crSizeNESW)
          case 3 : SetCursor(crSizeWE)
          case 4 : SetCursor(crSizeNWSE)
          case 5 : SetCursor(crSizeNS)
          case 6 : SetCursor(crSizeNESW)
          case 7 : SetCursor(crSizeWE)
          end select
       else
          if GetAncestor(FOverControl,GA_ROOTOWNER) <> FDialog then
              ReleaseCapture
          end if  
          SetCursor(crArrow)
          ClipCursor(0)
       end if
    end if
    FEndX = FNewX
    FEndY = FNewY
end sub

sub TDesigner.MouseUp(X as integer, Y as Integer, Shift as integer)
    dim as RECT R
    if FDown then
        FDown = false
        if FCanInsert then
           if (FBeginX > FEndX and FBeginY > FEndY) then
               swap FBeginX, FNewX
               swap FBeginY, FNewY
           end if
           if (FBeginX > FEndX and FBeginY < FEndY) then
               swap FBeginX, FNewX
           end if
           if (FBeginX < FEndX and FBeginY > FEndY) then
               swap FBeginY, FNewY
           end if
           DrawBox(Type<RECT>(FBeginX, FBeginY, FNewX, FNewY))
           if GetClassAcceptControls(GetClassName(FSelControl)) Then
               R.Left   = FBeginX
               R.Top    = FBeginY
               R.Right  = FNewX
               R.Bottom = FNewY
               MapWindowPoints(FDialog, FSelControl, cast(POINT ptr, @R), 2)
               if OnInsertingControl then
                   OnInsertingControl(this, FClass, FStyleEx, FStyle, FID)
               end if  
               CreateControl(FClass, "", "", FSelControl, R.Left, R.Top, R.Right -R.Left, R.Bottom -R.Top)
           else
               if OnInsertingControl then
                   OnInsertingControl(this, FClass, FStyleEx, FStyle, FID)
               end if
               CreateControl(FClass, "", "", FDialog, FBeginX, FBeginY, FNewX -FBeginX, FNewY -FBeginY)
           end If
           if FSelControl then
               BringWindowToTop(FSelControl)
               MoveDots(FSelControl)
               if OnInsertControl then OnInsertControl(this, FClass, FSelControl)
           end if
           FCanInsert = false
        end if
        if FCanSize then
            MoveDots(FSelControl)
            FCanSize = false
            if OnModified then OnModified(this, FSelControl)
        end If
        if FCanMove then
            MoveDots(FSelControl)
            FCanMove = false
            if OnModified then OnModified(this, FSelControl)
        end if
        FBeginX = FEndX
        FBeginY = FEndY
        FNewX   = FBeginX
        FNewY   = FBeginY
        ClipCursor(0)
        ReleaseCapture
    else
        ClipCursor(0)
    end if
end sub

sub TDesigner.DeleteControl(hDlg as HWND)
    if IsWindow(hDlg) then
        if hDlg <> FDialog then
           if OnDeleteControl then OnDeleteControl(this, hDlg)
           DestroyWindow(hDlg)
           if OnModified then OnModified(this, hDlg)
           HideDots
           FSelControl = FDialog
       end if
    end if
end sub

function TDesigner.HookChilds(Dlg as hwnd,lParam as lparam) as boolean
    if IsWindow(Dlg) then
       if GetWindowLongPtr(Dlg, GWL_WNDPROC) <> @HookChildProc then
          SetProp(Dlg, "@@@Proc", cast(WNDPROC, SetWindowLongPtr(Dlg, GWL_WNDPROC, cint(@HookChildProc))))
       end if
     end if
    return true    
end function

function TDesigner.UnHookChilds(Dlg as hwnd,lParam as lparam) as boolean
    if IsWindow(Dlg) then
       if GetWindowLongPtr(Dlg, GWL_WNDPROC) = @HookChildProc then
          SetWindowLongPtr(Dlg, GWL_WNDPROC, cint(GetProp(Dlg, "@@@Proc")))
          RemoveProp(Dlg, "@@@Proc")
       end if
    end if
    return true
end function

sub TDesigner.UnHookControl(Control as HWND)
    if IsWindow(Control) then
        if GetWindowLongPtr(Control, GWL_WNDPROC) = @HookChildProc then
            SetWindowLongPtr(Control, GWL_WNDPROC, cint(GetProp(Control, "@@@Proc")))
            RemoveProp(Control, "@@@Proc")
            EnumChildWindows(Control,cast(any ptr,@unHookChilds),0)
        end if
    end if  
end sub

sub TDesigner.HookControl(Control as HWND)
    if IsWindow(Control) then
        if GetWindowLongPtr(Control, GWL_WNDPROC) <> @HookChildProc then
          SetProp(Control, "@@@Proc", cast(WNDPROC, SetWindowLongPtr(Control, GWL_WNDPROC, cint(@HookChildProc))))
          EnumChildWindows(Control,cast(any ptr,@HookChilds),0)
        end if
    end if  
end sub

sub TDesigner.CreateControl(AClassName as string, AName as string, AText as string, AParent as HWND, x as integer,y as integer, cx as integer, cy as integer)
    FSelControl = CreateWindowEx(FStyleEx,_
                                 AClassName,_
                                 AText,_
                                 FStyle or WS_VISIBLE or WS_CHILD or WS_CLIPCHILDREN or WS_CLIPSIBLINGS,_
                                 x,_
                                 y,_
                                 iif(cx, cx, 50),_
                                 iif(cy, cy, 50),_
                                 AParent,_
                                 cast(HMENU, FID),_
                                 instance,_
                                 0)
    if IsWindow(FSelControl) then
        HookControl(FSelControl)
        'AName = iif(AName="", AName = AClassName & ...)
        'SetProp(Control, "Name", ...)
        'possibly ussing in propertylist inspector
        FClass = ""
    end if
end sub

sub TDesigner.UpdateGrid
    InvalidateRect(FDialog, 0, true)
end sub

sub TDesigner.DrawGrid(DC as HDC, R as RECT)
    dim as HDC mDc
    dim as HBITMAP mBMP, pBMP
    dim as RECT BrushRect = type(0, 0, FStepX, FStepY)
    if FGridBrush then
        DeleteObject(FGridBrush)
    end if  
    mDc   = CreateCompatibleDc(DC)
    mBMP  = CreateCompatibleBitmap(DC, FStepX, FStepY)
    pBMP  = SelectObject(mDc, mBMP)
    FillRect(mDc, @BrushRect, cast(HBRUSH, 16))
    SetPixel(mDc, 1, 1, 0)
    'for lines use MoveTo and LineTo or Rectangle function or whatever...
    FGridBrush = CreatePatternBrush(mBMP)
    FillRect(DC, @R, FGridBrush)
    SelectObject(mDc, pBMP)
    DeleteObject(mBMP)
    DeleteDc(mDc)
end sub

function TDesigner.HookChildProc(hDlg as HWND, uMsg as UINT, wParam as WPARAM, lParam as LPARAM) as LRESULT
    select case uMsg
    case WM_MOUSEFIRST to WM_MOUSELAST
        return true
    case WM_NCHITTEST
        return HTTRANSPARENT
    case WM_KEYFIRST to WM_KEYLAST
        return 0
    end select
    return CallWindowProc(GetProp(hDlg, "@@@Proc"), hDlg, uMsg, wParam, lParam)
end function

function TDesigner.HookDialogProc(hDlg as HWND, uMsg as UINT, wParam as WPARAM, lParam as LPARAM) as LRESULT
    dim as PDesigner Designer = GetProp(hDlg, "@@@Designer")
    if Designer then
        with *Designer
          select case uMsg
          case WM_ERASEBKGND
              dim as RECT R
              GetClientRect(hDlg, @R)
              if .FShowGrid then
                  .DrawGrid(cast(HDC, wParam), R)
              else
                  FillRect(cast(HDC, wParam), @R, cast(HBRUSH, 16))
              end if  
              return 1
          case WM_LBUTTONDOWN
              .MouseDown(loWord(lParam), hiWord(lParam),wParam and &HFFFF )
              return 0
          case WM_LBUTTONUP
              .MouseUp(loWord(lParam), hiWord(lParam),wParam and &HFFFF )
              return 0
          case WM_MOUSEMOVE
              .MouseMove(loword(lParam), hiword(lParam),wParam and &HFFFF )
              return 0
          case WM_RBUTTONUP
              if .FSelControl <> .FDialog then
                  dim as POINT P
                  P.x = loWord(lParam)
                  P.y = hiWord(lParam)
                  ClientToScreen(hDlg, @P)
                  TrackPopupMenu(.FPopupMenu, 0, P.x, P.y, 0, hDlg, 0)
              end if
              return 0
          case WM_COMMAND
              if IsWindow(cast(HWND, lParam)) then
              else
                 if hiWord(wParam) = 0 then
                     select case loWord(wParam)
                     case 10: if .FSelControl<> .FDialog then .DeleteControl(.FSelControl)
                     case 11: MessageBox(.FDialog, "Not implemented yet.","Designer", 0)
                     case 12: MessageBox(.FDialog, "Not implemented yet.","Designer", 0)
                     case 13: MessageBox(.FDialog, "Not implemented yet.","Designer", 0)
                     case 15: MessageBox(.FDialog, "Not implemented yet.","Designer", 0)
                     end select
                 end if
              end if '
              ''''Call and execute the based commands of dialogue.
              return CallWindowProc(GetProp(hDlg, "@@@Proc"), hDlg, uMsg, wParam, lParam)
              '''if don't want to call
              'return 0
          end select
       end with
    end if
    return CallWindowProc(GetProp(hDlg, "@@@Proc"), hDlg, uMsg, wParam, lParam)
end function

sub TDesigner.Hook
    if IsWindow(FDialog) then
        SetProp(FDialog, "@@@Designer", this)
        if GetWindowLongPtr(FDialog, GWL_WNDPROC) <> @HookDialogProc then
           SetProp(FDialog, "@@@Proc", cast(any ptr, SetWindowLong(FDialog, GWL_WNDPROC, cint(@HookDialogProc))))
        end if
        GetChilds
        for i as integer = 0 to FChilds.Count-1
            HookControl(FChilds.Child[i])
        next
    end if
end sub

sub TDesigner.UnHook
    SetWindowLong(FDialog, GWL_WNDPROC, cint(GetProp(FDialog, "@@@Proc")))
    RemoveProp(FDialog, "@@@Designer")
    RemoveProp(FDialog, "@@@Proc")
    GetChilds
    for i as integer = 0 to FChilds.Count-1
        UnHookControl(FChilds.Child[i])
    next
end sub

function TDesigner.DotWndProc(hDlg as HWND, uMsg as UINT, wParam as WPARAM, lParam as LPARAM) as LRESULT
    dim as PDesigner Designer = cast(PDesigner, GetWindowLong(hDlg, 0))
    select case uMsg
    case WM_PAINT
        dim as PAINTSTRUCT Ps
        dim as HDC Dc
        Dc = BeginPaint(hDlg, @Ps)
        FillRect(Dc, @Ps.rcPaint, iif(Designer, Designer->FDotBrush, cast(HBRUSH, GetStockObject(BLACK_BRUSH))))
        EndPaint(hDlg, @Ps)
        return 0
        'or use WM_ERASEBKGND message
    case WM_LBUTTONDOWN
        return 0
    case WM_NCHITTEST
        return HTTRANSPARENT
    case WM_DESTROY
        RemoveProp(hDlg,"@@@Control")
        return 0
    end select
    return DefWindowProc(hDlg, uMsg, wParam, lParam)
end function    

sub TDesigner.RegisterDotClass
   dim as WNDCLASSEX wcls
   wcls.cbSize        = sizeof(wcls)
   wcls.lpszClassName = @"Dot"
   wcls.lpfnWndProc   = @DotWndProc
   wcls.cbWndExtra   += 4
   wcls.hInstance     = instance
   RegisterClassEx(@wcls)
end sub

property TDesigner.Dialog as HWND
    return FDialog
end property

property TDesigner.Dialog(value as HWND)
    if value <> FDialog then
        UnHook
        FDialog = value
        if FActive then Hook
        InvalidateRect(FDialog, 0, true)
    end if  
end property

property TDesigner.Active as Boolean
    return FActive
end property

property TDesigner.Active(value as Boolean)
    if value <> FActive then
        FActive = value
        if value then
           Hook
        else
           UnHook
           HideDots
        end if
        InvalidateRect(FDialog, 0, true)
    end if
end property

property TDesigner.ChildCount as integer
    GetChilds
    return FChilds.Count
end property

property TDesigner.ChildCount(value as integer)
end property

property TDesigner.Child(index as integer) as HWND
    if index > -1 and index < FChilds.Count then
        return FChilds.Child[index]
    end if
    return 0
end property

property TDesigner.Child(index as integer,value as HWND)
end property

property TDesigner.StepX as integer
    return FStepX
end property

property TDesigner.StepX(value as integer)
    if value <> FStepX then
       FStepX = value
       UpdateGrid
    end if  
end property

property TDesigner.StepY as integer
    return FStepY
end property

property TDesigner.StepY(value as integer)
    if value <> FStepY then
       FStepY = value
       UpdateGrid
   end if
end property

property TDesigner.DotColor as integer
    dim as LOGBRUSH LB
    if GetObject(FDotBrush, sizeof(LB), @LB) then
        FDotColor = LB.lbColor
    end if
    return FDotColor
end property

property TDesigner.DotColor(value as integer)
    if value <> FDotColor then
        FDotColor = value
        if FDotBrush then DeleteObject(FDotBrush)
        FDotBrush = CreateSolidBrush(FDotColor)
        for i as integer = 0 to ubound(FDots)'-1
            InvalidateRect(FDots(i), 0, true)
        next
    end if
end property

property TDesigner.SnapToGrid as Boolean
    return FSnapToGrid
end property

property TDesigner.SnapToGrid(value as Boolean)
    FSnapToGrid = value
end property

property TDesigner.ShowGrid as Boolean
    return FShowGrid
end property

property TDesigner.ShowGrid(value as Boolean)
    FShowGrid = value
    if IsWindow(FDialog) then InvalidateRect(FDialog, 0, true)
end property

property TDesigner.ClassName as string
    return FClass
end property

property TDesigner.ClassName(value as string)
    FClass = value
end property

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

constructor TDesigner(hDlg as HWND)
    Dialog      = hDlg
    FStepX      = 6
    FStepY      = 6
    FShowGrid   = true
    FActive     = true
    FSnapToGrid = 1
    FDotBrush   = CreateSolidBrush(FDotColor)
    RegisterDotClass
    CreateDots(hDlg)
    FPopupMenu  = CreatePopupMenu
    AppendMenu(FPopupMenu, MF_STRING, 10, @"Delete")
    AppendMenu(FPopupMenu, MF_SEPARATOR, -1, @"-")
    AppendMenu(FPopupMenu, MF_STRING, 12, @"Copy")
    AppendMenu(FPopupMenu, MF_STRING, 13, @"Cut")
    AppendMenu(FPopupMenu, MF_STRING, 14, @"Paste")
    AppendMenu(FPopupMenu, MF_SEPARATOR, -1, @"-")
    AppendMenu(FPopupMenu, MF_STRING, 15, @"Properties")
end constructor

destructor TDesigner
    UnHook
    DeleteObject(FDotBrush)
    DeleteObject(FGridBrush)
    DestroyMenu(FPopupMenu)
    DestroyDots
    UnregisterClass("Dot", instance)
end destructor
Code:
/'
This is an FreeBasic GUI Application
Generated by Skeleton 1.0
Nastasa Eodor
nastasa.eodor@gmail.com
http://rqwork.xhost.ro

'/

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

#define instance GetModuleHandle(0)

common shared as HWND hAppHandle

#include once "designer.bi"

dim shared as TDesigner Designer = hAppHandle

sub MouseMove(Sender as TDesigner, X as integer, Y as integer, ByRef Over as HWND)
    dim as string s = "TinyDesigner [X: " & X & ", Y: " & Y & " Control: " & Over & "]"
    SetWindowText(hAppHandle, s)
end sub

Designer.OnMouseMove = @MouseMove

function myFBApplication_WindowProc(hDlg as HWND, Msg as UINT, wParam as WPARAM, lParam as LPARAM) as LRESULT
   select case Msg
        case WM_CREATE
           var hMenu   = CreateMenu
           var hFile   = CreatePopupMenu
           AppendMenu(hFile, MF_STRING, 10001, @"DesignTime Mode")
           AppendMenu(hFile, MF_STRING, 10002, @"RunTime Mode")
           AppendMenu(hFile, MF_SEPARATOR, -1, @"-")
           AppendMenu(hFile, MF_STRING, 10003, @"Snap To Grid")
           AppendMenu(hFile, MF_STRING, 10004, @"Show/Hide Grid")
           var hColor = CreatePopupMenu
           AppendMenu(hColor, MF_STRING, 101, @"Red")
           AppendMenu(hColor, MF_STRING, 102, @"Blue")
           AppendMenu(hColor, MF_STRING, 103, @"Gren")
           AppendMenu(hColor, MF_STRING, 104, @"Black")
           AppendMenu(hFile, MF_POPUP, cint(hColor), @"Dot Color")
           var hSize = CreatePopupMenu
           AppendMenu(hSize, MF_STRING, 105, @"3 x 3")
           AppendMenu(hSize, MF_STRING, 106, @"4 x 4")
           AppendMenu(hSize, MF_STRING, 107, @"6 x 6")
           AppendMenu(hSize, MF_STRING, 108, @"8 x 8")
           AppendMenu(hFile, MF_POPUP, cint(hSize), @"Grid Size")
           AppendMenu(hFile, MF_SEPARATOR, -1, @"-")
           AppendMenu(hFile, MF_STRING, 10005, @"Exit")
           var hEdit   = CreatePopupMenu
           AppendMenu(hEdit, MF_STRING, 10006, @"Button")
           AppendMenu(hEdit, MF_STRING, 10007, @"EditBox")
           AppendMenu(hEdit, MF_STRING, 10008, @"ComboBox")
           AppendMenu(hEdit, MF_STRING, 10009, @"TrackBar")
           AppendMenu(hEdit, MF_STRING, 10010, @"ToolBar")
           AppendMenu(hEdit, MF_STRING, 10011, @"TabControl")
           var hHelp   = CreatePopupMenu
           AppendMenu(hHelp, MF_STRING, 10012, @"About..")
           AppendMenu(hMenu, MF_POPUP, cint(hFile), @"Action")
           AppendMenu(hMenu, MF_POPUP, cint(hEdit), @"Classes")
           AppendMenu(hMenu, MF_POPUP, cint(hHelp), @"Help")
           SetMenu(hDlg, hMenu)
           DrawMenuBar(hDlg)
           CreateWindowEx(0,"BUTTON","Button",WS_CHILD OR WS_VISIBLE OR WS_CLIPSIBLINGS,10,10,75,35,hDlg,cast(HMENU,1001),instance,0)
           CreateWindowEx(512,"EDIT","Edit",WS_CHILD OR WS_VISIBLE OR WS_CLIPSIBLINGS,10,50,125,25,hDlg,cast(HMENU,1002),instance,0)
           CreateWindowEx(0,"SCROLLBAR","",WS_CHILD OR WS_VISIBLE OR WS_CLIPSIBLINGS,10,100,175,19,hDlg,cast(HMENU,1003),instance,0)
           return 0
        case WM_CLOSE
           select case MessageBox(hDlg,"Really close ?","myFBApplication",MB_YESNO OR MB_ICONERROR OR MB_TOPMOST OR MB_TASKMODAL)
               case IDYES
                   PostQuitMessage(0)
               case IDNO
                   return 1
           end select
           return 0
        case WM_COMMAND
           select case loword(wParam)
               case 10001
                   Designer.Dialog = hAppHandle
                   Designer.Active = true
               case 10002
                   Designer.Active = false
               case 10003
                   if Designer.SnapToGrid then
                       Designer.SnapToGrid = false
                   else
                       Designer.SnapToGrid = true
                   end if
               case 10004
                   if Designer.ShowGrid then
                       Designer.ShowGrid = false
                   else
                       Designer.ShowGrid = true
                   end if
               case 101 ' @"Red"
                   Designer.DotColor = &H0000FF
               case 102 ' @"Blue"
                   Designer.DotColor = &HFF0000
               case 103 ' @"Gren"
                   Designer.DotColor = &H00FF00
               case 104 ' @"Black"
                   Designer.DotColor = &H000000
               case 105 ' @"3 x 3"
                   Designer.StepX = 3
                   Designer.StepY = 3
               case 106 ' @"4 x 4"
                   Designer.StepX = 4
                   Designer.StepY = 4
               case 107 ' @"6 x 6"
                   Designer.StepX = 6
                   Designer.StepY = 6
               case 108 ' @"7 x 7"
                   Designer.StepX = 8
                   Designer.StepY = 8  
               case 10005
                   return SendMessage(hDlg,WM_CLOSE,0,0)
               case 10006
                   Designer.ClassName = "Button"
               case 10007
                   Designer.ClassName = "Edit"
               case 10008
                   Designer.ClassName = "ComboBox"
               case 10009
                   Designer.ClassName = "msctls_trackbar32"
               case 10010
                   Designer.ClassName = "ToolBarWindow32"  
               case 10011
                   Designer.ClassName = "SysTabControl32"
               case 10012  
                   MessageBox(hDlg,"TinyDesigner v 0.0"&chr(10)&_
                                   "This program was created for educational purposes to support the novice in the API and FreeBASIC."&chr(10)&_
                                   " You can change and improve to meet your needs."&chr(10)&_
                                   "(c)2013 Nastase Eodor"&chr(10)&_
                                   "http://rqwork.xhost.ro"&chr(10)&_
                                   "nastasa.eodor@gmail.com","Designer",_
                                   MB_ICONINFORMATION)
               case 1001 'Button Control
                   MessageBox(hDlg, "Hello ! I'm an tiny Designer.", "Designer", MB_ICONWARNING)
           end select
           return 0
   end select
   return DefWindowProc(hDlg, Msg, wParam, lParam)
end function

sub myFBApplication_CreateWindow
    hAppHandle = CreateWindowEx(WS_EX_APPWINDOW,"myFBApplication","myFBApplication",WS_OVERLAPPEDWINDOW OR WS_CLIPCHILDREN OR WS_CLIPSIBLINGS,200,200,500,350,0,0,instance,0)
    if IsWindow(hAppHandle) then
        ShowWindow(hAppHandle, SW_SHOW)
        UpdateWindow(hAppHandle)
    end if
end sub

sub myFBApplication_RegisterClass
    dim as WNDCLASSEX wcls
    wcls.cbSize        = sizeof(WNDCLASSEX)
    wcls.hInstance     = instance
    wcls.lpszClassName = @"myFBApplication"
    wcls.lpfnWndProc   = @myFBApplication_WindowProc
    wcls.hbrBackground = cast(HBRUSH, 16)
    wcls.hIcon         = LoadIcon(instance, "MAIN")
    wcls.hCursor       = LoadCursor(0, IDC_ARROW)
    wcls.lpszMenuName  = 0
    if RegisterClassEx(@wcls) = 0 then
        MessageBox(0,"Failed to register myFBApplication.","Application Error",MB_ICONERROR OR MB_TOPMOST OR MB_TASKMODAL)
    end if
end sub

/' Main  '/
myFBApplication_RegisterClass
myFBApplication_CreateWindow


dim as MSG uMsg  
while GetMessage(@uMsg, 0, 0, 0) > 0
    TranslateMessage(@uMsg)
    DispatchMessage(@uMsg)
wend

/'  Module  '/
sub Initialization constructor
    InitCommonControls
end sub

sub Finalization destructor
    UnregisterClass("myFBApplication", instance)
    ExitProcess(0)
end sub
Code:
/'
  tinyGUI wrapper for FreeBASIC
  (c)2013 Nastasa Eodor
  http://rqwork.xhost.ro
  mail: nastasa.eodor@gmail.com
'/

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

const LF = chr(10)

#define instance GetModuleHandle( 0 )

'user defined message
#define CM_COMMAND WM_APP + 100

type PContainer as TContainer ptr

'declare function GetGUIThreadInfo lib "user32" alias "GetGUIThreadInfo"(idThread as DWORD , lpgui as GUITHREADINFO ptr ) as Boolean
'declare function MsgBox(ByRef Text as string, Kind as integer =0, ByRef Caption as string ="") as integer
  
type TMessage
    Handle  as HWND
    Msg     as UINT
    wParam  as WPARAM
    lParam  as LPARAM
    Result  as LRESULT
    Sender  as PContainer
end type

type TContainer extends Object
    dim               as HFONT Font
    dim               as HBRUSH Brush = CreateSolidBrush(GetSysColor(COLOR_BTNFACE))
    dim               as HWND Handle, ParentWnd = 0
    dim               as integer StyleEx, Style, x, y, cx, cy
    dim               as string Text, Name
    dim               as string ClassName
  
    protected:
    declare static   function WindowProc(hDlg as HWND, uMsg as UINT, wParam as WPARAM, lParam as LPARAM) as LRESULT
    declare           sub Dispatch(ByRef message as TMessage)
    declare abstract sub DefaultHandler(ByRef message as TMessage)
    declare abstract sub RegisterClass
    declare           sub CreateWindow
    declare           sub DestroyWindow
    declare           sub DeleteObjects
  
    public:
    Tag                as any ptr
    TagI               as integer
    TagS               as string
    declare           property Parent as HWND
    declare           property Parent(value as HWND)
    declare           operator cast as HWND
    declare           constructor
    declare           destructor
    OnCreate           as sub(Sender as TContainer)
    OnDestroy          as sub(Sender as TContainer)
    OnMenuCommand      as sub(Sender as TContainer, ID as integer)
    OnAccelCommand     as sub(Sender as TContainer, ID as integer)
end type

type TFrame extends TContainer
    dim              as string MenuName = "MAINMENU"
    dim              as HMENU Menu, PopupMenu
  
    protected:
    declare          sub ApplicationMessage(ByRef message as TMessage)
    declare virtual sub DefaultHandler(ByRef message as TMessage)
    declare virtual sub RegisterClass
  
    public:
    declare          sub Run
    declare          sub Terminate
    declare          sub Close
    declare          operator cast as HWND
    declare          operator cast as TContainer ptr
    declare          constructor
    declare          destructor
    OnAppMessage      as sub(ByRef message as TMessage)
    OnShow            as sub(Sender as TFrame)
    OnClose           as sub(Sender as TFrame, ByRef Action as integer)
end type

type TControl extends TContainer
    dim              as HMENU PopupMenu
  
    protected:
    declare virtual sub DefaultHandler(ByRef message as TMessage)
    declare virtual sub RegisterClass
  
    public:
    dim               as Rect ClientRect
    dim               as HDC Canvas
    declare          operator cast as HWND
    declare          operator cast as TContainer ptr
    declare          constructor
    declare          destructor
    OnPaint           as sub(Sender as TControl)
end type

type TButton extends TControl
    dim              as integer ButtonStyle
  
    private:
    declare          function ClassProc as WNDPROC
  
    protected:
    declare virtual sub DefaultHandler(ByRef message as TMessage)
    declare virtual sub RegisterClass
  
    public:
    declare          sub Click
    declare          operator cast as HWND
    declare          operator cast as TControl ptr
    declare          constructor
    declare          destructor
    OnClick           as Sub(Sender as TButton)
end type

''''MsgBox
function MsgBox(ByRef Text as string, Kind as integer =0, ByRef Caption as string ="") as integer
    dim as GUITHREADINFO tif
    tif.cbSize = sizeof(tif)
    GetGUIThreadInfo(0, @tif)
    if Caption = "" then
        Caption = string(255, 0)
        GetModuleFileName(0, Caption, 255)
        Caption = trim(mid(Caption, instrrev(Caption, "\")+1, len(Caption)))
    end if  
    return MessageBox(tif.hwndActive, Text, Caption, MB_TOPMOST or MB_APPLMODAL or Kind)
end function

'''TContainer
function TContainer.WindowProc(hDlg as HWND, uMsg as UINT, wParam as WPARAM, lParam as LPARAM) as LRESULT
    dim as TContainer ptr Container = NULL
    dim as TMessage message = type( hDlg, uMsg, wParam, lParam, -1, Container )
    if uMsg = WM_NCCREATE then
        Container = cast( TContainer ptr, cast(LPCREATESTRUCT, lParam)->lpCreateParams )
        if Container then
            Container->Handle = hDlg
            SetWindowLong( hDlg, GetClassLong(hDlg, GCL_CBWNDEXTRA)-4, cint(Container) )
        else
            MessageBox( 0, "No linked object.", "Creation Error", MB_TOPMOST or MB_TASKMODAL or MB_ICONERROR )
        end if
    else
        Container = cast( TContainer ptr, GetWindowLong( hDlg, GetClassLong(hDlg, GCL_CBWNDEXTRA)-4 ))
    end if
    if Container then
        Container->Dispatch( message )
        return message.Result
    end if  
    return message.Result
end function

sub TContainer.Dispatch(ByRef message as TMessage)
    select case message.Msg
    case WM_CREATE
        if OnCreate then OnCreate(this)
        message.Result = false
    case WM_DESTROY
        if OnDestroy then OnDestroy(this)
        message.Result = false
    case WM_COMMAND
        dim as integer CtlType = hiWord(message.wParam)
        if IsWindow(cast(HWND, message.lParam)) then
            SendMessage(cast(HWND, message.lParam), CM_COMMAND, hiWord(message.wParam), cint(Handle))
        else
           if CtlType = 0 then
               if loWord(message.wParam) < &H00FF then
                    DefaultHandler(message)
                    exit sub
               else
                   if OnMenuCommand then OnMenuCommand(this,loWord(message.wParam))
               end if
           elseif CtlType = 1 then
               if OnAccelCommand then OnAccelCommand(this,loWord(message.wParam))
           end if
        end if
        message.Result = false
    end select  
    DefaultHandler(message)
end sub

sub TContainer.CreateWindow
    CreateWindowEx(StyleEx, ClassName, Text, Style, x, y, cx, cy, ParentWnd, 0, instance,  @this)
    if IsWindow(Handle) then
        SendMessage(Handle, WM_SETFONT, cint(Font), true)
    end if
end sub

sub TContainer.DestroyWindow
    if IsWindow(Handle) then
        .DestroyWindow(Handle)
        Handle = 0
    end if
end sub

sub TContainer.DeleteObjects
    if Brush then DeleteObject(Brush)
    if Font  then DeleteObject(Font)
end sub

property TContainer.Parent as HWND
    return ParentWnd
end property

property TContainer.Parent(value as HWND)
    ParentWnd = value
    if IsWindow(Handle) then
        SetParent(Handle, value)
    else
        CreateWindow
    end if
end property

operator TContainer.cast as HWND
    return Handle
end operator

constructor TContainer
    dim as LOGFONT LF
    If GetObject(GetStockObject(DEFAULT_GUI_FONT), sizeof(LF), @LF) then
        Font = CreateFontIndirect(@LF)
    end if
end constructor

destructor TContainer
    DeleteObjects
    DestroyWindow
end destructor

''''TFrame
sub TFrame.DefaultHandler(ByRef message as TMessage)
    select case message.Msg
    case WM_SHOWWINDOW
        if message.wParam then
            if OnShow then OnShow(this)
        end if
        message.Result = false
    case WM_CLOSE
        dim as integer Action
        if OnClose then OnClose(this, Action)
        if Action then
            select case Action
            case 2 : ShowWindow(Handle, SW_HIDE)
            Case 3 : ShowWindow(Handle, SW_MINIMIZE)
            end select
            message.Result = Action
            exit sub
        end if
        message.Result = false
    end select
    message.Result = DefWindowProc(message.Handle, message.Msg, message.wParam, message.lParam)
end sub

sub TFrame.ApplicationMessage(ByRef message as TMessage)
    if OnAppMessage then OnAppMessage(message)
end sub

sub TFrame.Run
    dim as MSG uMsg
    while GetMessage(@uMsg, 0, 0, 0) > 0
        dim as TMessage Msg 'work arround blocking toplevel window
        if IsWindow(uMsg.hWnd) then Msg =type(uMsg.hWnd, uMsg.message, uMsg.wParam, uMsg.lParam)
        ApplicationMessage( Msg )
        TranslateMessage( @uMsg )
        DispatchMessage( @uMsg )
    wend  
end sub

sub TFrame.Close
    SendMessage(Handle, WM_CLOSE, 0, 0)
end sub

sub TFrame.Terminate
    ExitProcess(0)
end sub

sub TFrame.RegisterClass
    dim as WNDCLASSEX wcls
    wcls.cbSize        = sizeof(wcls)
    wcls.style         = CS_DBLCLKS or CS_OWNDC
    wcls.hInstance     = instance
    wcls.cbWndExtra   += 4
    wcls.cbClsExtra   += 4
    wcls.hbrBackground = Brush
    wcls.lpszClassName = strptr(ClassName)
    wcls.lpfnWndProc   = @WindowProc
    wcls.lpszMenuName  = strptr(MenuName)
    wcls.hCursor       = LoadCursor( 0, IDC_ARROW )
    RegisterClassEx( @wcls )
end sub

operator TFrame.cast as HWND
    return Handle
end operator

operator TFrame.cast as TContainer ptr
    return cast(TContainer ptr, this)
end operator

constructor TFrame
     ClassName = "TFrame"
     Style     = WS_OVERLAPPEDWINDOW or WS_VISIBLE or WS_CLIPCHILDREN or WS_CLIPSIBLINGS
     cx        = 350
     cy        = 250'
     this.RegisterClass
end constructor

destructor TFrame
end destructor

''''TControl
sub TControl.DefaultHandler(ByRef message as TMessage)
    select case message.Msg
    case WM_PAINT
        dim as PAINTSTRUCT ps
        Canvas = BeginPaint(Handle, @ps)
        ClientRect = ps.rcPaint
        if OnPaint then OnPaint(this)
        EndPaint(Handle, @ps)
        Canvas = 0
        ClientRect = type(0, 0, 0, 0)
        message.Result = false
    end select
    message.Result = DefWindowProc(message.Handle, message.Msg, message.wParam, message.lParam)
end sub

sub TControl.RegisterClass
    dim as WNDCLASSEX wcls
    wcls.cbSize        = sizeof(wcls)
    wcls.style         = CS_DBLCLKS or CS_OWNDC or CS_HREDRAW or CS_VREDRAW
    wcls.hInstance     = instance
    wcls.cbWndExtra   += 4
    wcls.cbClsExtra   += 4
    wcls.hbrBackground = Brush
    wcls.lpszClassName = strptr(ClassName)
    wcls.lpfnWndProc   = @WindowProc
    wcls.lpszMenuName  = 0
    wcls.hCursor       = LoadCursor( 0, IDC_ARROW )
    RegisterClassEx( @wcls )
end sub

operator TControl.cast as HWND
    return Handle
end operator

constructor TControl
     ClassName = "TControl"
     StyleEx   = WS_EX_STATICEDGE
     Style     = WS_CHILD or WS_VISIBLE or WS_CLIPCHILDREN or WS_CLIPSIBLINGS
     cx        = 150
     cy        = 150
     this.RegisterClass
end constructor

destructor TControl
end destructor


''''TButton
function TButton.ClassProc as WNDPROC
    dim as WNDCLASSEX  wcls
    wcls.cbSize  = sizeof(wcls)
    if GetClassInfoEx(0, "Button", @wcls) then
        return wcls.lpfnWndProc
    end if
end function

sub TButton.DefaultHandler(ByRef message as TMessage)
    select case message.Msg
    case CM_COMMAND
        if message.wParam = BN_CLICKED then
            Click
        end if  
        message.Result = false
    end select
    message.Result = CallWindowProc(ClassProc,message.Handle, message.Msg, message.wParam, message.lParam)
end sub

sub TButton.Click
    if OnClick then OnClick(this)
end sub

sub TButton.RegisterClass
    dim as WNDCLASSEX wcls
    wcls.cbSize  = sizeof(wcls)
    if GetClassInfoEx(0, "Button", @wcls) then
        wcls.hInstance     = instance
        wcls.cbWndExtra   += 4
        wcls.cbClsExtra   += 4
        wcls.lpszClassName = strptr(ClassName)
        wcls.lpfnWndProc   = @WindowProc
        RegisterClassEx( @wcls )
    end if  
end sub

operator TButton.cast as HWND
    return Handle
end operator

operator TButton.cast as TControl ptr
    return cast(TControl ptr, @this)
end operator

constructor TButton
     ClassName = "TButton"
     StyleEx   = 0
     Style     = BS_PUSHLIKE or WS_CHILD or WS_VISIBLE or WS_CLIPCHILDREN or WS_CLIPSIBLINGS
     cx        = 75
     cy        = 35
     this.RegisterClass
end constructor

destructor TButton
end destructor

''''''''''''
''''TEST''''
''''''''''''
'here is the .rc
'MAINMENU MENU
'BEGIN
'  POPUP "File"
'  BEGIN
'     MENUITEM "New Frame",  10000
'     MENUITEM "Delete All", 10001
'     MENUITEM SEPARATOR
'     MENUITEM "Exit", 10002
'  END
'  MENUITEM "About",   10003
'END
'
'NEWMENU MENU
'BEGIN
'  POPUP "Help"
'  BEGIN
'     MENUITEM "About",   10003
'  END
'END

dim as TFrame Frame , Child
dim as TControl Control
dim as TButton Button

'''Events
sub ControlPaint(sender as TControl)
    Rectangle(sender.Canvas, 50, 30, 100, 100)
end sub

sub ButtonClick(Sender as TButton)
    'MessageBox(0,"Hello ! I'm clicked.","Button", 0)
    'MsgBox("Hello ! I'm clicked.",, "Button")
    MsgBox("Hello ! I'm clicked.")
end sub

sub FrameCreate(sender as TContainer)
    CreateWindowEx(0, "msctls_trackbar32", "", WS_CHILD or WS_VISIBLE, 160, 20, 100, 35, sender.Handle, cast(HMENU, 1001), instance, 0)
    MoveWindow(sender.Handle, 200, 200, 450, 250, true)
    MsgBox("Hi ! I'm a tinyGUI wrapper for FreeBasic.",MB_ICONINFORMATION)
end sub

sub FrameClose(sender as TFrame, ByRef Action as integer)
    if MsgBox("Close ?",MB_YESNO) = IDNO then
       Action = 1
    else
        PostQuitMessage(0)
        'sender.Terminate
    end if
end sub

        type TFrameList
            as integer count
            as TFrame ptr ptr Frames
        end type
        dim shared as TFrameList List
      
sub FrameMenuCommand(sender as TContainer, idCommand as integer)
    select case idCommand
    case 10000
        List.count += 1
        List.Frames = reallocate(List.FRames,List.count*sizeof(TFrame ptr))
        List.Frames[List.count-1]=New TFrame
        with *(List.Frames[List.count-1])
            .Parent=Sender
            MoveWindow(*(List.Frames[List.count-1]),List.Count*15,List.Count*15,200,150,true)
        end with  
    case 10001
        'MsgBox "" & idCommand
        for i as integer=List.count-1 to 0 step-1
            'delete List.Frames[i]
            *cast(TFrame ptr, List.Frames[i]).Close
        next
        'delete List.Frames
        List.count=0
    case 10002
        *cast(TFrame ptr, @sender).Close
    case 10003
        MsgBox "tinyGUI wrapper for FreeBASIC ."&lf &"(c)2013 Nastase Eodor"& lf &"nastasa.eodor@gmail.com", MB_ICONINFORMATION
    end select  
end sub

sub FrameDestroy(sender as TContainer)
    MsgBox("destroy")
    'for i as integer=List.count-1 to 0 step-1
         'delete List.Frames[i]
    '     *cast(TFrame ptr, List.Frames[i]).Close
    'next
    'delete List.Frames
end sub

sub ChildClose(sender as TFrame, ByRef Action as integer)
    sender.Menu=LoadMenu(instance,"NEWMENU")
    SetMenu(sender.Handle,sender.Menu)
    DrawMenuBar(sender.Handle)
    Action = 3
end sub

'''IMPL
Frame.OnCreate=@FrameCreate
Frame.OnClose=@FrameClose
Frame.OnMenuCommand=@FrameMenuCommand
Frame.OnDestroy=@FrameDestroy
Frame .Parent=0

Child.OnClose=@ChildClose
Child.Parent=Frame

Control.OnPaint=@ControlPaint
Control.Parent=Frame

Button.Text="Click me!"
Button.Parent=Child
Button.OnClick=@ButtonClick

Frame.Run


sub Initialization constructor
    InitCommonControls
    MsgBox "tinyGUI is initialized.", MB_ICONINFORMATION
end sub

sub Finalization destructor
    MsgBox "tinyGUI is finalized.", MB_ICONINFORMATION
end sub

Print this item

  DLL CONTROLS
Posted by: rqwork_de - 06-19-2020, 11:38 AM - Forum: Kogaion & gui wrapper - No Replies


.zip   RapidQ.zip (Size: 365.51 KB / Downloads: 0) Controls from DLL.

Code:
#include once "windows.bi"

common shared Main as hwnd

type PPropertyInfo as TPropertyInfo ptr
type TPropertyInfo  field = 1 ' is importand field align
    PropertyName  as zstring ptr
    PropertyValue as zstring ptr
end type

dim shared as TPropertyInfo PIF

sub click stdcall(sender as any ptr) export
    messagebox(main,"ok","ok",0)
end sub

function WndProc(Dlg as hwnd, Msg as uint, wParam as wParam, lParam as lparam) as uint
    static P as function(class as zstring ptr, Parent as hwnd, x as integer, y as integer, cx as integer, cy as integer, byref o as any ptr) as hwnd
    static DP as function stdcall(Dlg as hwnd) as boolean
    static LC as function stdcall() as zstring ptr
    static mC as function stdcall(Dlg as hwnd) as zstring ptr
    static ex as function stdcall() as integer
    static gh as function stdcall() as hwnd
    static mp as function stdcall (file as zstring ptr) as any ptr
    static da as sub stdcall()
    static PH as function stdcall() as Hwnd
    static as hmodule M, EM
    static as hwnd h, hclass, hDLL
    dim as zstring ptr s
    dim as string u
    dim as integer count
    dim as COPYDATASTRUCT WC
    static as any ptr ob, oc, oe, of, off
    select case msg
    case WM_CREATE
        M = dylibload("RapidQ.DLL")
        if M <> 0 then
           P = dylibsymbol(M, "Create")
           if P <> 0 then
               hclass = P(@"QButton", Dlg, 0, 0, 450, 250,ob)
               print "obj = ";ob
               hclass = P(@"QMemo", Dlg, 0, 255, 450, 250,oc )
               print "obj = ";oc
               hclass = P(@"QEdit", Dlg, 455, 0, 450, 250,oe)
               print "obj = ";oe
               hclass = P(@"QForm", Dlg, 455, 350, 250, 150,of)
               print "obj = ";of
               if IsWindow(hClass) then ShowWindow(hClass, SW_SHOW)
               hclass = P(@"QForm", 0, 40, 35, 250, 150,off)
               print "obj = ";off
               if IsWindow(hClass) then ShowWindow(hClass, SW_SHOW)

               DP = dylibsymbol(M, "Destroy")
               DA = dylibsymbol(M, "DestroyAll")
               LC = dylibsymbol(M, "GetClassName")
               mc = dylibsymbol(M, "ListDialogProperties")
               ex = dylibsymbol(M, "Execute")
               PH = dylibsymbol(M, "DLLHandle")
               if PH then hDLL = PH()
               if LC <> 0 then
                  s = LC()
                  print "length is = ";len(*s)
                  print *s
               end if
               if mc <> 0 then
                  s = mC(hclass)
                  print "addr ";s
                  print "length is = ";len(*s)
                  'copymemory(s, @u,len(*s))
                  print *s
               end if
              
           end if  
        end if
        return 0
    case WM_DESTROY
      
        return 0
    case WM_LBUTTONDOWN
        PIF.PropertyName = @"Text"
        PIF.PropertyValue = @"myEdit1"
        SendMessage(hDLL, WM_APP +1, cast(integer,oe), cast(integer, @PIF))
        PIF.PropertyName = @"Font.Name"
        PIF.PropertyValue = @"Lucida Console"
        SendMessage(hDLL, WM_APP +1, cast(integer,oe), cast(integer, @PIF))
        PIF.PropertyName = @"Font.Size"
        PIF.PropertyValue = @"12"
        SendMessage(hDLL, WM_APP +1, cast(integer,oe), cast(integer, @PIF))
        PIF.PropertyName = @"Lines"
        PIF.PropertyValue = @("Line 1"&chr(10)&"Line 2"&chr(10)&"Line 3"&chr(10)&"Last Line")
        SendMessage(hDLL, WM_APP +1, cast(integer,oc), cast(integer, @PIF))
        PIF.PropertyName = @"onclick"
        dim as string s = str(@click)
        PIF.PropertyValue = strptr(s)
        SendMessage(hDLL, WM_APP +1, cast(integer,ob), cast(integer, @PIF))
        PIF.PropertyName = @"Align"
        PIF.PropertyValue = @"alClient"
        SendMessage(hDLL, WM_APP +1, cast(integer,ob), cast(integer, @PIF))

        return 0
    case WM_RBUTTONDOWN
      
        return 0  
    case WM_CLOSE
        if Da <> 0 then DA()
        dylibfree(M)
        ExitProcess(0)
    end select
  
    return DefWindowProc(Dlg, Msg, wParam, lParam)
end function

function Register as integer
     dim as wndclassex wc
     wc.cbsize = sizeof(wc)
     wc.style = cs_owndc or cs_globalclass
     wc.hinstance = 0
     wc.lpszClassName = @"myCLASS"
     wc.lpfnWndProc = @WndProc
     wc.cbWndExtra += 4
     wc.hCursor = LoadCursor(0, IDC_ARROW)
     wc.hbrBackground = cast(HBRUSH, 16)
     return RegisterClassEx(@wc)
end function

function Create as hwnd
    Main = CreateWindowEx(0,@"myCLASS",@"myCLASS",WS_CLIPCHILDREN or WS_CLIPSIBLINGS or WS_OVERLAPPEDWINDOW or WS_VISIBLE, 0, 0, cw_usedefault, cw_usedefault,0,  cast(HMENU,0),GetModuleHandle(0), 0)

    return Main
end function

sub ApplicationRun
    DIM m as msg
    print Register
    print Create
    print getlasterror
    while GetMessage(@m, 0,0,0) > 0
        TranslateMessage(@m)
        DispatchMessage(@m)
    wend  
end sub

ApplicationRun

Print this item

  my old work for thoose who comment like a fools
Posted by: rqwork_de - 05-31-2020, 09:26 AM - Forum: User - No Replies

this is my work so far, this is for nonsense that gives its opinion ... it was published anonymously until NOW!
but from now on,
copyright © 2020 Vasile Eodor Nastasa, that's because you annoyed me!

here is download link
http://rqwork.de/myGUIworks.zip

Print this item

  Rad-Ide is here
Posted by: rqwork_de - 05-31-2020, 08:04 AM - Forum: Kogaion - No Replies

New rad-ide for FreeBasic, including windows gui wrapper.
Is pre alpha version and his purpose is for testing.
license: FREEWARE
http://rqwork.de/Kogaion_rad_ide.zip
or dependiences version, you must have Delphi7 instaled in you machine, or required DLL's
http://rqwork.de/Kogaion_rad_ide_dpc.zip
or
http://www.rqwork.de

Print this item

  Welcome
Posted by: rqwork_de - 05-28-2020, 06:46 AM - Forum: RqWork7 -Kogaion - No Replies

Welcome and enjoy!  Smile

Print this item