ScreenGadget prototype

Share your advanced PureBasic knowledge/code with the community.
Post Reply
User avatar
Guimauve
Enthusiast
Enthusiast
Posts: 742
Joined: Wed Oct 22, 2003 2:51 am
Location: Canada

ScreenGadget prototype

Post by Guimauve »

A small ScreenGadget prototype. I will probably not complete this code, so if someone is willing to complete, GO FOR IT !

Regards
Guimauve

Edit : The SetPOINTx and SetPOINTy Macros are now properlly located in the code. Sorry about that.

Save this file as : Screen Gadget Prototype.pb

Code: Select all

; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
; Project name : Screen Gadget Prototype
; File : Screen Gadget Prototype.pb
; File Version : 0.5.1
; Programmation : To be Complete
; Programmed by : Guimauve
; Date : 22-08-2006
; Last Update : 22-08-2006
; Coded for PureBasic V4.00
; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<

Procedure.b MouseReleasedButton(ButtonNumber.b)
  
  Static Appel.b, Appuyee.b, Relachee.b, Memoire.b
  
  If Appel = #False
    Relachee = #False
    Memoire = #False
    Appel = #True
  EndIf 
  
  Appuyee = MouseButton(ButtonNumber)
  
  If Appuyee = #True 
    Relachee = #False 
    Memoire = #True
  EndIf 
  
  If Appuyee = #False And Relachee = #False And Memoire = #True 
    Relachee = #True
    Appel = #False  
  EndIf 
  
  ProcedureReturn Relachee
EndProcedure 

Procedure.w WrapWord(Nombre.w, Minimum.w, Maximum.w)
  
  If Nombre > Maximum
    Nombre = Maximum 
  ElseIf Nombre < Minimum 
    Nombre = Minimum 
  EndIf
  
  ProcedureReturn Nombre
EndProcedure 

Procedure.l ColorLuminosity(Couleur, Echelle.f) ; Eclaicir ou foncer une couleur
  ProcedureReturn RGB(WrapWord(Red(Couleur) * Echelle, 0, 255), WrapWord(Green(Couleur) * Echelle, 0, 255), WrapWord(Blue(Couleur) * Echelle, 0, 255))
EndProcedure

; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
; AUTOMATICALLY GENERATED CODE, DO NOT MODIFY
; UNLESS YOU REALLY, REALLY, REALLY MEAN IT !!
; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<

; <<<<<<<<<<<<<<<<<<<<
; <<<<< Mutators >>>>>

Macro SetPOINTx(ObjetA, P_x)
  ObjetA\x = P_x
EndMacro

Macro SetPOINTy(ObjetA, P_y)
  ObjetA\y = P_y
EndMacro

; <<<<<<<<<<<<<<<<<<<<<<<
; <<<<< Observators >>>>>

Macro GetPOINTx(ObjetA)
  ObjetA\x
EndMacro

Macro GetPOINTy(ObjetA)
  ObjetA\y
EndMacro

; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
; <<<<< Code generated in : 15 ms <<<<<
; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<

; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
; <<<<< Structure declaration >>>>>

Structure ZONE

  x.w
  y.w
  Width.w
  Height.w

EndStructure

; <<<<<<<<<<<<<<<<<<<<
; <<<<< Mutators >>>>>

Macro SetZONEx(ZoneA, P_x)
  ZoneA\x = P_x
EndMacro

Macro SetZONEy(ZoneA, P_y)
  ZoneA\y = P_y
EndMacro
 
Macro SetZONEWidth(ZoneA, P_Width)
  ZoneA\Width = P_Width
EndMacro
 
Macro SetZONEHeight(ZoneA, P_Height)
  ZoneA\Height = P_Height 
EndMacro

; <<<<<<<<<<<<<<<<<<<<<<<
; <<<<< Observators >>>>>

Macro GetZONEx(ZoneA) 
  ZoneA\x 
EndMacro

Macro GetZONEy(ZoneA) 
  ZoneA\y 
EndMacro

Macro GetZONEWidth(ZoneA)
  ZoneA\Width
EndMacro

Macro GetZONEHeight(ZoneA)
  ZoneA\Height
EndMacro

; <<<<<<<<<<<<<<<<<<<<<<<<<
; <<<<< Simple Update >>>>>
 
Macro UpdateZONE(ZoneA, P_x, P_y, P_Width, P_Height)
  SetZONEx(ZoneA, P_x)
  SetZONEy(ZoneA, P_y)
  SetZONEWidth(ZoneA, P_Width)
  SetZONEHeight(ZoneA, P_Height)
EndMacro

; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
; <<<<< Code generated in : 16 ms <<<<<
; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<

Procedure FindZONECenter(*ZoneA.ZONE, *Center.POINT)
  SetPOINTx(*Center, (GetZONEWidth(*ZoneA)  >> 1) + GetZONEx(*ZoneA))
  SetPOINTy(*Center, (GetZONEHeight(*ZoneA) >> 1) + GetZONEy(*ZoneA))
EndProcedure 

