Macros, OOP, Custom gadgets, Automatic resizing

Share your advanced PureBasic knowledge/code with the community.
Post Reply
BorisTheOld
Enthusiast
Enthusiast
Posts: 542
Joined: Tue Apr 24, 2012 5:08 pm
Location: Ontario, Canada

Macros, OOP, Custom gadgets, Automatic resizing

Post by BorisTheOld »

Here's a small program that demonstrates some of the coding techniques that I use. The following posts contain a series of Include files that you can use with the following mainline program. In total, there are about 4900 lines of code. The code makes use of macros to create more readable code and to hide some of the PB clutter.

I prefer to write code that is easy to read, is easy to maintain, and is very modular. I started our PowerBasic to PureBasic conversion about three years ago and decided to use an OOP approach. The PB interface feature makes it possible to do this quite easily, and the resulting code is very modular. To simplify the code, and to avoid maintenance headaches, I avoid inheritance and other fancy OOP techniques. All classes are completely self-contained, which means we can tune them for both speed and functionality.

The classes in this example are highly edited versions of our actual classes. In order to keep this program to a reasonable size, I've removed the features that don't relate specifically to this example. This is particularly true of the auto-resizing code, which, although not complex, can be a little verbose.

Because some of our applications have been in use for almost 30 years, we have some very particular requirements for handling the GUI and the keyboard. This has required us to write our own versions of PB gadgets using the Canvas gadget, such as the Button class which is used in this example. The Canvas gadget has access to mouse and keyboard events that are not available with many other gadgets. Writing our own custom classes allows us to be truly cross-platform, without the need to use API code.

This sample program demonstrates the use of macros, OOP, custom controls, and automatic resizing. It is cross-platform, uses no API code, and has been tested using Linux Mint and Windows XP. It requires at least PB 5.20 LTS, x86.

NOTE: This code will not work correctly with Windows when using PB 5.21 LTS. In certain situations, the Canvas "focus" events are not being created by PB.

The program consists of the following files:

1) mainline code:

MOCAtest.pb

2) an Include file of constants and macros:

modMacro.pbi

3) Include files for the class interfaces:

objMOCAtest.pbi
objApplication.pbi
objContainer.pbi
objButtonBar.pbi
objButton.pbi
objGeneric.pbi

4) Include files for the class code:

clsMOCAtest.pbi
clsApplication.pbi
clsContainer.pbi
clsButtonBar.pbi
clsButton.pbi
clsGeneric.pbi


Here is the mainline code:

MOCAtest.pb

Code: Select all

;===============================================
;
;  file name       :  MOCAtest.pb
;  description     :  mainline code for package, "Macros, OOP, Custom gadgets, Automatic resizing"
;  author          :  Rod Gobby (BorisTheOld)
;  copyright       :  you have my permission to use this code as you wish
;  date generated  :  2013-10-23 21:00
;  configuration   :  PureBasic 5.20 LTS, x86, Linux & Windows
;  notes           :  no API used
;
;===============================================
;
;  common include files
;
IncludeFile "modMacro.pbi"                       ; global macros & constants
;
;-----------------------------------------------
;
;  interfaces
;
IncludeFile "objApplication.pbi"                 ; application interface
IncludeFile "objGeneric.pbi"                     ; generic interface
IncludeFile "objContainer.pbi"                   ; container interface
IncludeFile "objButtonBar.pbi"                   ; buttonBar interface
IncludeFile "objButton.pbi"                      ; button interface
IncludeFile "objMOCAtest.pbi"                    ; package interface 
;
;-----------------------------------------------
;
;  global objects
;
  GlobalObject(gloApp, objApplication)           ; declare the application object
  GlobalObject(gloMOCAtest, objMOCAtest)         ; declare the package object
;
;-----------------------------------------------
;
;  classes
;
IncludeFile "clsApplication.pbi"                 ; application class
IncludeFile "clsGeneric.pbi"                     ; generic class
IncludeFile "clsContainer.pbi"                   ; container class
IncludeFile "clsButtonBar.pbi"                   ; buttonBar class
IncludeFile "clsButton.pbi"                      ; button class
IncludeFile "clsMOCAtest.pbi"                    ; package class
;
;-----------------------------------------------
;
;  create global objects
;
;
  gloApp      = CreateObject(Application)        ; create the application object
  gloMOCAtest = CreateObject(MOCAtest)           ; create the package object
;
;-----------------------------------------------
;
;  package mainline
;
  ObjectCall(gloMOCAtest, Main) ()               ; execute the package
;
;-----------------------------------------------
;
;  destroy global objects
;
  DestroyObject(gloMOCAtest)                     ; destroy the package object                    
  DestroyObject(gloApp)                          ; destroy the application object
;
;-----------------------------------------------
;
End
;
;===============================================
;  end of  :  MOCAtest.pb
;===============================================
Last edited by BorisTheOld on Sun Nov 24, 2013 6:24 pm, edited 2 times in total.
For ten years Caesar ruled with an iron hand, then with a wooden foot, and finally with a piece of string.
~ Spike Milligan
Top
BorisTheOld
Enthusiast
Enthusiast
Posts: 542
Joined: Tue Apr 24, 2012 5:08 pm
Location: Ontario, Canada

Re: Macros, OOP, Custom gadgets, Automatic resizing

Post by BorisTheOld »

Here is the file that contains the constants and macros:

modMacro.pb

Note: you might need to change the button font and size constants to suit your configuration

Code: Select all

;===============================================
;
;  file name       :  modMacro.pbi
;  description     :  macros and constants for package, "Macros, OOP, Custom gadgets, Automatic resizing"
;  author          :  Rod Gobby (BorisTheOld)
;  copyright       :  you have my permission to use this code as you wish
;  date generated  :  2013-10-23 21:00
;  configuration   :  PureBasic 5.20 LTS, x86, Linux & Windows
;  notes           :  no API used
;
;===============================================
;
;  these constants can be changed to suit your configuration
;
#iBUTTONBAR_COLOUR = $FFFFFF           ; 16710 : buttonbar:  default colour : white
#iBUTTON_COLOUR_BORDER = $000000       ; 16707 : button:  default border colour : black
#iBUTTON_COLOUR_FOCUS = $00FFFF        ; 16705 : button:  default focus colour  : yellow
#iBUTTON_COLOUR_NORMAL = $FFFFFF       ; 16706 : button:  default normal colour : white
#iBUTTON_COLOUR_TEXT = $000000         ; 16708 : button:  default text colour   : black
#iBUTTON_CORNER_RADIUS = 2             ; 16714 : button:  default corner radius (pixels)
#sBUTTON_FONT_NAME = "Ubuntu"          ; 16700 : button:  default font name
#iBUTTON_FONT_SIZE = 11                ; 16701 : button:  default font size (points)
#iBUTTON_HEIGHT = 26                   ; 16703 : button:  default height (pixels)
#iBUTTON_SPACING = 4                   ; 16704 : button:  default spacing (pixels)
#iBUTTON_WIDTH = 80                    ; 16702 : button:  default width (pixels)
#iWINDOW_COLOUR = $998877              ; 16709 : window:  default colour : light slate gray
#iWINDOW_HEIGHT = 300                  ; 16712 : window:  default height (pixels)
#iWINDOW_PADDING = 16                  ; 16713 : window:  default padding (pixels)
#iWINDOW_WIDTH = 800                   ; 16711 : window:  default width (pixels)
;
;===============================================
;
;  these constants must not be changed
;
#iCALLBACK_POINTER_SIZE = 2            ; 15304 : number of entries in a callback pointer
#iCLASS_REF_APPLICATION = 6018         ; 15759 : module class:  application
#iCLASS_REF_BUTTON = 6045              ; 16432 : module class:  button
#iCLASS_REF_BUTTONBAR = 6044           ; 16431 : module class:  button bar
#iCLASS_REF_CONTAINER = 6019           ; 15760 : module class:  container
#iCLASS_REF_GENERIC = 6056             ; 16439 : module class:  generic
#iCLASS_REF_PAGE = 6071                ; 16516 : module class:  page
#iCLASS_REF_SPLITTER = 6020            ; 15768 : module class:  splitter
#iCOLOUR_DEFAULT = -1                  ; 16471 : colour:  default colour
#iEVENT_CUSTOM = $10000                ; 16492 : custom event base:  = #PB_Event_FirstCustomValue
#iEVENT_LEFT_CLICK = $10004            ; 16696 : custom event type:  simulated left click
#iGUI_ALIGN_CENTRE = 4                 ; 14558 : alignment:  position to the centre of the width or height
#iGUI_ALIGN_END = 3                    ; 13393 : alignment:  anchor to the right or bottom of the parent panel
#iGUI_ALIGN_FILL = 1                   ; 13391 : alignment:  expand to fill the parent panel
#iGUI_ALIGN_START = 2                  ; 13392 : alignment:  anchor to the left or top of the parent panel
#iGUI_LAYOUT_CENTRE = 5                ; 15765 : locate gadgets at box centre, maintain defined spacing
#iGUI_LAYOUT_EDGE = 2                  ; 15762 : lock gadgets to the box edges, stretch the spacing
#iGUI_LAYOUT_END = 4                   ; 15764 : lock gadgets to end of box, maintain defined spacing
#iGUI_LAYOUT_EXPAND = 6                ; 15766 : maintain gadget widths, stretch the spacing to fill the box
#iGUI_LAYOUT_FILL = 7                  ; 15767 : stretch the gadgets to fill the box, but with no spacing
#iGUI_LAYOUT_START = 3                 ; 15763 : lock gadgets to start of box, maintain defined spacing
#iGUI_LAYOUT_STRETCH = 1               ; 15761 : stretch the gadgets to fill the box, maintain defined spacing
#sNULL_STRING = ""                     ; 14040 : null value:  string
#iPAGE_MARGIN_LINUX_BOTTOM = 0         ; 16691 : adjustment to linux page container:  bottom (pixels)
#iPAGE_MARGIN_LINUX_LEFT = 0           ; 16692 : adjestment to linux page container:  left (pixels)
#iPAGE_MARGIN_LINUX_RIGHT = 0          ; 16693 : adjustment to linux page container:  right (pixels)
#iPAGE_MARGIN_LINUX_TOP = 1            ; 16690 : adjustment to linux page container:  top (pixels)
#iPAGE_MARGIN_WINDOWS_BOTTOM = 2       ; 16687 : adjustment to windows page container:  bottom (pixels)
#iPAGE_MARGIN_WINDOWS_LEFT = 2         ; 16688 : adjustment to windows page container:  left (pixels)
#iPAGE_MARGIN_WINDOWS_RIGHT = 1        ; 16689 : adjustment to windows page container:  right (pixels)
#iPAGE_MARGIN_WINDOWS_TOP = 3          ; 16686 : adjustment to windows page container:  top (pixels)
#lVALUE_FALSE = 0                      ; 15602 : value = 0  :  false
#lVALUE_TRUE = -1                      ; 15603 : value = -1  :  true
;
;===============================================
;
;  double quote for creating quoted strings
;
Macro QQ
  "
EndMacro
;
;===============================================
;
;  colon character used in macro creation
;
Macro QQColon
  :
EndMacro
;
;===============================================
;
;  null placeholder used in macro creation
;
Macro QQNull
EndMacro
;
;===============================================
;
;  creates the QQBlock macro
;
Macro CreateBlockName (bvsBlockName)
  QQNull#Macro Q#QQNull#QBlock#QQColon#bvsBlockName#QQColon#EndMacro
EndMacro
;
;===============================================
;
;  destroys the QQBlock macro
;
Macro DestroyBlockName
  UndefineMacro Q#QQNull#QBlock
EndMacro
;
;===============================================
;
;  begin a class definition
;
Macro BeginClass (bvsClassName)
  CreateBlockName(bvsClassName)
EndMacro
;
;===============================================
;
;  end a class definition
;
Macro EndClass
  DestroyBlockName
EndMacro
;
;===============================================
;
;  begin a class interface definition
;
Macro BeginClassInterface
  DeclareExternalFunction(Create, typObject) ()
  Interface obj#QQBlock
EndMacro
;
;===============================================
;
;  end a class interface definition
;
Macro EndClassInterface
  EndInterface
EndMacro
;
;===============================================
;
;  begin a class data definition
;
Macro BeginClassData
  Structure str#QQBlock
EndMacro
;
;===============================================
;
;  end a class data definition
;
Macro EndClassData
  EndStructure
EndMacro
;
;===============================================
;
;  begin the interface virtual table
;
Macro BeginVirtualTable
  DataSection
  Label(VirtualTable)
EndMacro
;
;===============================================
;
;  end the interface virtual table
;
Macro EndVirtualTable
  EndDataSection
EndMacro
;
;===============================================
;
;  replacement for pb:  default
;
Macro CaseElse
  Default
EndMacro
;
;===============================================
;
;  replacement for pb:  wend
;
Macro Loop
  Wend
EndMacro
;
;===============================================
;
;  exit from a loop:  for
;
Macro ExitFor
  Break
EndMacro
;
;===============================================
;
;  exit from a loop:  repeat
;
Macro ExitRepeat
  Break
EndMacro
;
;===============================================
;
;  element type:  character
;
Macro typChar
  S
EndMacro
;
;===============================================
;
;  element type:  int32
;
Macro typInt32
  L
EndMacro
;
;===============================================
;
;  element type:  boolean
;
Macro typBoolean
  L
EndMacro
;
;===============================================
;
;  element type:  dword
;
Macro typDword
  L
EndMacro
;
;===============================================
;
;  element type:  object
;
Macro typObject
  I
EndMacro
;
;===============================================
;
;  element type:  pointer
;
Macro typPointer
  I
EndMacro
;
;===============================================
;
;  element type:  string
;
Macro typString
  S
EndMacro
;
;===============================================
;
;  structure is passed by reference
;
Macro ByRef (bvsDataParmName, bvsDataParmType)
  *bvsDataParmName.bvsDataParmType
EndMacro
;
;===============================================
;
;  parameter is passed by value
;
Macro ByVal (bvsDataParmName, bvsDataParmType)
  bvsDataParmName.bvsDataParmType
EndMacro
;
;===============================================
;
;  a standard data type is passed by reference
;
Macro ByPtr (bvsDataParmName)
  *bvsDataParmName
EndMacro
;
;===============================================
;
;  a parameter is accessed by reference
;
Macro Ref (bvsDataParmName)
  *bvsDataParmName
EndMacro
;
;===============================================
;
;  self reference to the class property structure
;
Macro Me
  *Self
EndMacro
;
;===============================================
;
;  define a structure variable
;
Macro Field (bvsDataParmName, bvsDataParmType)
  bvsDataParmName.bvsDataParmType
EndMacro
;
;===============================================
;
;  define a structure pointer variable
;
Macro FieldPointer (bvsDataParmName)
  *bvsDataParmName
EndMacro
;
;===============================================
;
;  define a structure fixed array variable
;
Macro FieldFixedArray (bvsDataParmName, bvsDataParmType, bvsDataParmCount)
  Array bvsDataParmName.bvsDataParmType(bvsDataParmCount)
EndMacro
;
;===============================================
;
;  define a structure dynamic array variable
;
Macro FieldDynamicArray (bvsDataParmName, bvsDataParmType)
  Array bvsDataParmName.bvsDataParmType(0)
EndMacro
;
;===============================================
;
;  delete the contents of a dynamic array
;
Macro ClearDynamicArray (bvsDataParmName)
  Dim bvsDataParmName(0)
EndMacro
;
;===============================================
;
;  resize a dynamic array and preserve the contents
;
Macro ResizeDynamicArray (bvsDataParmName, bvsDataParmCount)
  Redim bvsDataParmName(bvsDataParmCount)
EndMacro
;
;===============================================
;
;  define an interface function
;
Macro InterfaceFunc (bvsDataParmName, bvsDataParmType)
  fun#bvsDataParmName.bvsDataParmType
EndMacro
;
;===============================================
;
;  define an interface subroutine
;
Macro InterfaceSubr (bvsDataParmName)
  sub#bvsDataParmName
EndMacro
;
;===============================================
;
;  define an interface get
;
Macro InterfaceGetx (bvsDataParmName, bvsDataParmType)
  get#bvsDataParmName.bvsDataParmType
EndMacro
;
;===============================================
;
;  define an interface set
;
Macro InterfaceSetx (bvsDataParmName)
  set#bvsDataParmName
EndMacro
;
;===============================================
;
;  define an external function block
;
Macro ExternalFunction (bvsProcName, bvsDataParmType)
  Procedure.bvsDataParmType cls#QQBlock#_fun#bvsProcName
EndMacro
;
;===============================================
;
;  define an external get block
;
Macro ExternalGet (bvsDataParmName, bvsDataParmType)
  Procedure.bvsDataParmType cls#QQBlock#_get#bvsDataParmName
EndMacro
;
;===============================================
;
;  define a private function block
;
Macro PrivateFunction (bvsProcName, bvsDataParmType)
  Procedure.bvsDataParmType cls#QQBlock#_fun#bvsProcName
EndMacro
;
;===============================================
;
;  terminate a function block
;
Macro EndFunction
  EndProcedure
EndMacro
;
;===============================================
;
;  terminate a get block
;
Macro EndGet
  EndProcedure
EndMacro
;
;===============================================
;
;  declare an external function block
;
Macro DeclareExternalFunction (bvsProcName, bvsDataParmType)
  Declare.bvsDataParmType cls#QQBlock#_fun#bvsProcName
EndMacro
;
;===============================================
;
;  declare a private function block
;
Macro DeclarePrivateFunction (bvsProcName, bvsDataParmType)
  Declare.bvsDataParmType cls#QQBlock#_fun#bvsProcName
EndMacro
;
;===============================================
;
;  define an external subroutine block
;
Macro ExternalSubroutine (bvsProcName)
  Procedure cls#QQBlock#_sub#bvsProcName
EndMacro
;
;===============================================
;
;  define an external set block
;
Macro ExternalSet (bvsProcName)
  Procedure cls#QQBlock#_set#bvsProcName
EndMacro
;
;===============================================
;
;  define a private subroutine block
;
Macro PrivateSubroutine (bvsProcName)
  Procedure cls#QQBlock#_sub#bvsProcName
EndMacro
;
;===============================================
;
;  terminate a subroutine block
;
Macro EndSubroutine
  EndProcedure
EndMacro
;
;===============================================
;
;  terminate a set block
;
Macro EndSet
  EndProcedure
EndMacro
;
;===============================================
;
;  declare an external subroutine block
;
Macro DeclareExternalSubroutine (bvsProcName)
  Declare cls#QQBlock#_sub#bvsProcName
EndMacro
;
;===============================================
;
;  declare a private subroutine block
;
Macro DeclarePrivateSubroutine (bvsProcName)
  Declare cls#QQBlock#_sub#bvsProcName
EndMacro
;
;===============================================
;
;  execute a class function and return a value
;
Macro ClassReturn (bvsProcName)
  cls#QQBlock#_fun#bvsProcName
EndMacro
;
;===============================================
;
;  execute an object function and return a value
;
Macro ObjectReturn (bvsObjectName, bvsProcName)
  bvsObjectName\fun#bvsProcName
EndMacro
;
;===============================================
;
;  execute a class subroutine
;
Macro ClassCall (bvsProcName)
  cls#QQBlock#_sub#bvsProcName
EndMacro
;
;===============================================
;
;  execute an object subroutine
;
Macro ObjectCall (bvsObjectName, bvsProcName)
  bvsObjectName\sub#bvsProcName
EndMacro
;
;===============================================
;
;  get a property value
;
Macro Get (bvsObjectName, bvsDataParmName)
  bvsObjectName\get#bvsDataParmName()
EndMacro
;
;===============================================
;
;  get an array property value
;
Macro GetArray (bvsObjectName, bvsDataParmName, bviIndex)
  bvsObjectName\get#bvsDataParmName(bviIndex)
EndMacro
;
;===============================================
;
;  set a property value
;
Macro Set (bvsObjectName, bvsDataParmName, bvsValue)
  bvsObjectName\set#bvsDataParmName(bvsValue)
EndMacro
;
;===============================================
;
;  set an array property value
;
Macro SetArray (bvsObjectName, bvsDataParmName, bviIndex, bvsValue)
  bvsObjectName\set#bvsDataParmName(bviIndex, bvsValue)
EndMacro
;
;===============================================
;
;  define a local variable
;
Macro Local (bvsDataParmName, bvsDataParmType)
  Protected bvsDataParmName.bvsDataParmType
EndMacro
;
;===============================================
;
;  define a global object
;
Macro GlobalObject (bvsDataParmName, bvsDataParmType)
  Global bvsDataParmName.bvsDataParmType
EndMacro
;
;===============================================
;
;  true if the item is an object
;
Macro IsObject (bvsDataParmName)
  bvsDataParmName <> 0
EndMacro
;
;===============================================
;
;   true if the item is not an object
;
Macro NotObject (bvsDataParmName)
  bvsDataParmName = 0
EndMacro
;
;===============================================
;
;  return an empty string value
;
Macro Null
  #sNULL_STRING
EndMacro
;
;===============================================
;
;  true if a string is empty
;
Macro IsNull (bvsDataParmName)
  bvsDataParmName = #sNULL_STRING
EndMacro
;
;===============================================
;
;  true if a string is not empty
;
Macro NotNull (bvsDataParmName)
  bvsDataParmName <> #sNULL_STRING
EndMacro
;
;===============================================
;
;  true if an expression is not zero
;
Macro IsTrue (bvsDataParmName)
  bvsDataParmName <> 0
EndMacro
;
;===============================================
;
;  true if an expression is zero
;
Macro IsFalse (bvsDataParmName)
  bvsDataParmName = 0
EndMacro
;
;===============================================
;
;  return a true value:  -1
;
Macro True
  #lVALUE_TRUE
EndMacro
;
;===============================================
;
;  return a false value:  0
;
Macro False
  #lVALUE_FALSE
EndMacro
;
;===============================================
;
;  define a label
;
Macro Label (bvsDataParmName)
  cls#QQBlock#_lbl#bvsDataParmName:
EndMacro
;
;===============================================
;
;  return a label pointer
;
Macro LabelPtr (bvsDataParmName)
  ?cls#QQBlock#_lbl#bvsDataParmName
