sGUI

[petan]

BTW, what means prefix 'TO_' in names of 'TO_routines()' ?.
Type object ??

[Muttonhead]

BTW, what means prefix 'TO_' in names of 'TO_routines()' ?.
Type object ??

TO_... means TextObject. Its a very basic and rudimentary core of an editor. In some controls its used to manage entries.
TO_ routines are encapsulated calls of the origin routines of a TextObject. Look at TO_Bindings.bas and you see what i mean.

A TO is an external object, an if you modify it (via TO_ routines) its important to update the control.

Mutton

[petan]

another enhancement ;)
- added variable setValuexSleep for switching an event catching from inside of 'event-loop'

Code: Select all

'System Events		("sGUI.bas")
static shared as integer setValuexSleep=1		'my

Usage, e.g.:
- pressing right maus btn. cycles 'event->xSleep(0) and 'event->xSleep(1);
usefull at continuous incrementing by holded 'Arrow gadget',
t.m. changing speedy stepping Incr/Decr to the low finest speed - one click==one step of difference

Code: Select all

do
'event->xSleep(0)
'event->xSleep(1)
'event->xSleep(-1)
event->xSleep(setValuexSleep)
  if RMB=HIT then	'defined action does the job
   setValuexSleep=iif(setValuexSleep=0,1,0)
   locate 11,10:? "xSleep is ";setValuexSleep
  end if 
'...  

[petan]

I made widget for setting number value (works as needed), no problem; and now I am on doubt because I don't know exactly correct mechanism for synchronning external variable passed into the gadget with its virtual value which is setted/changed in gadget's event loop - so keeping doubts whether my solution is right or not.
It looks like there is something missing for synchronising.
This would be good to explain in documentation .
Thx.
code snippet

Code: Select all

sub setNumeroWiget()
dim as any ptr gfxbackup5		'widget polygon
dim as integer i,y2,y1,x2,x1,gX,gY,ramikX,ramikY,widzetW,widzetH
dim as integer x,y,w,h,gdtX,gdtY,waitMiliSec
dim as single byStep(7)={0,0.001,0.01,0.1,1,10,100,1000}
dim as single byPauze(8)={0.005,0.01,0.02,0.05,0.1,0.2,0.3,0.4,0.5}
dim as single stepIs,kolik=777	'default value for incr/decr
dim as string someText=str(kolik)
dim as EventHandle ptr event=new EventHandle
dim as Gadget ptr bmpplus,bmpminus,bmpPMvalue,label,label2,label3,label4
dim as Gadget ptr combobox,combobox2,arrowu,arrowd
gdtX=30
gdtY=330
label=AddLabel(event,gdtX,330,"set number = ",cBlack):
SetLabelColor(label,cSilver)
 bmpPMvalue=AddStringGadget(event,gdtX+label->gadw,330,15,someText)
arrowu  =AddArrow(event,gdtX+label->gadw+bmpPMvalue->gadw,325,2)
arrowd  =AddArrow(event,gdtX+label->gadw+bmpPMvalue->gadw,325+arrowu->gadh,3)

'bmpplus= AddBMPSimpleGadget(event,270,330,"BMPs\PlusUnSelected.bmp","BMPs\PlusSelected.bmp","BMPs\PlusMask.bmp")
'bmpminus= AddBMPSimpleGadget(event,281,330,"BMPs\MinusUnSelected.bmp","BMPs\MinusSelected.bmp","BMPs\MinusMask.bmp")

 label2=AddLabel(event,gdtX,365,"by step ",cBlack)
combobox=AddComboBox(event,gdtX+label2->gadw,360,7,9)	
for i=0 to ubound (byStep)
	TO_AppendLine(combobox,str(byStep(i)))
next i
SetComboBoxVal(combobox,3):stepIs=byStep(GetComboBoxVal(combobox)-1)
UpdateGadget(combobox)

 label3=AddLabel(event,gdtX+label2->gadw+combobox->gadw,365,"  wait (sec.) ",cBlack)