ProcedureDLL.b MouseInsideZONE(*ZoneA.ZONE)
  If MouseX() > GetZONEx(*ZoneA) 
    If MouseX() < (GetZONEx(*ZoneA) + GetZONEWidth(*ZoneA))
      If MouseY() > GetZONEy(*ZoneA) 
        If MouseY() < (GetZONEy(*ZoneA) + GetZONEHeight(*ZoneA))
          InsideZone.b = #True 
        EndIf 
      EndIf  
    EndIf  
  EndIf 
  ProcedureReturn InsideZone
EndProcedure 

Enumeration 
  
  #Scr_Gadget_Text_Center
  #Scr_Gadget_Text_Left
  #Scr_Gadget_Text_Right
  
EndEnumeration 

Procedure BtnFaceRect3D(*Zone.ZONE, Texte$ ,TxtColor, BtnColor, state.b)
  
  x.w = GetZONEx(*Zone)
  y.w = GetZONEy(*Zone)
  Width.w = GetZONEWidth(*Zone)
  Height.w = GetZONEHeight(*Zone)
  FindZONECenter(*Zone, Center.POINT)
  
  StartDrawing(ScreenOutput());>
    
    TxtHeight = TextHeight(Texte$) >> 1   
    TxtLength = TextWidth(Texte$) >> 1
    
    If state = 0
      
      Couleur_COUCHE_00 = ColorLuminosity(BtnColor, 0.50) 
      Couleur_COUCHE_01 = ColorLuminosity(BtnColor, 0.60)
      Couleur_COUCHE_02 = ColorLuminosity(BtnColor, 0.70)
      Couleur_COUCHE_03 = ColorLuminosity(BtnColor, 0.80)
      Couleur_COUCHE_04 = ColorLuminosity(BtnColor, 0.92)
      Couleur_COUCHE_05 = ColorLuminosity(BtnColor, 0.97)
      Txt_x = GetPOINTx(Center)-TxtLength
      Txt_y = GetPOINTy(Center)-TxtHeight
      
    ElseIf state = 1
      
      Couleur_COUCHE_00 = ColorLuminosity(BtnColor, 0.97) 
      Couleur_COUCHE_01 = ColorLuminosity(BtnColor, 0.92)
      Couleur_COUCHE_02 = ColorLuminosity(BtnColor, 0.80)
      Couleur_COUCHE_03 = ColorLuminosity(BtnColor, 0.70)
      Couleur_COUCHE_04 = ColorLuminosity(BtnColor, 0.60)
      Couleur_COUCHE_05 = ColorLuminosity(BtnColor, 0.50)
      Txt_x = GetPOINTx(Center)-TxtLength + 1
      Txt_y = GetPOINTy(Center)-TxtHeight + 1
      
    EndIf 
    
    Box(x , y, Width, Height, Couleur_COUCHE_00)
    Box(x+1 , y+1, Width-2, Height-2, Couleur_COUCHE_01)
    Box(x+2 , y+2, Width-4, Height-4, Couleur_COUCHE_02)
    Box(x+3 , y+3, Width-6, Height-6, Couleur_COUCHE_03)
    Box(x+4 , y+4, Width-8, Height-8, Couleur_COUCHE_04)
    Box(x+5 , y+5, Width-10, Height-10, Couleur_COUCHE_05)
    
    Box(x+6 , y+6, Width-12, Height-12, BtnColor)
    
    DrawingMode(1)
    DrawText(Txt_x, Txt_y, Texte$, TxtColor)
    
  StopDrawing();<
  
EndProcedure 

Procedure BtnFaceRound3D(*Zone.ZONE, Texte$ ,TxtColor, BtnColor, state.b)
  
  x.w = GetZONEx(*Zone)
  y.w = GetZONEy(*Zone)
  Width.w = GetZONEWidth(*Zone) >> 1
  
  StartDrawing(ScreenOutput());>
    
    FindZONECenter(*Zone, Center.POINT)
    
    TxtHeight = TextHeight(Texte$) >> 1   
    TxtLength = TextWidth(Texte$) >> 1
    
    If state = 0
      
      Couleur_COUCHE_00 = ColorLuminosity(BtnColor, 0.50) 
      Couleur_COUCHE_01 = ColorLuminosity(BtnColor, 0.60)
      Couleur_COUCHE_02 = ColorLuminosity(BtnColor, 0.70)
      Couleur_COUCHE_03 = ColorLuminosity(BtnColor, 0.80)
      Couleur_COUCHE_04 = ColorLuminosity(BtnColor, 0.92)
      Couleur_COUCHE_05 = ColorLuminosity(BtnColor, 0.97)
      
      x = GetPOINTx(Center)-TxtLength
      y = GetPOINTy(Center)-TxtHeight
      
    ElseIf state = 1
      
      Couleur_COUCHE_00 = ColorLuminosity(BtnColor, 0.97) 
      Couleur_COUCHE_01 = ColorLuminosity(BtnColor, 0.92)
      Couleur_COUCHE_02 = ColorLuminosity(BtnColor, 0.80)
      Couleur_COUCHE_03 = ColorLuminosity(BtnColor, 0.70)
      Couleur_COUCHE_04 = ColorLuminosity(BtnColor, 0.60)
      Couleur_COUCHE_05 = ColorLuminosity(BtnColor, 0.50)
      
      x = GetPOINTx(Center)-TxtLength+1
      y = GetPOINTy(Center)-TxtHeight+1
      
    EndIf 
    
    Circle(GetPOINTx(Center), GetPOINTy(Center), Width, Couleur_COUCHE_00)
    Circle(GetPOINTx(Center), GetPOINTy(Center), Width-1, Couleur_COUCHE_01)
    Circle(GetPOINTx(Center), GetPOINTy(Center), Width-2, Couleur_COUCHE_02)
    Circle(GetPOINTx(Center), GetPOINTy(Center), Width-3, Couleur_COUCHE_03)
    Circle(GetPOINTx(Center), GetPOINTy(Center), Width-4, Couleur_COUCHE_04)
    Circle(GetPOINTx(Center), GetPOINTy(Center), Width-5, Couleur_COUCHE_05)
    
    Circle(GetPOINTx(Center), GetPOINTy(Center), Width-6, BtnColor)
    
    DrawingMode(1)
    DrawText(x, y, Texte$, TxtColor)
    
  StopDrawing();<
  
