A On Mouse Over Event for Gadgets

Share your advanced PureBasic knowledge/code with the community.
PAMKKKKK
User
User
Posts: 18
Joined: Sun May 01, 2005 7:55 am
Location: Germany Braunschweig
Contact:

A On Mouse Over Event for Gadgets

Post by PAMKKKKK »

Code updated For 5.20+

Hi Folks!

My second Program i develop a onMouseOver Event for Gadgets.
additionally it is a GagProgramm
who wisch to better....... here it is

Code: Select all

;******************************************************************************
; On mouse Over Demo
; Peter Kriegel http://www.network-gui.de 30.April.2005
; if the code is selfexplaining in englisch, i  use the German explanation only
;
; Demonstrate how you get easy an "on Mouse over" event from a Gadget
; only for Gadgets wich are rectangular
; Demonstriert wie man leicht ein On Mouse Over ereignis (event) von einem Gadget bekommt
; nur für Gadgets die rechteckige werte liefern
;******************************************************************************

;Procedure delivers 1 if the Mouse is ove the Gadget and 0 if is not
;Prozedur liefert 1 wenn die Maus über dem Gadget ist und 0 wenn nicht
;******************************************************************************
Procedure.b onMouseOver(GadgedNr)
  X = GadgetX(GadgedNr) ; queries Gadget X erfragen
  Y = GadgetY(GadgedNr) ; queries Gadget Y erfragen
  Mx = WindowMouseX(1) ; queries Mouse X erfragen
  My =WindowMouseY(1) ; queries Mouse Y erfragen
  ; in the if, i do the rectangular calculation and the compare with the Mousecoordinates
  ; in der if abfrage wird das Rechteckberechnet und mit den Mausekoordinaten verglichen
  ; GadgetWidth(GadgedNr) Gadget Breite erfragen / GadgetHeight(GadgedNr) Gadget Höhe erfragen
  If Mx > X And Mx < (X + GadgetWidth(GadgedNr)) And My > Y And My < (Y + GadgetHeight(GadgedNr) )
    ProcedureReturn 1 ; Mouse is over the Gadget ; Maus ist über dem Gadget
  EndIf
  ProcedureReturn 0 ; Mouse is not over the Gadget ; Maus ist nicht über dem Gadget
