PDA

View Full Version : my first ui example



lydia_sp
04-09-2009, 18:33
hello.

my first example with ui module. as I think it`s good to understand this gui module for applications. I will build one day my own application or first of all a nonsense gui for graphic input. have one idea for it. but my skills are still low, sorry.

there is no reason for me to learn c++ / c# or other languages. I try to go easier ways I see here. It`s possible to realize small guis with thinbasic and callbacks. I have seen a lot of examples here. thanks (martin for example). I am interested in building colour manipulations software. Perhaps there is a way to prevent to learn c++ or c#. I am happy to found thinbasic, you can imagine. good day. see you.


'' my first ui example (lydia)

uses "UI"

begin const
%ID_OPEN = 401
%ID_EXIT
%ID_SAVE
%ID_SIZE
%ID_OPTION1
%ID_OPTION2
%ID_OPTION3
%ID_OPTION4
%ID_HELP
%ID_HELP1
%ID_HELP2
%ID_HELP3
%ID_CompileHELP
%ID_ABOUT
%ID_ABOUT1
%ID_ABOUT2
%ID_ABOUT3
%ID_ABOUT4
%ID_DEBUG
%ID_IMPORT
%ID_BASIC
%ID_OK = 1
%ID_CANCEL = 2
%ID_TEXT = 100
%ID_OK1 = 3
end const

'--------------------------------------------------
FUNCTION TBMain() AS LONG
'--------------------------------------------------
LOCAL hDlg AS long
LOCAL lResult AS LONG
LOCAL hMenu, hMenu1 AS long
LOCAL hPopup1 AS long
LOCAL hPopup2 AS long
LOCAL hPopup3 AS long
LOCAL hPopup4 AS long
LOCAL hPopup5 AS long
' ** First create a top-level menu:
MENU NEW BAR TO hMenu
MENU NEW BAR TO hMenu1

' ** Add a top-level menu item with a popup menu:
MENU NEW POPUP TO hPopup1
MENU ADD POPUP, hMenu, "&File", hPopup1, %MF_ENABLED
MENU ADD STRING, hPopup1, "&Open", %ID_OPEN, %MF_CHECKED or %MF_GRAYED
MENU ADD STRING, hPopup1, "-", 0, 0
MENU ADD STRING, hPopup1, "-www.thinbasic.com-", 1, 1
MENU ADD STRING, hPopup1, "-", 0, 0
MENU ADD STRING, hPopup1, "&Save as..", %ID_SAVE, %MF_CHECKED or %MF_GRAYED
MENU ADD STRING, hPopup1, "-", 0, 0
MENU ADD STRING, hPopup1, "&Exit", %ID_EXIT, %MF_ENABLED

' ** Now we can add another item to the menu that will bring up a sub-menu. First we obtain a new popup menu handle to distinuish it from the first popup menu:
MENU NEW POPUP TO hPopup2
MENU NEW POPUP TO hPopup3
MENU NEW POPUP TO hPopup4

' ** Now add a new menu item to the first menu. This item will bring up the sub-menu when selected:
MENU ADD POPUP, hPopup1, "&More Options for Colours->", hPopup2, %MF_ENABLED

' ** Now we will define the sub menu:
MENU ADD STRING, hPopup2, "Option &1: Blue (B)", %ID_OPTION1, %MF_ENABLED
MENU ADD STRING, hPopup2, "Option &2: Red (R)", %ID_OPTION2, %MF_ENABLED
MENU ADD STRING, hPopup2, "Option &3: Green (G)", %ID_OPTION3, %MF_ENABLED
MENU ADD STRING, hPopup2, "Option &4: Yellow (Y)", %ID_OPTION4, %MF_ENABLED

' ** Finally, we'll add a second top-level menu and popup. For this popup, we can reuse the first popup variable:
MENU NEW POPUP TO hPopup2
MENU ADD POPUP, hMenu, "&Help", hPopup2, %MF_ENABLED
MENU ADD STRING, hPopup2, "&Help", %ID_HELP, %MF_ENABLED
MENU ADD STRING, hPopup2, "-", 0, 0
MENU ADD STRING, hPopup2, "&About", %ID_ABOUT, %MF_ENABLED


MENU NEW POPUP TO hPopup3
MENU ADD POPUP, hMenu, "&Mixed", hPopup3, %MF_ENABLED
MENU ADD STRING, hPopup3, "&basic-Info", %ID_HELP1, %MF_ENABLED
MENU ADD STRING, hPopup3, "-", 0, 0
MENU ADD STRING, hPopup3, "what ? ->", 0, 0
MENU ADD STRING, hPopup3, "empty heart :) ", 0, 0
MENU ADD STRING, hPopup3, "&RealMadrid", %ID_ABOUT1, %MF_ENABLED
MENU ADD STRING, hPopup3, "&Kings & Queens", %ID_ABOUT2, %MF_ENABLED

MENU NEW POPUP TO hPopup4
MENU ADD POPUP, hMenu, "&Compile fast", hPopup4, %MF_ENABLED
MENU ADD STRING, hPopup4, "&Compile_Help", %ID_CompileHELP, %MF_ENABLED

MENU ADD STRING, hPopup4, "&DebugModus", %ID_DEBUG, %MF_ENABLED
MENU ADD STRING, hPopup4, "BundleMe", 0, 0
MENU ADD STRING, hPopup4, "-", 0, 0
MENU ADD STRING, hPopup4, "Import Data", %ID_IMPORT, %MF_ENABLED
MENU ADD STRING, hPopup4, "&LydiaBasic", %ID_BASIC, %MF_ENABLED

MENU NEW POPUP TO hPopup5
MENU ADD POPUP, hMenu, "&WindowSize", hPopup5, %MF_ENABLED '' ok:)
MENU ADD STRING, hPopup5, "-", 0, 0
MENU ADD STRING, hPopup5, "&SizeMe", %ID_Size, %MF_ENABLED

'' MENU SET COLOR hdlg, 120,255

' ** Create a new dialog template
DIALOG NEW 0, "What's your name, thinbasic user?", -1, -1, 220, 120, _
%WS_DLGFRAME OR %DS_CENTER OR %WS_CAPTION OR %WS_SYSMENU OR %WS_OVERLAPPEDWINDOW, _
0 TO hDlg
DIALOG SET COLOR hDlg, 80,150

'---Attach menu to dialog
MENU ATTACH hMenu, hDlg

'' ** Display the dialog
' DIALOG SHOW modal hDlg call dlgCallback

DIALOG SHOW MODELESS hDlg, CALL dlgCallback
LOCAL Count as long
DO
DIALOG DOEVENTS TO Count
LOOP UNTIL Count = 0

end function

'--------------------------------------------------
callback function dlgCallback() as long
'--------------------------------------------------

local UserName as string
local MovieName as string

select case cbmsg

case %WM_INITDIALOG '---Message fired at the very beginning when dialog is initialized
'---Add relevant controls
CONTROL ADD TEXTBOX , cbhndl, %ID_TEXT, "", 14, 12, 134, 12, 0
CONTROL ADD BUTTON , cbhndl, %ID_OK, "OK", 14, 32, 40, 14, %BS_DEFAULT
CONTROL ADD BUTTON , cbhndl, %ID_OK1, "MovieStar", 56, 32, 40, 14, %BS_DEFAULT
CONTROL ADD BUTTON , cbhndl, %ID_CANCEL, "Cancel", 100, 32, 40, 14, 0
CONTROL ADD LABEL , cbhndl, %ID_CANCEL, "summer is always on my side, you prefer dancing more than drinking all night long!", 40, 60, 80, 36, 0

case %WM_Command
select case cbctl
case %ID_EXIT, %ID_CANCEL
msgbox 0, "wow! you kill me!"
dialog end cbhndl


case %ID_OK
CONTROL GET TEXT cbhndl, %ID_TEXT TO UserName
if UserName = "" then
msgbox cbhndl, "Please, specify a name", %MB_ICONEXCLAMATION
else
msgbox cbhndl, "Hello mr./mrs. " & UserName
end if

case %ID_OK1
CONTROL GET TEXT cbhndl, %ID_TEXT TO MovieName
if MovieName = "" then
msgbox cbhndl, "Please, speak and spell..", %MB_ICONEXCLAMATION
else
msgbox cbhndl, "Hello famous moviestar: " & MovieName
return 1 = %true
end if

case %ID_ABOUT
msgbox 0, "you are using: thinbasic vol 1.7.9.0 :)"
case %ID_ABOUT1
msgbox 0, "No goal for you today, raśl, mr. soccer star!"
case %ID_ABOUT2
msgbox 0, "the drunken queen wanted to have some new butlers!"
case %ID_IMPORT
msgbox 0, "load my personal data to the script!"
case %ID_BASIC
msgbox 0, "..but try LydiasAIR cause it's better to compile! :)"
case %ID_CompileHelp
msgbox 0, "..how to compile a file you look here =>"
case %ID_DEBUG
msgbox 0, "..use THINAIR and the BUG ICON, press F8!"
case %ID_HELP
msgbox 0, "read thinbasic manual, take mouse over syntax/word, push F1"
case %ID_HELP1
msgbox 0, "don't use C++ or C# for learning, you choose better thinbasic!"
case %ID_HELP2
msgbox 0, "check again your thinbasic code by DebugModus!"
end select