EndProcedure 

Procedure BtnFaceEllipse3D(*Zone.ZONE, Texte$ ,TxtColor, BtnColor, state.b)
  
  x.w = GetZONEx(*Zone)
  y.w = GetZONEy(*Zone)
  Width.w = GetZONEWidth(*Zone) >> 1
  Height.w = GetZONEHeight(*Zone) >> 1
  
  StartDrawing(ScreenOutput());>
    
    FindZONECenter(*Zone, Center.POINT)
    
    TxtHeight = TextHeight(Texte$) >> 1   
    TxtLength = TextWidth(Texte$) >> 1
    
    If state = 0
      
      Couleur_COUCHE_00 = ColorLuminosity(BtnColor, 0.50) 
      Couleur_COUCHE_01 = ColorLuminosity(BtnColor, 0.60)
      Couleur_COUCHE_02 = ColorLuminosity(BtnColor, 0.70)
      Couleur_COUCHE_03 = ColorLuminosity(BtnColor, 0.80)
      Couleur_COUCHE_04 = ColorLuminosity(BtnColor, 0.92)
      Couleur_COUCHE_05 = ColorLuminosity(BtnColor, 0.97)
      
      x = GetPOINTx(Center)-TxtLength
      y = GetPOINTy(Center)-TxtHeight
      
    ElseIf state = 1
      
      Couleur_COUCHE_00 = ColorLuminosity(BtnColor, 0.97) 
      Couleur_COUCHE_01 = ColorLuminosity(BtnColor, 0.92)
      Couleur_COUCHE_02 = ColorLuminosity(BtnColor, 0.80)
      Couleur_COUCHE_03 = ColorLuminosity(BtnColor, 0.70)
      Couleur_COUCHE_04 = ColorLuminosity(BtnColor, 0.60)
      Couleur_COUCHE_05 = ColorLuminosity(BtnColor, 0.50)
      
      x = GetPOINTx(Center)-TxtLength+1
      y = GetPOINTy(Center)-TxtHeight+1
      
    EndIf 
    
    Ellipse(GetPOINTx(Center), GetPOINTy(Center), Width, Height,  Couleur_COUCHE_00)
    Ellipse(GetPOINTx(Center), GetPOINTy(Center), Width-1, Height-1, Couleur_COUCHE_01)
    Ellipse(GetPOINTx(Center), GetPOINTy(Center), Width-2, Height-2, Couleur_COUCHE_02)
    Ellipse(GetPOINTx(Center), GetPOINTy(Center), Width-3, Height-3, Couleur_COUCHE_03)
    Ellipse(GetPOINTx(Center), GetPOINTy(Center), Width-4, Height-4, Couleur_COUCHE_04)
    Ellipse(GetPOINTx(Center), GetPOINTy(Center), Width-5, Height-4, Couleur_COUCHE_05)
    
    Ellipse(GetPOINTx(Center), GetPOINTy(Center), Width-6, Height-6, BtnColor)
    
    DrawingMode(1)
    DrawText(x, y, Texte$, TxtColor)
    
  StopDrawing();<
  
EndProcedure 