EndProcedure
;******************************************************************************
; begin Create Window and Gadgets ; Beginn Fenster und Gadgets erstellen
If OpenWindow(1, 216, 0, 260, 135 , "On Mouse over Demo",  #PB_Window_TitleBar | #PB_Window_ScreenCentered | #PB_Window_Invisible)
  
  ButtonGadget(1, 30, 80, 50, 25, "No")
  ; Paint first Image vor the Yes Button ; Das erste Bild für den Yes Knopf malen
  If CreateImage(1, 45, 20)
    If StartDrawing(ImageOutput(1)) ; das malen Starten
      DrawingMode(1)
      Box(0, 0, 45, 20 ,RGB($EC,$E9,$D8))
      DrawText(10, 3,"Yes")
      ;             (
      StopDrawing(); dont forget !!  ; das malen Stoppen nicht vergessen !!
    EndIf
    ; Paint second Image vor the Yes Button ; Das zweite Bild für den Yes Knopf malen
    If CreateImage(2, 45, 20)
      If StartDrawing(ImageOutput(2)) ; das malen Starten
        DrawingMode(1)
        Box(0, 0, 45, 20 ,RGB($0,$80,$FF))
        DrawText(5, 3,"Sure?")
        ;               (
        StopDrawing(); dont forget !!  ; das malen Stoppen nicht vergessen !!
      EndIf
    EndIf
    ButtonImageGadget(2, 100, 80, 50, 25, ImageID(1))  ; the Yes Button ; Der Yes Knopf
  EndIf
  TextGadget(3,30,20,200,20,"Haben Sie einen kleinen Penis ?",#PB_Text_Center)
  TextGadget(4,30,50,200,20,"Do you have a tiny dick ?",#PB_Text_Center)
  
EndIf
HideWindow(1,0)
; end Window stuff + Gadget ; Ende Fenster + Gadget 
;******************************************************************************
toggle = 0 ; Position switch Variable for Jumping Button ; Position Schalt Variable für den Springenden Knopf
Repeat
  EventID = WaitWindowEvent()
  If EventID <> 0 ; is true every Window event ; wird bei jedem Fensterereignis ausgeführt
    If onMouseOver(1) ; If the Mouse is over the Gadget1  then .... ; Wenn die Mause über dem Gadget1 ist dann ....
      If toggle ; .... let the button1 jump ; .... lass den Knopf1 springen
        ResizeGadget(1,GadgetX(1) - 140 ,-1,-1,-1) ; move the Button in X - 200 ; verschiebe den Knopf in X - 200
        ;UpdateWindow_(WindowID(1)) ; winAPI perhapst needed, on winXP not ; winAPI vieleicht nötig, auf winXP nicht
        toggle = 0
      Else
        ResizeGadget(1,GadgetX(1) + 140 ,-1,-1,-1); move the Button in X + 200 ; verschiebe den Knopf in X + 200
        ;UpdateWindow_(WindowID(1)) ; winAPI perhapst needed, on winXP not ; winAPI vieleicht nötig, auf winXP nicht
        toggle = 1       
      EndIf
    EndIf
    If onMouseOver(2) ; If the Mouse is over the Gadget2  then .... ; Wenn die Mause über dem Gadget2 ist dann ....
      SetGadgetState(2,ImageID(2)) ; .... use Image2 for the button2 .... ; .... benutze das Image2 für den Knopf2....
    Else
      SetGadgetState(2,ImageID(1))  ; .... else use Image1 for the button2 ; .... sonnst benutze das Image1 für den Knopf2
    EndIf
  EndIf
  Select EventID ; remainig Window event ; die restlichen Fensterereignisse
    Case #PB_Event_CloseWindow
      ;End ; The Window doesn´t close on this event !!; Das Fenster wird hier nicht geschlossen!!
    Case #PB_Event_Gadget
      Select EventGadget()
        Case 2 ; if Button Yes is Pressed ; Wenn der Yes Knopf gedrückt wurde
          MessageRequester("Poor Boy!!", "Armer Junge!!", #MB_OK|#MB_ICONWARNING)
          End ; here ends all ;Und alles zuende
      EndSelect
  EndSelect
ForEver
End

Have Phun!
Develop Standards, and you develop the World!
User avatar
Hroudtwolf
Addict
Addict
Posts: 803
Joined: Sat Feb 12, 2005 3:35 am
Location: Germany(Hessen)
Contact:

Post by Hroudtwolf »

a shorter way is....

Code: Select all

Procedure IsMouseOverGadget(gadget.l) 
    wnd.l=GadgetID(gadget.l)
    GetWindowRect_(wnd,re.RECT) 
    re\Left = re\left 
    re\top  = re\top 
    re\right  = re\right 
    re\bottom  = re\bottom 
    GetCursorPos_(pt.POINT) 
    Result = PtInRect_(re,pt\x,pt\y) 
    ProcedureReturn Result 
EndProcedure
 
PAMKKKKK
User
User
Posts: 18
Joined: Sun May 01, 2005 7:55 am
Location: Germany Braunschweig
Contact:

My solution is without winAPI

Post by PAMKKKKK »

butt... my solution is without winAPI !

And if you look at the relevant procedure...
my is even shorter :wink:
Develop Standards, and you develop the World!
thefool
Always Here
Always Here
Posts: 5875
Joined: Sat Aug 30, 2003 5:58 pm
Location: Denmark

Post by thefool »

Code: Select all

Procedure.b onMouseOver(GadgedNr)
  X = GadgetX(GadgedNr) ; queries Gadget X erfragen
  Y = GadgetY(GadgedNr) ; queries Gadget Y erfragen
  Mx = WindowMouseX() ; queries Mouse X erfragen
  My =WindowMouseY() ; queries Mouse Y erfragen
GadgetHeight(GadgedNr) Gadget Höhe erfragen
  If Mx > X And Mx < (X + GadgetWidth(GadgedNr)) And My > Y And My < (Y + GadgetHeight(GadgedNr) )
    ProcedureReturn 1
  EndIf
  ProcedureReturn 0
EndProcedure 
acutally its exact equal number of lines :)
but its definently a good thing that its without winapi! actually pb should support this as standart, but its not an urge.
User avatar
NoahPhense
Addict
Addict
Posts: 1999
Joined: Thu Oct 16, 2003 8:30 pm
Location: North Florida

Re: A On Mouse Over Event for Gadgets

Post by NoahPhense »

;)

Code: Select all

Declare ButtonImageGadget2(gadget.l, x.l, y.l, width.l, height.l, imageID.l, imgBorder.l)

#WND1 = 0

#BIG1 = 301
#BAR1 = 302

#IMG1 = 1

#WindowPain = #PB_Window_SystemMenu | #PB_Window_TitleBar | #PB_Window_ScreenCentered

Global Image0.l
Image0 = CatchImage(#IMG1, ?Image0)

hWin = OpenWindow(#WND1, 20, 20, 300, 300, #WindowPain, "ButtonImageGadget2") 
  If CreateGadgetList(WindowID(#WND1))
    ButtonImageGadget2(#BIG1, 10, 10, 150, 150, #IMG1, 15)
    hStatusBar = CreateStatusBar(#BAR1, WindowID(#WND1))
  EndIf 

Repeat
  Event = WaitWindowEvent()

  Select Event 

    Case #PB_EventGadget
      GadgetID = EventGadgetID()
        Select GadgetID
          Case #BIG1
            Debug "blah"
         EndSelect

    Case #WM_MOUSEMOVE 
      GetCursorPos_(@cursor_pos.POINT) 
      ScreenToClient_(WindowID(#WND1),@cursor_pos) 
      hChild = ChildWindowFromPoint_(WindowID(#WND1), cursor_pos\x,cursor_pos\y) 
      idChild = GetDlgCtrlID_(hChild) 

      Select idChild
        Case #BIG1        ; over the button
          StatusBarText(#BAR1, 0, "You are over the button.")
        Default           ; dont really need default - just using to test for other ids
          ;Debug idChild
      EndSelect
      
      Select hChild
        Case hWin         ; over the window
          StatusBarText(#BAR1, 0, "")
        Case hStatusBar   ; over the status bar
          StatusBarText(#BAR1, 0, "You are over the status bar.")
        Default           ; dont really need default - just using to test for other ids
          ;Debug hChild
      EndSelect
      
    Case 160 
      StatusBarText(#BAR1, 0, "")
  EndSelect 

Until Event = #PB_EventCloseWindow

End 

DataSection 
  Image0:
  IncludeBinary "C:\source\purebasic\Projects\Image & Sound\JL_BADGE_1024.bmp"
  ;IncludeBinary "C:\masm32\examples\EXAMPLE2\SHOWDIB\apollo11.bmp"
EndDataSection

Procedure ButtonImageGadget2(gadget.l, x.l, y.l, width.l, height.l, imageID.l, imgBorder.l) 
  UseImage(imageID)
  ResizeImage(imageID, width - imgBorder, height - imgBorder)
  NewImageID.l = UseImage(imageID) 
  ProcedureReturn ButtonImageGadget(gadget, x, y, width, height, NewImageID)
EndProcedure
- np
User avatar
NoahPhense
Addict
Addict
Posts: 1999
Joined: Thu Oct 16, 2003 8:30 pm
Location: North Florida

Post by NoahPhense »

Thanks for the API and NON-API code!!

- np
PAMKKKKK
User
User
Posts: 18
Joined: Sun May 01, 2005 7:55 am
Location: Germany Braunschweig
Contact:

when where why what ??

Post by PAMKKKKK »

@ thefool

the code is shorter :wink:
you dont have to use the line

Code: Select all

GadgetHeight(GadgedNr) Gadget Höhe erfragen
This is a Germann coment

Shorter is:

Code: Select all

Procedure.b onMouseOver(GadgedNr)
  X = GadgetX(GadgedNr) 
  Y = GadgetY(GadgedNr)
  Mx = WindowMouseX() 
  My =WindowMouseY() 
  If Mx > X And Mx < (X + GadgetWidth(GadgedNr)) And My > Y And My < (Y + GadgetHeight(GadgedNr) )
    ProcedureReturn 1
  EndIf
  ProcedureReturn 0
EndProcedure
The Variables X, Y, Mx and My, i use only for Performance reasons. (the Pure Functions are called once not twice)

The shortes thing is only one if and two returns:
(but a tic slower an not very beginner frendly)

Code: Select all

Procedure.b onMouseOver(GadgedNr)
  If WindowMouseX() > GadgetX(GadgedNr) And WindowMouseX() < (GadgetX(GadgedNr) + GadgetWidth(GadgedNr)) And WindowMouseY() > GadgetY(GadgedNr) And WindowMouseY() < (GadgetY(GadgedNr) + GadgetHeight(GadgedNr) )
    ProcedureReturn 1
  EndIf
  ProcedureReturn 0
EndProcedure
@ NoahPhense

What does your code do ??
No explanation?!?!?!

I cant use your code, i dont have the includes!
Develop Standards, and you develop the World!
User avatar
NoahPhense
Addict
Addict
Posts: 1999
Joined: Thu Oct 16, 2003 8:30 pm
Location: North Florida

Re: when where why what ??

Post by NoahPhense »

There's only one include.. you can get it from here.

http://bellsouthpwp.net/n/p/np/images/JL_BADGE_1024.bmp

- np
venom
User
User
Posts: 56
Joined: Fri Jul 25, 2003 1:54 pm
Location: Australia

Post by venom »

In Hroudtwolf's example why is 're' being assigned to itself?
Sub-Routine
User
User
Posts: 82
Joined: Tue May 03, 2005 2:51 am
Location: Wheeling, Illinois, USA
Contact:

Post by Sub-Routine »

In Hroudtwolf's example why is 're' being assigned to itself?
I was wondering this myself.

Rand
PAMKKKKK
User
User
Posts: 18
Joined: Sun May 01, 2005 7:55 am
Location: Germany Braunschweig
Contact:

Post by PAMKKKKK »

@NoahPhense
Sorry ! I didn´t reply to you!
I have tested your Code, and its well done :mrgreen:
Develop Standards, and you develop the World!
Post Reply