SuperStrict

Framework PUB.Win32
Import "WinAPI.bmx"
Import "-lcomctl32"

Const WINGUI_CLASSNAME : String = "WinGUI Class"

Type TWinGUI
   Global Instance      : Int
   Global DesktopGadget : TGadget
   Global StandardFont  : Int

   Function Init:Int()
      Local InitControls:TINITCOMMONCONTROLSEX, WindowClass:WNDCLASSEX
   
      TWinGUI.Instance = GetModuleHandleA(0)
      If Not TWinGUI.Instance Then Return False

      InitControls = New TINITCOMMONCONTROLSEX
      InitControls.dwSize = SizeOf(TINITCOMMONCONTROLSEX)
      InitControls.dwICC  = ICC_BAR_CLASSES ..
                            | ICC_PROGRESS_CLASS ..
                            | ICC_TREEVIEW_CLASSES
      If Not InitCommonControlsEx(InitControls) Then Return False

      WindowClass = New WNDCLASSEX
      WindowClass.cbSize        = SizeOf(WNDCLASSEX)
      WindowClass.Style         = CS_HREDRAW ..
                                  | CS_VREDRAW ..
                                  | CS_OWNDC
      WindowClass.lpfnWndProc   = TWinGUI.MessageHandler
      WindowClass.cbClsExtra    = 0
      WindowClass.cbWndExtra    = 0
      WindowClass.hInstance     = TWinGUI.Instance
      WindowClass.hIcon         = LoadIconA(Null, Byte Ptr(IDI_WINLOGO))
      WindowClass.hCursor       = LoadCursorA(Null, Byte Ptr(IDC_ARROW))
      WindowClass.hbrBackground = COLOR_MENU + 1
      WindowClass.lpszMenuName  = Null
      WindowClass.lpszClassName = WINGUI_CLASSNAME.ToCString()
      WindowClass.hIconSm       = LoadIconA(Null, Byte Ptr(IDI_WINLOGO))

      If Not RegisterClassExA(WindowClass) Then Return False

      DesktopGadget = New TGadget
      DesktopGadget.Handle = GetDesktopWindow()

      TWinGUI.StandardFont = TWinGUI.LoadFont("", 10)
      If Not TWinGUI.StandardFont Then Return False

      Return True
   End Function

   Function Desktop:TGadget()
      Return TWinGUI.DesktopGadget
   End Function

   Function LoadFont:Int(Fontname:String, Height:Int, Bold:Int=False, ..
                         Italic:Int=False, Underline:Int=False)
      Local DC:Int, Weight:Int

      DC = GetDC(0)
      Height = -(Height*GetDeviceCaps(DC, LOGPIXELSY)/72)
      ReleaseDC(0, DC)

      If Bold Then
         Weight = 700
      Else
         Weight = 400
      EndIf

      Return CreateFontA(Height, 0, 0, 0, Weight, Italic, Underline, False, ..
                         ANSI_CHARSET, OUT_DEFAULT_PRECIS, CLIP_DEFAULT_PRECIS, ..
                         DEFAULT_QUALITY, DEFAULT_PITCH, Fontname)
   End Function

   Function MessageHandler:Int(hWnd:Int, msg:Int, wParam:Int, lParam:Int)
      Select msg
         Case WM_CLOSE
            DestroyWindow(hWnd)

         Case WM_DESTROY
            PostQuitMessage(0)
            Return 0
   
         Default
            Return DefWindowProcA(hWnd, msg, wParam, lParam)
      End Select
   End Function
End Type