Procedure BtnFaceOblong3D(*Zone.ZONE, Texte$ ,TxtColor, BtnColor, state.b)
  
  x.w = GetZONEx(*Zone)
  y.w = GetZONEy(*Zone)
  Width.w = GetZONEWidth(*Zone)
  Height.w = GetZONEHeight(*Zone)
  Radius.w = Height >> 1
  
  StartDrawing(ScreenOutput());>
    
    FindZONECenter(*Zone, Center.POINT)
    
    TxtHeight = TextHeight(Texte$) >> 1   
    TxtLength = TextWidth(Texte$) >> 1
    
    If state = 0
      
      Couleur_COUCHE_00 = ColorLuminosity(BtnColor, 0.50) 
      Couleur_COUCHE_01 = ColorLuminosity(BtnColor, 0.60)
      Couleur_COUCHE_02 = ColorLuminosity(BtnColor, 0.70)
      Couleur_COUCHE_03 = ColorLuminosity(BtnColor, 0.80)
      Couleur_COUCHE_04 = ColorLuminosity(BtnColor, 0.92)
      Couleur_COUCHE_05 = ColorLuminosity(BtnColor, 0.97)
      
      Txt_x = GetPOINTx(Center)-TxtLength
      Txt_y = GetPOINTy(Center)-TxtHeight
      
    ElseIf state = 1
      
      Couleur_COUCHE_00 = ColorLuminosity(BtnColor, 0.97) 
      Couleur_COUCHE_01 = ColorLuminosity(BtnColor, 0.92)
      Couleur_COUCHE_02 = ColorLuminosity(BtnColor, 0.80)
      Couleur_COUCHE_03 = ColorLuminosity(BtnColor, 0.70)
      Couleur_COUCHE_04 = ColorLuminosity(BtnColor, 0.60)
      Couleur_COUCHE_05 = ColorLuminosity(BtnColor, 0.50)
      
      Txt_x = GetPOINTx(Center)-TxtLength+1
      Txt_y = GetPOINTy(Center)-TxtHeight+1
      
    EndIf 
    
    Circle(x + Radius, y + Radius, Radius, Couleur_COUCHE_00)
    Box(x+Radius, y, Width-2*Radius, Height, Couleur_COUCHE_00)
    Circle(x +Width - Radius, y + Radius, Radius, Couleur_COUCHE_00)
    
    Circle(x + Radius, y + Radius, Radius-1, Couleur_COUCHE_01)
    Box(x+Radius, y+1, Width-2*Radius, Height-2, Couleur_COUCHE_01)
    Circle(x +Width - Radius, y + Radius, Radius-1, Couleur_COUCHE_01)
    
    Circle(x + Radius, y + Radius, Radius-2, Couleur_COUCHE_02)
    Box(x+Radius, y+2, Width-2*Radius, Height-4, Couleur_COUCHE_02)
    Circle(x +Width - Radius, y + Radius, Radius-2, Couleur_COUCHE_02)
    
    Circle(x + Radius, y + Radius, Radius-3, Couleur_COUCHE_03)
    Box(x+Radius, y+3, Width-2*Radius, Height-6, Couleur_COUCHE_03)
    Circle(x +Width - Radius, y + Radius, Radius-3, Couleur_COUCHE_03)
    
    Circle(x + Radius, y + Radius, Radius-4, Couleur_COUCHE_04)
    Box(x+Radius, y+4, Width-2*Radius, Height-8, Couleur_COUCHE_04)
    Circle(x +Width - Radius, y + Radius, Radius-4, Couleur_COUCHE_04)
    
    Circle(x + Radius, y + Radius, Radius-5, Couleur_COUCHE_05)
    Box(x+Radius, y+5, Width-2*Radius, Height-10, Couleur_COUCHE_05)
    Circle(x +Width - Radius, y + Radius, Radius-5, Couleur_COUCHE_05)
    
    Circle(x + Radius, y + Radius, Radius-6, BtnColor)
    Box(x+Radius, y+6, Width-2*Radius, Height-12, BtnColor)
    Circle(x +Width - Radius, y + Radius, Radius-6, BtnColor)
    
    DrawingMode(1)
    DrawText(Txt_x, Txt_y, Texte$, TxtColor)
    
  StopDrawing();<
  
EndProcedure 
   
Procedure TextFace(*Zone.ZONE, Texte$ ,TxtColor, Options)
  
  x.w = GetZONEx(*Zone)
  y.w = GetZONEy(*Zone)
  Width.w = GetZONEWidth(*Zone)
  Height.w = GetZONEHeight(*Zone)
  FindZONECenter(*Zone, Center.POINT)
  
  StartDrawing(ScreenOutput());>
    
    TxtHeight = TextHeight(Texte$)   
    TxtLength = TextWidth(Texte$)
    
    Select Options 
      
      Case #Scr_Gadget_Text_Center
        x = GetPOINTx(Center) - (TxtLength >> 1)
        y = GetPOINTy(Center) - (TxtHeight >> 1)
        
      Case #Scr_Gadget_Text_Left
        y = GetPOINTy(Center) - (TxtHeight >> 1)
        
      Case #Scr_Gadget_Text_Right
        x = (x + Width) - TxtLength
        y = GetPOINTy(Center) - (TxtHeight >> 1)
        
    EndSelect
    
    DrawingMode(1)
    DrawText(x, y, Texte$, TxtColor)
  StopDrawing();<
  
EndProcedure 