EndMacro
;
;===============================================
;
;  return a function pointer
;
Macro FunctionPtr (bvsProcName)
  @cls#QQBlock#_fun#bvsProcName()
EndMacro
;
;===============================================
;
;  return a subroutine pointer
;
Macro SubroutinePtr (bvsProcName)
  @cls#QQBlock#_sub#bvsProcName()
EndMacro
;
;===============================================
;
;  return a variable pointer
;
Macro VarPtr (bvsDataParmName)
  @bvsDataParmName
EndMacro
;
;===============================================
;
;  define a virtual table pointer:  function
;
Macro VirtualFunc (bvsProcName)
  Data.I @cls#QQBlock#_fun#bvsProcName()
EndMacro
;
;===============================================
;
;  define a virtual table pointer:  subroutine
;
Macro VirtualSubr (bvsProcName)
  Data.I @cls#QQBlock#_sub#bvsProcName()
EndMacro
;
;===============================================
;
;  define a virtual table pointer:  get
;
Macro VirtualGetx (bvsProcName)
  Data.I @cls#QQBlock#_get#bvsProcName()
EndMacro
;
;===============================================
;
;  define a virtual table pointer:  set
;
Macro VirtualSetx (bvsProcName)
  Data.I @cls#QQBlock#_set#bvsProcName()
EndMacro
;
;===============================================
;
;  create a class instance
;
Macro CreateObject (bvsClassName)
  cls#bvsClassName#_funCreate()
EndMacro
;
;===============================================
;
;  destroy a class instance
;
Macro DestroyObject (bvsObjectName)
  If IsObject(bvsObjectName)
    bvsObjectName = bvsObjectName\funDestroy()
  EndIf
EndMacro
;
;===============================================
;
;  indicates an object reference is no longer valid
;
Macro Nothing
  0