end select

END FUNCTION

msgbox 0, "I am missing: <menu set color option>"


can anybody create: "menu set color" ? how to do that ?

have still few time to build new things with tbgl or ui. I visit a painting course :)

bye, lydia

martin
04-09-2009, 19:17
Hi Lydia,

I have seen a lot of examples here. thanks (martin for example).

My pleasure :mrgreen:
You know when I discovered ThinBasic some months ago, I found everything very difficult, everything was new for me, especially understanding coding GUI was hard for me, with all those callbacks, messages, events and parameters :? but after some practising it goes better and better. I really have great fun learning ThinBasic and I am sure you do to.

Martin

zlatkoAB
04-09-2009, 22:28
Just one thing C/C++ is not similiar with Net languages like C# .
I really heate Net platform :twisted:

lydia_sp
07-09-2009, 16:13
improved my ui script.

qt again: how to build "set menu color" ? doesnt exist yet as command I am thinking

a) how to create colored button, found nothing at the board
b) mouse over button / menu function would be nice to see how does it works or an example could help?

code as example:


'' my first ui example (lydia)

uses "UI", "console" '' forgotten, sorry

begin const
%ID_OPEN = 401
%ID_OPENCOLOR
%ID_EXIT
%ID_SAVE
%ID_SIZE
%ID_OPTION1
%ID_OPTION2
%ID_OPTION3
%ID_OPTION4
%ID_HELP
%ID_HELP1
%ID_HELP2
%ID_HELP3
%ID_CompileHELP
%ID_ABOUT
%ID_ABOUT1
%ID_ABOUT2
%ID_ABOUT3
%ID_ABOUT4
%ID_DEBUG
%ID_IMPORT
%ID_BASIC
%ID_OK = 1
%ID_CANCEL = 2
%ID_TEXT = 100
%ID_OK1 = 3
%btnClose2
%ID_COLORBUTTON
%statusbar
%frame
%sliderv
%option
%ip
%date
%spinrl
%ID_NEWWINDOW
%TEXTBOX
end const

%sbs_rightalign = &h4&
%sbs_vert = &h1&

dim hParent, style, exstyle, hmdichild as long
dim lColor as long
dim Msg AS LONG
dim wParam AS LONG
dim lParam AS LONG
dim hDlg AS long

TYPE RECT
nLeft AS LONG
nTop AS LONG
nRight AS LONG
nBottom AS LONG
END TYPE


'--------------------------------------------------
FUNCTION TBMain() AS LONG
'--------------------------------------------------
LOCAL hDlg AS long
LOCAL lResult AS LONG
LOCAL hMenu, hMenu1 AS long
LOCAL hPopup1 AS long
LOCAL hPopup2 AS long
LOCAL hPopup3 AS long
LOCAL hPopup4 AS long
LOCAL hPopup5 AS long

MENU NEW BAR TO hMenu
MENU NEW BAR TO hMenu1

' ** Add a top-level menu item with a popup menu:
MENU NEW POPUP TO hPopup1
MENU ADD POPUP, hMenu, "&File", hPopup1, %MF_ENABLED
MENU ADD STRING, hPopup1, "&Open", %ID_OPEN, %MF_CHECKED or %MF_GRAYED
MENU ADD STRING, hPopup1, "&OpenColorbox", %ID_OPENCOLOR, %MF_ENABLED
MENU ADD STRING, hPopup1, "-", 0, 0
MENU ADD STRING, hPopup1, "-www.thinbasic.com-", 1, 1
MENU ADD STRING, hPopup1, "-", 0, 0
MENU ADD STRING, hPopup1, "&Save as..", %ID_SAVE, %MF_CHECKED or %MF_GRAYED
MENU ADD STRING, hPopup1, "-", 0, 0
MENU ADD STRING, hPopup1, "&Exit", %ID_EXIT, %MF_ENABLED

' ** Now we can add another item to the menu that will bring up a sub-menu. First we obtain a new popup menu handle to distinuish it from the first popup menu:
MENU NEW POPUP TO hPopup2
MENU NEW POPUP TO hPopup3
MENU NEW POPUP TO hPopup4

' ** Now add a new menu item to the first menu. This item will bring up the sub-menu when selected:
MENU ADD POPUP, hPopup1, "&More Options for Colours->", hPopup2, %MF_ENABLED

' ** Now we will define the sub menu:
MENU ADD STRING, hPopup2, "Option &1: Blue (B)", %ID_OPTION1, %MF_ENABLED
MENU ADD STRING, hPopup2, "Option &2: Red (R)", %ID_OPTION2, %MF_ENABLED
MENU ADD STRING, hPopup2, "Option &3: Green (G)", %ID_OPTION3, %MF_ENABLED
MENU ADD STRING, hPopup2, "Option &4: Yellow (Y)", %ID_OPTION4, %MF_ENABLED

' ** Finally, we'll add a second top-level menu and popup. For this popup, we can reuse the first popup variable:
MENU NEW POPUP TO hPopup2
MENU ADD POPUP, hMenu, "&Help", hPopup2, %MF_ENABLED
MENU ADD STRING, hPopup2, "&Help", %ID_HELP, %MF_ENABLED
MENU ADD STRING, hPopup2, "-", 0, 0
MENU ADD STRING, hPopup2, "&About", %ID_ABOUT, %MF_ENABLED


MENU NEW POPUP TO hPopup3
MENU ADD POPUP, hMenu, "&Mixed", hPopup3, %MF_ENABLED
MENU ADD STRING, hPopup3, "&basic-Info", %ID_HELP1, %MF_ENABLED
MENU ADD STRING, hPopup3, "-", 0, 0
MENU ADD STRING, hPopup3, "what ? ->", 0, 0
MENU ADD STRING, hPopup3, "empty heart :) ", 0, 0
MENU ADD STRING, hPopup3, "&RealMadrid", %ID_ABOUT1, %MF_ENABLED
MENU ADD STRING, hPopup3, "&Kings & Queens", %ID_ABOUT2, %MF_ENABLED

MENU NEW POPUP TO hPopup4
MENU ADD POPUP, hMenu, "&Compile fast", hPopup4, %MF_ENABLED
MENU ADD STRING, hPopup4, "&Compile_Help", %ID_CompileHELP, %MF_ENABLED

MENU ADD STRING, hPopup4, "&DebugModus", %ID_DEBUG, %MF_ENABLED
MENU ADD STRING, hPopup4, "BundleMe", 0, 0
MENU ADD STRING, hPopup4, "-", 0, 0
MENU ADD STRING, hPopup4, "Import Data", %ID_IMPORT, %MF_ENABLED
MENU ADD STRING, hPopup4, "&LydiaBasic", %ID_BASIC, %MF_ENABLED

MENU NEW POPUP TO hPopup5
MENU ADD POPUP, hMenu, "&WindowSize", hPopup5, %MF_ENABLED '' ok:)
MENU ADD STRING, hPopup5, "-", 0, 0
MENU ADD STRING, hPopup5, "&SizeMe", %ID_Size, %MF_ENABLED

'' MENU SET COLOR hdlg, 120,255

' ** Create a new dialog template
DIALOG NEW 0, "What's your name, thinbasic user?", -1, -1, 240, 200, _
%WS_DLGFRAME OR %DS_CENTER OR %WS_CAPTION OR %WS_SYSMENU OR %WS_OVERLAPPEDWINDOW, _
0 TO hDlg
DIALOG SET COLOR hDlg, 80,150
DIALOG SET MINSIZE hDlg, 220, 180

'---Attach menu to dialog
MENU ATTACH hMenu, hDlg

'' ** Display the dialog
' DIALOG SHOW modal hDlg call dlgCallback

DIALOG SHOW MODELESS hDlg, CALL dlgCallback
LOCAL Count as long
DO
DIALOG DOEVENTS TO Count
LOOP UNTIL Count = 0

end function

'--------------------------------------------------
callback function dlgCallback() as long
'--------------------------------------------------

local UserName as string
local MovieName as string

select case cbmsg

case %WM_INITDIALOG '---Message fired at the very beginning when dialog is initialized
'---Add relevant controls
CONTROL ADD TEXTBOX , cbhndl, %ID_TEXT, "", 14, 12, 134, 12, 0
CONTROL ADD BUTTON , cbhndl, %ID_OK, "OK", 14, 32, 40, 14, %BS_DEFAULT
CONTROL ADD BUTTON , cbhndl, %ID_OK1, "MovieStar", 56, 32, 40, 14, %BS_DEFAULT
CONTROL ADD BUTTON , cbhndl, %ID_CANCEL, "Cancel", 100, 32, 40, 14, 0
CONTROL ADD BUTTON , cbhndl, %ID_NEWWINDOW, "newWin", 146, 32, 40, 14, 0
CONTROL ADD LABEL , cbhndl, %ID_CANCEL, "summer is always on my side, you prefer dancing more than drinking all night long!", 50, 64, 80, 36, 0