combobox2=AddComboBox(event,gdtX+label2->gadw+combobox->gadw+label3->gadw,360,5,8)	
for i=0 to ubound (byPauze)
	TO_AppendLine(combobox2,str(byPauze(i)))
next i
SetComboBoxVal(combobox2,2):waitMiliSec=1000*byPauze(GetComboBoxVal(combobox2)-1)
UpdateGadget(combobox2)
SetCaption(bmpPMvalue,someText)
'bmpPMvalue->caption=someText

ramikX=10	'frame
ramikY=10
CalcMinBBox (event,x,y,w,h)		'now yes known
x1=x-ramikX
y1=y-ramikY
x2=x+ramikX+w
y2=y+ramikY+h
widzetW=x2-x1+1		'wigdet size
widzetH=y2-y1+1
setmouse -1,-1,0
gfxbackup5=imagecreate(widzetW,widzetH)

 if gfxbackup5>0 then 
	get (x1,y1)-(x2,y2),gfxbackup5
 else
	? "Failed to create image."
 end if
setmouse -1,-1,1
line (x1,y1)-(x2,y2),cGold,BF
line (x1,y1)-(x2,y2),cSilver,B
line (x1,y1)-(x2,y2),cBlue,B,&b1100110011001100
SetNewBackGround (event)
GadgetOn (label,combobox2)
? tab(80);"stepIs= ";stepIs
? tab(80);"waitMiliSec= ";waitMiliSec
do
  event->xSleep(setValuexSleep)
   if multikey(&h3b) then MessageBox(50,500,"q -> Quit widget|RMB+LMB -> Quit widget|RMB ->switch events catch","Help",MBType_OK)
   'if KEY="q" then event->EXITEVENT=1
   if KEY="q" or (RMB and LMB) then event->EXITEVENT=1

  if RMB=HIT then setValuexSleep=iif(setValuexSleep=0,1,0): locate 11,10:? "xSleep is ";setValuexSleep
  if event->GADGETMESSAGE then
    select case event->GADGETMESSAGE
      case combobox
		stepIs=byStep(GetComboBoxVal(combobox)-1)
		locate 15,10:? "stepIs";stepIs
	  case combobox2
		waitMiliSec=1000*byPauze(GetComboBoxVal(combobox2)-1)
		locate 13,10:? "waitMiliSec=";waitMiliSec
    end select
  end if
    'manual number change - NO mouseclick >> synchronise
    if GetString(bmpPMvalue)<>str(kolik) then 
		? "not equal ";GetString(bmpPMvalue),str(kolik)
		kolik=val(GetString(bmpPMvalue))
		'bmpPMvalue->caption=str(kolik)	
		SetCaption(bmpPMvalue,str(kolik))	
		? GetString(bmpPMvalue),str(kolik),bmpPMvalue->caption
		MessageBox(50,500,"not equal","Error !",MBType_OK)
	end if		 		
    'if bmpPMvalue->caption<>str(kolik) then kolik=val(bmpPMvalue->caption) 
	'if bmpminus->over and LMB=HOLD then  	'oval
	if arrowd->over and LMB=HOLD then  
	  'if GetString(bmpPMvalue)<>str(kolik) then kolik=val(GetString(bmpPMvalue))
	  if GetString(bmpPMvalue)<>str(kolik) then kolik=val(bmpPMvalue->caption)	  
	  
  		'bmpPMvalue->caption=str(val(bmpPMvalue->caption)-stepIs)
		SetCaption(bmpPMvalue,str(val(bmpPMvalue->caption)-stepIs))  		
		kolik=val(bmpPMvalue->caption)
		'kolik=val(GetString(bmpPMvalue))					
		'bmpPMvalue->caption=str(kolik)		
		'SetString(bmpPMvalue,bmpPMvalue->caption)	
		  SetString (bmpPMvalue,str(kolik))	
		'UpdateGadget(bmpPMvalue)	  
		 locate 19,20:? using "kolik = ###.###";kolik
		 sleep waitMiliSec,1
	end if		 
	'if bmpplus->over and LMB=HOLD then   	'oval
	if arrowu->over and LMB=HOLD then  	
	  'if GetString(bmpPMvalue)<>str(kolik) then kolik=val(GetString(bmpPMvalue))		
	  if GetString(bmpPMvalue)<>str(kolik) then kolik=val(bmpPMvalue->caption)
		
		'bmpPMvalue->caption=str(val(bmpPMvalue->caption)+stepIs)
		SetCaption(bmpPMvalue,str(val(bmpPMvalue->caption)+stepIs))
		kolik=val(bmpPMvalue->caption)
		'qkolik=val(GetString(bmpPMvalue))			
		'bmpPMvalue->caption=str(kolik)
		'SetString (bmpPMvalue,bmpPMvalue->caption)	  
		  SetString(bmpPMvalue,str(kolik))			
		'UpdateGadget(bmpPMvalue)	  
		 locate 19,20:? using "kolik = ###.###";kolik
		 sleep waitMiliSec,1
	end if
    