Type TGadget
   Field Parent : TGadget
   Field Handle : Int

   Method Activate()
      SetFocus(Self.Handle)
   End Method

   Method ClientHeight:Int()
      Local ClientRect:Int[4]

      GetClientRect(Self.Handle, ClientRect)

      Return ClientRect[3] - ClientRect[1]
   End Method

   Method ClientWidth:Int()
      Local ClientRect:Int[4]

      GetClientRect(Self.Handle, ClientRect)

      Return ClientRect[2] - ClientRect[0]
   End Method

   Method Disable()
      EnableWindow(Self.Handle, False)
   End Method

   Method Enable()
      EnableWindow(Self.Handle, True)
   End Method

   Method Font:Int()
      Return SendMessageA(Self.Handle, WM_GETFONT, 0, 0)
   End Method

   Method Group:TGadget()
      Return Self.Parent
   End Method

   Method Height:Int()
      Local ClientRect:Int[4]

      GetWindowRect(Self.Handle, ClientRect)

      Return ClientRect[3] - ClientRect[1]
   End Method

   Method Text:String()
      Local Buffer:Byte Ptr, Length:Int, Index:Int, Out:String

      Buffer = MemAlloc(255)
      Length = GetWindowTextA(Self.Handle, Buffer, 255)
      For Index = 0 Until Length
         Out :+ Chr(Buffer[Index])
      Next

      Return Out
   End Method

   Method Width:Int()
      Local ClientRect:Int[4]

      GetWindowRect(Self.Handle, ClientRect)

      Return ClientRect[2] - ClientRect[0]
   End Method

   Method X:Int()
      Local ClientRect:Int[4]

      GetWindowRect(Self.Handle, ClientRect)

      Return ClientRect[0]
   End Method

   Method Y:Int()
      Local ClientRect:Int[4]

      GetWindowRect(Self.Handle, ClientRect)

      Return ClientRect[2]
   End Method

   Method Hide()
      ShowWindow(Self.Handle, SW_HIDE)
   End Method

   Method QueryObject:Int()
      Return Self.Handle
   End Method

   Method SetFont(Font:Int)
      SendMessageA(Self.Handle, WM_SETFONT, Font, True)
   End Method

   Method SetLayout(Left:Int, Right:Int, Top:Int, Bottom:Int)
      ' ???
   End Method

   Method SetShape(X:Int, Y:Int, Width:Int, Height:Int)
      MoveWindow(Self.Handle, X, Y, Width, Height, True)
   End Method

   Method SetText(Text:String)
      SetWindowTextA(Self.Handle, Text)
   End Method

   Method Show()
      ShowWindow(Self.Handle, SW_SHOW)
   End Method
End Type


Const WINDOW_TITLEBAR     : Int = 1
Const WINDOW_SCALEABLE    : Int = 2
Const WINDOW_MENU         : Int = 4
Const WINDOW_STATUSBAR    : Int = 8
Const WINDOW_TOOL         : Int = 16
Const WINDOW_CLIENTCOORDS : Int = 32