CONTROL ADD LABEL, cbhndl, %ID_COLORBUTTON, "ColorButton", 192, 10, 44, 44, %SS_NOTIFY or %SS_CENTER or %SS_CENTERIMAGE or %SS_SUNKEN
CONTROL ADD "sysdatetimepick32" , cbhndl, %date, "30.08.2009", 134, 120, 60, 14, %ws_child or %ws_visible

CONTROL ADD "msctls_statusbar32" , cbhndl, %statusbar, "statusbar: lydia tb infected", 0, 457, 490, 23, %ws_child or %ws_visible
StatusBar_SetParts cbhndl, %STATUSBAR, 140, 200, -1
control add "msctls_trackbar32" , cbhndl, %sliderv, "slide-me", 210, 66, 18, 84, %ws_child or %ws_visible or %tbs_autoticks or %tbs_vert
control add frame , cbhndl, %frame, "frame_lyd", 8, 52, 194, 114
control add option , cbhndl, %option, "show me", 24, 150, 44, 10
control add option , cbhndl, %option, "switch to c++", 68, 150, 60, 10
control add option , cbhndl, %option, "turn thinbasic", 128, 150, 60, 10
control add "sysipaddress32" , cbhndl, %ip, "10.11.58.57", 22, 104, 128, 14, %ws_child or %ws_visible
CONTROL ADD LABEL , cbhndl, %ID_CANCEL, " <type your ip adress!>", 24, 122, 74, 10, 0

case %WM_Command
select case cbctl
case %ID_EXIT, %ID_CANCEL
msgbox 0, "ok, you leave me!"
dialog end cbhndl

case %ID_OK
CONTROL GET TEXT cbhndl, %ID_TEXT TO UserName
if UserName = "" then
msgbox cbhndl, "Please, specify a name", %MB_ICONEXCLAMATION
else
msgbox cbhndl, "Hello mr./mrs. " & UserName
end if

case %ID_OK1
CONTROL GET TEXT cbhndl, %ID_TEXT TO MovieName
if MovieName = "" then
msgbox cbhndl, "Please, speak and spell..", %MB_ICONEXCLAMATION
else
msgbox cbhndl, "Hello famous moviestar: " & MovieName
return 1 = %true
end if

case %ID_NEWWINDOW
msgbox 0, "how to open a new window with same gui ?"

Style = %WS_CHILD | %DS_MODALFRAME | %WS_CAPTION | %WS_MINIMIZEBOX | %WS_MAXIMIZEBOX | %WS_SYSMENU | %WS_CLIPSIBLINGS
ExStyle = %WS_EX_MDICHILD | %WS_EX_CONTROLPARENT
Dialog New hParent, "new Window with Button and GUI", 0, 0, 267, 138, Style, ExStyle To hMDIChild

'' better =>
if CBCTLMSG = %BN_CLICKED THEN
Create_NewWinDialog()
end if

case %ID_OPENCOLOR
lColor = Dialog_ChooseColor(0, rgb(255, 0, 0), %CC_RGBINIT OR %CC_FULLOPEN )
if lColor = -1 then
msgbox 0, "Color Dialog cancel by user"
else
msgbox 0, "Your color is: " & hex$(lColor, 6)
end if

case %ID_ABOUT
msgbox 0, "you are using: thinbasic vol 1.7.9.0 :)"
' ** Create a new dialog template
case %ID_ABOUT1
msgbox 0, "No goal for you today, raśl, mr. soccer star!"
case %ID_ABOUT2
msgbox 0, "the drunken queen wanted to have some new butlers!"
case %ID_IMPORT
msgbox 0, "load my personal data to the script!"
case %ID_BASIC
msgbox 0, "..but try LydiasAIR cause it's better to compile! :)"
case %ID_CompileHelp
msgbox 0, "..how to compile a file you look here =>"
case %ID_DEBUG
msgbox 0, "..use THINAIR and the BUG ICON, press F8!"
case %ID_HELP
msgbox 0, "read thinbasic manual, take mouse over syntax/word, push F1"
case %ID_HELP1
msgbox 0, "don't use C++ or C# for learning, you choose better thinbasic!"
case %ID_HELP2
msgbox 0, "check again your thinbasic code by DebugModus!"
case %ID_COLORBUTTON
msgbox 0, "change background color of button "
control set color cbhndl, %ID_COLORBUTTON, rgb(255,40,0), rgb(0,40,255)
'control set color cbhndl, %ID_COLORBUTTON, rgb(0,140,250), rgb(200,0,255)
control redraw cbhndl, %ID_COLORBUTTON

end select

case %WM_MOVING
local RC as RECT ptr
RC = cblParam
printl time$, "Fired %WM_MOVING dialog message", RC.nLeft, RC.nTop, RC.nRight, RC.nBottom

end select

END FUNCTION

'msgbox 0, "UI command I am missing: 'MENU SET COLOR' option"


FUNCTION Create_NewWinDialog()
LOCAL hDlg AS LONG

DIALOG NEW 0, "Lydias_Window", 40, 220, 160, 120, _
%WS_POPUP OR %WS_VISIBLE OR _
%WS_CLIPCHILDREN OR %WS_CAPTION OR _
%WS_SYSMENU OR %WS_MINIMIZEBOX, 0 TO hDlg

' -- Place controls here

CONTROL ADD BUTTON, hDlg, %btnClose2, "LydiaClose", 95, 90, 60, 14
CONTROL ADD "sysdatetimepick32" , hdlg, %date, "30.08.2009", 14, 12, 60, 14, %ws_child or %ws_visible
CONTROL ADD "msctls_statusbar32" , hdlg, %statusbar, "new statusbar for wheather", 0, 20, 28, 23, %ws_child or %ws_visible
Control Add TextBox, hdlg, %TEXTBOX, "", 20, 36, 47, 50, _
%WS_CHILD Or %WS_VISIBLE Or %ES_MULTILINE Or %ES_WANTRETURN Or %ES_LEFT Or %WS_TABSTOP, _
%WS_EX_CLIENTEDGE
CONTROL ADD LABEL, hdlg, %ID_COLORBUTTON, "simple Textbox", 72, 40, 54, 14, %SS_NOTIFY or %SS_CENTER or %SS_CENTERIMAGE or %SS_SUNKEN
StatusBar_SetParts hdlg, %STATUSBAR, 140, 200, -1


DIALOG SHOW MODELESS hDlg, call NewWind_DlgProc

END FUNCTION


CALLBACK FUNCTION NewWind_DlgProc()

SELECT CASE CBMsg
CASE %WM_Command
' -- Here you can process the input from controls
SELECT CASE CBCtl
CASE %btnClose2
if CBCTLMSG = %BN_CLICKED THEN
dialog end cbhndl
END IF

END SELECT
END SELECT

END FUNCTION