loop until event->EXITEVENT
GadgetOff (label,combobox2)
 'hide mouse
 setmouse -1,-1,0
 put (x1,y1),gfxbackup5,pset
 imagedestroy gfxbackup5
 'leave mouse - empty buffer
while RMB or LMB
	event->xSleep(0)
wend
? ,"is out.."
locate 19,90:? using "kolik = ###.###";kolik
delete event
setmouse -1,-1,1
 sleep 2000
end sub

[petan]

Q + next tuning ;)

, as I want to move gadgets on the screen (quickly by mouse and slowly by arrow keypress)
for the finest placing them all & having perfect scene layout (such as a little Visual designer), I played with "Demo-Label.bas".
Not finished completely (arrows), but snippet shows 'Label' gadget in moving.

Q - are these my solutions the shortest way for enabling gadget's movement + fully colorized 'Label' gadget ?
Thx for your next comments !

Screenshot https://db.tt/wvHCwAeN
Changes:
- added 'mouseMoved' variable (in "sGUI.bas" + "sGUI_SystemEvents.bas"),
indicates mouse movement

- added 'AddLabelBackgrounded(...) routine (in "Label.bas"),
draw label with custom color+background

"sGUI.bas" -new lines

Code: Select all

'(Vergleichswerte)
'...
dim shared as integer wheelvalue,oldwheelvalue
static shared as integer mouseMoved				'my
'...

"sGUI_SystemEvents.bas" -new lines

Code: Select all

'...
	'Event Mausposition + Mausbewegung
  'if MOUSEX<>oldMOUSEX or MOUSEY<>oldMOUSEY then eventoccurred=1	'orig
  mouseMoved=0		'my
  if MOUSEX<>oldMOUSEX or MOUSEY<>oldMOUSEY then eventoccurred=1: mouseMoved=1  	'my
  'Event LMB
'...  

"Label.bas" -new lines

Code: Select all

'...  
declare function AddLabelBackgrounded(event as EventHandle ptr,PosX as integer,PosY as integer,Text as string,TextColor as integer=TextColor,byval BackgrndColor as integer=GadgetTextBackgroundColor) as Gadget ptr
declare sub DrawLabelBackgrounded(gad as Gadget ptr)	
'...  
function AddLabelBackgrounded(event as EventHandle ptr,PosX as integer,PosY as integer,Text as string,TextColor as integer=TextColor,byval BackgrndColor as integer=GadgetTextBackgroundColor) as Gadget ptr
  function=0
  dim as Gadget ptr gad
  gad=event->GadgetList->AppendNew (GadgetType)
  if gad then
    gad->event=event

  	gad->sel=0
    gad->act=0
    gad->posx=PosX
    gad->posy=PosY
    gad->gadw=8*len(Text)
    gad->gadh=fontheight

    gad->caption=Text

    gad->Ctrl(0)=TextColor
    gad->Ctrl(1)=BackgrndColor		'my
    gad->DoDraw     =@DrawLabelBackgrounded	'my
    gad->DoAction   =@LabelActions
    gad->DoUpdate   =@UpdateLabel

		gad->SaveBackGround
		function=gad
  end if