Procedure CheckBoxFace(*Zone.ZONE, Texte$ ,TxtColor, CheckColor, CheckBackColor, state.b)
  
  x.w = GetZONEx(*Zone)
  y.w = GetZONEy(*Zone)
  Width.w = GetZONEWidth(*Zone)
  Height.w = GetZONEHeight(*Zone)
  FindZONECenter(*Zone, Center.POINT)
  
  StartDrawing(ScreenOutput());>
    
    TxtHeight = TextHeight(Texte$) >> 1  
    TxtLength = TextWidth(Texte$)
    
    Box(x , GetPOINTy(Center) - TxtHeight , 16,16, CheckBackColor)
    
    DrawingMode(4)
    Box(x , GetPOINTy(Center) - TxtHeight, 16,16, TxtColor)
    
    If state = 1
      Box(x + 2, GetPOINTy(Center) - 8 + 7, 1, 2, CheckColor)
      Box(x + 3, GetPOINTy(Center) - 8 + 6, 1, 6, CheckColor)
      Box(x + 4, GetPOINTy(Center) - 8 + 7, 1, 6, CheckColor)
      Box(x + 5, GetPOINTy(Center) - 8 + 8, 1, 6, CheckColor)
      Box(x + 6, GetPOINTy(Center) - 8 + 10, 1, 4, CheckColor)
      Box(x + 7, GetPOINTy(Center) - 8 + 9, 1, 5, CheckColor)
      Box(x + 8, GetPOINTy(Center) - 8 + 7, 1, 6, CheckColor)
      Box(x + 9, GetPOINTy(Center) - 8 + 5, 1, 6, CheckColor)
      Box(x + 10, GetPOINTy(Center) - 8 + 4, 1, 5, CheckColor)
      Box(x + 11, GetPOINTy(Center) - 8 + 3, 1, 4, CheckColor)
      Box(x + 12, GetPOINTy(Center) - 8 + 2, 1, 4, CheckColor)
      Box(x + 13, GetPOINTy(Center) - 8 + 2, 1, 3, CheckColor) 
    EndIf 
    
    DrawingMode(1)
    DrawText(x+18, GetPOINTy(Center)-TxtHeight, Texte$,TxtColor)
    
  StopDrawing();<
  
EndProcedure 

Enumeration 
  
  #Scr_Gadget_Island
  #Scr_Gadget_Rectangular_Button
  #Scr_Gadget_Oblong_Button
  #Scr_Gadget_Circular_Button
  #Scr_Gadget_Elliptical_Button
  #Scr_Gadget_Text
  #Scr_Gadget_Checkbox
  
EndEnumeration 

; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
; AUTOMATICALLY GENERATED CODE, DO NOT MODIFY
; UNLESS YOU REALLY, REALLY, REALLY MEAN IT !!
; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<

; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
; <<<<< Structure declaration >>>>>

Structure ScrGadget
  
  id.l
  Type.b
  Zone.ZONE
  Text.s
  ForeColor.l
  BackColor.l
  EffexColor.l
  Options.l
  state.b
  ClickDown.b
  ClickUp.b
  
EndStructure

; <<<<<<<<<<<<<<<<<<<<
; <<<<< Mutators >>>>>

Macro SetScrGadgetID(ObjetA, P_ID)
  ObjetA\id = P_ID
EndMacro

Macro SetScrGadgetType(ObjetA, P_Type)
  ObjetA\Type = P_Type
EndMacro

Macro SetScrGadgetZone(ObjetA, P_Zone)
  CopyZONE(P_Zone, ObjetA\Zone)
EndMacro

Macro SetScrGadgetText(ObjetA, P_Text)
  ObjetA\Text = P_Text
EndMacro

Macro SetScrGadgetForeColor(ObjetA, P_ForeColor) 
  ObjetA\ForeColor = P_ForeColor 
EndMacro

Macro SetScrGadgetBackColor(ObjetA, P_BackColor) 
  ObjetA\BackColor = P_BackColor 
EndMacro

Macro SetScrGadgetEffexColor(ObjetA, P_EffexColor) 
  ObjetA\EffexColor = P_EffexColor
EndMacro

Macro SetScrGadgetOptions(ObjetA, P_Options) 
 ObjetA\Options = P_Options
EndMacro

Macro SetScrGadgetState(ObjetA, P_State) 
  ObjetA\state = P_State 
EndMacro

Macro SetScrGadgetClickDown(ObjetA, P_ClickDown) 
  ObjetA\ClickDown = P_ClickDown 
EndMacro

Macro SetScrGadgetClickUp(ObjetA, P_ClickUp) 
  ObjetA\ClickUp = P_ClickUp 
EndMacro

; <<<<<<<<<<<<<<<<<<<<<<<
; <<<<< Observators >>>>>

Macro GetScrGadgetID(ObjetA)
  ObjetA\id
EndMacro

Macro GetScrGadgetType(ObjetA) 
  ObjetA\Type
EndMacro

Macro GetScrGadgetZone(ObjetA)
  ObjetA\Zone
EndMacro

Macro GetScrGadgetText(ObjetA)
  ObjetA\Text
EndMacro

Macro GetScrGadgetForeColor(ObjetA)
  ObjetA\ForeColor
EndMacro

Macro GetScrGadgetBackColor(ObjetA)
  ObjetA\BackColor
EndMacro

Macro GetScrGadgetEffexColor(ObjetA) 
  ObjetA\EffexColor 
EndMacro

Macro GetScrGadgetOptions(ObjetA) 
  ObjetA\Options 
EndMacro

Macro GetScrGadgetState(ObjetA) 
  ObjetA\state 
EndMacro

Macro GetScrGadgetClickDown(ObjetA) 
  ObjetA\ClickDown 
EndMacro

Macro GetScrGadgetClickUp(ObjetA) 
  ObjetA\ClickUp 
EndMacro

; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
; <<<<< Code generated in : 32 ms <<<<<
; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<

Global NewList ScrGadgetList.ScrGadget()

; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<

Procedure.b SwitchState(Nombre.b, Minimum.b, Maximum.b)
  
  Nombre + 1
  If Nombre > Maximum
    Nombre = Minimum 
  EndIf
  
  ProcedureReturn Nombre
EndProcedure

; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<