I will expand my script. it`s a beginning to learn with complex ui commands and callbacks.

edit: I have corrected my script, thursday.

best regards to all, Lydia

ps: @zlatko, I know the different between c++ / c# using ;)

lydia_sp
08-09-2009, 14:04
have forgotten console word (line one) in my last script, sorry:

uses "ui", "console", then script works 100 per cent perfect!

lydia

Petr Schreiber
08-09-2009, 16:12
Hi Lydia,

menu set color is not provided by thinBasic.
Coloring buttons also not - because "classic" win32 buttons don't support it.

You may try CONTROL ADD XPBUTTON, it is used in samplescripts to use image on button.

I think mouse over is not standard Win32 message as well, so you have to handle %WM_MOUSEMOVE and test, if the mouse is in the region of button.

I hope it helps!


Petr

zlatkoAB
08-09-2009, 18:09
Yes i think that is not change button color becose is buttons thamed
with manifest.In CB i can change button color but only classic stayle
button not XP themed..

lydia_sp
09-09-2009, 17:19
thanks petr, slatko for replies.

I am a little proud to manage "mouse over" functions for my new open window in script ! 8) needed some minutes to found the problem ;)


'' my first ui example (lydia), sept''2009_lyd

uses "UI", "UIAdv","console"

begin const
%ID_OPEN = 401
%IDC_BUTTON1 = 101
%ID_CancelXP
%ID_OPENCOLOR
%ID_EXIT
%ID_SAVE
%ID_SIZE
%ID_OPTION1
%ID_OPTION2
%ID_OPTION3
%ID_OPTION4
%ID_HELP
%ID_HELP1
%ID_HELP2
%ID_HELP3
%ID_CompileHELP
%ID_ABOUT
%ID_ABOUT1
%ID_ABOUT2
%ID_ABOUT3
%ID_ABOUT4
%ID_DEBUG
%ID_IMPORT
%ID_BASIC
%ID_OK = 1
%ID_CANCEL = 2
%ID_TEXT = 100
%ID_OK1 = 3
%btnClose2
%ID_COLORBUTTON
%statusbar
%frame
%sliderv
%option
%ip
%date
%time
%spinrl
%ID_NEWWINDOW
%TEXTBOX
%btn_OK = 102
%txt_Result = 103

end const

%sbs_rightalign = &h4&
%sbs_vert = &h1&

dim hParent, style, exstyle, hmdichild as long
dim lColor as long
dim Msg AS LONG
dim wParam AS LONG
dim lParam AS LONG
dim hDlg AS long
dim hBtn_OK as dword
dim pt as POINTAPI
dim rc as RECT

TYPE RECT
nLeft AS LONG
nTop AS LONG
nRight AS LONG
nBottom AS LONG
END TYPE

TYPE POINTAPI
x AS LONG
y AS LONG
END TYPE

DECLARE FUNCTION PtInRect LIB "USER32.DLL" ALIAS "PtInRect" (lpRect AS RECT, BYVAL ptx AS LONG, BYVAL pty AS LONG) AS LONG
DECLARE FUNCTION SetCapture LIB "USER32.DLL" ALIAS "SetCapture" (BYVAL hWnd AS DWORD) AS LONG
DECLARE FUNCTION ReleaseCapture LIB "USER32.DLL" ALIAS "ReleaseCapture" () AS LONG
DECLARE FUNCTION GetCursorPos LIB "USER32.DLL" ALIAS "GetCursorPos" (lpPoint AS POINTAPI) AS LONG
DECLARE FUNCTION GetWindowRect LIB "USER32.DLL" ALIAS "GetWindowRect" (BYVAL hWnd AS DWORD, lpRect AS RECT) AS LONG

'--------------------------------------------------
FUNCTION TBMain() AS LONG
'--------------------------------------------------
LOCAL hDlg AS long
LOCAL lResult AS LONG
LOCAL hMenu, hMenu1 AS long
LOCAL hPopup1 AS long
LOCAL hPopup2 AS long
LOCAL hPopup3 AS long
LOCAL hPopup4 AS long
LOCAL hPopup5 AS long

MENU NEW BAR TO hMenu
MENU NEW BAR TO hMenu1

' ** Add a top-level menu item with a popup menu:
MENU NEW POPUP TO hPopup1
MENU ADD POPUP, hMenu, "&File", hPopup1, %MF_ENABLED
MENU ADD STRING, hPopup1, "&Open", %ID_OPEN, %MF_CHECKED or %MF_GRAYED
MENU ADD STRING, hPopup1, "&OpenColorbox", %ID_OPENCOLOR, %MF_ENABLED
MENU ADD STRING, hPopup1, "-", 0, 0
MENU ADD STRING, hPopup1, "-www.thinbasic.com-", 1, 1
MENU ADD STRING, hPopup1, "-", 0, 0
MENU ADD STRING, hPopup1, "&Save as..", %ID_SAVE, %MF_CHECKED or %MF_GRAYED
MENU ADD STRING, hPopup1, "-", 0, 0
MENU ADD STRING, hPopup1, "&Exit", %ID_EXIT, %MF_ENABLED

' ** Now we can add another item to the menu that will bring up a sub-menu. First we obtain a new popup menu handle to distinuish it from the first popup menu:
MENU NEW POPUP TO hPopup2
MENU NEW POPUP TO hPopup3
MENU NEW POPUP TO hPopup4

' ** Now add a new menu item to the first menu. This item will bring up the sub-menu when selected:
MENU ADD POPUP, hPopup1, "&More Options for Colours->", hPopup2, %MF_ENABLED

' ** Now we will define the sub menu:
MENU ADD STRING, hPopup2, "Option &1: Blue (B)", %ID_OPTION1, %MF_ENABLED
MENU ADD STRING, hPopup2, "Option &2: Red (R)", %ID_OPTION2, %MF_ENABLED
MENU ADD STRING, hPopup2, "Option &3: Green (G)", %ID_OPTION3, %MF_ENABLED
MENU ADD STRING, hPopup2, "Option &4: Yellow (Y)", %ID_OPTION4, %MF_ENABLED

' ** Finally, we'll add a second top-level menu and popup. For this popup, we can reuse the first popup variable:
MENU NEW POPUP TO hPopup2
MENU ADD POPUP, hMenu, "&Help", hPopup2, %MF_ENABLED
MENU ADD STRING, hPopup2, "&Help", %ID_HELP, %MF_ENABLED
MENU ADD STRING, hPopup2, "-", 0, 0
MENU ADD STRING, hPopup2, "&About", %ID_ABOUT, %MF_ENABLED

MENU NEW POPUP TO hPopup3
MENU ADD POPUP, hMenu, "&Mixed", hPopup3, %MF_ENABLED
MENU ADD STRING, hPopup3, "&basic-Info", %ID_HELP1, %MF_ENABLED
MENU ADD STRING, hPopup3, "-", 0, 0
MENU ADD STRING, hPopup3, "what ? ->", 0, 0
MENU ADD STRING, hPopup3, "empty heart :) ", 0, 0
MENU ADD STRING, hPopup3, "&RealMadrid", %ID_ABOUT1, %MF_ENABLED
MENU ADD STRING, hPopup3, "&Kings & Queens", %ID_ABOUT2, %MF_ENABLED

MENU NEW POPUP TO hPopup4
MENU ADD POPUP, hMenu, "&Compile fast", hPopup4, %MF_ENABLED
MENU ADD STRING, hPopup4, "&Compile_Help", %ID_CompileHELP, %MF_ENABLED

MENU ADD STRING, hPopup4, "&DebugModus", %ID_DEBUG, %MF_ENABLED
MENU ADD STRING, hPopup4, "BundleMe", 0, 0
MENU ADD STRING, hPopup4, "-", 0, 0
MENU ADD STRING, hPopup4, "Import Data", %ID_IMPORT, %MF_ENABLED
MENU ADD STRING, hPopup4, "&LydiaBasic", %ID_BASIC, %MF_ENABLED

MENU NEW POPUP TO hPopup5
MENU ADD POPUP, hMenu, "&WindowSize", hPopup5, %MF_ENABLED '' ok:)
MENU ADD STRING, hPopup5, "-", 0, 0
MENU ADD STRING, hPopup5, "&SizeMe", %ID_Size, %MF_ENABLED

'' MENU SET COLOR hdlg, 120,255

' ** Create a new dialog template
DIALOG NEW 0, "What's your name, thinbasic user?", -1, -1, 240, 200, _
%WS_DLGFRAME OR %DS_CENTER OR %WS_CAPTION OR %WS_SYSMENU OR %WS_OVERLAPPEDWINDOW, _
0 TO hDlg
DIALOG SET COLOR hDlg, 80,150
DIALOG SET MINSIZE hDlg, 220, 180

'---Attach menu to dialog
MENU ATTACH hMenu, hDlg

'' ** Display the dialog
' DIALOG SHOW modal hDlg call dlgCallback

DIALOG SHOW MODELESS hDlg, CALL dlgCallback
LOCAL Count as long
DO
DIALOG DOEVENTS TO Count
LOOP UNTIL Count = 0

end function

'--------------------------------------------------
callback function dlgCallback() as long
'--------------------------------------------------

local UserName as string
local MovieName as string

select case cbmsg

case %WM_INITDIALOG '---Message fired at the very beginning when dialog is initialized
'---Add relevant controls
CONTROL ADD TEXTBOX , cbhndl, %ID_TEXT, "", 14, 12, 134, 12, 0
CONTROL ADD BUTTON , cbhndl, %ID_OK, "OK", 14, 32, 40, 14, %BS_DEFAULT
CONTROL ADD BUTTON , cbhndl, %ID_OK1, "MovieStar", 56, 32, 40, 14, %BS_DEFAULT
CONTROL ADD BUTTON , cbhndl, %ID_CANCEL, "Cancel", 100, 32, 40, 14, 0
CONTROL ADD BUTTON , cbhndl, %ID_NEWWINDOW, "newLydWin", 146, 32, 44, 14, 0
CONTROL ADD LABEL , cbhndl, %ID_CANCEL, "summer is always on my side, you prefer dancing more than drinking all night long!", 50, 64, 80, 36, 0

CONTROL ADD LABEL, cbhndl, %ID_COLORBUTTON, "Push_Button!", 192, 10, 44, 44, %SS_NOTIFY or %SS_CENTER or %SS_CENTERIMAGE or %SS_SUNKEN
CONTROL ADD "sysdatetimepick32" , cbhndl, %date, "30.08.2009", 134, 120, 60, 14, %ws_child or %ws_visible

CONTROL ADD "msctls_statusbar32" , cbhndl, %statusbar, "statusbar: lydia tb infected", 0, 457, 490, 23, %ws_child or %ws_visible
StatusBar_SetParts cbhndl, %STATUSBAR, 140, 200, -1
control add "msctls_trackbar32" , cbhndl, %sliderv, "slide-me", 210, 66, 18, 84, %ws_child or %ws_visible or %tbs_autoticks or %tbs_vert
control add frame , cbhndl, %frame, "frame_lyd", 8, 52, 194, 114
control add option , cbhndl, %option, "show me", 24, 150, 44, 10
control add option , cbhndl, %option, "switch to c++", 68, 150, 60, 10
control add option , cbhndl, %option, "turn thinbasic", 128, 150, 60, 10
control add "sysipaddress32" , cbhndl, %ip, "10.11.58.57", 22, 104, 128, 14, %ws_child or %ws_visible
CONTROL ADD LABEL , cbhndl, %ID_CANCEL, " <type your ip adress!>", 24, 122, 74, 10, 0

case %WM_Command
select case cbctl
case %ID_EXIT, %ID_CANCEL
msgbox 0, "ok, you leave me!"
dialog end cbhndl

case %ID_OK
CONTROL GET TEXT cbhndl, %ID_TEXT TO UserName
if UserName = "" then
msgbox cbhndl, "Please, specify a name", %MB_ICONEXCLAMATION
else
msgbox cbhndl, "Hello mr./mrs. " & UserName
end if

case %ID_OK1
CONTROL GET TEXT cbhndl, %ID_TEXT TO MovieName
if MovieName = "" then
msgbox cbhndl, "Please, speak and spell..", %MB_ICONEXCLAMATION
else
msgbox cbhndl, "Hello famous moviestar: " & MovieName
return 1 = %true
end if

case %ID_NEWWINDOW
msgbox 0, " -> open a new window with more functions! "

Style = %WS_CHILD | %DS_MODALFRAME | %WS_CAPTION | %WS_MINIMIZEBOX | %WS_MAXIMIZEBOX | %WS_SYSMENU | %WS_CLIPSIBLINGS
ExStyle = %WS_EX_MDICHILD | %WS_EX_CONTROLPARENT
Dialog New hParent, "new Window with Button and GUI", 0, 0, 267, 138, Style, ExStyle To hMDIChild

'' better =>
if CBCTLMSG = %BN_CLICKED THEN
Create_NewWinDialog()
end if

case %ID_OPENCOLOR
lColor = Dialog_ChooseColor(0, rgb(255, 0, 0), %CC_RGBINIT OR %CC_FULLOPEN )
if lColor = -1 then
msgbox 0, "Color Dialog cancel by user"
else
msgbox 0, "Your color is: " & hex$(lColor, 6)
end if

case %ID_ABOUT
msgbox 0, "you are using: thinbasic vol 1.7.9.0 :)"
' ** Create a new dialog template
case %ID_ABOUT1
msgbox 0, "No goal for you today, raśl, mr. soccer star!"
case %ID_ABOUT2
msgbox 0, "the drunken queen wanted to have some new butlers!"
case %ID_IMPORT
msgbox 0, "load my personal data to the script!"
case %ID_BASIC
msgbox 0, "..but try LydiasAIR cause it's better to compile! :)"
case %ID_CompileHelp
msgbox 0, "..how to compile a file you look here =>"
case %ID_DEBUG
msgbox 0, "..use THINAIR and the BUG ICON, press F8!"
case %ID_HELP
msgbox 0, "read thinbasic manual, take mouse over syntax/word, push F1"
case %ID_HELP1
msgbox 0, "don't use C++ or C# for learning, you choose better thinbasic!"
case %ID_HELP2
msgbox 0, "check again your thinbasic code by DebugModus!"
case %ID_COLORBUTTON
msgbox 0, "change background color of button "
control set color cbhndl, %ID_COLORBUTTON, rgb(255,40,0), rgb(0,40,255)
'control set color cbhndl, %ID_COLORBUTTON, rgb(0,140,250), rgb(200,0,255)
control redraw cbhndl, %ID_COLORBUTTON

case %WM_MOVING
local RC as RECT ptr
RC = cblParam
printl time$, "Fired %WM_MOVING dialog message", RC.nLeft, RC.nTop, RC.nRight, RC.nBottom

End Select
End Select

END FUNCTION


FUNCTION Create_NewWinDialog()
LOCAL hDlg AS LONG

DIALOG NEW 0, "Lydias_Multy_Window", 40, 220, 260, 120, _
%WS_POPUP OR %WS_VISIBLE OR _
%WS_CLIPCHILDREN OR %WS_CAPTION OR _
%WS_SYSMENU OR %WS_MINIMIZEBOX, 0 TO hDlg

' -- Place controls here

CONTROL ADD BUTTON, hDlg, %btnClose2, "LydiaClose", 82, 90, 56, 14
CONTROL ADD "sysdatetimepick32" , hdlg, %time, "20:16:57", 14, 12, 60, 14, %ws_child or %ws_visible or %dts_timeformat
CONTROL ADD "msctls_statusbar32" , hdlg, %statusbar, "new statusbar for wheather", 0, 20, 28, 23, %ws_child or %ws_visible
Control Add TextBox, hdlg, %txt_Result, "", 20, 36, 47, 50, _
%WS_CHILD Or %WS_VISIBLE Or %ES_MULTILINE Or %ES_WANTRETURN Or %ES_LEFT Or %WS_TABSTOP, _
%WS_EX_CLIENTEDGE
CONTROL ADD LABEL, hdlg, %ID_COLORBUTTON, "<= simple Textbox", 72, 40, 60, 14, %SS_NOTIFY or %SS_CENTER or %SS_CENTERIMAGE or %SS_SUNKEN
StatusBar_SetParts hdlg, %STATUSBAR, 140, 200, -1

'' xp button controls ----------------

Control Add XPBUTTON, hDlg, %IDC_BUTTON1, "", 140, 16, 105, 85, %WS_TABSTOP Or %WS_VISIBLE Or %WS_CHILD

XPButton_SetImagePos hDlg, %IDC_BUTTON1, %XPBUTTON_CENTERCENTER
XPButton_SetIcon hDlg, %IDC_BUTTON1, app_sourcepath & "gibson-dogge2.ico", %XPBUTTON_NORMAL
XPButton_SetImageSize hDlg, %IDC_BUTTON1, 150, 128, %TRUE
CONTROL ADD LABEL, hdlg, %IDC_BUTTON1, "Click DogPicture", 142, 2, 60, 14, %SS_NOTIFY or %SS_CENTER or %SS_CENTERIMAGE or %SS_SUNKEN

''------------------------------------

CONTROL ADD textbox , hDlg, %txt_Result , " " , 80, 12, 60, 14, %WS_TABSTOP '' mouseover can be seen here!
CONTROL ADD BUTTON , hDlg, %btn_OK , "MOUSE_OVER_OK?" , 6, 90, 74, 14, %WS_TABSTOP
CONTROL HANDLE hDlg, %btn_OK to hBtn_OK

DIALOG SHOW MODELESS hDlg, call NewWind_DlgProc

END FUNCTION


'' new lyd window with functions and callbacks -------------

CALLBACK FUNCTION NewWind_DlgProc()

SELECT CASE CBMsg

'' lyd partido begin ---------------------------------------------------------

'' -- mouse move over..

case %WM_MOUSEMOVE
SetCapture cbhndl

GetCursorPos pt
GetWindowRect hBtn_OK, rc

IF ptInRect(rc,pt.x,pt.y) THEN
control set text cbhndl, %txt_Result, "hurray! the mighty Mouse found this great BUTTON!"
ELSE
control set text cbhndl, %txt_Result, ""
END IF

ReleaseCapture

'' lyd partido fin --------------------------------------------

CASE %WM_Command
' -- Here you can process the input from controls
SELECT CASE CBCtl
CASE %btnClose2
if CBCTLMSG = %BN_CLICKED THEN
dialog end cbhndl
END IF
CASE %ID_CANCELXP
IF CBCTLMSG = %BN_CLICKED THEN DIALOG END CBHNDL
CASE %IDC_BUTTON1
IF CBCTLMSG = %BN_CLICKED THEN
MSGBOX 0, "largest 'Gibson doggy' of world died one month ago :("
END IF
CASE %btn_OK
IF CBCTLMSG = %BN_CLICKED THEN
MSGBOX 0, "Great, you win the cup!"
END IF

END SELECT

END SELECT

END FUNCTION

'' printl "lydias multiwindow testscript starter, push a KEY"

'' printl waitkey


1) open "newWin" and you get new window (lydias multywindow). then move mouse over button_mouseover_ok? and in text field (rectangle kind, textbox) the message should appear "hurray the mighty mouse found the button!" this little code part takes nearly half an hour to found the solution!!!

2) click the dog picture, new message open (xp-button style), I managed this little nice thing!

any feedback will be welcome and useful.

it`s not the perfect solution for move mouse over (this command I am still missing for ui module), but this solution works. perhaps one profi can show nother way ?