end function

sub DrawLabelBackgrounded(gad as Gadget ptr)
	dim as integer PosX,PosY,GadWidth,GadgHeight
  dim as string Text
  PosX   =gad->posx
	PosY   =gad->posy
	GadWidth		=gad->gadw
	GadgHeight		=gad->gadh

  screenlock
	if gad->act=0 then
    put(PosX,PosY),gad->Background,pset
  else
    ClearBox (PosX,PosY,GadWidth,GadgHeight,gad->Ctrl(1))  'my
    draw string ( PosX, PosY),gad->caption,gad->Ctrl(0)
    if gad->act=2 then put(PosX,PosY),gad->Background,alpha,SleepShade
  end if
  screenunlock
end sub
'...  

"Demo-Label-2.bas"

Code: Select all

'Compileroption: "-s console"
#include "sGUI\sGUI.bas"
#include once "sGUI\Label.bas"
using sGUI

'screen 19,32
screen 20,32
InitGFX
bload "BMPs\effekt.bmp",0

dim as integer a2,b2
dim as EventHandle ptr event=new EventHandle

dim as Gadget ptr label,label2
label= AddLabel(event,100,100,"Klick mich an") '
label2= AddLabelBackgrounded(event,100,150,"..different background",,rgb(0,255,0))
GadgetOn(label)
GadgetOn(label2)
a2=label2->gadw
b2=label2->gadh

'Console öffnen für output
dim as integer ff=freefile
open cons for output as ff
print #ff,"<1> Labeltext auf 'ein anderer Labeltext' setzen"
print #ff,"<2> Labeltext auf 'noch ein anderer Labeltext' setzen"
print #ff,"<3> Labeltextfarbe auf &HFFFFFF setzen"
print #ff,"<4> Labeltextfarbe auf &H0000FF setzen"


? tab(61);"<1> Labeltext auf 'ein anderer Labeltext' setzen"
? tab(61);"<2> Labeltext auf 'noch ein anderer Labeltext' setzen"
? tab(61);"<3> Labeltextfarbe auf &HFFFFFF setzen"
? tab(61);"<4> Labeltextfarbe auf &H0000FF setzen"
? tab(61);"<5> move Label on another place of the screen"
?
? tab(61);"press '1-5', or"
? tab(61);"Drag&Drop colorized 'Label' on another place (with left mouse btn.)"
? tab(61);"press 'q' to Quit..."
do
  'event->xSleep(1)
  event->xSleep(0)

   locate 12,10:? using "#### ###";MOUSEX;MOUSEY
  
  if event->GADGETMESSAGE then
    select case event->GADGETMESSAGE
      case label
        print #ff,"Label wurde angeklickt"
    end select
  end if

		'keypress action
  if KEY<>"" then
   if lcase(KEY)="q" then event->EXITEVENT=1  'quit
    select case KEY
      case "1"
        SetCaption(label,"ein anderer Labeltext")
        print #ff,"Labeltext auf 'ein anderer Labeltext' gesetzt"
      case "2"
        SetCaption(label,"noch ein anderer Labeltext")
        print #ff,"Labeltext auf 'noch ein anderer Labeltext' gesetzt"
      case "3"
        SetLabelColor(label,&HFF0000)
        print #ff,"Labeltextfarbe auf &HF0000 gesetzt"
      case "4"
        SetLabelColor(label,&H0000FF)
        print #ff,"Labeltextfarbe auf &H0000FF gesetzt"
      case "5"
			GadgetOff(label2)
			label2->posx=MOUSEX		
			label2->posy=MOUSEY		
			GadgetOn(label2)      
    end select
  end if

		'detect moving action
	if label2->over and LMB=HOLD then
		label2->Ctrl(15)=1:	GadgetOff(label2)	
    end if	
    
		'draw moving
    if mouseMoved=1 and label2->Ctrl(15)=1 then
     'line (MOUSEX,MOUSEY)-(MOUSEX+a2,MOUSEY+b2),&H9966CC,B     'just for fun
		label2->posx=MOUSEX: label2->posy=MOUSEY		
		GadgetOn(label2)      
		sleep 50,1
		GadgetOff(label2)      
	end if	
	
		'clear+finish moving of Label
	if LMB=RELEASED and label2->Ctrl(15)=1 then
		label2->Ctrl(15)=0
			label2->posx=MOUSEX		
			label2->posy=MOUSEY		
			GadgetOn(label2)      
	end if		 