EndMacro
;
;===============================================
;
;  define a class callback pointer
;
Macro FieldCallBack (bvsDataParmName)
  FieldFixedArray(bvsDataParmName, typPointer, #iCALLBACK_POINTER_SIZE)
EndMacro
;
;===============================================
;
;  set a callback pointer
;
Macro SetCallBack (bvsObjectName, bvsDataParmName, bvsProcName)
  SetArray(bvsObjectName, bvsDataParmName, 1, SubroutinePtr(bvsProcName))
  SetArray(bvsObjectName, bvsDataParmName, 2, Me)
EndMacro
;
;===============================================
;
;  process a callback routine
;
Macro CallBack (bvsDataParmName)
  If bvsDataParmName(1) <> 0
    CallFunctionFast(bvsDataParmName(1), bvsDataParmName(2))
  EndIf
EndMacro
;
;===============================================
;
;  post a custom event
;
Macro PostCustomEvent (bvsObjectName, bviCustomEvent, bviOptionalEventData = 0)
  PostEvent(#iEVENT_CUSTOM, Get(gloApp, exiWindowNumber), bvsObjectName, bviCustomEvent, bviOptionalEventData)
EndMacro
;
;===============================================
;
;  attach me to the parent object
;
Macro AttachMeToParent
  ObjectCall(Me\exoParent, AttachChild) (Me)
EndMacro
;
;===============================================
;
;  detach me from the parent object
;
Macro DetachMeFromParent
  If IsObject(Me\exoParent)
    ObjectCall(Me\exoParent, DetachChild) (Me)
  EndIf
EndMacro
;
;===============================================
;
;  detach all the child objects from this object
;
Macro DetachMyChildren
  While Me\priChildCount > 0
    ClassCall(DetachChild) (Me, Me\proChild(Me\priChildCount))
  Loop
EndMacro
;
;===============================================
;
;  destroy the current object`s gadget
;
Macro DestroyMyGadget
  If IsGadget(Me\exiGadgetNumber)
    FreeGadget(Me\exiGadgetNumber)
  EndIf
  Me\exiGadgetNumber = 0
EndMacro
;
;===============================================
;
;  increment a value
;
Macro Increment (bvsValue)
  bvsValue = bvsValue + 1
EndMacro
;
;===============================================
;
;  decrement a value
;
Macro Decrement (bvsValue)
  bvsValue = bvsValue - 1
EndMacro
;
;===============================================
;
;  set focus to an object
;
Macro SetObjectFocus (bvsObjectName)
  SetActiveGadget(Get(bvsObjectName, exiGadgetNumber))
EndMacro
;
;===============================================
;  end of  :  modMacro.pbi
;===============================================
For ten years Caesar ruled with an iron hand, then with a wooden foot, and finally with a piece of string.
~ Spike Milligan
Top
BorisTheOld
Enthusiast
Enthusiast
Posts: 542
Joined: Tue Apr 24, 2012 5:08 pm
Location: Ontario, Canada

Re: Macros, OOP, Custom gadgets, Automatic resizing

Post by BorisTheOld »

Here are the interface and class files for the program:

objMOCAtest.pbi

Code: Select all

;===============================================
;
;  file name       :  objMOCAtest.pbi
;  description     :  class interface for package, "Macros, OOP, Custom gadgets, Automatic resizing"
;  author          :  Rod Gobby (BorisTheOld)
;  copyright       :  you have my permission to use this code as you wish
;  date generated  :  2013-10-23 21:00
;  configuration   :  PureBasic 5.20 LTS, x86, Linux & Windows
;  notes           :  no API used
;
;===============================================
;
BeginClass(MOCAtest)
;
BeginClassInterface
;
;  primary  methods
;
  InterfaceFunc(Destroy, typObject) ()
;
;  external methods
;
  InterfaceSubr(Main) ()
;
EndClassInterface
;
EndClass
;
;===============================================
;  end of  :  objMOCAtest.pbi
;===============================================
clsMOCAtest.pbi

Code: Select all

;===============================================
;
;  file name       :  clsMOCAtest.pbi
;  description     :  class code for package, "Macros, OOP, Custom gadgets, Automatic resizing"
;  author          :  Rod Gobby (BorisTheOld)
;  copyright       :  you have my permission to use this code as you wish
;  date generated  :  2013-10-23 21:00
;  configuration   :  PureBasic 5.20 LTS, x86, Linux & Windows
;  notes           :  no API used
;
;===============================================
;
BeginClass(MOCAtest)
;
;===============================================
;
BeginClassData
;
;  primary  properties
;
FieldPointer(prpVirtualTable)
;
;  private properties
;
  Field(proAppContainer, objContainer)
  Field(proButtonParent, objButtonBar)
  Field(proButton01, objButton)
  Field(proButton02, objButton)
  Field(proButton03, objButton)
  Field(proButton04, objButton)
  Field(proButton05, objButton)
  Field(proButton06, objButton)
  Field(proButton07, objButton)
  Field(proButton08, objButton)
;
EndClassData
;
;===============================================
;
;  Private Declares
;
DeclarePrivateSubroutine(Constructor)      (ByVal(Me, strMOCAtest))
DeclarePrivateSubroutine(Destructor)       (ByVal(Me, strMOCAtest))
DeclarePrivateSubroutine(DesignWindow)     (ByVal(Me, strMOCAtest))
DeclarePrivateSubroutine(DesignButtonBar)  (ByVal(Me, strMOCAtest))
DeclarePrivateSubroutine(ClickButton01)    (ByVal(Me, strMOCAtest))
DeclarePrivateSubroutine(ClickButton02)    (ByVal(Me, strMOCAtest))
DeclarePrivateSubroutine(ClickButton03)    (ByVal(Me, strMOCAtest))
DeclarePrivateSubroutine(ClickButton04)    (ByVal(Me, strMOCAtest))
DeclarePrivateSubroutine(ClickButton05)    (ByVal(Me, strMOCAtest))
DeclarePrivateSubroutine(ClickButton06)    (ByVal(Me, strMOCAtest))
DeclarePrivateSubroutine(ClickButton07)    (ByVal(Me, strMOCAtest))
DeclarePrivateSubroutine(ClickButton08)    (ByVal(Me, strMOCAtest))
;
;===============================================
;
;  Primary Methods
;
;-----------------------------------------------
;
ExternalFunction(Create, typObject) ()
;
;  create a class instance
;
  Local(Me, strMOCAtest)

  Me = AllocateMemory(SizeOf(strMOCAtest))
  If IsObject(Me)
    InitializeStructure(Me, strMOCAtest)
    Me\prpVirtualTable   = LabelPtr(VirtualTable)
    ClassCall(Constructor) (Me)
  EndIf
  ProcedureReturn Me
EndFunction
;
;-----------------------------------------------
;
ExternalFunction(Destroy, typObject) (ByVal(Me, strMOCAtest))
;
;  destroy a class instance
;
  If IsObject(Me)
    ClassCall(Destructor) (Me)
    ClearStructure(Me, strMOCAtest)
    FreeMemory(Me)
  EndIf
  ProcedureReturn Nothing
EndFunction
;
;===============================================
;
;  External Methods
;
;-----------------------------------------------
;
ExternalSubroutine(Main) (ByVal(Me, strMOCAtest))

  Set(gloApp, exsCaption, "Macros, OOP, Custom gadgets, Automatic resizing")
  Set(gloApp, exiBaseWidth, #iWINDOW_WIDTH)
  Set(gloApp, exiBaseHeight, #iWINDOW_HEIGHT)
  ObjectCall(gloApp, Build) ()

  Set(Me\proAppContainer, exoParent, gloApp)
  Set(Me\proAppContainer, exiBackgroundColour, #iWINDOW_COLOUR)
  Set(Me\proAppContainer, exiPadding, #iWINDOW_PADDING)
  SetCallBack(Me\proAppContainer, expCBDesign, DesignWindow)
  ObjectCall(Me\proAppContainer, Build) ()

  ObjectCall(gloApp, Events) ()

EndSubroutine
;
;===============================================
;
;  Private Methods
;
;-----------------------------------------------
;
PrivateSubroutine(Constructor) (ByVal(Me, strMOCAtest))

  Me\proAppContainer = CreateObject(Container)
  Me\proButtonParent = CreateObject(ButtonBar)
  Me\proButton01     = CreateObject(Button)
  Me\proButton02     = CreateObject(Button)
  Me\proButton03     = CreateObject(Button)
  Me\proButton04     = CreateObject(Button)
  Me\proButton05     = CreateObject(Button)
  Me\proButton06     = CreateObject(Button)
  Me\proButton07     = CreateObject(Button)
  Me\proButton08     = CreateObject(Button)

EndSubroutine
;
;-----------------------------------------------
;
PrivateSubroutine(Destructor) (ByVal(Me, strMOCAtest))

  DestroyObject(Me\proButton08)
  DestroyObject(Me\proButton07)
  DestroyObject(Me\proButton06)
  DestroyObject(Me\proButton05)
  DestroyObject(Me\proButton04)
  DestroyObject(Me\proButton03)
  DestroyObject(Me\proButton02)
  DestroyObject(Me\proButton01)
  DestroyObject(Me\proButtonParent)
  DestroyObject(Me\proAppContainer)

EndSubroutine
;
;-----------------------------------------------
;
PrivateSubroutine(DesignWindow) (ByVal(Me, strMOCAtest))

  Set(Me\proButtonParent, exoParent, Me\proAppContainer)
  Set(Me\proButtonParent, exnFirstButton, 2)
  Set(Me\proButtonParent, exiButtonLayoutMode, #iGUI_LAYOUT_START)
  SetCallBack(Me\proButtonParent, expCBDesign, DesignButtonBar)
  ObjectCall(Me\proButtonParent, Build) ()
  
EndSubroutine
;
;-----------------------------------------------
;
PrivateSubroutine(DesignButtonBar) (ByVal(Me, strMOCAtest))

  Set(Me\proButton01, exoParent, Me\proButtonParent)
  Set(Me\proButton01, exsCaption, "Cancel")
  Set(Me\proButton01, exlTrapEscKey, True)
  Set(Me\proButton01, exsToolTip, "Activated by: left-click, Esc-key (or Enter-key if has focus)")
  SetCallBack(Me\proButton01, expCBClick, ClickButton01)
  ObjectCall(Me\proButton01, Build) ()

  Set(Me\proButton02, exoParent, Me\proButtonParent)
  Set(Me\proButton02, exsCaption, "Start")
  Set(Me\proButton02, exnHotkeyPosition, 1)
  Set(Me\proButton02, exsToolTip, "Activated by: left-click, S-key (or Enter-key if has focus)")
  SetCallBack(Me\proButton02, expCBClick, ClickButton02)
  ObjectCall(Me\proButton02, Build) ()

  Set(Me\proButton03, exoParent, Me\proButtonParent)
  Set(Me\proButton03, exsCaption, "End")
  Set(Me\proButton03, exnHotkeyPosition, 1)
  Set(Me\proButton03, exsToolTip, "Activated by: left-click, E-key (or Enter-key if has focus)")
  SetCallBack(Me\proButton03, expCBClick, ClickButton03)
  ObjectCall(Me\proButton03, Build) ()

  Set(Me\proButton04, exoParent, Me\proButtonParent)
  Set(Me\proButton04, exsCaption, "Centre")
  Set(Me\proButton04, exnHotkeyPosition, 1)
  Set(Me\proButton04, exsToolTip, "Activated by: left-click, C-key (or Enter-key if has focus)")
  SetCallBack(Me\proButton04, expCBClick, ClickButton04)
  ObjectCall(Me\proButton04, Build) ()

  Set(Me\proButton05, exoParent, Me\proButtonParent)
  Set(Me\proButton05, exsCaption, "Expand")
  Set(Me\proButton05, exnHotkeyPosition, 2)
  Set(Me\proButton05, exsToolTip, "Activated by: left-click, X-key (or Enter-key if has focus)")
  SetCallBack(Me\proButton05, expCBClick, ClickButton05)
  ObjectCall(Me\proButton05, Build) ()

  Set(Me\proButton06, exoParent, Me\proButtonParent)
  Set(Me\proButton06, exsCaption, "Edge")
  Set(Me\proButton06, exnHotkeyPosition, 3)
  Set(Me\proButton06, exsToolTip, "Activated by: left-click, G-key (or Enter-key if has focus)")
  SetCallBack(Me\proButton06, expCBClick, ClickButton06)
  ObjectCall(Me\proButton06, Build) ()

  Set(Me\proButton07, exoParent, Me\proButtonParent)
  Set(Me\proButton07, exsCaption, "Stretch")
  Set(Me\proButton07, exnHotkeyPosition, 5)
  Set(Me\proButton07, exsToolTip, "Activated by: left-click, T-key (or Enter-key if has focus)")
  SetCallBack(Me\proButton07, expCBClick, ClickButton07)
  ObjectCall(Me\proButton07, Build) ()

  Set(Me\proButton08, exoParent, Me\proButtonParent)
  Set(Me\proButton08, exsCaption, "Fill")
  Set(Me\proButton08, exnHotkeyPosition, 1)
  Set(Me\proButton08, exsToolTip, "Activated by: left-click, F-key (or Enter-key if has focus)")
  SetCallBack(Me\proButton08, expCBClick, ClickButton08)
  ObjectCall(Me\proButton08, Build) ()

EndSubroutine
;
;-----------------------------------------------
;
PrivateSubroutine(ClickButton01) (ByVal(Me, strMOCAtest))

  Set(gloApp, exlQuitApplication, True)                    ; terminate the application

EndSubroutine
;
;-----------------------------------------------
;
PrivateSubroutine(ClickButton02) (ByVal(Me, strMOCAtest))

  Set(Me\proButtonParent, exiButtonLayoutMode, #iGUI_LAYOUT_START)

EndSubroutine
;
;-----------------------------------------------
;
PrivateSubroutine(ClickButton03) (ByVal(Me, strMOCAtest))

  Set(Me\proButtonParent, exiButtonLayoutMode, #iGUI_LAYOUT_END)

EndSubroutine
;
;-----------------------------------------------
;
PrivateSubroutine(ClickButton04) (ByVal(Me, strMOCAtest))

  Set(Me\proButtonParent, exiButtonLayoutMode, #iGUI_LAYOUT_CENTRE)

EndSubroutine
;
;-----------------------------------------------
;
PrivateSubroutine(ClickButton05) (ByVal(Me, strMOCAtest))

  Set(Me\proButtonParent, exiButtonLayoutMode, #iGUI_LAYOUT_EXPAND)

EndSubroutine
;
;-----------------------------------------------
;
PrivateSubroutine(ClickButton06) (ByVal(Me, strMOCAtest))

  Set(Me\proButtonParent, exiButtonLayoutMode, #iGUI_LAYOUT_EDGE)

EndSubroutine
;
;-----------------------------------------------
;
PrivateSubroutine(ClickButton07) (ByVal(Me, strMOCAtest))

  Set(Me\proButtonParent, exiButtonLayoutMode, #iGUI_LAYOUT_STRETCH)

EndSubroutine
;
;-----------------------------------------------
;
PrivateSubroutine(ClickButton08) (ByVal(Me, strMOCAtest))

  Set(Me\proButtonParent, exiButtonLayoutMode, #iGUI_LAYOUT_FILL)

EndSubroutine
;
;===============================================
;
;  Virtual Table
;
BeginVirtualTable
;
;  primary  methods
;
  VirtualFunc(Destroy)
;
;  external methods
;
  VirtualSubr(Main)
;
EndVirtualTable
;
;===============================================
;
EndClass
;
;===============================================
;  end of  :  clsMOCAtest.pbi
;===============================================
For ten years Caesar ruled with an iron hand, then with a wooden foot, and finally with a piece of string.
~ Spike Milligan
Top
BorisTheOld
Enthusiast
Enthusiast
Posts: 542
Joined: Tue Apr 24, 2012 5:08 pm
Location: Ontario, Canada

Re: Macros, OOP, Custom gadgets, Automatic resizing

Post by BorisTheOld »

Here are the interface and class files for the Application Class:

objApplication.pbi

Code: Select all

;===============================================
;
;  file name       :  objApplication.pbi
;  description     :  Application Class Interface
;  author          :  Rod Gobby (BorisTheOld)
;  copyright       :  you have my permission to use this code as you wish
;  date generated  :  2013-10-23 21:00
;  configuration   :  PureBasic 5.20 LTS, x86, Linux & Windows
;  notes           :  no API used
;
;===============================================
;
BeginClass(Application)
;
BeginClassInterface
;
;  primary  methods
;
  InterfaceFunc(Destroy, typObject)    ()
  InterfaceGetx(exiClassReferenceNumber, typInt32)  ()
  InterfaceSetx(exoParent)             (ByVal(bvoParent, typObject))
  InterfaceGetx(exiChildEntryNumber, typInt32) ()
  InterfaceSetx(exiChildEntryNumber)   (ByVal(bviChildEntryNumber, typInt32))
;
;  external methods
;
  InterfaceSubr(Events)                ()
  InterfaceSubr(Resize)                ()
  InterfaceSubr(Build)                 ()
  InterfaceSubr(AttachChild)           (ByVal(bvoChild, typObject))
  InterfaceSubr(DetachChild)           (ByVal(bvoChild, typObject))
;
;  external properties:  read/write
;
  InterfaceGetx(exsCaption, typString) ()
  InterfaceSetx(exsCaption)            (ByVal(bvsCaption, typString))
;
;  external properties:  read only
;
  InterfaceGetx(exiWindowNumber, typInt32)     ()
  InterfaceGetx(exiActualLeft, typInt32)       ()
  InterfaceGetx(exiActualTop, typInt32)        ()
  InterfaceGetx(exiActualWidth, typInt32)      ()
  InterfaceGetx(exiActualHeight, typInt32)     ()
  InterfaceGetx(exiButtonFontId, typInt32)     ()
;
;  external properties:  write only
;
  InterfaceSetx(exlResizeAllowed)      (ByVal(bvlResizeAllowed, typBoolean))
  InterfaceSetx(exlShrinkAllowed)      (ByVal(bvlShrinkAllowed, typBoolean))
  InterfaceSetx(exiBaseLeft)           (ByVal(bviBaseLeft, typInt32))
  InterfaceSetx(exiBaseTop)            (ByVal(bviBaseTop, typInt32))
  InterfaceSetx(exiBaseWidth)          (ByVal(bviBaseWidth, typInt32))
  InterfaceSetx(exiBaseHeight)         (ByVal(bviBaseHeight, typInt32))
  InterfaceSetx(exlQuitApplication)    (ByVal(bvlQuitApplication, typBoolean))
  InterfaceSetx(exsButtonFontName)     (ByVal(bvsButtonFontName, typString))
  InterfaceSetx(exiButtonFontSize)     (ByVal(bviButtonFontSize, typInt32))
;
EndClassInterface
;
EndClass
;
;===============================================
;  end of  :  objApplication.pbi
;===============================================
clsApplication.pbi

Code: Select all

;===============================================
;
;  file name       :  clsApplication.pbi
;  description     :  Application Class
;  author          :  Rod Gobby (BorisTheOld)
;  copyright       :  you have my permission to use this code as you wish
;  date generated  :  2013-10-23 21:00
;  configuration   :  PureBasic 5.20 LTS, x86, Linux & Windows
;  notes           :  no API used
;
;===============================================
;
BeginClass(Application)
;
;===============================================
;
;  Properties
;
BeginClassData
;
;  primary  properties
;
  FieldPointer(prpVirtualTable)                            ; 16393 : pointer to the class virtual table
  Field(exiClassReferenceNumber, typInt32)                 ; 16447 : the entity number for the class (module, program, package, etc)
  Field(exoParent, objGeneric)                             ; 16086 : reference to an object`s parent
  Field(exiChildEntryNumber, typInt32)                     ; 16484 : entry number of the object in the parent child array (1 based)
;
;  private properties
;
  FieldDynamicArray(proChild, objGeneric)                  ; 16448 : reference to a child object
  Field(priChildCount, typInt32)                           ; 16451 : number of child objects attached to a parent object
  Field(priButtonFontNumber, typInt32)                     ; 16699 : class font number:  button (#PB_Any)
;
;  external properties:  read/write
;
  Field(exsCaption, typString)                             ; 15328 : caption text
;
;  external properties:  read only
;
  Field(exiWindowNumber, typInt32)                         ; 16400 : assigned by pb using #pb_any
  Field(exiActualLeft, typInt32)                           ; 16417 : actual left position of the gui object (pixels)
  Field(exiActualTop, typInt32)                            ; 16418 : actual top position of the gui object (pixels)
  Field(exiActualWidth, typInt32)                          ; 16419 : actual width of the gui object (pixels)
  Field(exiActualHeight, typInt32)                         ; 16420 : actual height of the gui object (pixels)
  Field(exiButtonFontId, typInt32)                         ; 16665 : class font id:  button
;
;  external properties:  write only
;
  Field(exlResizeAllowed, typBoolean)                      ; 16405 : true = gui object can be resized
  Field(exlShrinkAllowed, typBoolean)                      ; 16406 : true = gui object can shrink below the base size
  Field(exiBaseLeft, typInt32)                             ; 16413 : nominal left position of the gui object (pixels)
  Field(exiBaseTop, typInt32)                              ; 16414 : nominal top position of the gui object (pixels)
  Field(exiBaseWidth, typInt32)                            ; 16415 : nominal width of the gui object (pixels)
  Field(exiBaseHeight, typInt32)                           ; 16416 : nominal height of the gui object (pixels)
  Field(exlQuitApplication, typBoolean)                    ; 16483 : true = initiate an orderly shutdown of the application
  Field(exsButtonFontName, typString)                      ; 16697 : class font name:  button
  Field(exiButtonFontSize, typInt32)                       ; 16698 : class font size:  button (points)
;
EndClassData
;
;===============================================
;
;  Private Declares
;
DeclarePrivateSubroutine(Constructor)  (ByVal(Me, strApplication))
DeclarePrivateSubroutine(Destructor)   (ByVal(Me, strApplication))
DeclarePrivateSubroutine(CustomEvent)  (ByVal(Me, strApplication))
DeclarePrivateSubroutine(GadgetEvent)  (ByVal(Me, strApplication))
DeclarePrivateSubroutine(SizeWindowEvent)      (ByVal(Me, strApplication))
DeclarePrivateSubroutine(UpdateWindowSizeInfo) (ByVal(Me, strApplication))
;
;===============================================
;
;  Primary Methods
;
;-----------------------------------------------
;
ExternalFunction(Create, typObject) ()
;
;  create a class instance
;
  Local(Me, strApplication)

  Me = AllocateMemory(SizeOf(strApplication))
  If IsObject(Me)
    InitializeStructure(Me, strApplication)
    Me\prpVirtualTable = LabelPtr(VirtualTable)
    ClassCall(Constructor) (Me)
  EndIf
  ProcedureReturn Me
EndFunction
;
;-----------------------------------------------
;
ExternalFunction(Destroy, typObject) (ByVal(Me, strApplication))
;
;  destroy a class instance
;
  If IsObject(Me)
    ClassCall(Destructor) (Me)
    ClearStructure(Me, strApplication)
    FreeMemory(Me)
  EndIf
  ProcedureReturn Nothing
EndFunction
;
;-----------------------------------------------
;
ExternalGet(exiClassReferenceNumber, typInt32) (ByVal(Me, strApplication))
  ProcedureReturn Me\exiClassReferenceNumber
EndGet
;
;-----------------------------------------------
;
ExternalSet(exoParent)                 (ByVal(Me, strApplication), ByVal(bvoParent, typObject))
  Me\exoParent = bvoParent
EndSet
;
;-----------------------------------------------
;
ExternalGet(exiChildEntryNumber, typInt32)     (ByVal(Me, strApplication))
  ProcedureReturn Me\exiChildEntryNumber
EndGet
;
ExternalSet(exiChildEntryNumber)       (ByVal(Me, strApplication), ByVal(bviChildEntryNumber, typInt32))
  Me\exiChildEntryNumber = bviChildEntryNumber
EndSet
;
;===============================================
;
;  External Methods
;
;-----------------------------------------------
;
ExternalSubroutine(Events)             (ByVal(Me, strApplication))
;
;  process the event loop
;
  Local(iWindowNumber, typInt32)                                               ; 16400 : assigned by pb using #pb_any
  Local(iWindowEvent, typInt32)                                                ; 16404 : window event type

  Repeat

    If IsTrue(Me\exlQuitApplication)
      ExitRepeat                                                               ; the application has signaled an orderly shutdown
    EndIf

    iWindowEvent  = WaitWindowEvent()                                          ; get an event
    iWindowNumber = EventWindow()                                              ; get the window number of the event

    If Me\exiWindowNumber <> iWindowNumber
      Continue                                                                 ; ignore the event if not for the application window
    EndIf

    Select iWindowEvent

      Case #PB_Event_CloseWindow
        ExitRepeat                                                             ; the system has signaled an orderly shutdown

      Case #iEVENT_CUSTOM
        ClassCall(CustomEvent) (Me)

      Case #PB_Event_Gadget
        ClassCall(GadgetEvent) (Me)

      Case #PB_Event_SizeWindow
        ClassCall(SizeWindowEvent) (Me)

    EndSelect

  ForEver

EndSubroutine
;
;-----------------------------------------------
;
ExternalSubroutine(Resize)             (ByVal(Me, strApplication))
;
;  process a window resize event
;
;  not used -- placeholder only
;
EndSubroutine
;
;-----------------------------------------------
;
ExternalSubroutine(Build)              (ByVal(Me, strApplication))
;
;  build this object
;
  Local(iWindowFlags, typInt32)                            ; 16401 : composite option flags used when creating a pb window

  If IsTrue(Me\exlResizeAllowed)
    iWindowFlags = #PB_Window_SystemMenu | #PB_Window_MinimizeGadget | #PB_Window_MaximizeGadget | #PB_Window_SizeGadget | #PB_Window_TitleBar | #PB_Window_ScreenCentered
  Else
    iWindowFlags = #PB_Window_SystemMenu | #PB_Window_MinimizeGadget | #PB_Window_TitleBar | #PB_Window_ScreenCentered
  EndIf

  Me\exiWindowNumber = OpenWindow(#PB_Any, Me\exiBaseLeft, Me\exiBaseTop, Me\exiBaseWidth, Me\exiBaseHeight, Me\exsCaption, iWindowFlags)

  If IsTrue(Me\exlResizeAllowed) And IsFalse(Me\exlShrinkAllowed)
    WindowBounds(Me\exiWindowNumber, Me\exiBaseWidth, Me\exiBaseHeight, #PB_Ignore, #PB_Ignore)        ; set the minimum window size
  EndIf

  ClassCall(UpdateWindowSizeInfo) (Me)                                         ; get the actual window size values

  Me\priButtonFontNumber = LoadFont(#PB_Any, Me\exsButtonFontName, Me\exiButtonFontSize)
  Me\exiButtonFontId     = FontID(Me\priButtonFontNumber)

EndSubroutine
;
;-----------------------------------------------
;
ExternalSubroutine(AttachChild)        (ByVal(Me, strApplication), ByRef(broChild, objGeneric))
;
;  attach a child object
;
;  broChild                            16448 : reference to a child object
;

  Increment(Me\priChildCount)
  ResizeDynamicArray(Me\proChild, Me\priChildCount)                            ; add an entry to the child array
  Me\proChild(Me\priChildCount) = Ref(broChild)                                ; store the child object reference
  Set(Ref(broChild), exiChildEntryNumber, Me\priChildCount)                    ; update the child`s entry number

EndSubroutine
;
;-----------------------------------------------
;
ExternalSubroutine(DetachChild)        (ByVal(Me, strApplication), ByRef(broChild, objGeneric))
;
;  detach a child object
;
;  broChild                            16448 : reference to a child object
;
  Local(iLoop, typInt32)                                                       ; 15051 : generic loop counter
  Local(iChildEntryNumber, typInt32)                                           ; 16484 : entry number of the object in the parent child array (1 based)

  iChildEntryNumber = Get(Ref(broChild), exiChildEntryNumber)                  ; extract the child entry number

  If (iChildEntryNumber > 0) And (iChildEntryNumber <= Me\priChildCount)

    Decrement(Me\priChildCount)

    For iLoop = iChildEntryNumber To Me\priChildCount                          ; adjust the array entries
      Me\proChild(iLoop) = Me\proChild(iLoop + 1)                              ; shift left into the vacated spot
      Set(Me\proChild(iLoop), exiChildEntryNumber, iLoop)                      ; adjust the child`s entry number
    Next

    ResizeDynamicArray(Me\proChild, Me\priChildCount)                          ; trim the last entry off the array

  EndIf

  Set(Ref(broChild), exoParent, Nothing)                                       ; detach the child from this parent object
  Set(Ref(broChild), exiChildEntryNumber, 0)                                   ; clear the child`s entry number

EndSubroutine
;
;===============================================
;
;  Property Methods
;
;-----------------------------------------------
;
;  external properties:  read/write
;
;--------
;
ExternalGet(exsCaption, typString)     (ByVal(Me, strApplication))
  ProcedureReturn Me\exsCaption
EndGet
;
ExternalSet(exsCaption)                (ByVal(Me, strApplication), ByVal(bvsCaption, typString))
  Me\exsCaption = bvsCaption
EndSet
;
;-----------------------------------------------
;
;  external properties:  read only
;
;--------
;
ExternalGet(exiWindowNumber, typInt32) (ByVal(Me, strApplication))
  ProcedureReturn Me\exiWindowNumber
EndGet
;
;--------
;
ExternalGet(exiActualLeft, typInt32)   (ByVal(Me, strApplication))
  ProcedureReturn Me\exiActualLeft
EndGet
;
;--------
;
ExternalGet(exiActualTop, typInt32)    (ByVal(Me, strApplication))
  ProcedureReturn Me\exiActualTop
EndGet
;
;--------
;
ExternalGet(exiActualWidth, typInt32)  (ByVal(Me, strApplication))
  ProcedureReturn Me\exiActualWidth
EndGet
;
;--------
;
ExternalGet(exiActualHeight, typInt32) (ByVal(Me, strApplication))
  ProcedureReturn Me\exiActualHeight
EndGet
;
;--------
;
ExternalGet(exiButtonFontId, typInt32) (ByVal(Me, strApplication))
  ProcedureReturn Me\exiButtonFontId
EndGet
;
;-----------------------------------------------
;
;  external properties:  write only
;
;--------
;
ExternalSet(exlResizeAllowed)          (ByVal(Me, strApplication), ByVal(bvlResizeAllowed, typBoolean))
  Me\exlResizeAllowed = bvlResizeAllowed
EndSet
;
;--------
;
ExternalSet(exlShrinkAllowed)          (ByVal(Me, strApplication), ByVal(bvlShrinkAllowed, typBoolean))
  Me\exlShrinkAllowed = bvlShrinkAllowed
EndSet
;
;--------
;
ExternalSet(exiBaseLeft)               (ByVal(Me, strApplication), ByVal(bviBaseLeft, typInt32))
  Me\exiBaseLeft = bviBaseLeft
EndSet
;
;--------
;
ExternalSet(exiBaseTop)                (ByVal(Me, strApplication), ByVal(bviBaseTop, typInt32))
  Me\exiBaseTop = bviBaseTop
EndSet
;
;--------
;
ExternalSet(exiBaseWidth)              (ByVal(Me, strApplication), ByVal(bviBaseWidth, typInt32))
  Me\exiBaseWidth = bviBaseWidth
EndSet
;
;--------
;
ExternalSet(exiBaseHeight)             (ByVal(Me, strApplication), ByVal(bviBaseHeight, typInt32))
  Me\exiBaseHeight = bviBaseHeight
EndSet
;
;--------
;
ExternalSet(exlQuitApplication)        (ByVal(Me, strApplication), ByVal(bvlQuitApplication, typBoolean))
  Me\exlQuitApplication = bvlQuitApplication
EndSet
;
;--------
;
ExternalSet(exsButtonFontName)         (ByVal(Me, strApplication), ByVal(bvsButtonFontName, typString))
  Me\exsButtonFontName = bvsButtonFontName
EndSet
;
;--------
;
ExternalSet(exiButtonFontSize)         (ByVal(Me, strApplication), ByVal(bviButtonFontSize, typInt32))
  Me\exiButtonFontSize = bviButtonFontSize
EndSet
;
;===============================================
;
;  Private Methods
;
;-----------------------------------------------
;
PrivateSubroutine(Constructor)         (ByVal(Me, strApplication))
;
;  class constructor
;

  Me\exiClassReferenceNumber = #iCLASS_REF_APPLICATION
  
  Me\exlResizeAllowed  = True
  Me\exlShrinkAllowed  = False
  Me\exsButtonFontName = #sBUTTON_FONT_NAME
  Me\exiButtonFontSize = #iBUTTON_FONT_SIZE

EndSubroutine
;
;-----------------------------------------------
;
PrivateSubroutine(Destructor)          (ByVal(Me, strApplication))
;
;  class destructor
;

  DetachMyChildren

  If IsFont(Me\priButtonFontNumber)
    FreeFont(Me\priButtonFontNumber)
  EndIf

  If IsWindow(Me\exiWindowNumber)
    CloseWindow(Me\exiWindowNumber)
  EndIf

EndSubroutine
;
;-----------------------------------------------
;
PrivateSubroutine(CustomEvent)         (ByVal(Me, strApplication))
;
;  process a custom event
;
;
  Local(oGenericGadget, objGeneric)                                            ; 16407 : generic gadget object

  oGenericGadget = EventGadget()                                               ; point to the associated gadget object

  If IsObject(oGenericGadget)
    ObjectCall(oGenericGadget, Events) ()                                      ; process the gadget event
  EndIf

EndSubroutine
;
;-----------------------------------------------
;
PrivateSubroutine(GadgetEvent)         (ByVal(Me, strApplication))
;
;  process a gadget event
;
;
  Local(iGadgetNumber, typInt32)                                               ; 16402 : assigned by pb using #pb_any
  Local(oGenericGadget, objGeneric)                                            ; 16407 : generic gadget object

  iGadgetNumber = EventGadget()                                                ; point to the gadget causing the event

  If IsGadget(iGadgetNumber)

    oGenericGadget = GetGadgetData(iGadgetNumber)                              ; create a reference to the associated gadget object

    If IsObject(oGenericGadget)
      ObjectCall(oGenericGadget, Events) ()                                    ; process the gadget event
    EndIf

  EndIf

EndSubroutine
;
;-----------------------------------------------
;
PrivateSubroutine(SizeWindowEvent)     (ByVal(Me, strApplication))
;
;  process a size window event
;
  Local(iLoop, typInt32)                                                       ; 15051 : generic loop counter

  If IsTrue(Me\exlResizeAllowed)

    ClassCall(UpdateWindowSizeInfo) (Me)                                       ; refresh the window size info

    For iLoop = 1 To Me\priChildCount                                          ; resize all child objects
      ObjectCall(Me\proChild(iLoop), Resize) ()
    Next

  EndIf

EndSubroutine
;
;-----------------------------------------------
;
PrivateSubroutine(UpdateWindowSizeInfo)        (ByVal(Me, strApplication))
;
;  update the window size information
;
;

  Me\exiActualLeft   = WindowX(Me\exiWindowNumber)
  Me\exiActualTop    = WindowY(Me\exiWindowNumber)
  Me\exiActualWidth  = WindowWidth(Me\exiWindowNumber)
  Me\exiActualHeight = WindowHeight(Me\exiWindowNumber)

EndSubroutine
;
;===============================================
;
;  Virtual Table
;
BeginVirtualTable
;
;  primary  methods
;
  VirtualFunc(Destroy)
  VirtualGetx(exiClassReferenceNumber)
  VirtualSetx(exoParent)
  VirtualGetx(exiChildEntryNumber)
  VirtualSetx(exiChildEntryNumber)
;
;  external methods
;
  VirtualSubr(Events)
  VirtualSubr(Resize)
  VirtualSubr(Build)
  VirtualSubr(AttachChild)
  VirtualSubr(DetachChild)
;
;  external properties:  read/write
;
  VirtualGetx(exsCaption)
  VirtualSetx(exsCaption)
;
;  external properties:  read only
;
  VirtualGetx(exiWindowNumber)
  VirtualGetx(exiActualLeft)
  VirtualGetx(exiActualTop)
  VirtualGetx(exiActualWidth)
  VirtualGetx(exiActualHeight)
  VirtualGetx(exiButtonFontId)
;
;  external properties:  write only
;
  VirtualSetx(exlResizeAllowed)
  VirtualSetx(exlShrinkAllowed)
  VirtualSetx(exiBaseLeft)
  VirtualSetx(exiBaseTop)
  VirtualSetx(exiBaseWidth)
  VirtualSetx(exiBaseHeight)
  VirtualSetx(exlQuitApplication)
  VirtualSetx(exsButtonFontName)
  VirtualSetx(exiButtonFontSize)
;
EndVirtualTable
;
;===============================================
;
EndClass
;
;===============================================
;  end of  :  clsApplication.pbi
;===============================================
For ten years Caesar ruled with an iron hand, then with a wooden foot, and finally with a piece of string.
~ Spike Milligan
Top
BorisTheOld
Enthusiast
Enthusiast
Posts: 542
Joined: Tue Apr 24, 2012 5:08 pm
Location: Ontario, Canada

Re: Macros, OOP, Custom gadgets, Automatic resizing

Post by BorisTheOld »

Here are the interface and class files for the Container Class:

objContainer.pbi

Code: Select all

;===============================================
;
;  file name       :  objContainer.pbi
;  description     :  Container Class Interface
;  author          :  Rod Gobby (BorisTheOld)
;  copyright       :  you have my permission to use this code as you wish
;  date generated  :  2013-10-23 21:00
;  configuration   :  PureBasic 5.20 LTS, x86, Linux & Windows
;  notes           :  no API used
;
;===============================================
;
BeginClass(Container)
;
BeginClassInterface
;
;  primary  methods
;
  InterfaceFunc(Destroy, typObject)    ()
  InterfaceGetx(exiClassReferenceNumber, typInt32)     ()
  InterfaceSetx(exoParent)             (ByVal(bvoParent, typObject))
  InterfaceGetx(exiChildEntryNumber, typInt32) ()
  InterfaceSetx(exiChildEntryNumber)   (ByVal(bviChildEntryNumber, typInt32))
;
;  external methods
;
  InterfaceSubr(Events)                ()
  InterfaceSubr(Resize)                ()
  InterfaceSubr(Build)                 ()
  InterfaceSubr(AttachChild)           (ByVal(bvoChild, typObject))
  InterfaceSubr(DetachChild)           (ByVal(bvoChild, typObject))
;
;  external properties:  read/write
;
  InterfaceGetx(exlBorder, typBoolean) ()
  InterfaceSetx(exlBorder)             (ByVal(bvlBorder, typBoolean))
  InterfaceGetx(exiPadding, typInt32)  ()
  InterfaceSetx(exiPadding)            (ByVal(bviPadding, typInt32))
;
;  external properties:  read only
;
  InterfaceGetx(exiGadgetNumber, typInt32)     ()
  InterfaceGetx(exiActualLeft, typInt32)       ()
  InterfaceGetx(exiActualTop, typInt32)        ()
  InterfaceGetx(exiActualWidth, typInt32)      ()
  InterfaceGetx(exiActualHeight, typInt32)     ()
;
;  external properties:  write only
;
  InterfaceSetx(exiBackgroundColour)   (ByVal(bviBackgroundColour, typInt32))
  InterfaceSetx(expCBDesign)           (ByVal(bviIndex, typInt32), ByVal(bvpCBDesign, typPointer))
  InterfaceSetx(exiMarginTop)          (ByVal(bviMarginTop, typInt32))
  InterfaceSetx(exiMarginBottom)       (ByVal(bviMarginBottom, typInt32))
  InterfaceSetx(exiMarginLeft)         (ByVal(bviMarginLeft, typInt32))
  InterfaceSetx(exiMarginRight)        (ByVal(bviMarginRight, typInt32))
  InterfaceSetx(exlResizeAllowed)      (ByVal(bvlResizeAllowed, typBoolean))
  InterfaceSetx(exlShrinkAllowed)      (ByVal(bvlShrinkAllowed, typBoolean))
  InterfaceSetx(exiHorizontalAlignmentMode)    (ByVal(bviHorizontalAlignmentMode, typInt32))
  InterfaceSetx(exlHorizontalAlignment)        (ByVal(bvlHorizontalAlignment, typBoolean))
  InterfaceSetx(exiVerticalAlignmentMode)      (ByVal(bviVerticalAlignmentMode, typInt32))
  InterfaceSetx(exlVerticalAlignment)  (ByVal(bvlVerticalAlignment, typBoolean))
  InterfaceSetx(exiBaseLeft)           (ByVal(bviBaseLeft, typInt32))
  InterfaceSetx(exiBaseTop)            (ByVal(bviBaseTop, typInt32))
  InterfaceSetx(exiBaseWidth)          (ByVal(bviBaseWidth, typInt32))
  InterfaceSetx(exiBaseHeight)         (ByVal(bviBaseHeight, typInt32))
  InterfaceSetx(exsToolTip)            (ByVal(bvsToolTip, typString))
;
EndClassInterface
;
EndClass
;
;===============================================
;  end of  :  objContainer.pbi
;===============================================
clsContainer.pbi

Code: Select all

;===============================================
;
;  file name       :  clsContainer.pbi
;  description     :  Container Class
;  author          :  Rod Gobby (BorisTheOld)
;  copyright       :  you have my permission to use this code as you wish
;  date generated  :  2013-10-23 21:00
;  configuration   :  PureBasic 5.20 LTS, x86, Linux & Windows
;  notes           :  no API used
;
;===============================================
;
BeginClass(Container)
;
;===============================================
;
;  Properties
;
BeginClassData
;
;  primary  properties
;
  FieldPointer(prpVirtualTable)                        ; 16393 : pointer to the class virtual table
  Field(exiClassReferenceNumber, typInt32)             ; 16447 : the entity number for the class (module, program, package, etc)
  Field(exoParent, objGeneric)                         ; 16086 : reference to an object`s parent
  Field(exiChildEntryNumber, typInt32)                 ; 16484 : entry number of the object in the parent child array (1 based)
;
;  private properties
;
  FieldDynamicArray(proChild, objGeneric)              ; 16448 : reference to a child object
  Field(priChildCount, typInt32)                       ; 16451 : number of child objects attached to a parent object
;
;  external properties:  read/write
;
  Field(exlBorder, typBoolean)                         ; 16390 : true = show a border around a panel
  Field(exiPadding, typInt32)                          ; 16412 : width of the empty border inside a gui object (pixels)
;
;  external properties:  read only
;
  Field(exiGadgetNumber, typInt32)                     ; 16402 : assigned by pb using #pb_any
  Field(exiActualLeft, typInt32)                       ; 16417 : actual left position of the gui object (pixels)
  Field(exiActualTop, typInt32)                        ; 16418 : actual top position of the gui object (pixels)
  Field(exiActualWidth, typInt32)                      ; 16419 : actual width of the gui object (pixels)
  Field(exiActualHeight, typInt32)                     ; 16420 : actual height of the gui object (pixels)
;
;  external properties:  write only
;
  Field(exiBackgroundColour, typInt32)                 ; 14751 : background colour
  FieldCallBack(expCBDesign)                           ; 16080 : callback ptr:  design an object
  Field(exiMarginTop, typInt32)                        ; 16128 : top margin outside the gadget (pixels)
  Field(exiMarginBottom, typInt32)                     ; 16129 : bottom margin outside the gadget (pixels)
  Field(exiMarginLeft, typInt32)                       ; 16130 : left margin outside the gadget (pixels)
  Field(exiMarginRight, typInt32)                      ; 16131 : right margin outside the gadget (pixels)
  Field(exlResizeAllowed, typBoolean)                  ; 16405 : true = gui object can be resized
  Field(exlShrinkAllowed, typBoolean)                  ; 16406 : true = gui object can shrink below the base size
  Field(exiHorizontalAlignmentMode, typInt32)          ; 16408 : fill, start, end, centre
  Field(exlHorizontalAlignment, typBoolean)            ; 16409 : true = horizontal gui object alignment is allowed
  Field(exiVerticalAlignmentMode, typInt32)            ; 16410 : fill, start, end, centre
  Field(exlVerticalAlignment, typBoolean)              ; 16411 : true = vertical gui object alignment is allowed
  Field(exiBaseLeft, typInt32)                         ; 16413 : nominal left position of the gui object (pixels)
  Field(exiBaseTop, typInt32)                          ; 16414 : nominal top position of the gui object (pixels)
  Field(exiBaseWidth, typInt32)                        ; 16415 : nominal width of the gui object (pixels)
  Field(exiBaseHeight, typInt32)                       ; 16416 : nominal height of the gui object (pixels)
  Field(exsToolTip, typString)                         ; 16421 : tooltip text:  blank = no tooltip
;
EndClassData
;
;===============================================
;
;  Private Declares
;
DeclarePrivateSubroutine(Constructor)  (ByVal(Me, strContainer))
DeclarePrivateSubroutine(Destructor)   (ByVal(Me, strContainer))
DeclarePrivateSubroutine(ApplyExternalResizeRules)     (ByVal(Me, strContainer))
DeclarePrivateSubroutine(ApplyPageResizeRules)         (ByVal(Me, strContainer))
DeclarePrivateSubroutine(ResizeSplitterChildContainer) (ByVal(Me, strContainer))
DeclarePrivateSubroutine(ResizeApplicationContainer)   (ByVal(Me, strContainer))
;
;===============================================
;
;  Primary Methods
;
;-----------------------------------------------
;
ExternalFunction(Create, typObject) ()
;
;  Create                              create a class instance
;
  Local(Me, strContainer)

  Me = AllocateMemory(SizeOf(strContainer))
  If IsObject(Me)
    InitializeStructure(Me, strContainer)
    Me\prpVirtualTable = LabelPtr(VirtualTable)
    ClassCall(Constructor) (Me)
  EndIf
  ProcedureReturn Me
EndFunction
;
;-----------------------------------------------
;
ExternalFunction(Destroy, typObject) (ByVal(Me, strContainer))
;
;  Destroy                             destroy a class instance
;
  If IsObject(Me)
    ClassCall(Destructor) (Me)
    ClearStructure(Me, strContainer)
    FreeMemory(Me)
  EndIf
  ProcedureReturn Nothing
EndFunction
;
;-----------------------------------------------
;
;  exiClassReferenceNumber             16447 : the entity number for the class (module, program, package, etc)
;
ExternalGet(exiClassReferenceNumber, typInt32) (ByVal(Me, strContainer))
  ProcedureReturn Me\exiClassReferenceNumber
EndGet
;
;-----------------------------------------------
;
;  exoParent                           16086 : reference to an object`s parent
;
ExternalSet(exoParent)                 (ByVal(Me, strContainer), ByVal(bvoParent, typObject))
  Me\exoParent = bvoParent
EndSet
;
;-----------------------------------------------
;
;  exiChildEntryNumber                 16484 : entry number of the object in the parent child array (1 based)
;
ExternalGet(exiChildEntryNumber, typInt32)     (ByVal(Me, strContainer))
  ProcedureReturn Me\exiChildEntryNumber
EndGet
;
ExternalSet(exiChildEntryNumber)       (ByVal(Me, strContainer), ByVal(bviChildEntryNumber, typInt32))
  Me\exiChildEntryNumber = bviChildEntryNumber
EndSet
;
;===============================================
;
;  External Methods
;
;-----------------------------------------------
;
ExternalSubroutine(Events)             (ByVal(Me, strContainer))
;
;  Events                              process gadget events
;
;  not used -- placeholder only
;
EndSubroutine
;
;-----------------------------------------------
;
ExternalSubroutine(Resize)             (ByVal(Me, strContainer))
;
;  Resize                              process a window resize event
;
;
  Local(iLoop, typInt32)                                                       ; 15051 : generic loop counter
  Local(iParentClassReferenceNumber, typInt32)                                 ; 16661 : the entity number of the parent class

  If IsTrue(Me\exlResizeAllowed)

    iParentClassReferenceNumber = Get(Me\exoParent, exiClassReferenceNumber)

    Select iParentClassReferenceNumber

      Case #iCLASS_REF_PAGE
        ClassCall(ApplyPageResizeRules) (Me)
        ResizeGadget(Me\exiGadgetNumber, Me\exiActualLeft, Me\exiActualTop, Me\exiActualWidth, Me\exiActualHeight)

      Case #iCLASS_REF_SPLITTER
        ClassCall(ResizeSplitterChildContainer) (Me)                           ; only need to update the actual values to the gadget state

      Case #iCLASS_REF_APPLICATION
        ClassCall(ResizeApplicationContainer) (Me)
        ResizeGadget(Me\exiGadgetNumber, Me\exiActualLeft, Me\exiActualTop, Me\exiActualWidth, Me\exiActualHeight)

      CaseElse
        ClassCall(ApplyExternalResizeRules) (Me)
        ResizeGadget(Me\exiGadgetNumber, Me\exiActualLeft, Me\exiActualTop, Me\exiActualWidth, Me\exiActualHeight)

    EndSelect

    For iLoop = 1 To Me\priChildCount                                          ; resize all child objects
      ObjectCall(Me\proChild(iLoop), Resize) ()
    Next

  EndIf

EndSubroutine
;
;-----------------------------------------------
;
ExternalSubroutine(Build)              (ByVal(Me, strContainer))
;
;  Build                               build this object
;
;
  Local(iGadgetFlags, typInt32)                                                ; 16403 : composite option flags used when creating a pb gadget
  Local(iParentClassReferenceNumber, typInt32)                                 ; 16661 : the entity number of the parent class

  AttachMeToParent

  iParentClassReferenceNumber = Get(Me\exoParent, exiClassReferenceNumber)

  Select iParentClassReferenceNumber

    Case #iCLASS_REF_PAGE
      ClassCall(ApplyPageResizeRules) (Me)                                     ; adjust the page size to fit its panelitem

    Case #iCLASS_REF_SPLITTER
      Me\exlResizeAllowed = True                                               ; all splitter child containers must be resizeable
;     splitter size values not required (values are set automatically by the splitter)
      ClassCall(ResizeApplicationContainer) (Me)                               ; temporarily assume a size for the design process

    Case #iCLASS_REF_APPLICATION
      ClassCall(ResizeApplicationContainer) (Me)                               ; occupy the entire window area

    CaseElse
      Me\exiActualLeft   = Me\exiBaseLeft                                      ; set the initial size values
      Me\exiActualTop    = Me\exiBaseTop
      Me\exiActualWidth  = Me\exiBaseWidth
      Me\exiActualHeight = Me\exiBaseHeight
      ClassCall(ApplyExternalResizeRules) (Me)

  EndSelect

  If IsTrue(Me\exlBorder)
    iGadgetFlags = #PB_Container_Flat
  Else
    iGadgetFlags = 0
  EndIf

  Me\exiGadgetNumber = ContainerGadget(#PB_Any, Me\exiActualLeft, Me\exiActualTop, Me\exiActualWidth, Me\exiActualHeight, iGadgetFlags)

  SetGadgetData(Me\exiGadgetNumber, Me)                                        ; link this container object to the gadget
  SetGadgetColor(Me\exiGadgetNumber, #PB_Gadget_BackColor, Me\exiBackgroundColour)
  GadgetToolTip(Me\exiGadgetNumber, Me\exsToolTip)

  CallBack(Me\expCBDesign)                                                     ; design the container

  CloseGadgetList()                                                            ; finish building the container contents

EndSubroutine
;
;-----------------------------------------------
;
ExternalSubroutine(AttachChild)        (ByVal(Me, strContainer), ByRef(broChild, objGeneric))
;
;  AttachChild                         attach a child object
;
;  broChild                            16448 : reference to a child object
;

  Increment(Me\priChildCount)
  ResizeDynamicArray(Me\proChild, Me\priChildCount)                            ; add an entry to the child array
  Me\proChild(Me\priChildCount) = Ref(broChild)                                ; store the child object reference
  Set(Ref(broChild), exiChildEntryNumber, Me\priChildCount)                    ; update the child`s entry number

EndSubroutine
;
;-----------------------------------------------
;
ExternalSubroutine(DetachChild)        (ByVal(Me, strContainer), ByRef(broChild, objGeneric))
;
;  DetachChild                         detach a child object
;
;  broChild                            16448 : reference to a child object
;
  Local(iLoop, typInt32)                                                       ; 15051 : generic loop counter
  Local(iChildEntryNumber, typInt32)                                           ; 16484 : entry number of the object in the parent child array (1 based)

  iChildEntryNumber = Get(Ref(broChild), exiChildEntryNumber)                  ; extract the child entry number

  If (iChildEntryNumber > 0) And (iChildEntryNumber <= Me\priChildCount)

    Decrement(Me\priChildCount)

    For iLoop = iChildEntryNumber To Me\priChildCount                          ; adjust the array entries
      Me\proChild(iLoop) = Me\proChild(iLoop + 1)                              ; shift left into the vacated spot
      Set(Me\proChild(iLoop), exiChildEntryNumber, iLoop)                      ; adjust the child`s entry number
    Next

    ResizeDynamicArray(Me\proChild, Me\priChildCount)                          ; trim the last entry off the array

  EndIf

  Set(Ref(broChild), exoParent, Nothing)                                       ; detach the child from this parent object
  Set(Ref(broChild), exiChildEntryNumber, 0)                                   ; clear the child`s entry number

EndSubroutine
;
;===============================================
;
;  Property Methods
;
;-----------------------------------------------
;
;  external properties:  read/write
;
;--------
;
ExternalGet(exlBorder, typBoolean)     (ByVal(Me, strContainer))
  ProcedureReturn Me\exlBorder
EndGet
;
ExternalSet(exlBorder)                 (ByVal(Me, strContainer), ByVal(bvlBorder, typBoolean))
  Me\exlBorder = bvlBorder
EndSet
;
;--------
;
ExternalGet(exiPadding, typInt32)      (ByVal(Me, strContainer))
  ProcedureReturn Me\exiPadding
EndGet
;
ExternalSet(exiPadding)                (ByVal(Me, strContainer), ByVal(bviPadding, typInt32))
  Me\exiPadding = bviPadding
EndSet
;
;-----------------------------------------------
;
;  external properties:  read only
;
;--------
;
ExternalGet(exiGadgetNumber, typInt32) (ByVal(Me, strContainer))
  ProcedureReturn Me\exiGadgetNumber
EndGet
;
;--------
;
ExternalGet(exiActualLeft, typInt32)   (ByVal(Me, strContainer))
  ProcedureReturn Me\exiActualLeft
EndGet
;
;--------
;
ExternalGet(exiActualTop, typInt32)    (ByVal(Me, strContainer))
  ProcedureReturn Me\exiActualTop
EndGet
;
;--------
;
ExternalGet(exiActualWidth, typInt32)  (ByVal(Me, strContainer))
  ProcedureReturn Me\exiActualWidth
EndGet
;
;--------
;
ExternalGet(exiActualHeight, typInt32) (ByVal(Me, strContainer))
  ProcedureReturn Me\exiActualHeight
EndGet
;
;-----------------------------------------------
;
;  external properties:  write only
;
;--------
;
ExternalSet(exiBackgroundColour)       (ByVal(Me, strContainer), ByVal(bviBackgroundColour, typInt32))
  Me\exiBackgroundColour = bviBackgroundColour
EndSet
;
;--------
;
ExternalSet(expCBDesign)               (ByVal(Me, strContainer), ByVal(bviIndex, typInt32), ByVal(bvpCBDesign, typPointer))
  Me\expCBDesign(bviIndex) = bvpCBDesign
EndSet
;
;--------
;
ExternalSet(exiMarginTop)              (ByVal(Me, strContainer), ByVal(bviMarginTop, typInt32))
  Me\exiMarginTop = bviMarginTop
EndSet
;
;--------
;
ExternalSet(exiMarginBottom)           (ByVal(Me, strContainer), ByVal(bviMarginBottom, typInt32))
  Me\exiMarginBottom = bviMarginBottom
EndSet
;
;--------
;
ExternalSet(exiMarginLeft)             (ByVal(Me, strContainer), ByVal(bviMarginLeft, typInt32))
  Me\exiMarginLeft = bviMarginLeft
EndSet
;
;--------
;
ExternalSet(exiMarginRight)            (ByVal(Me, strContainer), ByVal(bviMarginRight, typInt32))
  Me\exiMarginRight = bviMarginRight
EndSet
;
;--------
;
ExternalSet(exlResizeAllowed)          (ByVal(Me, strContainer), ByVal(bvlResizeAllowed, typBoolean))
  Me\exlResizeAllowed = bvlResizeAllowed
EndSet
;
;--------
;
ExternalSet(exlShrinkAllowed)          (ByVal(Me, strContainer), ByVal(bvlShrinkAllowed, typBoolean))
  Me\exlShrinkAllowed = bvlShrinkAllowed
EndSet
;
;--------
;
ExternalSet(exiHorizontalAlignmentMode)        (ByVal(Me, strContainer), ByVal(bviHorizontalAlignmentMode, typInt32))
  Me\exiHorizontalAlignmentMode = bviHorizontalAlignmentMode
EndSet
;
;--------
;
ExternalSet(exlHorizontalAlignment)    (ByVal(Me, strContainer), ByVal(bvlHorizontalAlignment, typBoolean))
  Me\exlHorizontalAlignment = bvlHorizontalAlignment
EndSet
;
;--------
;
ExternalSet(exiVerticalAlignmentMode)  (ByVal(Me, strContainer), ByVal(bviVerticalAlignmentMode, typInt32))
  Me\exiVerticalAlignmentMode = bviVerticalAlignmentMode
EndSet
;
;--------
;
ExternalSet(exlVerticalAlignment)      (ByVal(Me, strContainer), ByVal(bvlVerticalAlignment, typBoolean))
  Me\exlVerticalAlignment = bvlVerticalAlignment
EndSet
;
;--------
;
ExternalSet(exiBaseLeft)               (ByVal(Me, strContainer), ByVal(bviBaseLeft, typInt32))
  Me\exiBaseLeft = bviBaseLeft
EndSet
;
;--------
;
ExternalSet(exiBaseTop)                (ByVal(Me, strContainer), ByVal(bviBaseTop, typInt32))
  Me\exiBaseTop = bviBaseTop
EndSet
;
;--------
;
ExternalSet(exiBaseWidth)              (ByVal(Me, strContainer), ByVal(bviBaseWidth, typInt32))
  Me\exiBaseWidth = bviBaseWidth
EndSet
;
;--------
;
ExternalSet(exiBaseHeight)             (ByVal(Me, strContainer), ByVal(bviBaseHeight, typInt32))
  Me\exiBaseHeight = bviBaseHeight
EndSet
;
;--------
;
ExternalSet(exsToolTip)                (ByVal(Me, strContainer), ByVal(bvsToolTip, typString))
  Me\exsToolTip = bvsToolTip
EndSet
;
;===============================================
;
;  Private Methods
;
;-----------------------------------------------
;
PrivateSubroutine(Constructor)         (ByVal(Me, strContainer))
;
;  Constructor                         class constructor
;

  Me\exiClassReferenceNumber    = #iCLASS_REF_CONTAINER

  Me\exiBackgroundColour        = #iCOLOUR_DEFAULT     
  Me\exlResizeAllowed           = True                 
  Me\exlHorizontalAlignment     = True                 
  Me\exiHorizontalAlignmentMode = #iGUI_ALIGN_FILL     
  Me\exlVerticalAlignment       = True                 
  Me\exiVerticalAlignmentMode   = #iGUI_ALIGN_FILL     

EndSubroutine
;
;-----------------------------------------------
;
PrivateSubroutine(Destructor)          (ByVal(Me, strContainer))
;
;  Destructor                          class destructor
;

  DestroyMyGadget
  DetachMeFromParent
  DetachMyChildren

EndSubroutine
;
;-----------------------------------------------
;
PrivateSubroutine(ApplyExternalResizeRules)    (ByVal(Me, strContainer))
;
;  ApplyExternalResizeRules            apply the external resize rules
;
;
  Local(oGenericContainer, objContainer)              ; 16077 : generic reference to a container object
  Local(iParentWidth, typInt32)                       ; 16458 : parent container width (pixels)
  Local(iParentHeight, typInt32)                      ; 16459 : parent container height (pixels)
  Local(iParentPadding, typInt32)                     ; 16460 : parent container padding (pixels)
;
;  Note:
;
;  1)  If no horizontal alignment, then Me\exiActualLeft and Me\exiActualWidth remain unchanged
;
;  2)  If no vertical alignment, then Me\exiActualTop and Me\exiActualHeight remain unchanged
;

  oGenericContainer = Me\exoParent                                             ; reference the parent container

  iParentWidth   = Get(oGenericContainer, exiActualWidth)
  iParentHeight  = Get(oGenericContainer, exiActualHeight)
  iParentPadding = Get(oGenericContainer, exiPadding)

  If IsTrue(Me\exlHorizontalAlignment)
    Select Me\exiHorizontalAlignmentMode
      Case #iGUI_ALIGN_FILL
        Me\exiActualLeft  = iParentPadding + Me\exiMarginLeft
        Me\exiActualWidth = iParentWidth - iParentPadding - Me\exiMarginLeft - Me\exiMarginRight - iParentPadding
      Case #iGUI_ALIGN_START
        Me\exiActualLeft  = iParentPadding + Me\exiMarginLeft
      Case #iGUI_ALIGN_END
        Me\exiActualLeft  = iParentWidth - iParentPadding - Me\exiMarginRight - Me\exiActualWidth
      Case #iGUI_ALIGN_CENTRE
        Me\exiActualLeft  = (iParentWidth - Me\exiActualWidth) / 2
    EndSelect
  EndIf

  If IsTrue(Me\exlVerticalAlignment)
    Select Me\exiVerticalAlignmentMode
      Case #iGUI_ALIGN_FILL
        Me\exiActualTop  = iParentPadding + Me\exiMarginTop
        Me\exiActualHeight = iParentHeight - iParentPadding - Me\exiMarginTop - Me\exiMarginBottom - iParentPadding
      Case #iGUI_ALIGN_START
        Me\exiActualTop  = iParentPadding + Me\exiMarginTop
      Case #iGUI_ALIGN_END
        Me\exiActualTop  = iParentHeight - iParentPadding - Me\exiMarginBottom - Me\exiActualHeight
      Case #iGUI_ALIGN_CENTRE
        Me\exiActualTop  = (iParentHeight - Me\exiActualHeight) / 2
    EndSelect
  EndIf

EndSubroutine
;
;-----------------------------------------------
;
PrivateSubroutine(ApplyPageResizeRules)     (ByVal(Me, strContainer))
;
;  ApplyPageResizeRules                apply the panel page resize rules
;
;
;  Local(iParentWidth, typInt32)                       ; 16458 : parent container width (pixels)
;  Local(iParentHeight, typInt32)                      ; 16459 : parent container height (pixels)
;  Local(iParentPadding, typInt32)                     ; 16460 : parent container padding (pixels)
;  Local(oGenericPage, objPage)                        ; 16659 : generic page object
;
;  Note:
;
;  1)  the page container is aligned to fill the panelitem
;
;  2)  the parent padding is the value assigned to the associated panelitem
;
;  3)  the margin adjustments create a common page container size for supported operating systems

;  oGenericPage    = Me\exoParent                                               ; reference the parent page object

;  iParentWidth   = Get(oGenericPage, exiActualWidth)
;  iParentHeight  = Get(oGenericPage, exiActualHeight)
;  iParentPadding = Get(oGenericPage, exiPanelItemPadding)

;  CompilerSelect #PB_Compiler_OS
;    CompilerCase #PB_OS_Linux
;      Me\exiActualLeft   = iParentPadding + #iPAGE_MARGIN_LINUX_LEFT
;      Me\exiActualTop    = iParentPadding + #iPAGE_MARGIN_LINUX_TOP
;      Me\exiActualWidth  = iParentWidth  - iParentPadding - iParentPadding - #iPAGE_MARGIN_LINUX_LEFT - #iPAGE_MARGIN_LINUX_RIGHT
;      Me\exiActualHeight = iParentHeight - iParentPadding - iParentPadding - #iPAGE_MARGIN_LINUX_TOP  - #iPAGE_MARGIN_LINUX_BOTTOM
;    CompilerCase #PB_OS_Windows
;      Me\exiActualLeft   = iParentPadding + #iPAGE_MARGIN_WINDOWS_LEFT
;      Me\exiActualTop    = iParentPadding + #iPAGE_MARGIN_WINDOWS_TOP
;      Me\exiActualWidth  = iParentWidth  - iParentPadding - iParentPadding - #iPAGE_MARGIN_WINDOWS_LEFT - #iPAGE_MARGIN_WINDOWS_RIGHT
;      Me\exiActualHeight = iParentHeight - iParentPadding - iParentPadding - #iPAGE_MARGIN_WINDOWS_TOP  - #iPAGE_MARGIN_WINDOWS_BOTTOM
;    CompilerDefault
;      Me\exiActualLeft   = iParentPadding
;      Me\exiActualTop    = iParentPadding
;      Me\exiActualWidth  = iParentWidth  - iParentPadding - iParentPadding
;      Me\exiActualHeight = iParentHeight - iParentPadding - iParentPadding
;  CompilerEndSelect

EndSubroutine
;
;-----------------------------------------------
;
PrivateSubroutine(ResizeSplitterChildContainer)        (ByVal(Me, strContainer))
;
;  ResizeSplitterChildContainer        resize a splitter child container
;
;
;
;  Note:
;
;  The splitter containers are automatically resized when the splitter is resized or
;  when the splitter bar is moved.
;
;  This procedure refreshes the actual size info for these containers, prior to
;  their child objects being resized.
;

  Me\exiActualLeft   = GadgetX(Me\exiGadgetNumber)
  Me\exiActualTop    = GadgetY(Me\exiGadgetNumber)
  Me\exiActualWidth  = GadgetWidth(Me\exiGadgetNumber)
  Me\exiActualHeight = GadgetHeight(Me\exiGadgetNumber)

EndSubroutine
;
;-----------------------------------------------
;
PrivateSubroutine(ResizeApplicationContainer)  (ByVal(Me, strContainer))
;
;  ResizeApplicationContainer          resize an application container
;
;
;
;  Note:
;
;  The application container must be the same size as the main window.
;

  Me\exiActualLeft   = 0
  Me\exiActualTop    = 0
  Me\exiActualWidth  = Get(gloApp, exiActualWidth)
  Me\exiActualHeight = Get(gloApp, exiActualHeight)

EndSubroutine
;
;===============================================
;
;  Virtual Table
;
BeginVirtualTable
;
;  primary  methods
;
  VirtualFunc(Destroy)
  VirtualGetx(exiClassReferenceNumber)
  VirtualSetx(exoParent)
  VirtualGetx(exiChildEntryNumber)
  VirtualSetx(exiChildEntryNumber)
;
;  external methods
;
  VirtualSubr(Events)
  VirtualSubr(Resize)
  VirtualSubr(Build)
  VirtualSubr(AttachChild)
  VirtualSubr(DetachChild)
;
;  external properties:  read/write
;
  VirtualGetx(exlBorder)
  VirtualSetx(exlBorder)
  VirtualGetx(exiPadding)
  VirtualSetx(exiPadding)
;
;  external properties:  read only
;
  VirtualGetx(exiGadgetNumber)
  VirtualGetx(exiActualLeft)
  VirtualGetx(exiActualTop)
  VirtualGetx(exiActualWidth)
  VirtualGetx(exiActualHeight)
;
;  external properties:  write only
;
  VirtualSetx(exiBackgroundColour)
  VirtualSetx(expCBDesign)
  VirtualSetx(exiMarginTop)
  VirtualSetx(exiMarginBottom)
  VirtualSetx(exiMarginLeft)
  VirtualSetx(exiMarginRight)
  VirtualSetx(exlResizeAllowed)
  VirtualSetx(exlShrinkAllowed)
  VirtualSetx(exiHorizontalAlignmentMode)
  VirtualSetx(exlHorizontalAlignment)
  VirtualSetx(exiVerticalAlignmentMode)
  VirtualSetx(exlVerticalAlignment)
  VirtualSetx(exiBaseLeft)
  VirtualSetx(exiBaseTop)
  VirtualSetx(exiBaseWidth)
  VirtualSetx(exiBaseHeight)
  VirtualSetx(exsToolTip)
;
EndVirtualTable
;
;===============================================
;
EndClass
;
;===============================================
;  end of  :  clsContainer.pbi
;===============================================
For ten years Caesar ruled with an iron hand, then with a wooden foot, and finally with a piece of string.
~ Spike Milligan
Top
BorisTheOld
Enthusiast
Enthusiast
Posts: 542
Joined: Tue Apr 24, 2012 5:08 pm
Location: Ontario, Canada

Re: Macros, OOP, Custom gadgets, Automatic resizing

Post by BorisTheOld »

Here are the interface and class files for the ButtonBar Class:

objButtonBar.pbi

Code: Select all

;===============================================
;
;  file name       :  objButtonBar.pbi
;  description     :  ButtonBar Class Interface
;  author          :  Rod Gobby (BorisTheOld)
;  copyright       :  you have my permission to use this code as you wish
;  date generated  :  2013-10-23 21:00
;  configuration   :  PureBasic 5.20 LTS, x86, Linux & Windows
;  notes           :  no API used
;
;===============================================
;
BeginClass(ButtonBar)
;
BeginClassInterface
;
;  primary  methods
;
  InterfaceFunc(Destroy, typObject)    ()
  InterfaceGetx(exiClassReferenceNumber, typInt32)     ()
  InterfaceSetx(exoParent)             (ByVal(bvoParent, typObject))
  InterfaceGetx(exiChildEntryNumber, typInt32) ()
  InterfaceSetx(exiChildEntryNumber)   (ByVal(bviChildEntryNumber, typInt32))
;
;  external methods
;
  InterfaceSubr(Events)                ()
  InterfaceSubr(Resize)                ()
  InterfaceSubr(Build)                 ()
  InterfaceSubr(AttachChild)           (ByVal(bvoChild, typObject))
  InterfaceSubr(DetachChild)           (ByVal(bvoChild, typObject))
  InterfaceSubr(ProcessEsc)            ()
  InterfaceSubr(ProcessLeft)           (ByVal(bvoGenericButton, typObject))
  InterfaceSubr(ProcessRight)          (ByVal(bvoGenericButton, typObject))
  InterfaceSubr(ProcessHotkey)         (ByVal(bvcHotkeyChar, typChar))
;
;  external properties:  read/write
;
  InterfaceGetx(exlBorder, typBoolean) ()
  InterfaceSetx(exlBorder)             (ByVal(bvlBorder, typBoolean))
  InterfaceGetx(exiPadding, typInt32)  ()
  InterfaceSetx(exiPadding)            (ByVal(bviPadding, typInt32))
;
;  external properties:  read only
;
  InterfaceGetx(exiGadgetNumber, typInt32)     ()
  InterfaceGetx(exiActualLeft, typInt32)       ()
  InterfaceGetx(exiActualTop, typInt32)        ()
  InterfaceGetx(exiActualWidth, typInt32)      ()
  InterfaceGetx(exiActualHeight, typInt32)     ()
;
;  external properties:  write only
;
  InterfaceSetx(exnFirstButton)        (ByVal(bvnFirstButton, typDword))
  InterfaceSetx(exiBackgroundColour)   (ByVal(bviBackgroundColour, typInt32))
  InterfaceSetx(expCBDesign)           (ByVal(bviIndex, typInt32), ByVal(bvpCBDesign, typPointer))
  InterfaceSetx(exiMarginTop)          (ByVal(bviMarginTop, typInt32))
  InterfaceSetx(exiMarginBottom)       (ByVal(bviMarginBottom, typInt32))
  InterfaceSetx(exiMarginLeft)         (ByVal(bviMarginLeft, typInt32))
  InterfaceSetx(exiMarginRight)        (ByVal(bviMarginRight, typInt32))
  InterfaceSetx(exlResizeAllowed)      (ByVal(bvlResizeAllowed, typBoolean))
  InterfaceSetx(exlShrinkAllowed)      (ByVal(bvlShrinkAllowed, typBoolean))
  InterfaceSetx(exiHorizontalAlignmentMode)    (ByVal(bviHorizontalAlignmentMode, typInt32))
  InterfaceSetx(exlHorizontalAlignment)        (ByVal(bvlHorizontalAlignment, typBoolean))
  InterfaceSetx(exiVerticalAlignmentMode)      (ByVal(bviVerticalAlignmentMode, typInt32))
  InterfaceSetx(exlVerticalAlignment)  (ByVal(bvlVerticalAlignment, typBoolean))
  InterfaceSetx(exiBaseLeft)           (ByVal(bviBaseLeft, typInt32))
  InterfaceSetx(exiBaseTop)            (ByVal(bviBaseTop, typInt32))
  InterfaceSetx(exiBaseWidth)          (ByVal(bviBaseWidth, typInt32))
  InterfaceSetx(exiBaseHeight)         (ByVal(bviBaseHeight, typInt32))
  InterfaceSetx(exsToolTip)            (ByVal(bvsToolTip, typString))
  InterfaceSetx(exiBaseButtonSpacing)  (ByVal(bviBaseButtonSpacing, typInt32))
  InterfaceSetx(exiBaseButtonWidth)    (ByVal(bviBaseButtonWidth, typInt32))
  InterfaceSetx(exiBaseButtonHeight)   (ByVal(bviBaseButtonHeight, typInt32))
  InterfaceSetx(exiButtonLayoutMode)   (ByVal(bviButtonLayoutMode, typInt32))
;
EndClassInterface
;
EndClass
;
;===============================================
;  end of  :  objButtonBar.pbi
;===============================================
clsButtonBar.pbi

Code: Select all

;===============================================
;
;  file name       :  clsButtonBar.pbi
;  description     :  ButtonBar Class
;  author          :  Rod Gobby (BorisTheOld)
;  copyright       :  you have my permission to use this code as you wish
;  date generated  :  2013-10-23 21:00
;  configuration   :  PureBasic 5.20 LTS, x86, Linux & Windows
;  notes           :  no API used
;
;===============================================
;
BeginClass(ButtonBar)
;
;===============================================
;
;  Properties
;
BeginClassData
;
;  primary  properties
;
  FieldPointer(prpVirtualTable)                       ; 16393 : pointer to the class virtual table
  Field(exiClassReferenceNumber, typInt32)            ; 16447 : the entity number for the class (module, program, package, etc)
  Field(exoParent, objGeneric)                        ; 16086 : reference to an object`s parent
  Field(exiChildEntryNumber, typInt32)                ; 16484 : entry number of the object in the parent child array (1 based)
;
;  private properties
;
  FieldDynamicArray(proChild, objGeneric)             ; 16448 : reference to a child object
  Field(priChildCount, typInt32)                      ; 16451 : number of child objects attached to a parent object
;
;  external properties:  read/write
;
  Field(exlBorder, typBoolean)                        ; 16390 : true = show a border around a panel
  Field(exiPadding, typInt32)                         ; 16412 : width of the empty border inside a gui object (pixels)
;
;  external properties:  read only
;
  Field(exiGadgetNumber, typInt32)                    ; 16402 : assigned by pb using #pb_any
  Field(exiActualLeft, typInt32)                      ; 16417 : actual left position of the gui object (pixels)
  Field(exiActualTop, typInt32)                       ; 16418 : actual top position of the gui object (pixels)
  Field(exiActualWidth, typInt32)                     ; 16419 : actual width of the gui object (pixels)
  Field(exiActualHeight, typInt32)                    ; 16420 : actual height of the gui object (pixels)
;
;  external properties:  write only
;
  Field(exnFirstButton, typDword)                     ; 11670 : first button to receive focus
  Field(exiBackgroundColour, typInt32)                ; 14751 : background colour
  FieldCallBack(expCBDesign)                          ; 16080 : callback ptr:  design an object
  Field(exiMarginTop, typInt32)                       ; 16128 : top margin outside the gadget (pixels)
  Field(exiMarginBottom, typInt32)                    ; 16129 : bottom margin outside the gadget (pixels)
  Field(exiMarginLeft, typInt32)                      ; 16130 : left margin outside the gadget (pixels)
  Field(exiMarginRight, typInt32)                     ; 16131 : right margin outside the gadget (pixels)
  Field(exlResizeAllowed, typBoolean)                 ; 16405 : true = gui object can be resized
  Field(exlShrinkAllowed, typBoolean)                 ; 16406 : true = gui object can shrink below the base size
  Field(exiHorizontalAlignmentMode, typInt32)         ; 16408 : fill, start, end, centre
  Field(exlHorizontalAlignment, typBoolean)           ; 16409 : true = horizontal gui object alignment is allowed
  Field(exiVerticalAlignmentMode, typInt32)           ; 16410 : fill, start, end, centre
  Field(exlVerticalAlignment, typBoolean)             ; 16411 : true = vertical gui object alignment is allowed
  Field(exiBaseLeft, typInt32)                        ; 16413 : nominal left position of the gui object (pixels)
  Field(exiBaseTop, typInt32)                         ; 16414 : nominal top position of the gui object (pixels)
  Field(exiBaseWidth, typInt32)                       ; 16415 : nominal width of the gui object (pixels)
  Field(exiBaseHeight, typInt32)                      ; 16416 : nominal height of the gui object (pixels)
  Field(exsToolTip, typString)                        ; 16421 : tooltip text:  blank = no tooltip
  Field(exiBaseButtonSpacing, typInt32)               ; 16678 : nominal spacing between and around each button (pixels)
  Field(exiBaseButtonWidth, typInt32)                 ; 16679 : nominal width to be applied to each button (pixels)
  Field(exiBaseButtonHeight, typInt32)                ; 16680 : nominal height to be applied to each button (pixels)
  Field(exiButtonLayoutMode, typInt32)                ; 16685 : Layout mode:  edge, start, end, centre, expand, fill, stretch
;
EndClassData
;
;===============================================
;
;  Private Declares
;
DeclarePrivateSubroutine(Constructor)  (ByVal(Me, strButtonBar))
DeclarePrivateSubroutine(Destructor)   (ByVal(Me, strButtonBar))
DeclarePrivateSubroutine(ApplyExternalResizeRules)     (ByVal(Me, strButtonBar))
DeclarePrivateSubroutine(setexiButtonLayoutMode)       (ByVal(Me, strButtonBar))
DeclarePrivateSubroutine(ApplyInternalResizeRules)     (ByVal(Me, strButtonBar))
DeclarePrivateSubroutine(BuildStartLayout)     (ByVal(Me, strButtonBar))
DeclarePrivateSubroutine(BuildEndLayout)       (ByVal(Me, strButtonBar))
DeclarePrivateSubroutine(BuildCentreLayout)    (ByVal(Me, strButtonBar))
DeclarePrivateSubroutine(BuildEdgeLayout)      (ByVal(Me, strButtonBar))
DeclarePrivateSubroutine(BuildExpandLayout)    (ByVal(Me, strButtonBar))
DeclarePrivateSubroutine(BuildStretchLayout)   (ByVal(Me, strButtonBar))
DeclarePrivateSubroutine(BuildFillLayout)      (ByVal(Me, strButtonBar))
;
;===============================================
;
;  Primary Methods
;
;-----------------------------------------------
;
ExternalFunction(Create, typObject) ()
;
;  Create                              create a class instance
;
  Local(Me, strButtonBar)

  Me = AllocateMemory(SizeOf(strButtonBar))
  If IsObject(Me)
    InitializeStructure(Me, strButtonBar)
    Me\prpVirtualTable = LabelPtr(VirtualTable)
    ClassCall(Constructor) (Me)
  EndIf
  ProcedureReturn Me
EndFunction
;
;-----------------------------------------------
;
ExternalFunction(Destroy, typObject) (ByVal(Me, strButtonBar))
;
;  Destroy                             destroy a class instance
;
  If IsObject(Me)
    ClassCall(Destructor) (Me)
    ClearStructure(Me, strButtonBar)
    FreeMemory(Me)
  EndIf
  ProcedureReturn Nothing
EndFunction
;
;-----------------------------------------------
;
;  exiClassReferenceNumber             16447 : the entity number for the class (module, program, package, etc)
;
ExternalGet(exiClassReferenceNumber, typInt32) (ByVal(Me, strButtonBar))
  ProcedureReturn Me\exiClassReferenceNumber
EndGet
;
;-----------------------------------------------
;
;  exoParent                           16086 : reference to an object`s parent
;
ExternalSet(exoParent)                 (ByVal(Me, strButtonBar), ByVal(bvoParent, typObject))
  Me\exoParent = bvoParent
EndSet
;
;-----------------------------------------------
;
;  exiChildEntryNumber                 16484 : entry number of the object in the parent child array (1 based)
;
ExternalGet(exiChildEntryNumber, typInt32)     (ByVal(Me, strButtonBar))
  ProcedureReturn Me\exiChildEntryNumber
EndGet
;
ExternalSet(exiChildEntryNumber)       (ByVal(Me, strButtonBar), ByVal(bviChildEntryNumber, typInt32))
  Me\exiChildEntryNumber = bviChildEntryNumber
EndSet
;
;===============================================
;
;  External Methods
;
;-----------------------------------------------
;
ExternalSubroutine(Events)             (ByVal(Me, strButtonBar))
;
;  Events                              process gadget events
;
;  not used -- placeholder only
;
EndSubroutine
;
;-----------------------------------------------
;
ExternalSubroutine(Resize)             (ByVal(Me, strButtonBar))
;
;  Resize                              process a window resize event
;
;
  Local(iLoop, typInt32)                                                       ; 15051 : generic loop counter

  If IsTrue(Me\exlResizeAllowed)

    ClassCall(ApplyExternalResizeRules) (Me)                                   ; resize the buttonbar

    ResizeGadget(Me\exiGadgetNumber, Me\exiActualLeft, Me\exiActualTop, Me\exiActualWidth, Me\exiActualHeight)

    ClassCall(ApplyInternalResizeRules) (Me)                                   ; resize the buttons

  EndIf

EndSubroutine
;
;-----------------------------------------------
;
ExternalSubroutine(Build)              (ByVal(Me, strButtonBar))
;
;  Build                               build this object
;
;
  Local(oGenericButton, objButton)                                             ; 16116 : generic reference to a button object
  Local(iGadgetFlags, typInt32)                                                ; 16403 : composite option flags used when creating a pb gadget

  AttachMeToParent

  Me\exiActualLeft   = Me\exiBaseLeft                                          ; set the initial size values
  Me\exiActualTop    = Me\exiBaseTop
  Me\exiActualWidth  = Me\exiBaseWidth
  Me\exiActualHeight = Me\exiPadding + Me\exiBaseButtonSpacing + Me\exiBaseButtonHeight + Me\exiBaseButtonSpacing + Me\exiPadding

  ClassCall(ApplyExternalResizeRules) (Me)

  If IsTrue(Me\exlBorder)
    iGadgetFlags = #PB_Container_Flat
  Else
    iGadgetFlags = 0
  EndIf

  Me\exiGadgetNumber = ContainerGadget(#PB_Any, Me\exiActualLeft, Me\exiActualTop, Me\exiActualWidth, Me\exiActualHeight, iGadgetFlags)

  SetGadgetData(Me\exiGadgetNumber, Me)                                        ; link this buttonbar object to the gadget
  GadgetToolTip(Me\exiGadgetNumber, Me\exsToolTip)
  SetGadgetColor(Me\exiGadgetNumber, #PB_Gadget_BackColor, Me\exiBackgroundColour)

  CallBack(Me\expCBDesign)                                                     ; design the buttonbar

  CloseGadgetList()                                                            ; finish building the buttonbar contents

  ClassCall(ApplyInternalResizeRules) (Me)                                     ; position the buttons

  oGenericButton = Me\proChild(Me\exnFirstButton)                              ; create a reference to the primary button
  SetObjectFocus(oGenericButton)                                               ; activate the primary button

EndSubroutine
;
;-----------------------------------------------
;
ExternalSubroutine(AttachChild)        (ByVal(Me, strButtonBar), ByRef(broChild, objGeneric))
;
;  AttachChild                         attach a child object
;
;  broChild                            16448 : reference to a child object
;

  Increment(Me\priChildCount)
  ResizeDynamicArray(Me\proChild, Me\priChildCount)                            ; add an entry to the child array
  Me\proChild(Me\priChildCount) = Ref(broChild)                                ; store the child object reference
  Set(Ref(broChild), exiChildEntryNumber, Me\priChildCount)                    ; update the child`s entry number

EndSubroutine
;
;-----------------------------------------------
;
ExternalSubroutine(DetachChild)        (ByVal(Me, strButtonBar), ByRef(broChild, objGeneric))
;
;  DetachChild                         detach a child object
;
;  broChild                            16448 : reference to a child object
;
  Local(iLoop, typInt32)                                                       ; 15051 : generic loop counter
  Local(iChildEntryNumber, typInt32)                                           ; 16484 : entry number of the object in the parent child array (1 based)

  iChildEntryNumber = Get(Ref(broChild), exiChildEntryNumber)                  ; extract the child entry number

  If (iChildEntryNumber > 0) And (iChildEntryNumber <= Me\priChildCount)

    Decrement(Me\priChildCount)

    For iLoop = iChildEntryNumber To Me\priChildCount                          ; adjust the array entries
      Me\proChild(iLoop) = Me\proChild(iLoop + 1)                              ; shift left into the vacated spot
      Set(Me\proChild(iLoop), exiChildEntryNumber, iLoop)                      ; adjust the child`s entry number
    Next

    ResizeDynamicArray(Me\proChild, Me\priChildCount)                          ; trim the last entry off the array

  EndIf

  Set(Ref(broChild), exoParent, Nothing)                                       ; detach the child from this parent object
  Set(Ref(broChild), exiChildEntryNumber, 0)                                   ; clear the child`s entry number

EndSubroutine
;
;-----------------------------------------------
;
ExternalSubroutine(ProcessEsc)         (ByVal(Me, strButtonBar))
;
;  ProcessEsc                          process a button escape key
;
;
  Local(iLoop, typInt32)                                                       ; 15051 : generic loop counter
  Local(oGenericButton, objButton)                                             ; 16116 : generic reference to a button object

  For iLoop = 1 To Me\priChildCount

    oGenericButton = Me\proChild(iLoop)

    If Get(oGenericButton, exlTrapEscKey) = True
      SetObjectFocus(oGenericButton)
      PostCustomEvent(oGenericButton, #iEVENT_LEFT_CLICK)
      ExitFor
    EndIf

  Next

EndSubroutine
;
;-----------------------------------------------
;
ExternalSubroutine(ProcessLeft)        (ByVal(Me, strButtonBar), ByRef(broGenericButton, objButton))
;
;  ProcessLeft                         process a button left key
;
;  broGenericButton                    16116 : generic reference to a button object
;
  Local(oGenericButton, objButton)                                             ; 16116 : generic reference to a button object
  Local(iChildEntryNumber, typInt32)                                           ; 16484 : entry number of the object in the parent child array (1 based)

  iChildEntryNumber = Get(Ref(broGenericButton), exiChildEntryNumber)          ; extract the button entry number

  If iChildEntryNumber > 1
    Decrement(iChildEntryNumber)                                               ; shift left to the previous button
  Else
    iChildEntryNumber = Me\priChildCount                                       ; loop to the last button
  EndIf

  oGenericButton = Me\proChild(iChildEntryNumber)                              ; create a reference to the new button
  SetObjectFocus(oGenericButton)

EndSubroutine
;
;-----------------------------------------------
;
ExternalSubroutine(ProcessRight)       (ByVal(Me, strButtonBar), ByRef(broGenericButton, objButton))
;
;  ProcessRight                        process a button right key
;
;  broGenericButton                    16116 : generic reference to a button object
;
  Local(oGenericButton, objButton)                                             ; 16116 : generic reference to a button object
  Local(iChildEntryNumber, typInt32)                                           ; 16484 : entry number of the object in the parent child array (1 based)

  iChildEntryNumber = Get(Ref(broGenericButton), exiChildEntryNumber)          ; extract the button entry number

  If iChildEntryNumber < Me\priChildCount
    Increment(iChildEntryNumber)                                               ; shift right to the next button
  Else
    iChildEntryNumber = 1                                                      ; loop to the first button
  EndIf

  oGenericButton = Me\proChild(iChildEntryNumber)                              ; create a reference to the new button
  SetObjectFocus(oGenericButton)

EndSubroutine
;
;-----------------------------------------------
;
ExternalSubroutine(ProcessHotkey)      (ByVal(Me, strButtonBar), ByVal(bvcHotkeyChar, typChar))
;
;  ProcessHotkey                       process a button hotkey
;
;  bvcHotkeyChar                       11683 : hot key character: alphanumeric
;
  Local(iLoop, typInt32)                                                       ; 15051 : generic loop counter
  Local(oGenericButton, objButton)                                             ; 16116 : generic reference to a button object

  For iLoop = 1 To Me\priChildCount

    oGenericButton = Me\proChild(iLoop)

    If Get(oGenericButton, excHotkeyChar) = bvcHotkeyChar
      SetObjectFocus(oGenericButton)
      PostCustomEvent(oGenericButton, #iEVENT_LEFT_CLICK)
      ExitFor
    EndIf

  Next

EndSubroutine
;
;===============================================
;
;  Property Methods
;
;-----------------------------------------------
;
;  external properties:  read/write
;
;--------
;
ExternalGet(exlBorder, typBoolean)     (ByVal(Me, strButtonBar))
  ProcedureReturn Me\exlBorder
EndGet
;
ExternalSet(exlBorder)                 (ByVal(Me, strButtonBar), ByVal(bvlBorder, typBoolean))
  Me\exlBorder = bvlBorder
EndSet
;
;--------
;
ExternalGet(exiPadding, typInt32)      (ByVal(Me, strButtonBar))
  ProcedureReturn Me\exiPadding
EndGet
;
ExternalSet(exiPadding)                (ByVal(Me, strButtonBar), ByVal(bviPadding, typInt32))
  Me\exiPadding = bviPadding
EndSet
;
;-----------------------------------------------
;
;  external properties:  read only
;
;--------
;
ExternalGet(exiGadgetNumber, typInt32) (ByVal(Me, strButtonBar))
  ProcedureReturn Me\exiGadgetNumber
EndGet
;
;--------
;
ExternalGet(exiActualLeft, typInt32)   (ByVal(Me, strButtonBar))
  ProcedureReturn Me\exiActualLeft
EndGet
;
;--------
;
ExternalGet(exiActualTop, typInt32)    (ByVal(Me, strButtonBar))
  ProcedureReturn Me\exiActualTop
EndGet
;
;--------
;
ExternalGet(exiActualWidth, typInt32)  (ByVal(Me, strButtonBar))
  ProcedureReturn Me\exiActualWidth
EndGet
;
;--------
;
ExternalGet(exiActualHeight, typInt32) (ByVal(Me, strButtonBar))
  ProcedureReturn Me\exiActualHeight
EndGet
;
;-----------------------------------------------
;
;  external properties:  write only
;
;--------
;
ExternalSet(exnFirstButton)            (ByVal(Me, strButtonBar), ByVal(bvnFirstButton, typDword))
  Me\exnFirstButton = bvnFirstButton
EndSet
;
;--------
;
ExternalSet(exiBackgroundColour)       (ByVal(Me, strButtonBar), ByVal(bviBackgroundColour, typInt32))
  Me\exiBackgroundColour = bviBackgroundColour
EndSet
;
;--------
;
ExternalSet(expCBDesign)               (ByVal(Me, strButtonBar), ByVal(bviIndex, typInt32), ByVal(bvpCBDesign, typPointer))
  Me\expCBDesign(bviIndex) = bvpCBDesign
EndSet
;
;--------
;
ExternalSet(exiMarginTop)              (ByVal(Me, strButtonBar), ByVal(bviMarginTop, typInt32))
  Me\exiMarginTop = bviMarginTop
EndSet
;
;--------
;
ExternalSet(exiMarginBottom)           (ByVal(Me, strButtonBar), ByVal(bviMarginBottom, typInt32))
  Me\exiMarginBottom = bviMarginBottom
EndSet
;
;--------
;
ExternalSet(exiMarginLeft)             (ByVal(Me, strButtonBar), ByVal(bviMarginLeft, typInt32))
  Me\exiMarginLeft = bviMarginLeft
EndSet
;
;--------
;
ExternalSet(exiMarginRight)            (ByVal(Me, strButtonBar), ByVal(bviMarginRight, typInt32))
  Me\exiMarginRight = bviMarginRight
EndSet
;
;--------
;
ExternalSet(exlResizeAllowed)          (ByVal(Me, strButtonBar), ByVal(bvlResizeAllowed, typBoolean))
  Me\exlResizeAllowed = bvlResizeAllowed
EndSet
;
;--------
;
ExternalSet(exlShrinkAllowed)          (ByVal(Me, strButtonBar), ByVal(bvlShrinkAllowed, typBoolean))
  Me\exlShrinkAllowed = bvlShrinkAllowed
EndSet
;
;--------
;
ExternalSet(exiHorizontalAlignmentMode)        (ByVal(Me, strButtonBar), ByVal(bviHorizontalAlignmentMode, typInt32))
  Me\exiHorizontalAlignmentMode = bviHorizontalAlignmentMode
EndSet
;
;--------
;
ExternalSet(exlHorizontalAlignment)    (ByVal(Me, strButtonBar), ByVal(bvlHorizontalAlignment, typBoolean))
  Me\exlHorizontalAlignment = bvlHorizontalAlignment
EndSet
;
;--------
;
ExternalSet(exiVerticalAlignmentMode)  (ByVal(Me, strButtonBar), ByVal(bviVerticalAlignmentMode, typInt32))
  Me\exiVerticalAlignmentMode = bviVerticalAlignmentMode
EndSet
;
;--------
;
ExternalSet(exlVerticalAlignment)      (ByVal(Me, strButtonBar), ByVal(bvlVerticalAlignment, typBoolean))
  Me\exlVerticalAlignment = bvlVerticalAlignment
EndSet
;
;--------
;
ExternalSet(exiBaseLeft)               (ByVal(Me, strButtonBar), ByVal(bviBaseLeft, typInt32))
  Me\exiBaseLeft = bviBaseLeft
EndSet
;
;--------
;
ExternalSet(exiBaseTop)                (ByVal(Me, strButtonBar), ByVal(bviBaseTop, typInt32))
  Me\exiBaseTop = bviBaseTop
EndSet
;
;--------
;
ExternalSet(exiBaseWidth)              (ByVal(Me, strButtonBar), ByVal(bviBaseWidth, typInt32))
  Me\exiBaseWidth = bviBaseWidth
EndSet
;
;--------
;
ExternalSet(exiBaseHeight)             (ByVal(Me, strButtonBar), ByVal(bviBaseHeight, typInt32))
  Me\exiBaseHeight = bviBaseHeight
EndSet
;
;--------
;
ExternalSet(exsToolTip)                (ByVal(Me, strButtonBar), ByVal(bvsToolTip, typString))
  Me\exsToolTip = bvsToolTip
EndSet
;
;--------
;
ExternalSet(exiBaseButtonSpacing)      (ByVal(Me, strButtonBar), ByVal(bviBaseButtonSpacing, typInt32))
  Me\exiBaseButtonSpacing = bviBaseButtonSpacing
EndSet
;
;--------
;
ExternalSet(exiBaseButtonWidth)        (ByVal(Me, strButtonBar), ByVal(bviBaseButtonWidth, typInt32))
  Me\exiBaseButtonWidth = bviBaseButtonWidth
EndSet
;
;--------
;
ExternalSet(exiBaseButtonHeight)       (ByVal(Me, strButtonBar), ByVal(bviBaseButtonHeight, typInt32))
  Me\exiBaseButtonHeight = bviBaseButtonHeight
EndSet
;
;--------
;
ExternalSet(exiButtonLayoutMode)       (ByVal(Me, strButtonBar), ByVal(bviButtonLayoutMode, typInt32))
  Me\exiButtonLayoutMode = bviButtonLayoutMode
  ClassCall(setexiButtonLayoutMode) (Me)
EndSet
;
;===============================================
;
;  Private Methods
;
;-----------------------------------------------
;
PrivateSubroutine(Constructor)         (ByVal(Me, strButtonBar))
;
;  Constructor                         class constructor
;

  Me\exiClassReferenceNumber    = #iCLASS_REF_BUTTONBAR

  Me\exiBackgroundColour        = #iBUTTONBAR_COLOUR             
  Me\exlResizeAllowed           = True                           
  Me\exlHorizontalAlignment     = True                           
  Me\exiHorizontalAlignmentMode = #iGUI_ALIGN_FILL               
  Me\exlVerticalAlignment       = True                           
  Me\exiVerticalAlignmentMode   = #iGUI_ALIGN_END                
  Me\exiBaseButtonSpacing       = #iBUTTON_SPACING               
  Me\exiBaseButtonWidth         = #iBUTTON_WIDTH                 
  Me\exiBaseButtonHeight        = #iBUTTON_HEIGHT                
  Me\exiButtonLayoutMode        = #iGUI_LAYOUT_START             
  Me\exnFirstButton             = 1                              

EndSubroutine
;
;-----------------------------------------------
;
PrivateSubroutine(Destructor)          (ByVal(Me, strButtonBar))
;
;  Destructor                          class destructor
;

  DestroyMyGadget
  DetachMeFromParent
  DetachMyChildren

EndSubroutine
;
;-----------------------------------------------
;
PrivateSubroutine(ApplyExternalResizeRules)    (ByVal(Me, strButtonBar))
;
;  ApplyExternalResizeRules            apply the external resize rules
;
;
  Local(oGenericContainer, objContainer)              ; 16077 : generic reference to a container object
  Local(iParentWidth, typInt32)                       ; 16458 : parent container width (pixels)
  Local(iParentHeight, typInt32)                      ; 16459 : parent container height (pixels)
  Local(iParentPadding, typInt32)                     ; 16460 : parent container padding (pixels)
;
;  Note:
;
;  1)  If no horizontal alignment, then Me\exiActualLeft and Me\exiActualWidth remain unchanged
;
;  2)  If no vertical alignment, then Me\exiActualTop and Me\exiActualHeight remain unchanged
;

  oGenericContainer = Me\exoParent                                             ; reference the parent container

  iParentWidth   = Get(oGenericContainer, exiActualWidth)
  iParentHeight  = Get(oGenericContainer, exiActualHeight)
  iParentPadding = Get(oGenericContainer, exiPadding)

  If IsTrue(Me\exlHorizontalAlignment)
    Select Me\exiHorizontalAlignmentMode
      Case #iGUI_ALIGN_FILL
        Me\exiActualLeft  = iParentPadding + Me\exiMarginLeft
        Me\exiActualWidth = iParentWidth - iParentPadding - Me\exiMarginLeft - Me\exiMarginRight - iParentPadding
      Case #iGUI_ALIGN_START
        Me\exiActualLeft  = iParentPadding + Me\exiMarginLeft
      Case #iGUI_ALIGN_END
        Me\exiActualLeft  = iParentWidth - iParentPadding - Me\exiMarginRight - Me\exiActualWidth
      Case #iGUI_ALIGN_CENTRE
        Me\exiActualLeft  = (iParentWidth - Me\exiActualWidth) / 2
    EndSelect
  EndIf

  If IsTrue(Me\exlVerticalAlignment)
    Select Me\exiVerticalAlignmentMode
      Case #iGUI_ALIGN_FILL
        Me\exiActualTop  = iParentPadding + Me\exiMarginTop
        Me\exiActualHeight = iParentHeight - iParentPadding - Me\exiMarginTop - Me\exiMarginBottom - iParentPadding
      Case #iGUI_ALIGN_START
        Me\exiActualTop  = iParentPadding + Me\exiMarginTop
      Case #iGUI_ALIGN_END
        Me\exiActualTop  = iParentHeight - iParentPadding - Me\exiMarginBottom - Me\exiActualHeight
      Case #iGUI_ALIGN_CENTRE
        Me\exiActualTop  = (iParentHeight - Me\exiActualHeight) / 2
    EndSelect
  EndIf

EndSubroutine
;
;-----------------------------------------------
;
PrivateSubroutine(setexiButtonLayoutMode)      (ByVal(Me, strButtonBar))
;
;  update the buttonbar to match the new layout mode 
;

  ClassCall(ApplyInternalResizeRules) (Me)

EndSubroutine
;
;-----------------------------------------------
;
PrivateSubroutine(ApplyInternalResizeRules)    (ByVal(Me, strButtonBar))
;
;  ApplyInternalResizeRules            apply the internal resize rules
;
;

  Select Me\exiButtonLayoutMode
    Case #iGUI_LAYOUT_START
      ClassCall(BuildStartLayout) (Me)
    Case #iGUI_LAYOUT_END
      ClassCall(BuildEndLayout) (Me)
    Case #iGUI_LAYOUT_CENTRE
      ClassCall(BuildCentreLayout) (Me)
    Case #iGUI_LAYOUT_EDGE
      ClassCall(BuildEdgeLayout) (Me)
    Case #iGUI_LAYOUT_EXPAND
      ClassCall(BuildExpandLayout) (Me)
    Case #iGUI_LAYOUT_STRETCH
      ClassCall(BuildStretchLayout) (Me)
    Case #iGUI_LAYOUT_FILL
      ClassCall(BuildFillLayout) (Me)
    CaseElse
      ClassCall(BuildStartLayout) (Me)
  EndSelect

EndSubroutine
;
;-----------------------------------------------
;
PrivateSubroutine(BuildStartLayout)    (ByVal(Me, strButtonBar))
;
;  BuildStartLayout                    build buttons:  layout mode = start
;
;
  Local(iLoop, typInt32)                                                       ; 15051 : generic loop counter
  Local(oGenericButton, objButton)                                             ; 16116 : generic reference to a button object
  Local(iBaseLeft, typInt32)                                                   ; 16413 : nominal left position of the gui object (pixels)
  Local(iBaseTop, typInt32)                                                    ; 16414 : nominal top position of the gui object (pixels)
  Local(iBaseWidth, typInt32)                                                  ; 16415 : nominal width of the gui object (pixels)
  Local(iBaseHeight, typInt32)                                                 ; 16416 : nominal height of the gui object (pixels)

  iBaseLeft   = 0
  iBaseTop    = Me\exiBaseButtonSpacing
  iBaseWidth  = Me\exiBaseButtonWidth
  iBaseHeight = Me\exiBaseButtonHeight

  For iLoop = 1 To Me\priChildCount                                            ; resize all child objects

    oGenericButton = Me\proChild(iLoop)

    Set(oGenericButton, exiBaseLeft, iBaseLeft)
    Set(oGenericButton, exiBaseTop, iBaseTop)
    Set(oGenericButton, exiBaseWidth, iBaseWidth)
    Set(oGenericButton, exiBaseHeight, iBaseHeight)
    ObjectCall(oGenericButton, Resize) ()

    iBaseLeft = iBaseLeft + iBaseWidth + Me\exiBaseButtonSpacing               ; set location of the next button

  Next

EndSubroutine
;
;-----------------------------------------------
;
PrivateSubroutine(BuildEndLayout)      (ByVal(Me, strButtonBar))
;
;  BuildEndLayout                      build buttons:  layout mode = end
;
;
  Local(iLoop, typInt32)                                                       ; 15051 : generic loop counter
  Local(oGenericButton, objButton)                                             ; 16116 : generic reference to a button object
  Local(iBaseLeft, typInt32)                                                   ; 16413 : nominal left position of the gui object (pixels)
  Local(iBaseTop, typInt32)                                                    ; 16414 : nominal top position of the gui object (pixels)
  Local(iBaseWidth, typInt32)                                                  ; 16415 : nominal width of the gui object (pixels)
  Local(iBaseHeight, typInt32)                                                 ; 16416 : nominal height of the gui object (pixels)

  iBaseLeft   = Me\exiActualWidth - Me\exiBaseButtonWidth
  iBaseTop    = Me\exiBaseButtonSpacing
  iBaseWidth  = Me\exiBaseButtonWidth
  iBaseHeight = Me\exiBaseButtonHeight

  For iLoop = Me\priChildCount To 1 Step -1                                    ; resize all child objects

    oGenericButton = Me\proChild(iLoop)

    Set(oGenericButton, exiBaseLeft, iBaseLeft)
    Set(oGenericButton, exiBaseTop, iBaseTop)
    Set(oGenericButton, exiBaseWidth, iBaseWidth)
    Set(oGenericButton, exiBaseHeight, iBaseHeight)
    ObjectCall(oGenericButton, Resize) ()

    iBaseLeft = iBaseLeft - iBaseWidth - Me\exiBaseButtonSpacing               ; set location of the previous button

  Next

EndSubroutine
;
;-----------------------------------------------
;
PrivateSubroutine(BuildCentreLayout)   (ByVal(Me, strButtonBar))
;
;  BuildCentreLayout                   build buttons:  layout mode = centre
;
;
  Local(iLoop, typInt32)                                                       ; 15051 : generic loop counter
  Local(oGenericButton, objButton)                                             ; 16116 : generic reference to a button object
  Local(iBaseLeft, typInt32)                                                   ; 16413 : nominal left position of the gui object (pixels)
  Local(iBaseTop, typInt32)                                                    ; 16414 : nominal top position of the gui object (pixels)
  Local(iBaseWidth, typInt32)                                                  ; 16415 : nominal width of the gui object (pixels)
  Local(iBaseHeight, typInt32)                                                 ; 16416 : nominal height of the gui object (pixels)

  iBaseLeft   = (Me\exiActualWidth - (Me\exiBaseButtonWidth + Me\exiBaseButtonSpacing) * Me\priChildCount - Me\exiBaseButtonSpacing) / 2
  iBaseTop    = Me\exiBaseButtonSpacing
  iBaseWidth  = Me\exiBaseButtonWidth
  iBaseHeight = Me\exiBaseButtonHeight

  For iLoop = 1 To Me\priChildCount                                            ; resize all child objects

    oGenericButton = Me\proChild(iLoop)

    Set(oGenericButton, exiBaseLeft, iBaseLeft)
    Set(oGenericButton, exiBaseTop, iBaseTop)
    Set(oGenericButton, exiBaseWidth, iBaseWidth)
    Set(oGenericButton, exiBaseHeight, iBaseHeight)
    ObjectCall(oGenericButton, Resize) ()

    iBaseLeft = iBaseLeft + iBaseWidth + Me\exiBaseButtonSpacing               ; set location of the next button

  Next

EndSubroutine
;
;-----------------------------------------------
;
PrivateSubroutine(BuildEdgeLayout)     (ByVal(Me, strButtonBar))
;
;  BuildEdgeLayout                     build buttons:  layout mode = edge
;
;
  Local(iLoop, typInt32)                                                       ; 15051 : generic loop counter
  Local(oGenericButton, objButton)                                             ; 16116 : generic reference to a button object
  Local(iBaseLeft, typInt32)                                                   ; 16413 : nominal left position of the gui object (pixels)
  Local(iBaseTop, typInt32)                                                    ; 16414 : nominal top position of the gui object (pixels)
  Local(iBaseWidth, typInt32)                                                  ; 16415 : nominal width of the gui object (pixels)
  Local(iBaseHeight, typInt32)                                                 ; 16416 : nominal height of the gui object (pixels)
  Local(iBaseButtonSpacing, typInt32)                                          ; 16678 : nominal spacing between and around each button (pixels)
  Local(iUnusedWidth, typInt32)                                                ; 16694 : unused width in resizing operations (pixels)

  iUnusedWidth = Me\exiActualWidth - (Me\exiBaseButtonWidth * Me\priChildCount)        ; total amount of available spacing
  iBaseButtonSpacing = iUnusedWidth / (Me\priChildCount - 1)                   ; nominal spacing between buttons
  iUnusedWidth = iUnusedWidth % (Me\priChildCount - 1)                         ; unused width to be allocated to spaces

  iBaseLeft   = 0
  iBaseTop    = Me\exiBaseButtonSpacing
  iBaseWidth  = Me\exiBaseButtonWidth
  iBaseHeight = Me\exiBaseButtonHeight

  For iLoop = 1 To Me\priChildCount                                            ; resize all child objects

    oGenericButton = Me\proChild(iLoop)

    Set(oGenericButton, exiBaseLeft, iBaseLeft)
    Set(oGenericButton, exiBaseTop, iBaseTop)
    Set(oGenericButton, exiBaseWidth, iBaseWidth)
    Set(oGenericButton, exiBaseHeight, iBaseHeight)
    ObjectCall(oGenericButton, Resize) ()

    iBaseLeft = iBaseLeft + iBaseWidth + iBaseButtonSpacing                    ; set the nominal location of the next button

    If iUnusedWidth > 0
      Increment(iBaseLeft)                                                     ; assign an extra pixel to the spacing
      Decrement(iUnusedWidth)                                                  ; reduce the number of available spacing pixels
    EndIf

  Next

EndSubroutine
;
;-----------------------------------------------
;
PrivateSubroutine(BuildExpandLayout)   (ByVal(Me, strButtonBar))
;
;  BuildExpandLayout                   build buttons:  layout mode = expand
;
;
  Local(iLoop, typInt32)                                                       ; 15051 : generic loop counter
  Local(oGenericButton, objButton)                                             ; 16116 : generic reference to a button object
  Local(iBaseLeft, typInt32)                                                   ; 16413 : nominal left position of the gui object (pixels)
  Local(iBaseTop, typInt32)                                                    ; 16414 : nominal top position of the gui object (pixels)
  Local(iBaseWidth, typInt32)                                                  ; 16415 : nominal width of the gui object (pixels)
  Local(iBaseHeight, typInt32)                                                 ; 16416 : nominal height of the gui object (pixels)
  Local(iBaseButtonSpacing, typInt32)                                          ; 16678 : nominal spacing between and around each button (pixels)
  Local(iUnusedWidth, typInt32)                                                ; 16694 : unused width in resizing operations (pixels)

  iUnusedWidth = Me\exiActualWidth - (Me\exiBaseButtonWidth * Me\priChildCount)        ; total amount of available spacing
  iBaseButtonSpacing = iUnusedWidth / (Me\priChildCount + 1)                   ; nominal spacing between buttons
  iUnusedWidth = iUnusedWidth % (Me\priChildCount + 1)                         ; unused width to be allocated to spaces

  iBaseLeft   = iBaseButtonSpacing
  iBaseTop    = Me\exiBaseButtonSpacing
  iBaseWidth  = Me\exiBaseButtonWidth
  iBaseHeight = Me\exiBaseButtonHeight

  For iLoop = 1 To Me\priChildCount                                            ; resize all child objects

    oGenericButton = Me\proChild(iLoop)

    Set(oGenericButton, exiBaseLeft, iBaseLeft)
    Set(oGenericButton, exiBaseTop, iBaseTop)
    Set(oGenericButton, exiBaseWidth, iBaseWidth)
    Set(oGenericButton, exiBaseHeight, iBaseHeight)
    ObjectCall(oGenericButton, Resize) ()

    iBaseLeft = iBaseLeft + iBaseWidth + iBaseButtonSpacing                    ; set the nominal location of the next button

    If iUnusedWidth > 0
      Increment(iBaseLeft)                                                     ; assign an extra pixel to the spacing
      Decrement(iUnusedWidth)                                                  ; reduce the number of available spacing pixels
    EndIf

  Next

EndSubroutine
;
;-----------------------------------------------
;
PrivateSubroutine(BuildStretchLayout)  (ByVal(Me, strButtonBar))
;
;  BuildStretchLayout                  build buttons:  layout mode = stretch
;
;
  Local(iLoop, typInt32)                                                       ; 15051 : generic loop counter
  Local(oGenericButton, objButton)                                             ; 16116 : generic reference to a button object
  Local(iBaseLeft, typInt32)                                                   ; 16413 : nominal left position of the gui object (pixels)
  Local(iBaseTop, typInt32)                                                    ; 16414 : nominal top position of the gui object (pixels)
  Local(iBaseWidth, typInt32)                                                  ; 16415 : nominal width of the gui object (pixels)
  Local(iBaseHeight, typInt32)                                                 ; 16416 : nominal height of the gui object (pixels)
  Local(iBaseButtonWidth, typInt32)                                            ; 16679 : nominal width to be applied to each button (pixels)
  Local(iUnusedWidth, typInt32)                                                ; 16694 : unused width in resizing operations (pixels)

  iUnusedWidth = Me\exiActualWidth - (Me\exiBaseButtonSpacing * (Me\priChildCount + 1))        ; total amount of available button width
  iBaseButtonWidth = iUnusedWidth / Me\priChildCount                           ; nominal button width
  iUnusedWidth = iUnusedWidth % Me\priChildCount                               ; unused width to be allocated to buttons

  iBaseLeft   = Me\exiBaseButtonSpacing
  iBaseTop    = Me\exiBaseButtonSpacing
  iBaseWidth  = iBaseButtonWidth
  iBaseHeight = Me\exiBaseButtonHeight

  For iLoop = 1 To Me\priChildCount                                            ; resize all child objects

    oGenericButton = Me\proChild(iLoop)

    Set(oGenericButton, exiBaseLeft, iBaseLeft)
    Set(oGenericButton, exiBaseTop, iBaseTop)
    Set(oGenericButton, exiBaseWidth, iBaseWidth)
    Set(oGenericButton, exiBaseHeight, iBaseHeight)
    ObjectCall(oGenericButton, Resize) ()

    iBaseLeft  = iBaseLeft + iBaseWidth + Me\exiBaseButtonSpacing              ; set the location of the next button
    iBaseWidth = iBaseButtonWidth                                              ; set the nominal width of the next button

    If iUnusedWidth > 0
      Increment(iBaseWidth)                                                    ; assign an extra pixel to the button width
      Decrement(iUnusedWidth)                                                  ; reduce the number of available spacing pixels
    EndIf

  Next

EndSubroutine
;
;-----------------------------------------------
;
PrivateSubroutine(BuildFillLayout)     (ByVal(Me, strButtonBar))
;
;  BuildFillLayout                     build buttons:  layout mode = fill
;
;
  Local(iLoop, typInt32)                                                       ; 15051 : generic loop counter
  Local(oGenericButton, objButton)                                             ; 16116 : generic reference to a button object
  Local(iBaseLeft, typInt32)                                                   ; 16413 : nominal left position of the gui object (pixels)
  Local(iBaseTop, typInt32)                                                    ; 16414 : nominal top position of the gui object (pixels)
  Local(iBaseWidth, typInt32)                                                  ; 16415 : nominal width of the gui object (pixels)
  Local(iBaseHeight, typInt32)                                                 ; 16416 : nominal height of the gui object (pixels)
  Local(iBaseButtonWidth, typInt32)                                            ; 16679 : nominal width to be applied to each button (pixels)
  Local(iUnusedWidth, typInt32)                                                ; 16694 : unused width in resizing operations (pixels)

  iUnusedWidth = Me\exiActualWidth                                             ; total amount of available button width
  iBaseButtonWidth = iUnusedWidth / Me\priChildCount                           ; nominal button width
  iUnusedWidth = iUnusedWidth % Me\priChildCount                               ; unused width to be allocated to buttons

  iBaseLeft   = 0
  iBaseTop    = Me\exiBaseButtonSpacing
  iBaseWidth  = iBaseButtonWidth
  iBaseHeight = Me\exiBaseButtonHeight

  For iLoop = 1 To Me\priChildCount                                            ; resize all child objects

    oGenericButton = Me\proChild(iLoop)

    Set(oGenericButton, exiBaseLeft, iBaseLeft)
    Set(oGenericButton, exiBaseTop, iBaseTop)
    Set(oGenericButton, exiBaseWidth, iBaseWidth)
    Set(oGenericButton, exiBaseHeight, iBaseHeight)
    ObjectCall(oGenericButton, Resize) ()

    iBaseLeft  = iBaseLeft + iBaseWidth                                        ; set the location of the next button
    iBaseWidth = iBaseButtonWidth                                              ; set the nominal width of the next button

    If iUnusedWidth > 0
      Increment(iBaseWidth)                                                    ; assign an extra pixel to the button width
      Decrement(iUnusedWidth)                                                  ; reduce the number of available spacing pixels
    EndIf

  Next

EndSubroutine
;
;===============================================
;
;  Virtual Table
;
BeginVirtualTable
;
;  primary  methods
;
  VirtualFunc(Destroy)
  VirtualGetx(exiClassReferenceNumber)
  VirtualSetx(exoParent)
  VirtualGetx(exiChildEntryNumber)
  VirtualSetx(exiChildEntryNumber)
;
;  external methods
;
  VirtualSubr(Events)
  VirtualSubr(Resize)
  VirtualSubr(Build)
  VirtualSubr(AttachChild)
  VirtualSubr(DetachChild)
  VirtualSubr(ProcessEsc)
  VirtualSubr(ProcessLeft)
  VirtualSubr(ProcessRight)
  VirtualSubr(ProcessHotkey)
;
;  external properties:  read/write
;
  VirtualGetx(exlBorder)
  VirtualSetx(exlBorder)
  VirtualGetx(exiPadding)
  VirtualSetx(exiPadding)
;
;  external properties:  read only
;
  VirtualGetx(exiGadgetNumber)
  VirtualGetx(exiActualLeft)
  VirtualGetx(exiActualTop)
  VirtualGetx(exiActualWidth)
  VirtualGetx(exiActualHeight)
;
;  external properties:  write only
;
  VirtualSetx(exnFirstButton)
  VirtualSetx(exiBackgroundColour)
  VirtualSetx(expCBDesign)
  VirtualSetx(exiMarginTop)
  VirtualSetx(exiMarginBottom)
  VirtualSetx(exiMarginLeft)
  VirtualSetx(exiMarginRight)
  VirtualSetx(exlResizeAllowed)
  VirtualSetx(exlShrinkAllowed)
  VirtualSetx(exiHorizontalAlignmentMode)
  VirtualSetx(exlHorizontalAlignment)
  VirtualSetx(exiVerticalAlignmentMode)
  VirtualSetx(exlVerticalAlignment)
  VirtualSetx(exiBaseLeft)
  VirtualSetx(exiBaseTop)
  VirtualSetx(exiBaseWidth)
  VirtualSetx(exiBaseHeight)
  VirtualSetx(exsToolTip)
  VirtualSetx(exiBaseButtonSpacing)
  VirtualSetx(exiBaseButtonWidth)
  VirtualSetx(exiBaseButtonHeight)
  VirtualSetx(exiButtonLayoutMode)
;
EndVirtualTable
;
;===============================================
;
EndClass
;
;===============================================
;  end of  :  clsButtonBar.bi
;===============================================
For ten years Caesar ruled with an iron hand, then with a wooden foot, and finally with a piece of string.
~ Spike Milligan
Top
BorisTheOld
Enthusiast
Enthusiast
Posts: 542
Joined: Tue Apr 24, 2012 5:08 pm
Location: Ontario, Canada

Re: Macros, OOP, Custom gadgets, Automatic resizing

Post by BorisTheOld »

Here are the interface and class files for the Button Class:

objButton.pbi

Code: Select all

;===============================================
;
;  file name       :  objButton.pbi
;  description     :  Button Class Interface
;  author          :  Rod Gobby (BorisTheOld)
;  copyright       :  you have my permission to use this code as you wish
;  date generated  :  2013-10-23 21:00
;  configuration   :  PureBasic 5.20 LTS, x86, Linux & Windows
;  notes           :  no API used
;
;===============================================
;
BeginClass(Button)
;
BeginClassInterface
;
;  primary  methods
;
  InterfaceFunc(Destroy, typObject)    ()
  InterfaceGetx(exiClassReferenceNumber, typInt32)     ()
  InterfaceSetx(exoParent)             (ByVal(bvoParent, typObject))
  InterfaceGetx(exiChildEntryNumber, typInt32) ()
  InterfaceSetx(exiChildEntryNumber)   (ByVal(bviChildEntryNumber, typInt32))
;
;  external methods
;
  InterfaceSubr(Events)                ()
  InterfaceSubr(Resize)                ()
  InterfaceSubr(Build)                 ()
  InterfaceSubr(AttachChild)           (ByVal(bvoChild, typObject))
  InterfaceSubr(DetachChild)           (ByVal(bvoChild, typObject))
;
;  external properties:  read/write
;
  InterfaceGetx(excHotkeyChar, typChar)        ()
  InterfaceSetx(excHotkeyChar)         (ByVal(bvcHotkeyChar, typChar))
  InterfaceGetx(exlTrapEscKey, typBoolean)     ()
  InterfaceSetx(exlTrapEscKey)         (ByVal(bvlTrapEscKey, typBoolean))
;
;  external properties:  read only
;
  InterfaceGetx(exiGadgetNumber, typInt32)     ()
  InterfaceGetx(exiActualLeft, typInt32)       ()
  InterfaceGetx(exiActualTop, typInt32)        ()
  InterfaceGetx(exiActualWidth, typInt32)      ()
  InterfaceGetx(exiActualHeight, typInt32)     ()
  InterfaceGetx(exlButtonHasFocus, typBoolean) ()
;
;  external properties:  write only
;
  InterfaceSetx(exnHotkeyPosition)     (ByVal(bvnHotkeyPosition, typDword))
  InterfaceSetx(exsCaption)            (ByVal(bvsCaption, typString))
  InterfaceSetx(expCBClick)            (ByVal(bviIndex, typInt32), ByVal(bvpCBClick, typPointer))
  InterfaceSetx(exiBaseLeft)           (ByVal(bviBaseLeft, typInt32))
  InterfaceSetx(exiBaseTop)            (ByVal(bviBaseTop, typInt32))
  InterfaceSetx(exiBaseWidth)          (ByVal(bviBaseWidth, typInt32))
  InterfaceSetx(exiBaseHeight)         (ByVal(bviBaseHeight, typInt32))
  InterfaceSetx(exsToolTip)            (ByVal(bvsToolTip, typString))
;
EndClassInterface
;
EndClass
;
;===============================================
;  end of  :  objButton.pbi
;===============================================
clsButton.pbi

Code: Select all

;===============================================
;
;  file name       :  clsButton.pbi
;  description     :  Button Class
;  author          :  Rod Gobby (BorisTheOld)
;  copyright       :  you have my permission to use this code as you wish
;  date generated  :  2013-10-23 21:00
;  configuration   :  PureBasic 5.20 LTS, x86, Linux & Windows
;  notes           :  no API used
;
;===============================================
;
BeginClass(Button)
;
;===============================================
;
;  Properties
;
BeginClassData
;
;  primary  properties
;
  FieldPointer(prpVirtualTable)                       ; 16393 : pointer to the class virtual table
  Field(exiClassReferenceNumber, typInt32)            ; 16447 : the entity number for the class (module, program, package, etc)
  Field(exoParent, objGeneric)                        ; 16086 : reference to an object`s parent
  Field(exiChildEntryNumber, typInt32)                ; 16484 : entry number of the object in the parent child array (1 based)
;
;  private properties
;
  Field(priButtonFontId, typInt32)                    ; 16665 : class font id:  button
  Field(priCaptionLeft, typInt32)                     ; 16666 : left offset of the gadget caption (pixels)
  Field(priHotkeyLeft, typInt32)                      ; 16667 : left offset of the gadget hotkey (pixels)
  Field(priCaptionWidth, typInt32)                    ; 16668 : width of the gadget caption (pixels)
  Field(priHotkeyWidth, typInt32)                     ; 16669 : width of the hotkey character (pixels)
  Field(priCaptionTop, typInt32)                      ; 16670 : top offset of the gadget caption (pixels)
  Field(priCaptionHeight, typInt32)                   ; 16671 : height of the gadget caption (pixels)
  Field(priHotkeyMarkerTop, typInt32)                 ; 16672 : top offset of the gadget hotkey marker (pixels)
  Field(priCaptionPrefixWidth, typInt32)              ; 16673 : width of the characters before the caption hotkey (pixels)
  Field(proButtonParent, objButtonBar)                ; 16675 : reference to the parent buttonbar of a button
;
;  external properties:  read/write
;
  Field(excHotkeyChar, typChar)                       ; 11683 : hot key character: alphanumeric
  Field(exlTrapEscKey, typBoolean)                    ; 16676 : true = this object should trap the esc key
;
;  external properties:  read only
;
  Field(exiGadgetNumber, typInt32)                    ; 16402 : assigned by pb using #pb_any
  Field(exiActualLeft, typInt32)                      ; 16417 : actual left position of the gui object (pixels)
  Field(exiActualTop, typInt32)                       ; 16418 : actual top position of the gui object (pixels)
  Field(exiActualWidth, typInt32)                     ; 16419 : actual width of the gui object (pixels)
  Field(exiActualHeight, typInt32)                    ; 16420 : actual height of the gui object (pixels)
  Field(exlButtonHasFocus, typBoolean)                ; 16677 : true = the button has focus
;
;  external properties:  write only
;
  Field(exnHotkeyPosition, typDword)                  ; 11677 : hot key position in text
  Field(exsCaption, typString)                        ; 15328 : caption text
  FieldCallBack(expCBClick)                           ; 16083 : callback ptr:  event = click
  Field(exiBaseLeft, typInt32)                        ; 16413 : nominal left position of the gui object (pixels)
  Field(exiBaseTop, typInt32)                         ; 16414 : nominal top position of the gui object (pixels)
  Field(exiBaseWidth, typInt32)                       ; 16415 : nominal width of the gui object (pixels)
  Field(exiBaseHeight, typInt32)                      ; 16416 : nominal height of the gui object (pixels)
  Field(exsToolTip, typString)                        ; 16421 : tooltip text:  blank = no tooltip
;
EndClassData
;
;===============================================
;
;  Private Declares
;
DeclarePrivateSubroutine(Constructor)  (ByVal(Me, strButton))
DeclarePrivateSubroutine(Destructor)   (ByVal(Me, strButton))
DeclarePrivateSubroutine(PrepareTheCanvas)     (ByVal(Me, strButton))
DeclarePrivateSubroutine(DrawNormalButton)     (ByVal(Me, strButton))
DeclarePrivateSubroutine(DrawFocusButton)      (ByVal(Me, strButton))
DeclarePrivateSubroutine(GotFocusEvent)        (ByVal(Me, strButton))
DeclarePrivateSubroutine(LostFocusEvent)       (ByVal(Me, strButton))
DeclarePrivateSubroutine(LeftClickEvent)       (ByVal(Me, strButton))
DeclarePrivateSubroutine(KeyUpEvent)   (ByVal(Me, strButton))
DeclarePrivateSubroutine(KeyDownEvent) (ByVal(Me, strButton))
;
;===============================================
;
;  Primary Methods
;
;-----------------------------------------------
;
ExternalFunction(Create, typObject) ()
;
;  create a class instance
;
  Local(Me, strButton)

  Me = AllocateMemory(SizeOf(strButton))
  If IsObject(Me)
    InitializeStructure(Me, strButton)
    Me\prpVirtualTable = LabelPtr(VirtualTable)
    ClassCall(Constructor) (Me)
  EndIf
  ProcedureReturn Me
EndFunction
;
;-----------------------------------------------
;
ExternalFunction(Destroy, typObject) (ByVal(Me, strButton))
;
;  destroy a class instance
;
  If IsObject(Me)
    ClassCall(Destructor) (Me)
    ClearStructure(Me, strButton)
    FreeMemory(Me)
  EndIf
  ProcedureReturn Nothing
EndFunction
;
;-----------------------------------------------
;
ExternalGet(exiClassReferenceNumber, typInt32) (ByVal(Me, strButton))
  ProcedureReturn Me\exiClassReferenceNumber
EndGet
;
;-----------------------------------------------
;
ExternalSet(exoParent)                 (ByVal(Me, strButton), ByVal(bvoParent, typObject))
  Me\exoParent = bvoParent
EndSet
;
;-----------------------------------------------
;
ExternalGet(exiChildEntryNumber, typInt32)     (ByVal(Me, strButton))
  ProcedureReturn Me\exiChildEntryNumber
EndGet
;
ExternalSet(exiChildEntryNumber)       (ByVal(Me, strButton), ByVal(bviChildEntryNumber, typInt32))
  Me\exiChildEntryNumber = bviChildEntryNumber
EndSet
;
;===============================================
;
;  External Methods
;
;-----------------------------------------------
;
ExternalSubroutine(Events)             (ByVal(Me, strButton))
;
;  process gadget events
;

  Select EventType()

    Case #PB_EventType_Focus
      ClassCall(GotFocusEvent) (Me)

    Case #PB_EventType_LostFocus
      ClassCall(LostFocusEvent) (Me)

    Case #PB_EventType_LeftClick
      ClassCall(LeftClickEvent) (Me)

    Case #PB_EventType_KeyUp
      ClassCall(KeyUpEvent) (Me)

    Case #PB_EventType_KeyDown
      ClassCall(KeyDownEvent) (Me)

    Case #iEVENT_LEFT_CLICK
      ClassCall(LeftClickEvent) (Me)

  EndSelect

EndSubroutine
;
;-----------------------------------------------
;
ExternalSubroutine(Resize)             (ByVal(Me, strButton))
;
;  process a window resize event
;

  Me\exiActualLeft   = Me\exiBaseLeft                                          ; use values passed from the buttonbar
  Me\exiActualTop    = Me\exiBaseTop
  Me\exiActualWidth  = Me\exiBaseWidth
  Me\exiActualHeight = Me\exiBaseHeight

  ResizeGadget(Me\exiGadgetNumber, Me\exiActualLeft, Me\exiActualTop, Me\exiActualWidth, Me\exiActualHeight)

  ClassCall(PrepareTheCanvas) (Me)                                             ; refresh the button metrics

  If Me\exlButtonHasFocus = True                                               ; redraw the button
    ClassCall(DrawFocusButton) (Me)
  Else
    ClassCall(DrawNormalButton) (Me)
  EndIf

EndSubroutine
;
;-----------------------------------------------
;
ExternalSubroutine(Build)              (ByVal(Me, strButton))
;
;  build this object
;
  Local(iGadgetFlags, typInt32)                                                ; 16403 : composite option flags used when creating a pb gadget

  AttachMeToParent

  Me\proButtonParent = Me\exoParent                                            ; 16675 : reference to the parent buttonbar of a button
  Me\priButtonFontId = Get(gloApp, exiButtonFontId)                            ; 16665 : class font id:  button

  Me\exiActualLeft   = Me\exiBaseLeft                                          ; set the initial dimensions
  Me\exiActualTop    = Me\exiBaseTop
  Me\exiActualWidth  = Me\exiBaseWidth
  Me\exiActualHeight = Me\exiBaseHeight

  iGadgetFlags = #PB_Canvas_Keyboard                                           ; capture keyboard events

  Me\exiGadgetNumber = CanvasGadget(#PB_Any, Me\exiActualLeft, Me\exiActualTop, Me\exiActualWidth, Me\exiActualHeight, iGadgetFlags)

  SetGadgetData(Me\exiGadgetNumber, Me)                                        ; link this object to its gadget
  GadgetToolTip(Me\exiGadgetNumber, Me\exsToolTip)                        

  ClassCall(PrepareTheCanvas) (Me)

  ClassCall(DrawNormalButton) (Me)

EndSubroutine
;
;-----------------------------------------------
;
ExternalSubroutine(AttachChild)        (ByVal(Me, strButton), ByRef(broChild, objGeneric))
;
;  attach a child object
;
;  broChild                            16448 : reference to a child object
;
;  not used -- placeholder only
;
EndSubroutine
;
;-----------------------------------------------
;
ExternalSubroutine(DetachChild)        (ByVal(Me, strButton), ByRef(broChild, objGeneric))
;
;  detach a child object
;
;  broChild                            16448 : reference to a child object
;
;  not used -- placeholder only
;
EndSubroutine
;
;===============================================
;
;  Property Methods
;
;-----------------------------------------------
;
;  external properties:  read/write
;
;--------
;
ExternalGet(excHotkeyChar, typChar)    (ByVal(Me, strButton))
  ProcedureReturn Me\excHotkeyChar
EndGet
;
ExternalSet(excHotkeyChar)             (ByVal(Me, strButton), ByVal(bvcHotkeyChar, typChar))
  Me\excHotkeyChar = bvcHotkeyChar
EndSet
;
;--------
;
ExternalGet(exlTrapEscKey, typBoolean) (ByVal(Me, strButton))
  ProcedureReturn Me\exlTrapEscKey
EndGet
;
ExternalSet(exlTrapEscKey)             (ByVal(Me, strButton), ByVal(bvlTrapEscKey, typBoolean))
  Me\exlTrapEscKey = bvlTrapEscKey
EndSet
;
;-----------------------------------------------
;
;  external properties:  read only
;
;--------
;
ExternalGet(exiGadgetNumber, typInt32) (ByVal(Me, strButton))
  ProcedureReturn Me\exiGadgetNumber
EndGet
;
;--------
;
ExternalGet(exiActualLeft, typInt32)   (ByVal(Me, strButton))
  ProcedureReturn Me\exiActualLeft
EndGet
;
;--------
;
ExternalGet(exiActualTop, typInt32)    (ByVal(Me, strButton))
  ProcedureReturn Me\exiActualTop
EndGet
;
;--------
;
ExternalGet(exiActualWidth, typInt32)  (ByVal(Me, strButton))
  ProcedureReturn Me\exiActualWidth
EndGet
;
;--------
;
ExternalGet(exiActualHeight, typInt32) (ByVal(Me, strButton))
  ProcedureReturn Me\exiActualHeight
EndGet
;
;--------
;
ExternalGet(exlButtonHasFocus, typBoolean)     (ByVal(Me, strButton))
  ProcedureReturn Me\exlButtonHasFocus
EndGet
;
;-----------------------------------------------
;
;  external properties:  write only
;
;--------
;
ExternalSet(exnHotkeyPosition)         (ByVal(Me, strButton), ByVal(bvnHotkeyPosition, typDword))
  Me\exnHotkeyPosition = bvnHotkeyPosition
EndSet
;
;--------
;
ExternalSet(exsCaption)                (ByVal(Me, strButton), ByVal(bvsCaption, typString))
  Me\exsCaption = bvsCaption
EndSet
;
;--------
;
ExternalSet(expCBClick)                (ByVal(Me, strButton), ByVal(bviIndex, typInt32), ByVal(bvpCBClick, typPointer))
  Me\expCBClick(bviIndex) = bvpCBClick
EndSet
;
;--------
;
ExternalSet(exiBaseLeft)               (ByVal(Me, strButton), ByVal(bviBaseLeft, typInt32))
  Me\exiBaseLeft = bviBaseLeft
EndSet
;
;--------
;
ExternalSet(exiBaseTop)                (ByVal(Me, strButton), ByVal(bviBaseTop, typInt32))
  Me\exiBaseTop = bviBaseTop
EndSet
;
;--------
;
ExternalSet(exiBaseWidth)              (ByVal(Me, strButton), ByVal(bviBaseWidth, typInt32))
  Me\exiBaseWidth = bviBaseWidth
EndSet
;
;--------
;
ExternalSet(exiBaseHeight)             (ByVal(Me, strButton), ByVal(bviBaseHeight, typInt32))
  Me\exiBaseHeight = bviBaseHeight
EndSet
;
;--------
;
ExternalSet(exsToolTip)                (ByVal(Me, strButton), ByVal(bvsToolTip, typString))
  Me\exsToolTip = bvsToolTip
EndSet
;
;===============================================
;
;  Private Methods
;
;-----------------------------------------------
;
PrivateSubroutine(Constructor)         (ByVal(Me, strButton))
;
;  class constructor
;

  Me\exiClassReferenceNumber = #iCLASS_REF_BUTTON                              

  Me\exlTrapEscKey = False

EndSubroutine
;
;-----------------------------------------------
;
PrivateSubroutine(Destructor)          (ByVal(Me, strButton))
;
;  class destructor
;

  DestroyMyGadget
  DetachMeFromParent

EndSubroutine
;
;-----------------------------------------------
;
PrivateSubroutine(PrepareTheCanvas)    (ByVal(Me, strButton))
;
;  calculate the button metrics
;

  StartDrawing(CanvasOutput(Me\exiGadgetNumber))

    DrawingFont(Me\priButtonFontId)                        ; the font is needed for calculating the button metrics

    Me\priCaptionWidth  = TextWidth(Me\exsCaption)
    Me\priCaptionHeight = TextHeight(Me\exsCaption)
    Me\priCaptionLeft   = (Me\exiActualWidth  - Me\priCaptionWidth)  / 2
    Me\priCaptionTop    = (Me\exiActualHeight - Me\priCaptionHeight) / 2

    Select Me\exnHotkeyPosition
      Case 0
        Me\priCaptionPrefixWidth = 0
        Me\priHotkeyLeft         = 0
        Me\excHotkeyChar         = Null
        Me\priHotkeyWidth        = 0
        Me\priHotkeyMarkerTop    = 0
      Case 1
        Me\priCaptionPrefixWidth = 0
        Me\priHotkeyLeft         = Me\priCaptionLeft
        Me\excHotkeyChar         = Mid(Me\exsCaption, Me\exnHotkeyPosition, 1)
        Me\priHotkeyWidth        = TextWidth(Me\excHotkeyChar)
        Me\priHotkeyMarkerTop    = Me\priCaptionTop + Me\priCaptionHeight + 1
      CaseElse
        Me\priCaptionPrefixWidth = TextWidth(Mid(Me\exsCaption, 1, Me\exnHotkeyPosition - 1))
        Me\priHotkeyLeft         = Me\priCaptionLeft + Me\priCaptionPrefixWidth
        Me\excHotkeyChar         = Mid(Me\exsCaption, Me\exnHotkeyPosition, 1)
        Me\priHotkeyWidth        = TextWidth(Me\excHotkeyChar)
        Me\priHotkeyMarkerTop    = Me\priCaptionTop + Me\priCaptionHeight + 1
    EndSelect

    Me\excHotkeyChar = UCase(Me\excHotkeyChar)

  StopDrawing()

EndSubroutine
;
;-----------------------------------------------
;
PrivateSubroutine(DrawNormalButton)    (ByVal(Me, strButton))
;
;  draw the contents of a normal button
;

  StartDrawing(CanvasOutput(Me\exiGadgetNumber))

    DrawingFont(Me\priButtonFontId)
    RoundBox(0, 0, Me\exiActualWidth, Me\exiActualHeight, #iBUTTON_CORNER_RADIUS, #iBUTTON_CORNER_RADIUS, #iBUTTON_COLOUR_BORDER) ; create a black drawing area
    RoundBox(1, 1, Me\exiActualWidth - 2, Me\exiActualHeight - 2, #iBUTTON_CORNER_RADIUS, #iBUTTON_CORNER_RADIUS, #iBUTTON_COLOUR_NORMAL) ; create a 1-pixel border
    DrawText(Me\priCaptionLeft, Me\priCaptionTop, Me\exsCaption, #iBUTTON_COLOUR_TEXT, #iBUTTON_COLOUR_NORMAL)

    If Me\exnHotkeyPosition > 0
      Line(Me\priHotkeyLeft, Me\priHotkeyMarkerTop, Me\priHotkeyWidth, 1, #iBUTTON_COLOUR_TEXT)        ; underline the hotkey
    EndIf

  StopDrawing()

EndSubroutine
;
;-----------------------------------------------
;
PrivateSubroutine(DrawFocusButton)     (ByVal(Me, strButton))
;
;  draw the contents of a button that has focus
;

  StartDrawing(CanvasOutput(Me\exiGadgetNumber))

    DrawingFont(Me\priButtonFontId)
    RoundBox(0, 0, Me\exiActualWidth, Me\exiActualHeight, #iBUTTON_CORNER_RADIUS, #iBUTTON_CORNER_RADIUS, #iBUTTON_COLOUR_BORDER) ; create a black drawing area
    RoundBox(2, 2, Me\exiActualWidth - 4, Me\exiActualHeight - 4, #iBUTTON_CORNER_RADIUS, #iBUTTON_CORNER_RADIUS, #iBUTTON_COLOUR_FOCUS) ; create a 2-pixel border
    DrawText(Me\priCaptionLeft, Me\priCaptionTop, Me\exsCaption, #iBUTTON_COLOUR_TEXT, #iBUTTON_COLOUR_FOCUS)

    If Me\exnHotkeyPosition > 0
      Line(Me\priHotkeyLeft, Me\priHotkeyMarkerTop, Me\priHotkeyWidth, 1, #iBUTTON_COLOUR_TEXT)        ; underline the hotkey
    EndIf

  StopDrawing()

EndSubroutine
;
;-----------------------------------------------
;
PrivateSubroutine(GotFocusEvent)       (ByVal(Me, strButton))
;
;  process a gotfocus event
;

  Me\exlButtonHasFocus = True         
  ClassCall(DrawFocusButton) (Me)     

EndSubroutine
;
;-----------------------------------------------
;
PrivateSubroutine(LostFocusEvent)      (ByVal(Me, strButton))
;
;  process a lostfocus event
;

  Me\exlButtonHasFocus = False          
  ClassCall(DrawNormalButton) (Me)        

EndSubroutine
;
;-----------------------------------------------
;
PrivateSubroutine(LeftClickEvent)      (ByVal(Me, strButton))
;
;  process a leftclick event
;

  CallBack(Me\expCBClick)

EndSubroutine
;
;-----------------------------------------------
;
PrivateSubroutine(KeyUpEvent)          (ByVal(Me, strButton))
;
;  process a keyup event
;
  Local(cHotkeyChar, typChar)                              ; 11683 : hot key character: alphanumeric
  Local(iShortcutKey, typInt32)                            ; 16674 : PB shortcut key code

  iShortcutKey = GetGadgetAttribute(Me\exiGadgetNumber, #PB_Canvas_Key)

  Select iShortcutKey

    Case #PB_Shortcut_Return
      ClassCall(LeftClickEvent) (Me)

    Case #PB_Shortcut_Escape
      If IsTrue(Me\exlTrapEscKey)
        ClassCall(LeftClickEvent) (Me)
      Else
        ObjectCall(Me\proButtonParent, ProcessEsc) ()
      EndIf

    Case #PB_Shortcut_0 To #PB_Shortcut_9
      cHotkeyChar = Chr(iShortcutKey)
      If Me\excHotkeyChar = cHotkeyChar
        ClassCall(LeftClickEvent) (Me)
      Else
        ObjectCall(Me\proButtonParent, ProcessHotkey) (cHotkeyChar)
      EndIf

    Case #PB_Shortcut_A To #PB_Shortcut_Z
      cHotkeyChar = Chr(iShortcutKey)
      If Me\excHotkeyChar = cHotkeyChar
        ClassCall(LeftClickEvent) (Me)
      Else
        ObjectCall(Me\proButtonParent, ProcessHotkey) (cHotkeyChar)
      EndIf

    Case Asc("a") To Asc("z")
      cHotkeyChar = UCase(Chr(iShortcutKey))
      If Me\excHotkeyChar = cHotkeyChar
        ClassCall(LeftClickEvent) (Me)
      Else
        ObjectCall(Me\proButtonParent, ProcessHotkey) (cHotkeyChar)
      EndIf

  EndSelect

EndSubroutine
;
;-----------------------------------------------
;
PrivateSubroutine(KeyDownEvent)        (ByVal(Me, strButton))
;
;  process a keydown event
;
;
  Local(iShortcutKey, typInt32)                            ; 16674 : PB shortcut key code

  iShortcutKey = GetGadgetAttribute(Me\exiGadgetNumber, #PB_Canvas_Key)

  Select iShortcutKey

    Case #PB_Shortcut_Left
      ObjectCall(Me\proButtonParent, ProcessLeft) (Me)

    Case #PB_Shortcut_Right
      ObjectCall(Me\proButtonParent, ProcessRight) (Me)

  EndSelect

EndSubroutine
;
;===============================================
;
;  Virtual Table
;
BeginVirtualTable
;
;  primary  methods
;
  VirtualFunc(Destroy)
  VirtualGetx(exiClassReferenceNumber)
  VirtualSetx(exoParent)
  VirtualGetx(exiChildEntryNumber)
  VirtualSetx(exiChildEntryNumber)
;
;  external methods
;
  VirtualSubr(Events)
  VirtualSubr(Resize)
  VirtualSubr(Build)
  VirtualSubr(AttachChild)
  VirtualSubr(DetachChild)
;
;  external properties:  read/write
;
  VirtualGetx(excHotkeyChar)
  VirtualSetx(excHotkeyChar)
  VirtualGetx(exlTrapEscKey)
  VirtualSetx(exlTrapEscKey)
;
;  external properties:  read only
;
  VirtualGetx(exiGadgetNumber)
  VirtualGetx(exiActualLeft)
  VirtualGetx(exiActualTop)
  VirtualGetx(exiActualWidth)
  VirtualGetx(exiActualHeight)
  VirtualGetx(exlButtonHasFocus)
;
;  external properties:  write only
;
  VirtualSetx(exnHotkeyPosition)
  VirtualSetx(exsCaption)
  VirtualSetx(expCBClick)
  VirtualSetx(exiBaseLeft)
  VirtualSetx(exiBaseTop)
  VirtualSetx(exiBaseWidth)
  VirtualSetx(exiBaseHeight)
  VirtualSetx(exsToolTip)
;
EndVirtualTable
;
;===============================================
;
EndClass
;
;===============================================
;  end of  :  clsButton.pbi
;===============================================
Last edited by BorisTheOld on Sun Oct 27, 2013 3:09 am, edited 1 time in total.
For ten years Caesar ruled with an iron hand, then with a wooden foot, and finally with a piece of string.
~ Spike Milligan
Top
BorisTheOld
Enthusiast
Enthusiast
Posts: 542
Joined: Tue Apr 24, 2012 5:08 pm
Location: Ontario, Canada

Re: Macros, OOP, Custom gadgets, Automatic resizing

Post by BorisTheOld »

Here are the interface and class files for the Generic Class:

objGeneric.pbi

Code: Select all

;===============================================
;
;  file name       :  objGeneric.pbi
;  description     :  Generic Class Interface
;  author          :  Rod Gobby (BorisTheOld)
;  copyright       :  you have my permission to use this code as you wish
;  date generated  :  2013-10-23 21:00
;  configuration   :  PureBasic 5.20 LTS, x86, Linux & Windows
;  notes           :  no API used
;
;===============================================
;
BeginClass(Generic)
;
BeginClassInterface
;
;  primary  methods
;
  InterfaceFunc(Destroy, typObject)    ()
  InterfaceGetx(exiClassReferenceNumber, typInt32)     ()
  InterfaceSetx(exoParent)             (ByVal(bvoParent, typObject))
  InterfaceGetx(exiChildEntryNumber, typInt32) ()
  InterfaceSetx(exiChildEntryNumber)   (ByVal(bviChildEntryNumber, typInt32))
;
;  external methods
;
  InterfaceSubr(Events)                ()
  InterfaceSubr(Resize)                ()
  InterfaceSubr(Build)                 ()
  InterfaceSubr(AttachChild)           (ByVal(bvoChild, typObject))
  InterfaceSubr(DetachChild)           (ByVal(bvoChild, typObject))
;
EndClassInterface
;
EndClass
;
;===============================================
;  end of  :  objGeneric.pbi
;===============================================
clsGeneric.pbi

Code: Select all

;===============================================
;
;  file name       :  clsGeneric.pbi
;  description     :  Generic Class
;  author          :  Rod Gobby (BorisTheOld)
;  copyright       :  you have my permission to use this code as you wish
;  date generated  :  2013-10-23 21:00
;  configuration   :  PureBasic 5.20 LTS, x86, Linux & Windows
;  notes           :  no API used
;
;===============================================
;
BeginClass(Generic)
;
;===============================================
;
;  Properties
;
BeginClassData
;
;  primary  properties
;
  FieldPointer(prpVirtualTable)                            ; 16393 : pointer to the class virtual table
  Field(exiClassReferenceNumber, typInt32)                 ; 16447 : the entity number for the class (module, program, package, etc)
  Field(exoParent, objGeneric)                             ; 16086 : reference to an object`s parent
  Field(exiChildEntryNumber, typInt32)                     ; 16484 : entry number of the object in the parent child array (1 based)
;
EndClassData
;
;===============================================
;
;  Private Declares
;
DeclarePrivateSubroutine(Constructor)  (ByVal(Me, strGeneric))
DeclarePrivateSubroutine(Destructor)   (ByVal(Me, strGeneric))
;
;===============================================
;
;  Primary Methods
;
;-----------------------------------------------
;
ExternalFunction(Create, typObject) ()
;
;  create a class instance
;
  Local(Me, strGeneric)

  Me = AllocateMemory(SizeOf(strGeneric))
  If IsObject(Me)
    InitializeStructure(Me, strGeneric)
    Me\prpVirtualTable = LabelPtr(VirtualTable)
    ClassCall(Constructor) (Me)
  EndIf
  ProcedureReturn Me
EndFunction
;
;-----------------------------------------------
;
ExternalFunction(Destroy, typObject) (ByVal(Me, strGeneric))
;
;  destroy a class instance
;
  If IsObject(Me)
    ClassCall(Destructor) (Me)
    ClearStructure(Me, strGeneric)
    FreeMemory(Me)
  EndIf
  ProcedureReturn Nothing
EndFunction
;
;-----------------------------------------------
;
ExternalGet(exiClassReferenceNumber, typInt32) (ByVal(Me, strGeneric))
  ProcedureReturn Me\exiClassReferenceNumber
EndGet
;
;-----------------------------------------------
;
ExternalSet(exoParent)                 (ByVal(Me, strGeneric), ByVal(bvoParent, typObject))
  Me\exoParent = bvoParent
EndSet
;
;-----------------------------------------------
;
ExternalGet(exiChildEntryNumber, typInt32)     (ByVal(Me, strGeneric))
  ProcedureReturn Me\exiChildEntryNumber
EndGet
;
ExternalSet(exiChildEntryNumber)       (ByVal(Me, strGeneric), ByVal(bviChildEntryNumber, typInt32))
  Me\exiChildEntryNumber = bviChildEntryNumber
EndSet
;
;===============================================
;
;  External Methods
;
;-----------------------------------------------
;
ExternalSubroutine(Events)             (ByVal(Me, strGeneric))
;
;  process gadget events
;
;  not used -- placeholder only
;
EndSubroutine
;
;-----------------------------------------------
;
ExternalSubroutine(Resize)             (ByVal(Me, strGeneric))
;
;  process a window resize event
;
;  not used -- placeholder only
;
EndSubroutine
;
;-----------------------------------------------
;
ExternalSubroutine(Build)              (ByVal(Me, strGeneric))
;
;  build this object
;
;  not used -- placeholder only
;
EndSubroutine
;
;-----------------------------------------------
;
ExternalSubroutine(AttachChild)        (ByVal(Me, strGeneric), ByRef(broChild, objGeneric))
;
;  attach a child object
;
;  broChild                            16448 : reference to a child object
;
;  not used -- placeholder only
;
EndSubroutine
;
;-----------------------------------------------
;
ExternalSubroutine(DetachChild)        (ByVal(Me, strGeneric), ByRef(broChild, objGeneric))
;
;  detach a child object
;
;  broChild                            16448 : reference to a child object
;
;  not used -- placeholder only
;
EndSubroutine
;
;===============================================
;
;  Property Methods
;
;-----------------------------------------------
;
;===============================================
;
;  Private Methods
;
;-----------------------------------------------
;
PrivateSubroutine(Constructor)         (ByVal(Me, strGeneric))
;
;  class constructor
;

  Me\exiClassReferenceNumber = #iCLASS_REF_GENERIC          

EndSubroutine
;
;-----------------------------------------------
;
PrivateSubroutine(Destructor)          (ByVal(Me, strGeneric))
;
;  class destructor
;
EndSubroutine
;
;===============================================
;
;  Virtual Table
;
BeginVirtualTable
;
;  primary  methods
;
  VirtualFunc(Destroy)
  VirtualGetx(exiClassReferenceNumber)
  VirtualSetx(exoParent)
  VirtualGetx(exiChildEntryNumber)
  VirtualSetx(exiChildEntryNumber)
;
;  external methods
;
  VirtualSubr(Events)
  VirtualSubr(Resize)
  VirtualSubr(Build)
  VirtualSubr(AttachChild)
  VirtualSubr(DetachChild)
;
EndVirtualTable
;
;===============================================
;
EndClass
;
;===============================================
;  end of  :  clsGeneric.pbi
;===============================================
For ten years Caesar ruled with an iron hand, then with a wooden foot, and finally with a piece of string.
~ Spike Milligan
Top
Post Reply

Return to “Tricks 'n' Tips”