Visual display of CanvasGadget events

Share your advanced PureBasic knowledge/code with the community.
User avatar
Demivec
Addict
Addict
Posts: 4269
Joined: Mon Jul 25, 2005 3:51 pm
Location: Utah, USA

Visual display of CanvasGadget events

Post by Demivec »

Code updated for 5.20+

Here is a tool I found useful to display the events received by a CanvasGadget.

It's a visual way to see what is received by the CanvasGadget, when it is received, and how it changes as the gadget is interacted with.

I tried to make it as self-explanatory as possible. For the maximum benefit it should be used hand-in-hand with the PB Manual to understand in more detail what is being displayed.

Code: Select all

;Author: Demivec
;program: displays CanvasGadget events in a graphical way
;Written for PB v4.61
;
;Note:  All events are displayed.  All attributes are displayed except
;  those dealing with the mouse cursor image, the gadget image,  and 
;  mouse cliping status.
;
;  This program was written for a MicroSoft Windows system.  It should
;also function well for Linux.  Some mild attempts have been made to
;account for differences that occur when running on a Mac.  These attempts
;detected the Command Key instead of the Control Key and also react to a
;MouseLeave event by recording all the mouse buttons as being released.
;
;My appologies for the colors chosen for the display.  I was having a bad day ;).

EnableExplicit