loop until event->EXITEVENT

close ff
delete event
? "is out.."
sleep 1500
end

Tip - enabling gadgets movement could be the fourth choice in "Demo-activation.bas"
1 - GadgetsON
2 - GadgetsSLEEP
3 - GadgetsOFF
4 - GadgetsMOVEMENT

[Muttonhead]

static shared as integer mouseMoved

Code: Select all

why static?

movement:

It looks good, you can do that in this way. But dont forget to set the new background before switching ON.
At moment all controls containing the old background from their previous locations

Mutton

[petan]

Thx for speedy response;

why static?

Only my first infinite feeling/concern due its importance,heavy usage etc., based on my previous drilled-up skill in one old app.
And also to get it (movement) very speedily running.. without troubles.

Code: Select all

dim shared as integer mouseMoved

is the second sufficient solution, yes.Which one of them to implement will be seen in real usage/tests.
Your opinion is that the second solution to use as better, like other global mouse variables there ..?

To movement/visual design I got another idea.
For creation code of joined group of gadgets for one job (or widget with more controls) is quite long time to write code&compute pix. distances between two neighbours.
Looks like one small primitive routine for gadget type selection and setting distance plus writing code into the source in poloautomatic mode would be really helpful.

[petan]

Hmm, unclear, still missing me very important identificator like
'Gadget_None' / 'NoGadget'
and public variable 'mouseOnGadget'
which permanently says a mouse position to any gadget (WITHOUT doing any clicks !),
where actually mouse is (walks/stopped - no matter) ?
... on some gadget area ('mouseOnGadget=1'), or out of any gadget area ('mouseOnGadget=0')...

Q - howto easily know it ?
( directly asking in event-loop, if mouse is in/out ?? )

If I click the mouse, all is detected; but if NOTHING is clicked .. where is mouse .. ? In, or Out of any gadget area ??

I found

Code: Select all

if mouseover=mousenext then

but not working as expected

edit:
Solved,
seems just newly added variable 'mouseOnGadget' is enough (without indicator 'Gadget_None')

[Muttonhead]

:) haa, yeah... I need this routine too...
The variables you have found are rests of a not working solution for that problem.

in every eventhandle exists a member routine called GetGadgetPointer. This routine do exactly what you want, but its for internal use only.
Not tested: at moment this declared as PRIVATE but you can change it and see whats happen

Mutton

[petan]

Excellent hint, Mutton !! Big thanks.

Problem fixed quickly as new public sub 'mouseAgainstGadgetPosition()', what is tuned shorten private 'GetGadgetPointer'.
When mouse founded on some gadget area, exited sub imediately(saving time).
I think calling it would be a part of 'xSleep', because knowing mouse coordinates, buttons+wheel status and mouse position against any gaddet is one job.
As I don't know yet detailed philosophy of calling private 'GetGadgetPointer' (what&why&when calls it) -
therefore solution is written as separate public sub, for now, needed in 'WizDizzy', aka very simple sGUI Visual designer (in progress).
'GetGadgetPointer' is easily expandable in that way also.Next tests show final usage.

:) haa, yeah... I need this routine too...

Here is needed code ;)
Changes:
- added in "sGUI_EventHandle.bas"

Code: Select all

type EventHandle extends node
'...
'public
'...
  declare sub GlowGList
  declare sub GadgetControl
  declare sub mouseAgainstGadgetPosition()  'my
private:
'...
end type