Type TWindow Extends TGadget
   Field WindowMenu : TMenu
   Field Statusbar  : Int

   Method Active()
      ShowWindow(Self.Handle, SW_SHOW)
   End Method

   Method Maximize()
      ShowWindow(Self.Handle, SW_SHOWMAXIMIZED)
   End Method

   Method Minimize()
      ShowWindow(Self.Handle, SW_SHOWMINIMIZED)
   End Method

   Method Restore()
      ShowWindow(Self.Handle, SW_RESTORE)
   End Method

   Method SetMinSize(Width:Int=-1, Height:Int=-1)
      ' ???
   End Method

   Method SetStatusText(Text:String)
      If Self.Statusbar Then SetWindowTextA(Self.Statusbar, Text)
   End Method

   Method Menu:TMenu()
      Return Self.WindowMenu
   End Method

   Method UpdateMenu()
      SetMenu(Self.Handle, Self.WindowMenu.Handle)
   End Method

   Method Maximized:Int()
      Local Info:WINDOWPLACEMENT

      Info = New WINDOWPLACEMENT
      Info.Length = SizeOf(WINDOWPLACEMENT)
      GetWindowPlacement(Self.Handle, Info)

      Return (Info.showCmd = SW_SHOWMAXIMIZED Or Info.showCmd = SW_MAXIMIZE) > 0
   End Method

   Method Minimized:Int()
      Local Info:WINDOWPLACEMENT

      Info = New WINDOWPLACEMENT
      Info.Length = SizeOf(WINDOWPLACEMENT)
      GetWindowPlacement(Self.Handle, Info)

      Return (Info.showCmd = SW_SHOWMINIMIZED Or Info.showCmd = SW_MINIMIZE) > 0
   End Method

   Function Create:TWindow(Text:String, X:Int, Y:Int, Width:Int, Height:Int, ..
                           Group:TGadget=Null, Style:Int=WINDOW_TITLEBAR | ..
                           WINDOW_SCALEABLE | WINDOW_MENU | WINDOW_STATUSBAR)
      Local Window:TWindow, ExStyle:Int, WinStyle:Int, Parent:Int, Menu:Int

      Window = New TWindow
      If Group Then
         Window.Parent = Group
         Parent = Group.Handle
      EndIf

      WinStyle = WS_VISIBLE
      If Style & WINDOW_TITLEBAR   Then WinStyle :| WS_CAPTION | WS_SYSMENU
      If Style & WINDOW_SCALEABLE  Then WinStyle :| WS_SIZEBOX | WS_MINIMIZEBOX ..
                                                  | WS_MAXIMIZEBOX
      If Style & WINDOW_TOOL       Then ExStyle  :| WS_EX_TOOLWINDOW

      If Style & WINDOW_MENU Then
         Window.WindowMenu = New TMenu
         Window.WindowMenu.Handle = CreateMenu_()
         Menu = Window.WindowMenu.Handle
      EndIf
         
      Window.Handle = CreateWindowExA(ExStyle, WINGUI_CLASSNAME, Text, WinStyle, ..
                                      X, Y, Width, Height, Parent, Menu, ..
                                      TWinGUI.Instance, Null)
      If Not Window.Handle Then Return Null

      If Style & WINDOW_STATUSBAR Then Window.Statusbar = ..
         CreateWindowExA(0, STATUSCLASSNAME , "", WS_CHILD | WS_VISIBLE, ..
                         0, 0, 0, 0, Window.Handle, 0, TWinGUI.Instance, Null)

      Return Window
   End Function
End Type

Type TMenu
   Field Handle : Int

   Method Check()
   End Method

   Method Disable()
      
   End Method

   Method Uncheck()
   End Method

   Function Create:TMenu(Text:String, MenuID:Int, ParentMenu:TMenu)
   End Function
End Type


Const BUTTON_PUSHBUTTON  : Int = 1
Const BUTTON_CHECKBOX    : Int = 2
Const BUTTON_RADIOBUTTON : Int = 3
Const BUTTON_FIXED       : Int = 65536

Type TButton Extends TGadget
   Method State:Int()
      
   End Method

   Method SetState(State:Int)
      
   End Method

   Function Create:TButton(Text:String, X:Int, Y:Int, Width:Int, Height:Int, ..
                           Group:TGadget, Style:Int=BUTTON_PUSHBUTTON)
      Local Button:TButton, WinStyle:Int
      
      Button = New TButton
      Button.Parent = Group

      WinStyle = WS_VISIBLE | WS_CHILD
      Select Style & %11
         Case BUTTON_PUSHBUTTON
            WinStyle :| BS_PUSHBUTTON

         Case BUTTON_CHECKBOX
            WinStyle :| BS_AUTOCHECKBOX

         Case BUTTON_RADIOBUTTON
            WinStyle :| BS_AUTORADIOBUTTON

         Default
            Return Null
      End Select

      Button.Handle = CreateWindowExA(0, "BUTTON", Text, WinStyle, ..
                                      X, Y, Width, Height, Group.Handle, ..
                                      0, TWinGUI.Instance, Null)
      If Not Button.Handle Then Return Null

      Button.SetFont(TWinGUI.StandardFont)
      Return Button
   End Function
End Type


Const TEXTFIELD_PASSWORD : Int = 1
Const TEXTFIELD_FIXED    : Int = 65535