thanks petr for using %wm_movemouse feature hint :)

take care good guys, lydia

Petr Schreiber
09-09-2009, 17:32
Hi Lydia,

congratulations!
Maybe you could post your solution to your problem here so others can learn from it too?


Thanks,
Petr

lydia_sp
10-09-2009, 11:46
(loading times of this board ui/my first ui example are very long, don`t know why, anybody can check?)

@petr: take the long way to answer. not usual for me.

it's a little pleasure. ok. what kind of reward I can get from you for my solution? free voyage to usa (california) or galapagos island ?

although there were more to understand than this line for me (as martin said it was all new for him at his start with callbacks and ui!), here my solution.

make it short and simple: you shouldn't use "hdlg" or other silly things in "callback functions" !!!
better always use: "cbhndl".

! I repeat: you better and always use: "cbhndl". in "callback functions" !!!

it's like using salt, pepper for your meat and soup.

I changed / arranged order of %wm command at second place, %wm_mousemove at first place. this takes 5 minutes to find out.

"control add textbox" or "control add button" and more you can use "hDlg" without problems.


first:




FUNCTION Create_NewWinDialog()

''..

CONTROL ADD textbox , hDlg, %txt_Result , " " , 80, 12, 60, 14, %WS_TABSTOP '' mouseover can be seen here!
CONTROL ADD BUTTON , hDlg, %btn_OK , "MOUSE_OVER_OK?" , 6, 90, 74, 14, %WS_TABSTOP
CONTROL HANDLE hDlg, %btn_OK to hBtn_OK

DIALOG SHOW MODELESS hDlg, call NewWind_DlgProc



mouse over function doesn't work for me withouth: "CONTROL HANDLE hDlg, %btn_OK to hBtn_OK" that takes 10 minutes to find out.

I am new here, don't forget! I am no teacher for thinbasic ui module! learning by doing and making experiments. best side of learning faster I suppose.


second:



CALLBACK FUNCTION NewWind_DlgProc()

SELECT CASE CBMsg

'' lyd partido begin ---------------------------------------------------------

'' -- mouse move over..

case %WM_MOUSEMOVE
SetCapture cbhndl

GetCursorPos pt
GetWindowRect hBtn_OK, rc

IF ptInRect(rc,pt.x,pt.y) THEN
control set text cbhndl, %txt_Result, "hurray! the mighty Mouse found this great BUTTON!"
ELSE
control set text cbhndl, %txt_Result, ""
END IF

ReleaseCapture

'' lyd partido fin --------------------------------------------

CASE %WM_Command
' -- Here you can process the input from controls
SELECT CASE CBCtl
CASE %btnClose2
if CBCTLMSG = %BN_CLICKED THEN
dialog end cbhndl
END IF
CASE %ID_CANCELXP
IF CBCTLMSG = %BN_CLICKED THEN DIALOG END CBHNDL
CASE %IDC_BUTTON1
IF CBCTLMSG = %BN_CLICKED THEN
MSGBOX 0, "largest 'Gibson doggy' of world died one month ago :("
END IF
CASE %btn_OK
IF CBCTLMSG = %BN_CLICKED THEN
MSGBOX 0, "Great, you win the cup!"
END IF

END SELECT

END SELECT

END FUNCTION


takes again 20 minutes to check how to fit callbacks and controls all together !

qt: "cbhndl" does meaning: callbackhandle. ? it`s a metafile, so I have no possibilities to check the syntax or background infos.

I was very glad to find this solution for me! checked other callback scripts from thinbasic sample script folder. takes some minutes (over one, two hours! ). after that my mind was full of new commands and callback using, confused more than beginning. I am learning with my script step by step. no one thousand kilo pounds weight will beat me falling from heaven on my head.

hope this helps new users. like to myself or newbies.

nobody can really understand how's feeling to learn new coding (ui module) language, the script is working fine, if you are a professional thinbasic (powerbasic) user like most guys here. my opinion. better to have a closer look for beginners and patience to help or making tutorials. the hurdle is high to understand new chapters like "tbgl/ui module" for non-using-thinbasic language users. oxygen and assembler coding was fitted for professional users too, I have seen at this forum. I like this forum. it's alive ! but I am missing also new users showing their projects. perhaps they are afraid of blaming themselves showing not running tb codes full of mistakes ? everybody begins with an interesting, simple example you wished to program and you use help from other users here. that's fine, cause the help of other users is really ok here! but would like to see more of new people with questions about their tb scripts :)

I don't dare to use oxygen yet! I am happy to understand one piece of fancy cake to ui module / tbgl module. I don't learn new language to speak in one week or month. I suggest you know what I mean. I can motivate myself:
if the script show good results I am always happy.


competition for advanced users: how many minutes I needed for this script ? I wish to have a serious tb ui script with result and callback functions in minutes!

the example is going on. all work in progress.

thanks back. lydia. life is precious, positive and full of wonder. thinbasic is like good icecream in summer

Petr Schreiber
10-09-2009, 12:15
what kind of reward I can get from you for my solution? free voyage to usa (california) or galapagos island ?

The best reward is the feeling of victory of mind over code, isn't it :)

CBHNDL = Callback Handle
CBMSG = Callback Message
CBCTL = Callback Control
CBCTLMSG = Callback Control Message

Maybe more easy to read Callback_Handle, Callback_Message, Callback_Control, Callback_ControlMessage would be better for you?

Just add following on the top of the script:


ALIAS CBHNDL AS Callback_Handle
ALIAS CBMSG AS Callback_Message
ALIAS CBCTL AS Callback_Control
ALIAS CBCTLMSG AS Callback_ControlMessage


... and you can use it in your code, for better clarity.

Tutorials ... yes, sure they are useful for the beginners. You can find some introduction to callback programming in ThinBASIC Journal #2 (http://community.thinbasic.com/index.php?topic=2310.0). I recommend to read it for better understanding of the callback world.

lydia_sp
10-09-2009, 17:03
hi petr, thanks for explanations :)