'is mouse on some gadget ?
sub EventHandle.mouseAgainstGadgetPosition()	'my
  dim as Gadget ptr gad		',over
  gad=GadgetList->GetFirst
  if gad then
   mouseOnGadget=0	'we think mouse is off gagdet
    do
      if gad->act=1 then'nur bei Activation=1 gibt es eine Antwort
        if  (MOUSEX>=gad->posx) and (MOUSEX<gad->posx+gad->gadw) and (MOUSEY>=gad->posy) and (MOUSEY<gad->posy+gad->gadh) then
' BUT mouse is in some gadget area >> exit
			mouseOnGadget=1: exit sub
      	end if
	  end if
      gad=cast(Gadget ptr,gad->next_node)
    loop until (gad=0)
  end if
end sub

- added global variable 'mouseOnGadget' in "sGUI.bas"

Code: Select all

'...
'(Vergleichswerte)
'...
dim shared as integer wheelvalue,oldwheelvalue
'static shared as integer mouseMoved				'my
dim shared as integer mouseMoved				'my
static shared as integer mouseOnGadget=0		'my - permanent value needed safe
'...

Usage - in "Demo_Activation.bas" (just ride on the screen without mouse clickin')

Code: Select all

'...
dim as string openfile
 locate 25,10:? "xSleep is ";setValuexSleep
do
  event->xSleep(setValuexSleep)	
  event->mouseAgainstGadgetPosition()
  locate 27,12:? "mouseOnGadget";mouseOnGadget
'...

Perfectly working :))

Beautiful day; today..

[petan]

More precise mouse status against gadget area..

Code: Select all

'...
 locate 25,10:? "xSleep is ";setValuexSleep
do
  sleep 20	'REM it - this only fix char's flickering if you need to see stable message!
  event->xSleep(setValuexSleep)  
  event->mouseAgainstGadgetPosition()
  locate 26,12:? "mouseOnGadget";mouseOnGadget,
  if mouseMoved=1 then ? "mouse moving " else ? "mouse staying"
  locate 27,12:? space(45)
  if mouseOnGadget and mouseMoved then locate 27,12:? "mouse on some Gadget area"+" and in moving  "
  if mouseOnGadget=0 and mouseMoved=0 then locate 27,12:? "mouse is off any Gadget area"+" and staying "  
  if mouseOnGadget and mouseMoved=0 then locate 27,12:? "mouse on some Gadget area"+" and staying    "  
  if mouseOnGadget=0 and mouseMoved then locate 27,12:? "maus is off any Gadget area"+" and in moving"  
'...  
'...  
  if RMB=HIT then
		'cycling 0 1 -1 values for xSleep
	setValuexSleep=iif(setValuexSleep=0,1,iif(setValuexSleep=1,-1,0))
	locate 25,5:? "cycling..xSleep is ";setValuexSleep
  end if
  sleep waitMiliSec
loop until event->EXITEVENT
'...  

[petan]

Problem founded.
When added "(Demo_Activation.bas)"

Code: Select all

'...
dim as Gadget ptr check,acton,actsleep,actoff,actmove	'new gaddet
'...
actmove    =AddRadioButton(event,730,520,0,"Movable",acton)
check=AddCheckMarkGadget(event,730,440,1,"Menue")

, I see pink background under "Movable" word.
Fixed by moving all 4 gadgets -20px to left ( on [710,440]).

Q - Is this behavior bug, or enough will be warning sentence about this in manual ?

[Muttonhead]

my goal was to replace the menu system by a new kind of controls(Gadget UDT).
but an important (visual) feature of a menu system is the hightlighting. So i need the "mouse-over-control property" to realise
highlighting.
But some controls a composed: controls(and an eventhandle) can exists inside a control. In this cas the highlighting dont work correctly... so i removed that stuff

Mutton

[Muttonhead]

I see pink background under "Movable" word.

contact with Screenborders? This problem is not handled

[petan]

my goal was to replace the menu system by a new kind of controls(Gadget UDT).
but an important (visual) feature of a menu system is the hightlighting

Which way did you mean ?, highlightning by
- adding dotted randomly colorized 1-2 px line as gadget/widget frame border,
(as shown on above picture in both widgets)
- or gadget text background area redrawn with high light color e.g.azur (light blue)