Type TTextField Extends TGadget
   Function Create:TTextField(X:Int, Y:Int, Width:Int, Height:Int, Group:TGadget, ..
                              Style:Int=0)
      Local TextField:TTextField, WinStyle:Int

      TextField = New TTextField
      TextField.Parent = Group

      WinStyle = WS_VISIBLE | WS_CHILD
      If Style & TEXTFIELD_PASSWORD Then WinStyle :| ES_PASSWORD

      TextField.Handle = CreateWindowExA(WS_EX_STATICEDGE, "EDIT", "", WinStyle, ..
                                         X, Y, Width, Height, Group.Handle, ..
                                         0, TWinGUI.Instance, Null)
      If Not TextField.Handle Then Return Null

      TextField.SetFont(TWinGUI.StandardFont)
      Return TextField
   End Function
End Type


Global Window    : TWindow
Global Button1   : TButton
Global Button2   : TButton
Global Button3   : TButton
Global TextField : TTextField
Global Message   : MSG

If Not TWinGUI.Init() Then End

Window    = TWindow.Create("Window",      0,    0, 200, 200, Null,   1)
Button1   = TButton.Create("Button",      20,  20, 100,  30, Window, 1)
Button2   = TButton.Create("Checkbox",    20,  60, 100,  30, Window, 2)
Button3   = TButton.Create("Radiobutton", 20, 100, 100,  30, Window, 3)
TextField = TTextField.Create(            20, 140, 100,  20, Window, 1)

Message = New MSG
While GetMessageA(Message, 0, 0, 0) > 0
   TranslateMessage(Message)
   DispatchMessageA(Message)
Wend

End

Const IDI_WINLOGO        : Short  = $32517
Const MB_OK              : Int    = $0
Const MB_ICONEXCLAMATION : Int    = $30
Const LBS_NOTIFY         : Int    = $1
Const LB_ADDSTRING       : Int    = $180
Const LB_GETANCHORINDEX  : Int    = $19D
Const LBN_SELCHANGE      : Int    = 1
Const SB_SETTEXT         : Int    = WM_USER + 11

Const STATUSCLASSNAME    : String = "msctls_statusbar32"

Extern "Win32"
   Function ReleaseDC:Int(hWnd:Int, hDC:Int)
   Function RegisterClassExA:Int(lpwcx:Byte Ptr)
   Function SendMessage:Byte Ptr(hWnd:Int, msg:Int, wParam:Byte Ptr, lParam:Byte Ptr) ..
            = "SendMessageA@16"
   Function CreatePopupMenu:Int()
   Function CheckMenuItem:Int(hMenu:Int, uIDCheckItem:Int, uCheck:Int)
   Function GetMenuState:Int(hMenu:Int, uID:Int, uFlags:Int)
   Function CreateWindowExA:Int(dwExStyle:Int, lpClassName$z, lpWindowName$z, ..
                                dwStyle:Int, x:Int, y:Int, nWidth:Int, nHeight:Int, ..
                                hWndParent:Int, hMenu:Int, hInstance:Int, lpParam:Byte Ptr)
   Function EnableWindow:Int(hWnd:Int, bEnable:Int)
   Function CreateStatusWindow:Int(style:Int, lpszText$z, hwndParent:Int, wID:Short)
   Function GetWindowPlacement:Int(hWnd:Int, lpwndpl:Byte Ptr)
   Function GetWindowTextA:Int(hWnd:Int, lpString:Byte Ptr, nMaxCount:Int)
   Function MessageBoxA:Int(hWnd:Int, lpText$z, lpCaption$z, uType:Int)

   Function InitCommonControlsEx:Int(lpInitCtrls:Byte Ptr)
   
   Function GetLastError:Int()
End Extern

Type WNDCLASSEX
   Field cbSize        : Int
   Field style         : Int
   Field lpfnWndProc   : Byte Ptr
   Field cbClsExtra    : Int
   Field cbWndExtra    : Int
   Field hInstance     : Int
   Field hIcon         : Int
   Field hCursor       : Int
   Field hbrBackground : Int
   Field lpszMenuName  : Byte Ptr
   Field lpszClassName : Byte Ptr
   Field hIconSm       : Int
End Type

Type WINDOWPLACEMENT
   Field length           : Int
   Field flags            : Int
   Field showCmd          : Int
   Field ptMinPosition    : Byte Ptr
   Field ptMaxPosition    : Byte Ptr
   Field rcNormalPosition : Byte Ptr
End Type