here my last example.


'' --------------------------------------------
'' my first ui example (lydia), sept''2009_lyd
'' --------------------------------------------

uses "UI", "UIAdv","console"

ALIAS CBHNDL AS Callback_Handle
ALIAS CBMSG AS Callback_Message
ALIAS CBCTL AS Callback_Control
ALIAS CBCTLMSG AS Callback_ControlMessage

begin const
%ID_OPEN = 401
%IDC_BUTTON1 = 100
%IDC_BUTTON2 = 101
%ID_CancelXP
%ID_OPENCOLOR
%ID_EXIT
%ID_SAVE
%ID_SIZE
%ID_OPTION1
%ID_OPTION2
%ID_OPTION3
%ID_OPTION4
%ID_HELP
%ID_HELP1
%ID_HELP2
%ID_HELP3
%ID_CompileHELP
%ID_ABOUT
%ID_ABOUT1
%ID_ABOUT2
%ID_ABOUT3
%ID_ABOUT4
%ID_DEBUG
%ID_IMPORT
%ID_BASIC
%ID_OK = 1
%ID_CANCEL = 2
%ID_TEXT = 102
%ID_OK1 = 3
%btnClose2
%ID_COLORBUTTON
%statusbar
%frame
%sliderv
%option
%ip
%date
%time
%spinrl
%ID_NEWWINDOW
%TEXTBOX
%btn_OK = 103
%txt_Result = 104
%txt_Result2 = 105
end const

%sbs_rightalign = &h4&
%sbs_vert = &h1&

dim hParent, style, exstyle, hmdichild as long
dim lColor as long
dim Msg AS LONG
dim wParam AS LONG
dim lParam AS LONG
dim hDlg AS long
dim hBtn_OK,hBtn_OK2 as dword
dim pt as POINTAPI
dim rc as RECT

TYPE RECT
nLeft AS LONG
nTop AS LONG
nRight AS LONG
nBottom AS LONG
END TYPE

TYPE POINTAPI
x AS LONG
y AS LONG
END TYPE

DECLARE FUNCTION PtInRect LIB "USER32.DLL" ALIAS "PtInRect" (lpRect AS RECT, BYVAL ptx AS LONG, BYVAL pty AS LONG) AS LONG
DECLARE FUNCTION SetCapture LIB "USER32.DLL" ALIAS "SetCapture" (BYVAL hWnd AS DWORD) AS LONG
DECLARE FUNCTION ReleaseCapture LIB "USER32.DLL" ALIAS "ReleaseCapture" () AS LONG
DECLARE FUNCTION GetCursorPos LIB "USER32.DLL" ALIAS "GetCursorPos" (lpPoint AS POINTAPI) AS LONG
DECLARE FUNCTION GetWindowRect LIB "USER32.DLL" ALIAS "GetWindowRect" (BYVAL hWnd AS DWORD, lpRect AS RECT) AS LONG

'--------------------------------------------------
FUNCTION TBMain() AS LONG
'--------------------------------------------------
LOCAL hDlg AS long
LOCAL lResult AS LONG
LOCAL hMenu, hMenu1 AS long
LOCAL hPopup1 AS long
LOCAL hPopup2 AS long
LOCAL hPopup3 AS long
LOCAL hPopup4 AS long
LOCAL hPopup5 AS long

