RollOverGadget

[Alexa]

I tried a lot and I failed adding the fade effect between the normal image and hover image .. it freezes somehow .. I will paste my code in here , did you manage to add that feature into your code dear Guimauve

[TI-994A]

Hello Guimauve. Great code indeed. I made some modifications to the DrawRollOverButton() procedure in your Version 4, and managed to simulate the fade effect that Alexa's looking for. It's not perfect, and noticeably slow, but with a little more optimisation to the drawing routines, it could work well:

replace the DrawRollOverButton() procedure in Guimauve's Version 4 with this:

Code: Select all

Procedure DrawRollOverButton(GadgetID)
  
  Static OneShot.b, BackgroundColor.l 
  
  If OneShot = #False
    
    OneShot = #True
    
    CompilerSelect #PB_Compiler_OS 
        
      CompilerCase #PB_OS_Windows  
        BackgroundColor = GetSysColor_(#COLOR_3DFACE) 
        
      CompilerCase #PB_OS_Linux 
        BackgroundColor = RGB(238, 237, 236)
        
      CompilerCase #PB_OS_MacOS 
        BackgroundColor = RGB(237, 235, 236) 
        
    CompilerEndSelect 
    
  EndIf
  
  If IsGadget(GadgetID)
    
    *RollOverA.RollOver = GetGadgetData(GadgetID)
    
    If *RollOverA <> #Null
      
      If IsImage(GetRollOverStateImage(*RollOverA, GetRollOverCurrentState(*RollOverA)))
        
        If GetRollOverCurrentState(*RollOverA)
          
          For fade = 1 To 255
            If StartDrawing(CanvasOutput(GadgetID))
              Box(0, 0, GadgetWidth(GadgetID), GadgetHeight(GadgetID), BackgroundColor)
              DrawAlphaImage(ImageID(GetRollOverStateImage(*RollOverA, GetRollOverCurrentState(*RollOverA))), 0, 0, fade)
              StopDrawing()
            EndIf
          Next fade
          
        Else  
          
          StartDrawing(CanvasOutput(GadgetID))
            DrawAlphaImage(ImageID(GetRollOverStateImage(*RollOverA, GetRollOverCurrentState(*RollOverA))), 0, 0)
          StopDrawing()
          
        EndIf    
        
      EndIf
      
    EndIf
    
  EndIf
  
EndProcedure

Due to the structure of the current routines, fading both in and out would be too slow. It's currently set to fade out when the mouse moves away.

[StarBootics]

Hello everyone,

A small conversion of Guimauve's into a module no example, sorry.
Maybe for images to use with this module is to use the VectorIcon

Best regards
StarBootics

Code: Select all

; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
; Project name : RollOverGadget - Module
; File Name : RollOverGadget - Module.pb
; File version: 0.0.0
; Programming : OK
; Programmed by : StarBootics
; Date : 26-03-2016
; Last Update : 26-03-2016
; PureBasic code : V5.42 LTS
; Platform : Windows, Linux, MacOS X
; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<

; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
; This code was originally created by Guimauve.
;
; I deserve credit only to convert the original 
; code into a Module.
;
; This code is free to be use where ever you like 
; but you use it at your own risk.
;
; The author can in no way be held responsible 
; for data loss, damage or other annoying 
; situations that may occur.
;
; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<

DeclareModule RollOver
  
  Declare Gadget(GadgetID.l, x.l, y.l, FileName00.s, FileName01.s = "")
  Declare SwitchImage(GadgetID.l, WinID.l)
  Declare Free(GadgetID.l)
  
EndDeclareModule

Module RollOver
  
  Enumeration
    
    #STATE_HOVER
    #STATE_NORMAL
    #STATE_MAX
    
  EndEnumeration
  
  Structure RollOver
    
    CurrentState.b
    StateImage.l[#STATE_MAX]
    
  EndStructure
  
  ; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
  ; <<<<< L'opérateur HoverGadgetCheck <<<<<
  
  Macro HoverGadgetCheck(x, y, Gadget)
    
    (x >= GadgetX(Gadget) And y >= GadgetY(Gadget) And x < (GadgetX(Gadget) + GadgetWidth(Gadget)) And y < (GadgetY(Gadget) + GadgetHeight(Gadget)))
    
  EndMacro
  
  ; <<<<<<<<<<<<<<<<<<<<<<<<<<<
  ; <<<<< Le Constructeur <<<<<
  
  Procedure.i CreateNewRollOver()
    
    *RollOverA.RollOver = AllocateMemory(SizeOf(RollOver))
    
    If *RollOverA = #Null
      MessageRequester("Fatal Error", "CreateNewRollOverButton() - Impossible to Allocate Memory !")
      End
    EndIf
    
    ProcedureReturn *RollOverA
  EndProcedure
  
  Procedure Gadget(GadgetID.l, x.l, y.l, FileName00.s, FileName01.s = "")
    
    *RollOverA.RollOver = CreateNewRollOver()
    
    If *RollOverA <> #Null
      
      If FileName01 = ""
        
        ImageHandle = LoadImage(#PB_Any, FileName00)
        
        Width = ImageWidth(ImageHandle) >> 1
        Height = ImageHeight(ImageHandle)
        
        *RollOverA\StateImage[#STATE_HOVER] = GrabImage(ImageHandle, #PB_Any, 0, 0, Width, Height)
        *RollOverA\StateImage[#STATE_NORMAL] = GrabImage(ImageHandle, #PB_Any, Width, 0, Width, Height)
        FreeImage(ImageHandle)
        
      Else
        
        *RollOverA\StateImage[#STATE_HOVER] = LoadImage(#PB_Any, FileName01)
        *RollOverA\StateImage[#STATE_NORMAL] = LoadImage(#PB_Any, FileName00)
        
        Width = ImageWidth(*RollOverA\StateImage[#STATE_NORMAL])
        Height = ImageHeight(*RollOverA\StateImage[#STATE_NORMAL])
        
      EndIf
      
      GadgetHandle = ImageGadget(GadgetID, x, y, Width, Height, ImageID(*RollOverA\StateImage[#STATE_NORMAL]))
      
      If GadgetID = #PB_Any
        GadgetID = GadgetHandle
      EndIf
      
      *RollOverA\CurrentState = #STATE_NORMAL
      SetGadgetData(GadgetID, *RollOverA)
      
    EndIf
    
    ProcedureReturn GadgetHandle
  EndProcedure
  
  Procedure SwitchImage(GadgetID.l, WinID.l)
    
    If IsGadget(GadgetID)
      
      WinMouseX = WindowMouseX(WinID)
      WinMouseY = WindowMouseY(WinID)
      
      *RollOverA.RollOver = GetGadgetData(GadgetID)
      
      If *RollOverA <> 0
        
        If HoverGadgetCheck(WinMouseX, WinMouseY, GadgetID)
          
          If *RollOverA\CurrentState <> #STATE_HOVER
            SetGadgetState(GadgetID, ImageID(*RollOverA\StateImage[#STATE_HOVER]))
            *RollOverA\CurrentState = #STATE_HOVER
          EndIf
          
        Else
          
          If *RollOverA\CurrentState <> #STATE_NORMAL
            SetGadgetState(GadgetID, ImageID(*RollOverA\StateImage[#STATE_NORMAL]))
            *RollOverA\CurrentState = #STATE_NORMAL
          EndIf
          
        EndIf
        
      EndIf
      
    EndIf
    
  EndProcedure
  
  Procedure Free(GadgetID.l)
    
    If IsGadget(GadgetID)
      
      *RollOverA.RollOver = GetGadgetData(GadgetID)
      
      If *RollOverA <> #Null
        
        *RollOverA\CurrentState = 0
        
        For Index = 0 To #STATE_MAX - 1
          
          If IsImage(*RollOverA\StateImage[Index])
            FreeImage(*RollOverA\StateImage[Index])
            *RollOverA\StateImage[Index] = 0
          EndIf
          
        Next
        
        FreeMemory(*RollOverA)
        FreeGadget(GadgetID)
      EndIf
      
    EndIf
    
  EndProcedure
  
EndModule

; <<<<<<<<<<<<<<<<<<<<<<<
; <<<<< END OF FILE <<<<<
; <<<<<<<<<<<<<<<<<<<<<<<