Procedure displayCanvasEvents(gadgetID = 0)
  Static kx = -40, ky = 5, mx = 5, my = 5, vx = 310, vy = 45, lx = 95, ly = 300
  Static is_L_ButtonDown, is_M_ButtonDown, is_R_ButtonDown
  Static hasKeyboardFocus, isMouseOver
  Static Dim isVKeysDown(255)
  
  Protected event = EventType(), px, py, buttonStatus, keyStatus, rawKeyCode
  
  
  px = GetGadgetAttribute(gadgetID, #PB_Canvas_MouseX): py = GetGadgetAttribute(gadgetID, #PB_Canvas_MouseY)
  buttonStatus = GetGadgetAttribute(gadgetID, #PB_Canvas_Buttons)
  keyStatus = GetGadgetAttribute(gadgetID, #PB_Canvas_Modifiers)
  rawKeyCode = GetGadgetAttribute(gadgetID, #PB_Canvas_Key)
  
  Protected move_fcolor = $FFFFFF, wheel_fcolor = $FFFFFF, input_fcolor = $FFFFFF, raw_fcolor = $FFFFFF
  Select event
    Case #PB_EventType_MouseEnter: isMouseOver = 1
    Case #PB_EventType_MouseLeave: isMouseOver = 0
      CompilerIf  #PB_Compiler_OS = #PB_OS_MacOS
        ;signal mousebutton release if mouse leaves gadget
        is_L_ButtonDown = 0
        is_M_ButtonDown = 0
        is_R_ButtonDown = 0
      CompilerEndIf 
    
    Case #PB_EventType_Focus    : hasKeyboardFocus = 1: Dim isVKeysDown(255)
    Case #PB_EventType_LostFocus: hasKeyboardFocus = 0
      
    Case #PB_EventType_LeftButtonDown: is_L_ButtonDown = 1
    Case #PB_EventType_LeftButtonUp: is_L_ButtonDown = 0
    Case #PB_EventType_MiddleButtonDown: is_M_ButtonDown = 1
    Case #PB_EventType_MiddleButtonUp: is_M_ButtonDown = 0
    Case #PB_EventType_RightButtonDown: is_R_ButtonDown = 1
    Case #PB_EventType_RightButtonUp: is_R_ButtonDown = 0
      
    Case #PB_EventType_MouseMove: move_fcolor = $D402B4
    Case #PB_EventType_MouseWheel: wheel_fcolor = $D402B4
    Case #PB_EventType_Input: input_fcolor = $D402B4
    Case #PB_EventType_KeyDown: raw_fcolor = $D402B4: isVKeysDown(rawKeyCode) = 1
    Case #PB_EventType_KeyUp: raw_fcolor = $D402B4: isVKeysDown(rawKeyCode) = 0
  EndSelect
  
  
  Protected x, i
  StartDrawing(CanvasOutput(gadgetID))
    Box(0, 0, OutputWidth(), OutputHeight(), $C0E0C0)
    
    ;legend
    DrawingMode(#PB_2DDrawing_Transparent)
    x = DrawText(lx + 0, ly, "Legend", 0)
    x = DrawText(x, ly, ":  ", $FFFFFF)
    x = DrawText(x, ly, "Last Message", $D402B4)
    x = DrawText(x, ly, ", ", $FFFFFF)
    DrawingMode(#PB_2DDrawing_Default)
    x = DrawText(x, ly, "Historical Status", $FFFFFF ! $2020, $C0E0C0 ! $2020)
    x = DrawText(x, ly, ", ", $FFFFFF, $C0E0C0)
    x = DrawText(x, ly, "Active Status", 0, $C0E0C0 ! $2020)
    
    DrawingMode(#PB_2DDrawing_Transparent)
    DrawText(mx + 58, my + 0, "Mouse", 0)
    x = DrawText(mx + 7, my + 90, "Move :", move_fcolor): DrawText(x + 5, my + 90, RSet(Str(px), 5, " ") + ", " + RSet(Str(py), 5, " "))
    x = DrawText(mx + 5, my + 110, "Wheel:", wheel_fcolor): DrawText(x + 5, my + 110, RSet(Str(GetGadgetAttribute(0, #PB_Canvas_WheelDelta)), 2, " "))
    
    ;mouse over
    DrawingMode(#PB_2DDrawing_Outlined | #PB_2DDrawing_Transparent)
    Box(mx + 55, my + 30, 50, 20): DrawText(mx + 63, my + 31, "Enter")
    Box(mx + 55, my + 50, 50, 20): DrawText(mx + 67, my + 51, "Exit")
    DrawingMode(#PB_2DDrawing_XOr)
    If event = #PB_EventType_MouseEnter Or event = #PB_EventType_MouseLeave
      Box(mx + 55, my + 50 - 20 * isMouseOver, 50, 20, $14E200)
    Else
      Box(mx + 55, my + 50 - 20 * isMouseOver, 50, 20, $2020)
    EndIf 
    
    
    ;mouse buttons
    DrawingMode(#PB_2DDrawing_Outlined | #PB_2DDrawing_Transparent)
    DrawText(mx + 55, my + 150, "Buttons", 0)
    Box(mx + 50, my + 170, 20 * 3, 20 * 5): DrawText(mx + 30, my + 172, "CC")
    Box(mx + 50, my + 190, 20 * 3, 20 * 3): DrawText(mx + 38, my + 192, "C")
    Box(mx + 50, my + 210, 20 * 3, 20 * 1): DrawText(mx + 20, my + 212, "Msg")
    Box(mx + 70, my + 170, 20 * 1, 20 * 5)
    DrawText(mx + 55, my + 212, "L", 0): DrawText(mx + 74, my + 212, "M", 0): DrawText(mx + 94, my + 212, "R", 0)
    DrawText(mx + 38, my + 232, "U")
    DrawText(mx + 38, my + 252, "D")
    
    DrawingMode(#PB_2DDrawing_XOr)
    ;Test for is_L_ButtonDown is to differentiate between no event (=0) and an actual LeftClick event (=0).
    ;This allows this procedure to draw it's output even when no actual gadget events are being interpreted.
    If event = #PB_EventType_LeftClick And is_L_ButtonDown: Box(mx + 50, my + 190, 20, 20, $14E274): EndIf 
    If event = #PB_EventType_RightClick: Box(mx + 90, my + 190, 20, 20, $14E274): EndIf 
    If event = #PB_EventType_LeftDoubleClick: Box(mx + 50, my + 170, 20, 20, $14E274): EndIf
    If event = #PB_EventType_RightDoubleClick: Box(mx + 90, my + 170, 20, 20, $14E274): EndIf 
    If event = #PB_EventType_LeftButtonUp Or event = #PB_EventType_LeftButtonDown
      Box(mx + 50, my + 230 + 20 * is_L_ButtonDown, 20, 20, $14E274)
    Else
      Box(mx + 50, my + 230 + 20 * is_L_ButtonDown, 20, 20, $2020)
    EndIf 
    If event = #PB_EventType_MiddleButtonUp Or event = #PB_EventType_MiddleButtonDown
      Box(mx + 70, my + 230 + 20 * is_M_ButtonDown, 20, 20, $14E274)
    Else
      Box(mx + 70, my + 230 + 20 * is_M_ButtonDown, 20, 20, $2020)
    EndIf 
    If event = #PB_EventType_RightButtonUp Or event = #PB_EventType_RightButtonDown
      Box(mx + 90, my + 230 + 20 * is_R_ButtonDown, 20, 20, $14E274)
    Else
      Box(mx + 90, my + 230 + 20 * is_R_ButtonDown, 20, 20, $2020)
    EndIf 
    If buttonStatus & #PB_Canvas_LeftButton > 0  : Box(mx + 50, my + 210, 20, 20, $2020): EndIf
    If buttonStatus & #PB_Canvas_MiddleButton > 0: Box(mx + 70, my + 210, 20, 20, $2020): EndIf
    If buttonStatus & #PB_Canvas_RightButton > 0 : Box(mx + 90, my + 210, 20, 20, $2020): EndIf
    
    
    DrawingMode(#PB_2DDrawing_Transparent)
    DrawText(kx + 250, ky + 0, "Key", 0)
    ;keyboard focus
    DrawingMode(#PB_2DDrawing_Outlined | #PB_2DDrawing_Transparent)
    Box(kx + 220, ky + 30, 86, 20): DrawText(kx + 243, ky + 31, "Focus")
    Box(kx + 220, ky + 50, 86, 20): DrawText(kx + 228, ky + 51, "Lost Focus")
    DrawingMode(#PB_2DDrawing_XOr)
    If event = #PB_EventType_Focus Or event = #PB_EventType_LostFocus
      Box(kx + 220, ky + 50 - 20 * hasKeyboardFocus, 86, 20, $14E200)
    Else
      Box(kx + 220, ky + 50 - 20 * hasKeyboardFocus, 86, 20, $2020)
    EndIf 
    
    ;key codes
    DrawingMode(#PB_2DDrawing_Transparent)
    x = DrawText(kx + 210, ky + 90, "Raw Code: ", raw_fcolor): DrawText(x, ky + 90, "$" + RSet(Hex(rawKeyCode), 2, "0"))
    x = DrawText(kx + 206, ky + 110, "Input Code: ", input_fcolor): DrawText(x, ky + 110, "$" + RSet(Hex(GetGadgetAttribute(gadgetID, #PB_Canvas_Input)), 2, "0"))
    
    ;key modifiers
    DrawingMode(#PB_2DDrawing_Outlined | #PB_2DDrawing_Transparent)
    DrawText(kx + 232, ky + 190, "Modifiers", 0)
    Box(kx + 232, ky + 210, 20 * 3, 20 * 1)
    Box(kx + 252, ky + 210, 20 * 1, 20 * 1)
    DrawText(kx + 238, ky + 212, "S", 0): DrawText(kx + 258, ky + 212, "A", 0): DrawText(kx + 277, ky + 212, "C", 0)
    DrawText(kx + 202, ky + 212, "Msg")
    DrawingMode(#PB_2DDrawing_XOr)
    If keyStatus & #PB_Canvas_Shift > 0  : Box(kx + 232, ky + 210, 20, 20, $2020): EndIf
    If keyStatus & #PB_Canvas_Alt > 0: Box(kx + 252, ky + 210, 20, 20, $2020): EndIf
    CompilerIf #PB_Compiler_OS = #PB_OS_MacOS
      If keyStatus & #PB_Canvas_Command > 0 : Box(kx + 272, ky + 210, 20, 20, $2020): EndIf
    CompilerElse
      If keyStatus & #PB_Canvas_Control > 0 : Box(kx + 272, ky + 210, 20, 20, $2020): EndIf
    CompilerEndIf 
    
    ;virtual keys status
    DrawingMode(#PB_2DDrawing_Outlined | #PB_2DDrawing_Transparent)
    DrawText(vx + 50, vy - 40, "Virtual Key Status")
    Box(vx + 0, vy + 0, 16 * 14, 16 * 14)
    Line(vx + 0, vy + 8 * 14, 16 * 14, 1)
    Line(vx + 8 * 14, vy + 0, 1, 16 * 14)
    For i = 0 To 15: DrawText(vx + i * 14 + ((14 - TextWidth(Hex(i))) / 2), vy - 16, Hex(i)): Next
    For i = 0 To 15: DrawText(vx - 18, vy  + i * 14 + ((14 - TextHeight(Hex(i) + "x")) / 2), Hex(i) + "x"): Next
    For i = 1 To 7
      Box(vx + 0, vy + i * 14, 16 * 14, (8 - i) * 2 * 14)
      Box(vx + i * 14, vy + 0, (8 - i) * 2 * 14, 16 * 14)
    Next 
    
    DrawingMode(#PB_2DDrawing_XOr)
    For i = 0 To 255
      If isVKeysDown(i) = 1
        If rawKeyCode = i
          Box(vx + (i % 16) * 14, vy + (i / 16) * 14, 14, 14, $14E274)
        Else
          Box(vx + (i % 16) * 14, vy + (i / 16) * 14, 14, 14, $2020)
        EndIf 
      EndIf 
    Next 
  StopDrawing()
  
  Delay(10) ;slow down display of events
EndProcedure



OpenWindow(0, 0, 0, 550, 350, "Canvas Gadget event reporter", #PB_Window_SystemMenu)
CanvasGadget(0, 0, 0, 550, 320, #PB_Canvas_Keyboard | #PB_Canvas_DrawFocus)
CanvasGadget(1, 0, 320, 550, 30, #PB_Canvas_Keyboard | #PB_Canvas_DrawFocus)
StartDrawing(CanvasOutput(1))
  DrawText((OutputWidth() - TextWidth("Another Gadget")) / 2, (OutputHeight() - TextHeight("Another Gadget")) / 2, "Another Gadget", 0, $FFFFFF)
StopDrawing()

displayCanvasEvents()

Define event
Repeat
  Repeat 
    event = WindowEvent()
    If event = #PB_Event_CloseWindow
      Break 2
    EndIf
    
    If event = #PB_Event_Gadget
      If EventGadget() = 0
        displayCanvasEvents()
      EndIf
    EndIf 
  Until event = 0
  
ForEver
I hope others find it useful. If you have any suggestions or improvements, feel free to contribute.


@Edit: Minor code update to 'Define' a variable. Thanks ts-soft.

@Edit: A major improvement to the code is posted below that allows dynamic monitoring of any canvas gadget and is implemented as an include file.
Last edited by Demivec on Fri Mar 16, 2012 7:21 am, edited 2 times in total.
IdeasVacuum
Always Here
Always Here
Posts: 6426
Joined: Fri Oct 23, 2009 2:33 am
Location: Wales, UK
Contact:

Re: Visual display of CanvasGadget events

Post by IdeasVacuum »

Very clever Demivec :D .... have a headache now from those colours though :mrgreen:
IdeasVacuum
If it sounds simple, you have not grasped the complexity.
User avatar
ts-soft
Always Here
Always Here
Posts: 5756
Joined: Thu Jun 24, 2004 2:44 pm
Location: Berlin - Germany

Re: Visual display of CanvasGadget events

Post by ts-soft »

Image very usefull :D

But i have added two lines:

Code: Select all

EnableExplicit
Define event
:wink:
PureBasic 5.73 | SpiderBasic 2.30 | Windows 10 Pro (x64) | Linux Mint 20.1 (x64)
Old bugs good, new bugs bad! Updates are evil: might fix old bugs and introduce no new ones.
Image
User avatar
Demivec
Addict
Addict
Posts: 4269
Joined: Mon Jul 25, 2005 3:51 pm
Location: Utah, USA

Re: Visual display of CanvasGadget events

Post by Demivec »

ts-soft wrote:Image very usefull :D

But i have added two lines:

Code: Select all

EnableExplicit
Define event
:wink:
@ts-soft. Thank you. I have added those lines to the initial post.

@IdeasVacuum: Regarding colors, it could have been worse. :mrgreen: I may update the colors with something from this century. The only question is when.
User avatar
Derren
Enthusiast
Enthusiast
Posts: 316
Joined: Sat Jul 23, 2011 1:13 am
Location: Germany

Re: Visual display of CanvasGadget events

Post by Derren »

Coolio.
That would be really handy if you use it something like this

Code: Select all

InitCanvasMonitor() ;Opens the window from the demo

OpenWindow(...
Canvasget(#Gadget,...

MonitorCanvas(#Gadget)...

Repeat
UpdateMonitor()
...
So the monitor shows the events of another CanvasGadget.
juror
Enthusiast
Enthusiast
Posts: 232
Joined: Mon Jul 09, 2007 4:47 pm
Location: Courthouse

Re: Visual display of CanvasGadget events

Post by juror »

very useful. many thanks for sharing
User avatar
Kwai chang caine
Always Here
Always Here
Posts: 5494
Joined: Sun Nov 05, 2006 11:42 pm
Location: Lyon - France

Re: Visual display of CanvasGadget events

Post by Kwai chang caine »

Nice and useful for numerous person not always understand this new and complex GADGET..thanks for sharing 8)
ImageThe happiness is a road...
Not a destination
User avatar
electrochrisso
Addict
Addict
Posts: 989
Joined: Mon May 14, 2007 2:13 am
Location: Darling River

Re: Visual display of CanvasGadget events

Post by electrochrisso »

@IdeasVacuum: Regarding colors, it could have been worse. :mrgreen: I may update the colors with something from this century. The only question is when.
Thank you, I like it, and I have no problem with the colours. :)
PureBasic! Purely the best 8)
User avatar
Demivec
Addict
Addict
Posts: 4269
Joined: Mon Jul 25, 2005 3:51 pm
Location: Utah, USA

Re: Visual display of CanvasGadget events

Post by Demivec »

Derren wrote:Coolio.
That would be really handy if you use it something like this

Code: Select all

InitCanvasMonitor() ;Opens the window from the demo

OpenWindow(...
Canvasget(#Gadget,...

MonitorCanvas(#Gadget)...

Repeat
UpdateMonitor()
...

So the monitor shows the events of another CanvasGadget.
@Derren: That is a cool suggestion.

I've made some code improvments that implement that idea. I've decided to post it here instead of updating the code in the initial post because the two function in a slightly different way. The initial post strictly shows the events while interacting with itself. The newer include file shows the interactions with a specific canvas gadget. This can't be applied to the monitor because it is actually a ImageGadget now. I might flipflop and change it later, but for now I think it works better because the ImageGadget doesn't generate as many messages.


First the new include file,

[canvasMonitor.pbi]

Code: Select all

;Author: Demivec
;filename: canvasMonitor.pbi
;program: displays CanvasGadget events in a graphical way
;Date: 3/20/2012
;Written for PB v4.61
;
;  This program was written for a MicroSoft Windows system.  It should
;also function well for Linux.  Some mild attempts have been made to
;account for differences that occur when running on a Mac.  These attempts
;detect the Command Key instead of the Control Key and also react to a
;MouseLeave event by recording all the mouse buttons as being released.
;
;  TODO: address an issue with the 'Alt' key because of the side effects caused
;when it is pushed.  These include where it isn't registered until it is pressed
;twice, and also tracking other keys' down status when 'Alt' is pushed.
;
;
;Updates:
;
;3/15/2012  Implemented Derren's suggestion to allow the selective monitoring of 
;  different canvas gadgets.  Only one canvas gadget at a time can be monitored.
;
;3/15/2012  Added a procedure to set a delay so that some events may be more
;  easily seen in the monitor.  The setting defaults to a delay of approx 10ms for
;  each event. If no delay is desired a value < 0 may be used.  Setting this
;  value too high may cause problems interacting with a programs GUI.
;
;  setCanvasMonitorDelay(delay) ;
;
;3/20/2012  Added display of the remaining attributes: mouse cursor image,
;  the gadget image, and mouse cliping status.  Now displays all attributes.
;    Also added constants to control the display of colors.  See _canvasMonitor
;  for descriptions.  See initCanvasMonitor() to change the default assignments.
;
;
;Here is a summary of the included procedures:
;
;  initCanvasMonitor()     ;opens a window and sets initial conditions to display the monitor
;  monitorCanvas(canvasID) ;sets the monitor to display events for a specific CanvasGadget
;  updateCanvasMonitor()   ;updates display of events for the monitored CanvasGadget
;  stopCanvasMonitor()     ;stops the current display of events for monitored CanvasGadget, needs monitorCanvas() to restart
;  closeCanvasMonitor()    ;ends monitoring and closes monitor window, need initCanvasMonitor() to restart monitoring
;  setCanvasMonitoringDelay(delay) ;set the minimum delay in ms for each canvas event to be displayed
;
;
;The long explanation of the 'Basic' use involves:
;
;  1. Include the file before it's used (or at the beginning).
;       Code:  IncludeFile "canvasMonitor.pbi" 
;  2. Call initCanvasMonitor().  The return value can be checked to ensure it is ready to use.
;       Code: initCanvasMonitor()
;  3. Instantiate the canvas gadget that is going to be monitored,
;       Code: CanvasGadget(#gadgetID, ...) ;this is specific to each program's purpose
;  4. Call monitorCanvas() with the gadgetID of the desired canvas gadget.  A short description of 
;     the gadget can also be included that will be display in the window title of the monitor.
;       Code:  monitorCanvas(#gadgetID, "draw surface")
;  5. Call updateCanvasMonitor() each time an update is desired.  This should be placed in the event loop
;     after it has been determined that an event is for a gadget.
;       Code:   If event = #PB_Event_Gadget: updateCanvasMonitor() ;one possible way
;  6. Call monitorCanvas() with a different gadgetID to switch to monitoring a new canvas gadget.
;  7. Call stopCanvasMonitor() to cease responding to calls to updateCanvasMonitor() until a new call
;     to mointorCanvas() is made.
;  8. Call closeCanvasMonitor() to close the monitor window and free the other resources being used.
;     Monitoring can be restarted by returning to step #2 above and continuing from there.

EnableExplicit

Structure _canvasMonitor
  window.i                 ;window number of monitor
  imageGadget.i            ;imageGadget number of monitor
  canvasGadget.i           ;canvasGadget to monitor
  image.i                  ;image number to display in image gadget
  delay.i                  ;minimum delay for each canvas event to be displayed
  Array isVKeysDown.i(255) ;history of virtual keys 'Down' status
  is_L_ButtonDown.i        ;Mouse button's 'Down' status
  is_M_ButtonDown.i
  is_R_ButtonDown.i
  hasKeyboardFocus.i       ;keyboard focus status
  isMouseOver.i            ;mouse over status
  isInitialized.i          ;indicator of whether canvas monitor has been initialized
  c_bak.i   ;background                        
  c_hbak.i  ;history message background area      
  c_cbak.i  ;current message background area      
  c_abak.i  ;attribute message background area   
  c_dtxt.i  ;descriptive text labels & box lines 
  c_ttxt.i  ;title text, i.e. 'Mouse', 'Keys'     
  c_atxt.i  ;attribute message text              
  c_ctxt.i  ;current message text
EndStructure

Define _canvasMonitor._canvasMonitor ;working values for Canvas Monitor

Procedure setCanvasMonitorDelay(delay) ;set the minimum delay in ms for each canvas event to be displayed
  Shared _canvasMonitor
  If delay > 3000: delay = 3000: EndIf ;sanity check
  _canvasMonitor\delay = delay
EndProcedure

Procedure initCanvasMonitor() ;opens a window and sets initial conditions to display the monitor, returns true if successful
  Protected oldGadgetList, text.s
  Shared _canvasMonitor
  
  With _canvasMonitor
    If Not \isInitialized
      \window = OpenWindow(#PB_Any, 0, 0, 550, 320, "Canvas Gadget event reporter", #PB_Window_SystemMenu | #PB_Window_NoGadgets)
      If \window
        \image = CreateImage(#PB_Any, 550, 320)
        If \image
          StartDrawing(ImageOutput(\image))
            Box(0, 0, OutputWidth(), OutputHeight(), $C0C0C0)
            text = "No CanvasGadget Specified"
            DrawText((OutputWidth() - TextWidth(text)) / 2, (OutputHeight() - TextHeight(text)) / 2, text, 0, $FFFFFF)
          StopDrawing()
          
          oldGadgetList = UseGadgetList(WindowID(\window))
          ;decorate image with default display
          \imageGadget = ImageGadget(#PB_Any, 0, 0, 550, 320, ImageID(\image))
          UseGadgetList(oldGadgetList)
          If \imageGadget
            \isInitialized = 1
            \c_bak  = $C9D5C9 ;background                    
            \c_ttxt = $000000 ;title text
            \c_hbak = $BFBFDF ;history message background area
            \c_dtxt = $FFFFFF ;descriptive text labels & box lines 
            \c_cbak = $FF513F ;current message background area 
            \c_ctxt = $000000 ;current message text
            \c_abak = $A4F3FA ;attribute messagebackground area   
            \c_atxt = $A4F3FA ;attribute message text
            setCanvasMonitorDelay(10)
          Else
            FreeImage(\image): \image = 0
            CloseWindow(\window): \window = 0
          EndIf 
        Else 
          CloseWindow(\window): \window = 0
        EndIf 
      EndIf 
    EndIf
    
    ProcedureReturn \isInitialized
  EndWith
EndProcedure

Procedure updateCanvasMonitor(setup = 0) ;updates display of events for the monitored CanvasGadget, if setup <> 0, events won't be shown, only history status
  Static kx = 210, ky = 5, mx = 43, my = 5, vx = 310, vy = 45, lx = 90, ly = 300, cx = 160, cy = 230
  Protected mox = mx - 3, moy = my + 30, MMx = mx - 21, mmy = my + 88  
  Protected mwx = mx - 23, mwy = my + 108, mcx = mx - 30, mcy = my + 128, mbx = mx - 28, mby = my + 160
  Protected kfx = kx - 30, kfy = ky + 30, krx = kx - 32, kry = ky + 88
  Protected kix = kx - 36, kiy = ky + 108, kmx = kx - 18, kmy = ky + 160
  Protected ccx = cx - 53, ccy = cy + 20, ix = cx + 3, iy = cy + 40
  
  Shared _canvasMonitor
  
  Protected event, px, py, buttonStatus, keyStatus, rawKeyCode, inputKey, wheelData
  Protected isClipped, currentImageID, customCursor, cursor

  With _canvasMonitor
    Protected move_fcolor = \c_dtxt, wheel_fcolor = \c_dtxt, input_fcolor = \c_dtxt, raw_fcolor = \c_dtxt
    If \imageGadget 
      If Not setup And EventGadget() = \canvasGadget
        event = EventType()
        px = GetGadgetAttribute(\canvasGadget, #PB_Canvas_MouseX): py = GetGadgetAttribute(\canvasGadget, #PB_Canvas_MouseY)
        buttonStatus = GetGadgetAttribute(\canvasGadget, #PB_Canvas_Buttons)
        keyStatus = GetGadgetAttribute(\canvasGadget, #PB_Canvas_Modifiers)
        rawKeyCode = GetGadgetAttribute(\canvasGadget, #PB_Canvas_Key)
        inputKey = GetGadgetAttribute(\canvasGadget, #PB_Canvas_Input)
        wheelData = GetGadgetAttribute(\canvasGadget, #PB_Canvas_WheelDelta)
        isClipped = GetGadgetAttribute(\canvasGadget, #PB_Canvas_Clip)
        currentImageID = GetGadgetAttribute(\canvasGadget, #PB_Canvas_Image)
        customCursor = GetGadgetAttribute(\canvasGadget, #PB_Canvas_CustomCursor)
        cursor = GetGadgetAttribute(\canvasGadget, #PB_Canvas_Cursor)
        
        Select event
          Case #PB_EventType_MouseEnter: \isMouseOver = 1
          Case #PB_EventType_MouseLeave: \isMouseOver = 0
            CompilerIf  #PB_Compiler_OS = #PB_OS_MacOS
              ;signal mousebutton release if mouse leaves gadget
              \is_L_ButtonDown = 0
              \is_M_ButtonDown = 0
              \is_R_ButtonDown = 0
            CompilerEndIf 
            
          Case #PB_EventType_Focus    : \hasKeyboardFocus = 1: Dim \isVKeysDown(255)
          Case #PB_EventType_LostFocus: \hasKeyboardFocus = 0
          Case #PB_EventType_LeftButtonDown: \is_L_ButtonDown = 1
          Case #PB_EventType_LeftButtonUp: \is_L_ButtonDown = 0
          Case #PB_EventType_MiddleButtonDown: \is_M_ButtonDown = 1
          Case #PB_EventType_MiddleButtonUp: \is_M_ButtonDown = 0
          Case #PB_EventType_RightButtonDown: \is_R_ButtonDown = 1
          Case #PB_EventType_RightButtonUp: \is_R_ButtonDown = 0
          Case #PB_EventType_MouseMove: move_fcolor = \c_cbak
          Case #PB_EventType_MouseWheel: wheel_fcolor = \c_cbak
          Case #PB_EventType_Input: input_fcolor = \c_cbak
          Case #PB_EventType_KeyDown: raw_fcolor = \c_cbak: \isVKeysDown(rawKeyCode) = 1
          Case #PB_EventType_KeyUp: raw_fcolor = \c_cbak: \isVKeysDown(rawKeyCode) = 0
        EndSelect
        
      Else
        event = -1 ;value represents no valid event
      EndIf 
      
      Protected x, i
      StartDrawing(ImageOutput(\image))
        Box(0, 0, OutputWidth(), OutputHeight(), \c_bak)
        
        ;legend
        DrawingMode(#PB_2DDrawing_Transparent)
        x = DrawText(lx, ly, "Legend", \c_ttxt)
        x = DrawText(x, ly, ":  ", \c_dtxt)
        x = DrawText(x, ly, "Last Message", \c_cbak)
        x = DrawText(x, ly, ", ", \c_dtxt)
        DrawingMode(#PB_2DDrawing_Default)
        x = DrawText(x, ly, "Historical Status", \c_dtxt, \c_hbak)
        x = DrawText(x, ly, ", ", \c_dtxt, \c_bak)
        x = DrawText(x, ly, "Attribute Status", \c_atxt, \c_bak)
        
        ;mouse label
        DrawingMode(#PB_2DDrawing_Transparent)
        DrawText(mx, my, "Mouse", \c_ttxt)
        
        ;misc attributes
        x = DrawText(MMx, mmy, "Move :", move_fcolor): DrawText(x + 5, mmy, RSet(Str(px), 5, " ") + ", " + RSet(Str(py), 5, " "), \c_atxt)
        x = DrawText(mwx, mwy, "Wheel:", wheel_fcolor): DrawText(x + 5, mwy, RSet(Str(wheelData), 2, " "), \c_atxt)
        x = DrawText(mcx, mcy, "Clipped:", \c_dtxt):
        If isClipped
          DrawText(x + 10, mcy, "yes", \c_atxt)
        Else
          DrawText(x + 10, mcy, "no", \c_atxt)
        EndIf 
        x = DrawText(cx, cy, "Cursor:", \c_dtxt): DrawText(x + 5, cy, Str(cursor), \c_atxt)
        x = DrawText(ccx, ccy, "Custom Cursor:", \c_dtxt): DrawText(x + 5, ccy, "$" + RSet(Hex(customCursor), SizeOf(Integer), "0"), \c_atxt)
        x = DrawText(ix, iy, "Image:", \c_dtxt): DrawText(x + 5, iy, "$" + RSet(Hex(currentImageID), SizeOf(Integer), "0"), \c_atxt)
        
        ;mouse over
        DrawingMode(#PB_2DDrawing_Default)
        If event = #PB_EventType_MouseEnter Or event = #PB_EventType_MouseLeave
          Box(mox, moy + 20 - 20 * \isMouseOver, 50, 20, \c_cbak)
        Else
          Box(mox, moy + 20 - 20 * \isMouseOver, 50, 20, \c_hbak)
        EndIf 
        DrawingMode(#PB_2DDrawing_Outlined | #PB_2DDrawing_Transparent)
        Box(mox, moy, 50, 20, \c_dtxt): DrawText(mox + 8, moy + 1, "Enter", \c_dtxt)
        Box(mox, moy + 20, 50, 20, \c_dtxt): DrawText(mox + 12, moy + 21, "Exit", \c_dtxt)
   
        ;mouse buttons
        DrawingMode(#PB_2DDrawing_Default)
        If event = #PB_EventType_LeftClick : Box(mbx + 20, mby + 40, 20, 20, \c_cbak): EndIf 
        If event = #PB_EventType_RightClick: Box(mbx + 60, mby + 40, 20, 20, \c_cbak): EndIf 
        If event = #PB_EventType_LeftDoubleClick: Box(mbx + 20, mby + 20, 20, 20, \c_cbak): EndIf
        If event = #PB_EventType_RightDoubleClick: Box(mbx + 60, mby + 20, 20, 20, \c_cbak): EndIf 
        If event = #PB_EventType_LeftButtonUp Or event = #PB_EventType_LeftButtonDown
          Box(mbx + 20, mby + 80 + 20 * \is_L_ButtonDown, 20, 20, \c_cbak)
        Else
          Box(mbx + 20, mby + 80 + 20 * \is_L_ButtonDown, 20, 20, \c_hbak)
        EndIf 
        If event = #PB_EventType_MiddleButtonUp Or event = #PB_EventType_MiddleButtonDown
          Box(mbx + 40, mby + 80 + 20 * \is_M_ButtonDown, 20, 20, \c_cbak)
        Else
          Box(mbx + 40, mby + 80 + 20 * \is_M_ButtonDown, 20, 20, \c_hbak)
        EndIf 
        If event = #PB_EventType_RightButtonUp Or event = #PB_EventType_RightButtonDown
          Box(mbx + 60, mby + 80 + 20 * \is_R_ButtonDown, 20, 20, \c_cbak)
        Else
          Box(mbx + 60, mby + 80 + 20 * \is_R_ButtonDown, 20, 20, \c_hbak)
        EndIf 
        If buttonStatus & #PB_Canvas_LeftButton  : Box(mbx + 20, mby + 60, 20, 20, \c_abak): EndIf
        If buttonStatus & #PB_Canvas_MiddleButton: Box(mbx + 40, mby + 60, 20, 20, \c_abak): EndIf
        If buttonStatus & #PB_Canvas_RightButton : Box(mbx + 60, mby + 60, 20, 20, \c_abak): EndIf
        
        DrawingMode(#PB_2DDrawing_Outlined | #PB_2DDrawing_Transparent)
        DrawText(mbx + 25, mby, "Buttons", \c_ttxt)
        Box(mbx + 20, mby + 20, 20 * 3, 20 * 5, \c_dtxt): DrawText(mbx, mby + 22, "CC", \c_dtxt)
        Box(mbx + 20, mby + 40, 20 * 3, 20 * 3, \c_dtxt): DrawText(mbx + 8, mby + 42, "C", \c_dtxt)
        Box(mbx + 20, mby + 60, 20 * 3, 20 * 1, \c_dtxt)
        Box(mbx + 40, mby + 20, 20 * 1, 20 * 5, \c_dtxt)
        DrawText(mbx + 25, mby + 62, "L", \c_ttxt): DrawText(mbx + 44, mby + 62, "M", \c_ttxt): DrawText(mbx + 64, mby + 62, "R", \c_ttxt)
        DrawText(mbx + 8, mby + 82, "U", \c_dtxt)
        DrawText(mbx + 8, mby + 102, "D", \c_dtxt)
         
        ;keyboard label
        DrawingMode(#PB_2DDrawing_Transparent)
        DrawText(kx, ky, "Key", \c_ttxt)
        ;keyboard focus
        DrawingMode(#PB_2DDrawing_Default)
        If event = #PB_EventType_Focus Or event = #PB_EventType_LostFocus
          Box(kfx, kfy + 20 - 20 * \hasKeyboardFocus, 86, 20, \c_cbak)
        Else
          Box(kfx, kfy + 20 - 20 * \hasKeyboardFocus, 86, 20, \c_hbak)
        EndIf 
        DrawingMode(#PB_2DDrawing_Outlined | #PB_2DDrawing_Transparent)
        Box(kfx, kfy, 86, 20, \c_dtxt): DrawText(kfx + 23, kfy + 1, "Focus", \c_dtxt)
        Box(kfx, kfy + 20, 86, 20, \c_dtxt): DrawText(kfx + 8, kfy + 21, "Lost Focus", \c_dtxt)

        ;key codes
        DrawingMode(#PB_2DDrawing_Default)
        x = DrawText(krx, kry, "Raw Code: ", raw_fcolor, \c_bak): DrawText(x, kry, "$" + RSet(Hex(rawKeyCode), 2, "0"), \c_atxt, \c_bak)
        x = DrawText(kix, kiy, "Input Code: ", input_fcolor, \c_bak): DrawText(x, kiy, "$" + RSet(Hex(inputKey), 2, "0"), \c_atxt, \c_bak)
        
        ;key modifiers
        DrawingMode(#PB_2DDrawing_Default)
        If keyStatus & #PB_Canvas_Shift: Box(kmx, kmy + 20, 20, 20, \c_abak): EndIf
        If keyStatus & #PB_Canvas_Alt  : Box(kmx + 20, kmy + 20, 20, 20, \c_abak): EndIf
        CompilerIf #PB_Compiler_OS = #PB_OS_MacOS
          If keyStatus & #PB_Canvas_Command: Box(kmx + 40, kmy + 20, 20, 20, \c_abak): EndIf
        CompilerElse
          If keyStatus & #PB_Canvas_Control: Box(kmx + 40, kmy + 20, 20, 20, \c_abak): EndIf
        CompilerEndIf 
        DrawingMode(#PB_2DDrawing_Outlined | #PB_2DDrawing_Transparent)
        DrawText(kmx, kmy, "Modifiers", \c_ttxt)
        Box(kmx, kmy + 20, 20 * 3, 20 * 1, \c_dtxt)
        Box(kmx + 20, kmy + 20, 20 * 1, 20 * 1, \c_dtxt)
        DrawText(kmx + 6, kmy + 22, "S", \c_ttxt): DrawText(kmx + 26, kmy + 22, "A", \c_ttxt): DrawText(kmx + 45, kmy + 22, "C", \c_ttxt)
        
        ;virtual keys status
        DrawingMode(#PB_2DDrawing_Default)
        For i = 0 To 255
          If \isVKeysDown(i) = 1
            If rawKeyCode = i
              Box(vx + (i % 16) * 14, vy + (i / 16) * 14, 14, 14, \c_cbak)
            Else
              Box(vx + (i % 16) * 14, vy + (i / 16) * 14, 14, 14, \c_hbak)
            EndIf 
          EndIf 
        Next
        
        DrawingMode(#PB_2DDrawing_Outlined | #PB_2DDrawing_Transparent)
        DrawText(vx + 50, vy - 40, "Virtual Key Status", \c_dtxt)
        Box(vx, vy, 16 * 14, 16 * 14, \c_dtxt)
        Line(vx, vy + 8 * 14, 16 * 14, 1, \c_dtxt)
        Line(vx + 8 * 14, vy, 1, 16 * 14, \c_dtxt)
        For i = 0 To 15: DrawText(vx + i * 14 + ((14 - TextWidth(Hex(i))) / 2), vy - 16, Hex(i), \c_dtxt): Next
        For i = 0 To 15: DrawText(vx - 18, vy  + i * 14 + ((14 - TextHeight(Hex(i) + "x")) / 2), Hex(i) + "x", \c_dtxt): Next
        For i = 1 To 7
          Box(vx, vy + i * 14, 16 * 14, (8 - i) * 2 * 14, \c_dtxt)
          Box(vx + i * 14, vy, (8 - i) * 2 * 14, 16 * 14, \c_dtxt)
        Next 
        
      StopDrawing()
      
      SetGadgetState(\imageGadget, ImageID(\image))
      
      If \delay >=0: Delay(\delay): EndIf 
    EndIf
  EndWith
EndProcedure

Procedure monitorCanvas(canvasID, description.s = "") ;sets the monitor to display events for a specific CanvasGadget
  ;returns false if canvasID does not exist or if it is not a CanvasGadget
  Shared _canvasMonitor
  
  With _canvasMonitor
    If \isInitialized And IsGadget(canvasID) And GadgetType(canvasID) = #PB_GadgetType_Canvas
      \canvasGadget = canvasID
      
      Dim \isVKeysDown(255)
      \is_L_ButtonDown = 0: \is_M_ButtonDown = 0: \is_R_ButtonDown = 0
      \hasKeyboardFocus = 0
      \isMouseOver = 0
      If description
        description = ", " + description
      EndIf 
      SetWindowTitle(\window, "Canvas gadget event reporter -- #" + Str(canvasID) + description)
      updateCanvasMonitor(1)
      ProcedureReturn 1 ;success
    EndIf
  EndWith
  
  ProcedureReturn 0 ;failure
EndProcedure

Procedure stopCanvasMonitor() ;stops the current display of events for any CanvasGadget, needs monitorCanvas() to restart
  Shared _canvasMonitor
  
  With _canvasMonitor
    \canvasGadget = 0
    If \isInitialized And IsWindow(\window)
      SetWindowTitle(\window, "Canvas gadget event reporter, no gadget selected")
    EndIf 
  EndWith
EndProcedure

Procedure closeCanvasMonitor() ;ends monitoring and closes monitor window, need initCanvasMonitor() to restart monitoring
  Shared _canvasMonitor
  With _canvasMonitor
    If IsGadget(\imageGadget)
      FreeGadget(\imageGadget)
    EndIf
    
    If IsImage(\image)
      FreeImage(\image)
    EndIf
    
    If IsWindow(\window)
      CloseWindow(\window)
    EndIf
  EndWith  
  
  ClearStructure(@_canvasMonitor, _canvasMonitor)
EndProcedure

DisableExplicit
And now a short example:

Code: Select all

;Author: Demivec
;program: displays CanvasGadget events in a graphical way
;Date: 3/15/2012
;Written for PB v4.61
;

XIncludeFile "canvasMonitor.pbi"
EnableExplicit

Enumeration ;gadgets
  #redCanvas
  #whiteCanvas
  #greenCanvas
  #button
EndEnumeration
  
OpenWindow(0, 0, 0, 210, 80, "Our Gadget's Window", #PB_Window_SystemMenu)
CanvasGadget(#redCanvas, 0, 0, 100, 60, #PB_Canvas_Keyboard | #PB_Canvas_DrawFocus)
CanvasGadget(#whiteCanvas, 100, 0, 110, 50, #PB_Canvas_Keyboard | #PB_Canvas_DrawFocus)
CanvasGadget(#greenCanvas, 100, 50, 110, 30) ;note that keyboard interaction is not allowed for this gadget
ButtonGadget(#button, 0, 60, 100, 20, "Switch Monitor")
StartDrawing(CanvasOutput(#redCanvas))
  Box(0, 0, OutputWidth(), OutputHeight(), RGB(255, 0, 0))
  DrawText((OutputWidth() - TextWidth("Gadget #0")) / 2, (OutputHeight() - TextHeight("Gadget #0")) / 2, "Gadget #0", 0, $FFFFFF)
StopDrawing()
StartDrawing(CanvasOutput(#whiteCanvas))
  DrawText((OutputWidth() - TextWidth("Gadget #1")) / 2, (OutputHeight() - TextHeight("Gadget #1")) / 2, "Gadget #1", 0, $FFFFFF)
StopDrawing()
StartDrawing(CanvasOutput(#greenCanvas))
  Box(0, 0, OutputWidth(), OutputHeight(), RGB(0, 255, 0))
  DrawText((OutputWidth() - TextWidth("Gadget #2")) / 2, (OutputHeight() - TextHeight("Gadget #2")) / 2, "Gadget #2", 0, $FFFFFF)
StopDrawing()

Define event, monitoredGadget = #redCanvas
initCanvasMonitor(): monitorCanvas(monitoredGadget)

Repeat
  
  Repeat 
    event = WindowEvent()
    If event = #PB_Event_CloseWindow
      Break 2
    EndIf
    
    If event = #PB_Event_Gadget
      updateCanvasMonitor()
      If EventGadget() = #button
        monitoredGadget = (monitoredGadget + 1) % 4
        monitorCanvas(monitoredGadget)
      EndIf
    EndIf 
  Until event = 0
  
ForEver
To demonstrate the ease with which you can put this into existing or developing code here is an example with the current example in the help file for the canvas gadget called 'CanvasGadget.pb'. Make the few changes to it, as detailed below:

Code: Select all

;insert the following before the 'enumeration' line on line 11
XIncludeFile "canvasMonitor.pbi" ;if not in the same directory put the complete path to the include file

;insert the following 3 lines before the 'repeat' line on line 113 (was originally 112)
initCanvasMonitor()
setCanvasMonitorDelay(-1)
monitorCanvas(#GADGET_Canvas, "draw surface")

;insert the follow line before the 'select' line on line 121 (was originally 117)
updateCanvasMonitor()

I have decided to implement the display of the remaining attributes of mouse clipping, mouse cursor info and image info. It will take require some thinking to decide how they will be displayed. Stay tuned...

@Edit: The canvas monitor now includes all attributes of the CanvasGadget. It also includes better colors, hopefully, and the source can be easily modified to customize them. A programmatic way could be done without much difficulty; I have left that as an exercise for those that think this is really necessary :wink: . I have updated the include file above.

TODO: address an issue with the 'Alt' key because of the side effects caused when it is pushed. These include where it isn't registered until it is pressed twice, and also tracking other keys' down status when 'Alt' is pushed.
Last edited by Demivec on Wed Mar 21, 2012 3:20 am, edited 1 time in total.
User avatar
Derren
Enthusiast
Enthusiast
Posts: 316
Joined: Sat Jul 23, 2011 1:13 am
Location: Germany

Re: Visual display of CanvasGadget events

Post by Derren »

Nice one.
All you need to do now is to use constants for the color scheme :P
User avatar
Demivec
Addict
Addict
Posts: 4269
Joined: Mon Jul 25, 2005 3:51 pm
Location: Utah, USA

Re: Visual display of CanvasGadget events

Post by Demivec »

The canvas monitor now includes all attributes of the CanvasGadget. It also includes better colors, hopefully, and the source can be easily modified to customize them. A programmatic way could be done without much difficulty; I have left that as an exercise for those that think this is really necessary . I have updated the include file 'canvasMonitor.pbi' in the previous message.

TODO: address an issue with the 'Alt' key because of the side effects caused when it is pushed. These include where it isn't registered until it is pressed twice, and also tracking other keys' down status when 'Alt' is pushed.
Post Reply