MENU NEW BAR TO hMenu
MENU NEW BAR TO hMenu1

' ** Add a top-level menu item with a popup menu:
MENU NEW POPUP TO hPopup1
MENU ADD POPUP, hMenu, "&File", hPopup1, %MF_ENABLED
MENU ADD STRING, hPopup1, "&Open", %ID_OPEN, %MF_CHECKED or %MF_GRAYED
MENU ADD STRING, hPopup1, "&OpenColorbox", %ID_OPENCOLOR, %MF_ENABLED
MENU ADD STRING, hPopup1, "-", 0, 0
MENU ADD STRING, hPopup1, "-www.thinbasic.com-", 1, 1
MENU ADD STRING, hPopup1, "-", 0, 0
MENU ADD STRING, hPopup1, "&Save as..", %ID_SAVE, %MF_CHECKED or %MF_GRAYED
MENU ADD STRING, hPopup1, "-", 0, 0
MENU ADD STRING, hPopup1, "&Exit", %ID_EXIT, %MF_ENABLED

' ** Now we can add another item to the menu that will bring up a sub-menu. First we obtain a new popup menu handle to distinuish it from the first popup menu:
MENU NEW POPUP TO hPopup2
MENU NEW POPUP TO hPopup3
MENU NEW POPUP TO hPopup4

' ** Now add a new menu item to the first menu. This item will bring up the sub-menu when selected:
MENU ADD POPUP, hPopup1, "&More Options for Colours->", hPopup2, %MF_ENABLED

' ** Now we will define the sub menu:
MENU ADD STRING, hPopup2, "Option &1: Blue (B)", %ID_OPTION1, %MF_ENABLED
MENU ADD STRING, hPopup2, "Option &2: Red (R)", %ID_OPTION2, %MF_ENABLED
MENU ADD STRING, hPopup2, "Option &3: Green (G)", %ID_OPTION3, %MF_ENABLED
MENU ADD STRING, hPopup2, "Option &4: Yellow (Y)", %ID_OPTION4, %MF_ENABLED

' ** Finally, we'll add a second top-level menu and popup. For this popup, we can reuse the first popup variable:
MENU NEW POPUP TO hPopup2
MENU ADD POPUP, hMenu, "&Help", hPopup2, %MF_ENABLED
MENU ADD STRING, hPopup2, "&Help", %ID_HELP, %MF_ENABLED
MENU ADD STRING, hPopup2, "-", 0, 0
MENU ADD STRING, hPopup2, "&About", %ID_ABOUT, %MF_ENABLED

MENU NEW POPUP TO hPopup3
MENU ADD POPUP, hMenu, "&Mixed", hPopup3, %MF_ENABLED
MENU ADD STRING, hPopup3, "&basic-Info", %ID_HELP1, %MF_ENABLED
MENU ADD STRING, hPopup3, "-", 0, 0
MENU ADD STRING, hPopup3, "what ? ->", 0, 0
MENU ADD STRING, hPopup3, "empty heart :) ", 0, 0
MENU ADD STRING, hPopup3, "&RealMadrid", %ID_ABOUT1, %MF_ENABLED
MENU ADD STRING, hPopup3, "&Kings & Queens", %ID_ABOUT2, %MF_ENABLED

MENU NEW POPUP TO hPopup4
MENU ADD POPUP, hMenu, "&Compile fast", hPopup4, %MF_ENABLED
MENU ADD STRING, hPopup4, "&Compile_Help", %ID_CompileHELP, %MF_ENABLED

MENU ADD STRING, hPopup4, "&DebugModus", %ID_DEBUG, %MF_ENABLED
MENU ADD STRING, hPopup4, "BundleMe", 0, 0
MENU ADD STRING, hPopup4, "-", 0, 0
MENU ADD STRING, hPopup4, "Import Data", %ID_IMPORT, %MF_ENABLED
MENU ADD STRING, hPopup4, "&LydiaBasic", %ID_BASIC, %MF_ENABLED

MENU NEW POPUP TO hPopup5
MENU ADD POPUP, hMenu, "&WindowSize", hPopup5, %MF_ENABLED '' ok:)
MENU ADD STRING, hPopup5, "-", 0, 0
MENU ADD STRING, hPopup5, "&SizeMe", %ID_Size, %MF_ENABLED

'' MENU SET COLOR hdlg, 120,255

' ** Create a new dialog template
DIALOG NEW 0, "What's your name, thinbasic user?", -1, -1, 240, 200, _
%WS_DLGFRAME OR %DS_CENTER OR %WS_CAPTION OR %WS_SYSMENU OR %WS_OVERLAPPEDWINDOW, _
0 TO hDlg
DIALOG SET COLOR hDlg, 80,150
DIALOG SET MINSIZE hDlg, 220, 180

'---Attach menu to dialog
MENU ATTACH hMenu, hDlg

'' ** Display the dialog
' DIALOG SHOW modal hDlg call dlgCallback

DIALOG SHOW MODELESS hDlg, CALL dlgCallback
LOCAL Count as long
DO
DIALOG DOEVENTS TO Count
LOOP UNTIL Count = 0

end function

'--------------------------------------------------
callback function dlgCallback() as long
'--------------------------------------------------

local UserName as string
local MovieName as string

select case cbmsg

case %WM_INITDIALOG '---Message fired at the very beginning when dialog is initialized
'---Add relevant controls
CONTROL ADD TEXTBOX , cbhndl, %ID_TEXT, "", 14, 12, 134, 12, 0
CONTROL ADD BUTTON , cbhndl, %ID_OK, "OK", 14, 32, 40, 14, %BS_DEFAULT
CONTROL ADD BUTTON , cbhndl, %ID_OK1, "MovieStar", 56, 32, 40, 14, %BS_DEFAULT
CONTROL ADD BUTTON , cbhndl, %ID_CANCEL, "Cancel", 100, 32, 40, 14, 0
CONTROL ADD BUTTON , cbhndl, %ID_NEWWINDOW, "newLydWin", 146, 32, 44, 14, 0
CONTROL ADD LABEL , cbhndl, %ID_CANCEL, "summer is always on my side, you prefer dancing more than drinking all night long!", 50, 64, 80, 36, 0

CONTROL ADD LABEL, cbhndl, %ID_COLORBUTTON, "Push_Button!", 192, 10, 44, 44, %SS_NOTIFY or %SS_CENTER or %SS_CENTERIMAGE or %SS_SUNKEN
CONTROL ADD "sysdatetimepick32" , cbhndl, %date, "30.08.2009", 134, 120, 60, 14, %ws_child or %ws_visible

CONTROL ADD "msctls_statusbar32" , cbhndl, %statusbar, "statusbar: lydia tb infected", 0, 457, 490, 23, %ws_child or %ws_visible
StatusBar_SetParts cbhndl, %STATUSBAR, 140, 200, -1
control add "msctls_trackbar32" , cbhndl, %sliderv, "slide-me", 210, 66, 18, 84, %ws_child or %ws_visible or %tbs_autoticks or %tbs_vert
control add frame , cbhndl, %frame, "frame_lyd", 8, 52, 194, 114
control add option , cbhndl, %option, "show me", 24, 150, 44, 10
control add option , cbhndl, %option, "switch to c++", 68, 150, 60, 10
control add option , cbhndl, %option, "turn thinbasic", 128, 150, 60, 10
control add "sysipaddress32" , cbhndl, %ip, "10.11.58.57", 22, 104, 128, 14, %ws_child or %ws_visible
CONTROL ADD LABEL , cbhndl, %ID_CANCEL, " <type your ip adress!>", 24, 122, 74, 10, 0

case %WM_Command
select case cbctl
case %ID_EXIT, %ID_CANCEL
msgbox 0, "ok, you leave me!"
dialog end cbhndl

case %ID_OK
CONTROL GET TEXT cbhndl, %ID_TEXT TO UserName
if UserName = "" then
msgbox cbhndl, "Please, specify a name", %MB_ICONEXCLAMATION
else
msgbox cbhndl, "Hello mr./mrs. " & UserName
end if

case %ID_OK1
CONTROL GET TEXT cbhndl, %ID_TEXT TO MovieName
if MovieName = "" then
msgbox cbhndl, "Please, speak and spell..", %MB_ICONEXCLAMATION
else
msgbox cbhndl, "Hello famous moviestar: " & MovieName
return 1 = %true
end if

case %ID_NEWWINDOW
msgbox 0, " -> open a new window with more functions! "

Style = %WS_CHILD | %DS_MODALFRAME | %WS_CAPTION | %WS_MINIMIZEBOX | %WS_MAXIMIZEBOX | %WS_SYSMENU | %WS_CLIPSIBLINGS
ExStyle = %WS_EX_MDICHILD | %WS_EX_CONTROLPARENT
Dialog New hParent, "new Window with Button and GUI", 0, 0, 267, 138, Style, ExStyle To hMDIChild