Procedure ThisScrGadgetIDExist(id) 
  
  Trouve = #False
  ForEach ScrGadgetList()
    If GetScrGadgetID(ScrGadgetList()) = id 
      Trouve = #True
      Break 
    EndIf
  Next 
  
  ProcedureReturn Trouve
EndProcedure

; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<

Procedure ButtonScrGadget(id.l, x.w, y.w, Width.w, Height.w, Text.s, TxtColor.l, BtnColor.l, Type.b) ;, Color03.l), Option.l, State.b)
  
  Succes.b = #False
  If ThisScrGadgetIDExist(id) = #False 
    If AddElement(ScrGadgetList())
      SetScrGadgetID(ScrGadgetList(), id)
      SetScrGadgetType(ScrGadgetList(), Type)
      UpdateZONE(GetScrGadgetZone(ScrGadgetList()), x, y, Width, Height)
      SetScrGadgetText(ScrGadgetList(), Text)
      SetScrGadgetForeColor(ScrGadgetList(), TxtColor)
      SetScrGadgetBackColor(ScrGadgetList(), BtnColor)
      Succes = #True 
    EndIf 
  EndIf 
  
  ProcedureReturn Succes 
EndProcedure

; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<

Procedure TextScrGadget(id.l, x.w, y.w, Width.w, Height.w, Text.s, TxtColor.l, Option.l) ;, Color03.l), Option.l, State.b)
  
  Succes.b = #False 
  If ThisScrGadgetIDExist(id) = #False 
    If AddElement(ScrGadgetList()) 
      SetScrGadgetID(ScrGadgetList(), id)
      SetScrGadgetType(ScrGadgetList(), #Scr_Gadget_Text)
      UpdateZONE(GetScrGadgetZone(ScrGadgetList()), x, y, Width, Height)
      SetScrGadgetText(ScrGadgetList(), Text)
      SetScrGadgetForeColor(ScrGadgetList(), TxtColor)
      SetScrGadgetOptions(ScrGadgetList(), Option)
      Succes = #True 
    EndIf 
  EndIf 
  
  ProcedureReturn Succes 
EndProcedure

; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<

Procedure CheckBoxScrGadget(id.l, x.w, y.w, Width.w, Height.w, Text.s, TxtColor.l, CheckColor.l, CheckBackColor.l)
  
  Succes.b = #False 
  If ThisScrGadgetIDExist(id) = #False  
    If AddElement(ScrGadgetList())
      SetScrGadgetID(ScrGadgetList(), id)
      SetScrGadgetType(ScrGadgetList(), #Scr_Gadget_Checkbox)
      UpdateZONE(GetScrGadgetZone(ScrGadgetList()), x, y, Width, Height)
      SetScrGadgetText(ScrGadgetList(), Text)
      SetScrGadgetForeColor(ScrGadgetList(), TxtColor)
      SetScrGadgetBackColor(ScrGadgetList(), CheckColor)
      SetScrGadgetEffexColor(ScrGadgetList(), CheckBackColor)
      Succes = #True 
    EndIf 
  EndIf 
  
  ProcedureReturn Succes 
EndProcedure

; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<

Procedure IslandScrGadget(id.l, x.w, y.w, Width.w, Height.w, BackColor.l)
  
  Succes.b = #False 
  If ThisScrGadgetIDExist(id) = #False  
    If AddElement(ScrGadgetList())
      SetScrGadgetID(ScrGadgetList(), id)
      SetScrGadgetType(ScrGadgetList(), #Scr_Gadget_Island)
      UpdateZONE(GetScrGadgetZone(ScrGadgetList()), x, y, Width, Height)
      SetScrGadgetForeColor(ScrGadgetList(), BackColor)
      Succes = #True 
    EndIf 
  EndIf 
  
  ProcedureReturn Succes 
EndProcedure

; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
; <<<<< Remise à zéro des cliques de souris <<<<<

Procedure ResetScrGadgetMouseClick()
  
  ForEach ScrGadgetList()
    SetScrGadgetClickDown(ScrGadgetList(), #False)
    SetScrGadgetClickUp(ScrGadgetList(), #False)
  Next 
  
EndProcedure 

; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
; <<<<< Trouver le Gadget Cliqué <<<<<

Procedure ScrGadgetClickDown()
  
  ForEach ScrGadgetList()
    If MouseInsideZONE(GetScrGadgetZone(ScrGadgetList())) = #True 
      SetScrGadgetClickDown(ScrGadgetList(), #True) 
    EndIf  
  Next 
  
EndProcedure 

; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
; <<<<< Trouver le Gadget Décliqué <<<<<

Procedure.l ScrGadgetClickUp()
  
  ForEach ScrGadgetList()
    If GetScrGadgetClickDown(ScrGadgetList())= #True
      If MouseInsideZONE(GetScrGadgetZone(ScrGadgetList())) = #True  
        If GetScrGadgetClickDown(ScrGadgetList()) = #True 
          SetScrGadgetClickUp(ScrGadgetList(), #True)
          EventGadgetID = GetScrGadgetID(ScrGadgetList()) 
          If GetScrGadgetType(ScrGadgetList()) = #Scr_Gadget_Checkbox 
            SetScrGadgetState(ScrGadgetList(), SwitchState(GetScrGadgetState(ScrGadgetList()),0,1)) 
          EndIf  
        EndIf  
      Else  
        EventGadgetID = -1 
      EndIf  
    EndIf  
  Next 
  
  ProcedureReturn EventGadgetID
EndProcedure

; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<

Procedure.l ScrGadgetEvent()
  
  ClearScreen(00)
  ExamineMouse()
  
  ForEach ScrGadgetList()
    
    Select GetScrGadgetType(ScrGadgetList())
      
      Case #Scr_Gadget_Island
        BtnFaceRect3D(GetScrGadgetZone(ScrGadgetList()), "" , 0, GetScrGadgetForeColor(ScrGadgetList()), 0)
        
      Case #Scr_Gadget_Rectangular_Button
        BtnFaceRect3D(GetScrGadgetZone(ScrGadgetList()), GetScrGadgetText(ScrGadgetList()) , GetScrGadgetForeColor(ScrGadgetList()), GetScrGadgetBackColor(ScrGadgetList()), MouseInsideZONE(GetScrGadgetZone(ScrGadgetList())))
        
      Case #Scr_Gadget_Oblong_Button 
        BtnFaceOblong3D(GetScrGadgetZone(ScrGadgetList()), GetScrGadgetText(ScrGadgetList()) , GetScrGadgetForeColor(ScrGadgetList()), GetScrGadgetBackColor(ScrGadgetList()), MouseInsideZONE(GetScrGadgetZone(ScrGadgetList())))
        
      Case #Scr_Gadget_Circular_Button 
        BtnFaceRound3D(GetScrGadgetZone(ScrGadgetList()), GetScrGadgetText(ScrGadgetList()) , GetScrGadgetForeColor(ScrGadgetList()), GetScrGadgetBackColor(ScrGadgetList()), MouseInsideZONE(GetScrGadgetZone(ScrGadgetList())))
        
      Case #Scr_Gadget_Elliptical_Button
        BtnFaceEllipse3D(GetScrGadgetZone(ScrGadgetList()), GetScrGadgetText(ScrGadgetList()) , GetScrGadgetForeColor(ScrGadgetList()), GetScrGadgetBackColor(ScrGadgetList()), MouseInsideZONE(GetScrGadgetZone(ScrGadgetList())))
        
      Case #Scr_Gadget_Text
        TextFace(GetScrGadgetZone(ScrGadgetList()), GetScrGadgetText(ScrGadgetList()) , GetScrGadgetForeColor(ScrGadgetList()), GetScrGadgetOptions(ScrGadgetList()))
        
      Case #Scr_Gadget_Checkbox
        CheckBoxFace(GetScrGadgetZone(ScrGadgetList()), GetScrGadgetText(ScrGadgetList()) , GetScrGadgetForeColor(ScrGadgetList()), GetScrGadgetBackColor(ScrGadgetList()), GetScrGadgetEffexColor(ScrGadgetList()), GetScrGadgetState(ScrGadgetList())) 
        
    EndSelect  
  Next 
  
  ForEach ScrGadgetList()
    
    ; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
    ; <<<<< Il faut enlever les gadgets décoratifs <<<<<
    ; <<<<< car ils ne génèrent aucun évènements.  <<<<<
    ; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
    
    If GetScrGadgetType(ScrGadgetList()) <> #Scr_Gadget_Island 
      If GetScrGadgetType(ScrGadgetList()) <> #Scr_Gadget_Text
        If MouseButton(1) = #True
          ScrGadgetClickDown() 
        EndIf 
        If MouseReleasedButton(1) = #True
          EventGadgetID.l = ScrGadgetClickUp()
          ResetScrGadgetMouseClick() 
        EndIf  
      EndIf  
    EndIf  
  Next 
  
  ProcedureReturn EventGadgetID
EndProcedure 

; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<

Procedure ModifyScrGadgetText(id.l, Text.s)
  
  Succes = #False
  ForEach ScrGadgetList()
    If GetScrGadgetID(ScrGadgetList()) = id
      SetScrGadgetText(ScrGadgetList(), Text)
      Succes = #True
      Break 
    EndIf
  Next 
  
  ProcedureReturn Succes
EndProcedure

; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<

Procedure CheckScrGadgetState(id.l)
  
  ForEach ScrGadgetList() 
    If GetScrGadgetID(ScrGadgetList()) = id
      state = GetScrGadgetState(ScrGadgetList())
      Break 
    EndIf
  Next 
  
  ProcedureReturn state 
EndProcedure

; <<<<<<<<<<<<<<<<<<<<<<<
; <<<<< END OF FILE <<<<<
; <<<<<<<<<<<<<<<<<<<<<<<
Save this file as : Exemple_Scr_Gadget.pb

Code: Select all

; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
; Project name : Exemple of use Screen Gadget Prototype
; File : Screen Gadget Exemple
; File Version : 1.0.0
; Programmation : Experimental code
; Programmed by : Guimauve
; Date : 22-08-2006
; Last Update : 22-08-2006
; Coded for PureBasic V4.00
; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<

IncludeFile "Screen Gadget Prototype.pb"

Enumeration 
  
  #Iles
  #Btn_RECT
  #Btn_OBLONG
  #Btn_ROND
  #Btn_ELLIPSE
  #Txt_Message
  #Check_Vert
  #Check_Rouge
  #Check_Bleu
  
EndEnumeration 

; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
; <<<<< Game menu Prototype <<<<<

ScreenW = GetSystemMetrics_(#SM_CXSCREEN)
ScreenH = GetSystemMetrics_(#SM_CYSCREEN)
Title.s = "Game menu Prototype"
#Cursor = 125

If InitKeyboard() = 0 Or InitSprite() = 0 Or InitSprite3D() = 0 Or InitMouse() = 0
  
  MessageRequester("ERROR","Can't initialize DirectX !",#MB_ICONERROR)
  End 
  
EndIf 

If OpenScreen(ScreenW, ScreenH, 32, Title) = 0 
  
  If OpenScreen(ScreenW, ScreenH, 24, Title) = 0 
    
    If OpenScreen(ScreenW, ScreenH, 16, Title) = 0 
      
      MessageRequester("ERROR", "Can't open DirectX screen !", #MB_ICONERROR)
      End
      
    EndIf
    
  EndIf
  
EndIf 

If CreateSprite(#Cursor, 32,32, #PB_Sprite_Texture)
  
  StartDrawing(SpriteOutput(#Cursor));>
    
    For Coord = 2 To 20
      Circle(Coord,4,4,#Blue) 
      Circle(4,Coord,4,#Blue) 
    Next
    
    For Coord = 0 To 27 Step 1
      Circle(Coord,Coord,4,#Blue) 
    Next
    
  StopDrawing();<
  
  CreateSprite3D(#Cursor, #Cursor)
  
EndIf

IslandScrGadget(#Iles, 0,0, 200,265, RGB(200,200,200))
ButtonScrGadget(#Btn_RECT, 10,10,180,30, "Bouton Rectangulaire", 0, #Yellow, #Scr_Gadget_Rectangular_Button) 
ButtonScrGadget(#Btn_OBLONG, 10,45,180,30,"Bouton Oblong - Quitter", #White,  #Gray , #Scr_Gadget_Oblong_Button) 
ButtonScrGadget(#Btn_ROND, 10,80,50,50, "Rond", 0, #Green, #Scr_Gadget_Circular_Button)
ButtonScrGadget(#Btn_ELLIPSE, 70,80, 100, 50, "Ovale", 0, RGB(150,30,255), #Scr_Gadget_Elliptical_Button) 
TextScrGadget(#Txt_Message, 10,135, 180,30, "Un texte centré" ,0, #Scr_Gadget_Text_Center)
CheckBoxScrGadget(#Check_Vert, 10,170, 200,20, "CheckBox 01 - Vert" ,0, #Green, #White)
CheckBoxScrGadget(#Check_Rouge, 10,200, 200,20, "CheckBox 02 - Rouge" ,0, #Red, #White)
CheckBoxScrGadget(#Check_Bleu, 10,230, 200,20, "CheckBox 03 - Bleu" ,0, #Blue, #White)

Repeat

  ScreenGadgetEvent = ScrGadgetEvent()
  
  Select ScreenGadgetEvent
    
    Case #Btn_RECT
      ModifyScrGadgetText(#Txt_Message, "Bouton Jaune Cliqué !")
      
    Case #Btn_OBLONG
      exit = #True
      
    Case #Btn_ROND
      ModifyScrGadgetText(#Txt_Message, "Bouton Rond Cliqué !")
      
    Case #Btn_ELLIPSE
      ModifyScrGadgetText(#Txt_Message, "Bouton Elliptique Cliqué !")
      
  EndSelect 
  
  Start3D();>
    DisplaySprite3D(#Cursor, MouseX(), MouseY())
  Stop3D();<
  
  ExamineKeyboard()
  
  FlipBuffers()
  
Until KeyboardPushed(#PB_Key_Escape) Or exit = #True

CloseScreen()
End

; <<<<<<<<<<<<<<<<<<<<<<<
; <<<<< END OF FILE <<<<<
; <<<<<<<<<<<<<<<<<<<<<<<
Last edited by Guimauve on Wed Aug 23, 2006 9:19 am, edited 2 times in total.
Top
rsts
Addict
Addict
Posts: 2736
Joined: Wed Aug 24, 2005 8:39 am
Location: Southwest OH - USA

Post by rsts »

Lots of nice stuff to learn from.

Thanks for sharing it with us.

cheers
Top
Dare
Addict
Addict
Posts: 1965
Joined: Mon May 29, 2006 1:01 am
Location: Outback

Post by Dare »

Hi Guimauve,

Nice.

Just a suggestion - you may want to shift the SetPOINTx and SetPOINTy Macros to the start of the code in your post above otherwise, as-is, it won't compile.

Thanks again. :)
Dare2 cut down to size
Top
Thalius
Enthusiast
Enthusiast
Posts: 711
Joined: Thu Jul 17, 2003 4:15 pm
Contact:
Contact Thalius

Post by Thalius »

Very Nice ! =)

Thanks for sharing!


Cheers, Thalius
"In 3D there is never enough Time to do Things right,
but there's always enough Time to make them *look* right."
"psssst! i steal signatures... don't tell anyone! ;)"
Top
Post Reply

Return to “Tricks 'n' Tips”