'' better =>
if CBCTLMSG = %BN_CLICKED THEN
Create_NewWinDialog()
end if

case %ID_OPENCOLOR
lColor = Dialog_ChooseColor(0, rgb(255, 0, 0), %CC_RGBINIT OR %CC_FULLOPEN )
if lColor = -1 then
msgbox 0, "Color Dialog cancel by user"
else
msgbox 0, "Your color is: " & hex$(lColor, 6)
end if

case %ID_ABOUT
msgbox 0, "you are using: thinbasic vol 1.7.9.0 :)"
' ** Create a new dialog template
case %ID_ABOUT1
msgbox 0, "No goal for you today, raśl, mr. soccer star!"
case %ID_ABOUT2
msgbox 0, "the drunken queen wanted to have some new butlers!"
case %ID_IMPORT
msgbox 0, "load my personal data to the script!"
case %ID_BASIC
msgbox 0, "..but try LydiasAIR cause it's better to compile! :)"
case %ID_CompileHelp
msgbox 0, "..how to compile a file you look here =>"
case %ID_DEBUG
msgbox 0, "..use THINAIR and the BUG ICON, press F8!"
case %ID_HELP
msgbox 0, "read thinbasic manual, take mouse over syntax/word, push F1"
case %ID_HELP1
msgbox 0, "don't use C++ or C# for learning, you choose better thinbasic!"
case %ID_HELP2
msgbox 0, "check again your thinbasic code by DebugModus!"
case %ID_COLORBUTTON
msgbox 0, "change background color of button "
control set color cbhndl, %ID_COLORBUTTON, rgb(255,40,0), rgb(0,40,255)
'control set color cbhndl, %ID_COLORBUTTON, rgb(0,140,250), rgb(200,0,255)
control redraw cbhndl, %ID_COLORBUTTON

case %WM_MOVING
local RC as RECT ptr
RC = cblParam
printl time$, "Fired %WM_MOVING dialog message", RC.nLeft, RC.nTop, RC.nRight, RC.nBottom

End Select
End Select

END FUNCTION


''--------- my new window gui with function

FUNCTION Create_NewWinDialog()
LOCAL hDlg AS LONG

DIALOG NEW 0, "Lydias_Multy_Window_B", 70, 250, 260, 140, _
%WS_POPUP OR %WS_VISIBLE OR _
%WS_CLIPCHILDREN OR %WS_CAPTION OR _
%WS_SYSMENU OR %WS_MINIMIZEBOX, 0 TO hDlg

' -- Place controls here

CONTROL ADD BUTTON, hDlg, %btnClose2, "LydiaCloseWin", 152, 104, 58, 16
CONTROL ADD "sysdatetimepick32" , hdlg, %time, "20:16:57", 10, 12, 60, 14, %ws_child or %ws_visible or %dts_timeformat
CONTROL ADD "msctls_statusbar32" , hdlg, %statusbar, "new statusbar for gui", 0, 20, 28, 23, %ws_child or %ws_visible
Control Add TextBox, hdlg, %txt_Result, "", 20, 36, 47, 50, _
%WS_CHILD Or %WS_VISIBLE Or %ES_MULTILINE Or %ES_WANTRETURN Or %ES_LEFT Or %WS_TABSTOP, _
%WS_EX_CLIENTEDGE
CONTROL ADD LABEL, hdlg, %ID_COLORBUTTON, "<= simple Textbox", 72, 40, 60, 14, %SS_NOTIFY or %SS_CENTER or %SS_CENTERIMAGE or %SS_SUNKEN
StatusBar_SetParts hdlg, %STATUSBAR, 140, 200, -1


'' xp button controls ----------------

Control Add XPBUTTON, hDlg, %IDC_BUTTON1, "", 150, 16, 105, 85, %WS_TABSTOP Or %WS_VISIBLE Or %WS_CHILD

XPButton_SetImagePos hDlg, %IDC_BUTTON1, %XPBUTTON_CENTERCENTER
XPButton_SetIcon hDlg, %IDC_BUTTON1, app_sourcepath & "gibson-dogge2.ico", %XPBUTTON_NORMAL
XPButton_SetImageSize hDlg, %IDC_BUTTON1, 150, 128, %TRUE
CONTROL ADD LABEL, hdlg, %IDC_BUTTON1, "Click_move_over picture", 154, 2, 80, 14, %SS_NOTIFY or %SS_CENTER or %SS_CENTERIMAGE or %SS_SUNKEN

''------------------------------------

CONTROL ADD textbox , hDlg, %txt_Result2 , " " , 74, 12, 70, 14, %WS_TABSTOP '' mouseover can be seen here!
CONTROL ADD BUTTON , hDlg, %btn_OK , "MOUSE_OVER_BUTTON_OK" , 6, 96, 110, 18, %WS_TABSTOP
CONTROL ADD BUTTON , hDlg, %IDC_BUTTON2, "" , 150, 16, 105, 85, %WS_TABSTOP Or %WS_VISIBLE Or %WS_CHILD

CONTROL HANDLE hDlg, %btn_OK to hBtn_OK
CONTROL HANDLE hDlg, %IDC_BUTTON2 to hBtn_OK2

DIALOG SET COLOR hDlg, 80,180
DIALOG SET MINSIZE hDlg, 60, 240

DIALOG SHOW MODELESS hDlg, call NewWind_DlgProc

END FUNCTION


'' new callbacks -------------

CALLBACK FUNCTION NewWind_DlgProc()

SELECT CASE CBMsg

'' -- mouse move over..

case %WM_MOUSEMOVE
SetCapture cbhndl
GetCursorPos pt
GetWindowRect hBtn_OK, rc

IF ptInRect(rc,pt.x,pt.y) THEN
control set text cbhndl, %txt_Result, "hurray! the mighty Mouse found this great BUTTON!"
msgbox 0, "found my button with move mouse over!"
ELSE
control set text cbhndl, %txt_Result, ""
END IF

SetCapture cbhndl
GetCursorPos pt
GetWindowRect hBtn_OK2, rc

IF ptInRect(rc,pt.x,pt.y) THEN
control set text cbhndl, %txt_Result2, "yeah, master doggy you have found!"
msgbox 0, "found the the hughe doggy beast ;) "
ELSE
control set text cbhndl, %txt_Result2, " "
END IF

ReleaseCapture

'' lyd partido fin --------------------------------------------

CASE %WM_Command
' -- Here you can process the input from controls
SELECT CASE CBCtl
CASE %btnClose2
if CBCTLMSG = %BN_CLICKED THEN
dialog end cbhndl
END IF
CASE %ID_CANCELXP
IF CBCTLMSG = %BN_CLICKED THEN DIALOG END CBHNDL
CASE %IDC_BUTTON1
IF CBCTLMSG = %BN_CLICKED THEN
MSGBOX 0, "largest 'Gibson doggy' of world died one month ago :("
END IF
CASE %btn_OK
IF CBCTLMSG = %BN_CLICKED THEN
MSGBOX 0, "Great, you win the doggy cup!"
END IF

END SELECT

END SELECT

END FUNCTION

printl
printl "lydias multy_window starter, push a KEY to start new GUI"

printl waitkey


purpose of this example:

create a window with callbacks, colors, popup window, menus.
open a new window
-mouse over functions for button AND xp button with picture.
- you will get two separately messages for button and xp picture (doggy)

everything works good here. I am proud. end the script. ready.

best regards, Lydia

Petr Schreiber
10-09-2009, 17:38
Hi Lydia,

the example is very nice!
But I have still an impression the mouseOver does not work 100% for all situations.
WM_MOUSEMOVE is only produced when you are on dialog field, not on its buttons.
For tricky case, you can use WM_SETCURSOR (took me some googling too).



case %WM_SETCURSOR, %WM_MOUSEMOVE

SetCapture cbhndl

GetCursorPos pt
GetWindowRect hBtn_OK, rc

IF ptInRect(rc,pt.x,pt.y) THEN
control set text cbhndl, %txt_Result, "hurray! the mighty Mouse found this great BUTTON!"
printl "found my button with move mouse over!"
ELSE
control set text cbhndl, %txt_Result, ""
END IF
control redraw cbhndl, %txt_Result


GetCursorPos pt
GetWindowRect hBtn_OK2, rc

IF ptInRect(rc,pt.x,pt.y) THEN
control set text cbhndl, %txt_Result2, "yeah, master doggy you have found!"
printl "found the the hughe doggy beast ;) "
ELSE
control set text cbhndl, %txt_Result2, " "
END IF
control redraw cbhndl, %txt_Result2

ReleaseCapture


This results in 100% mouseOver detection for classic button, the XP button seems ... resistent and works as before (= 90% ok, 10% no reaction).

zlatkoAB
10-09-2009, 20:11
Hmm...
I'm not 100% sure but i think that xp button require WM_NOTIFY
for mouse over effect.
@Lydia - I'm glad that your UI example work fine :occasion: