Announcement

Collapse
No announcement yet.

Using arrays for buttons Demo

Collapse
X
 
  • Filter
  • Time
  • Show
Clear All
new posts

  • Using arrays for buttons Demo

    '
    Code:
                    
    'May 2009
    'Sample code - arrays to set up buttons and using button flags for multiple purposes
    'PBWIN 9.01 - WinApi 05/2008 - XP Pro SP3
    'Button colors compliments of Laurence Jackson
    #Compile Exe  
    #Dim All 
    #Optimize SPEED  'Fly baby Fly!!!
    #Debug Display On '<<<<<<<<<<<<<<< Remember to turn off for production code
    #Include "WIN32API.INC"  
     'these next included files needed for button colors can be found here: 
     'http://www.powerbasic.com/support/pbforums/showthread.php?t=38904
    #Include "C:\Only_My_Programs\Include Files\ButtonPlus.bas"
    #Resource "C:\Only_My_Programs\Include Files\ButtonPlusDemo.pbr"
    %Button_Ids_Start_At = 1000
    '
     Global hdlg As Dword
     Global Btn_bg_Colors(), Btn_Id(), Btn_Flag() As Long
     Global Btn_Description() As String
    '
    ' *******************************************************
    '
    Macro Common_Locals
    'Normally I use an #Include file here: 
    ''' #Include "C:\Power Basic\Includes\Variables_Common_to_All_Programs.inc"
    ' that has variables I commonly use.
    '                                            
    Local Btn_Face_Color, Btn_Text_Color, Btn_Width, Btn_Height As Long
    Local col, col1, col2, col3, col4, col5 As Long
    Local ctr, ctr1, ctr2, ctr3, ctr4, ctr5 As Long
    Local Id, Wdth, Hght, Stile As Long
    Local Row, Row1, Row2, Row3, Row4, Row5 As Long
    Local t, t1, t2, t3 As String
     
    End Macro
    '
    ' *******************************************************
    '
    Macro Btn_Set_Text_Color = ButtonPlus hDlg, Id, %BP_TEXT_COLOR, Btn_Text_Color '&H003F3F7F
    '   ButtonPlus h_Dlg, Ctrl_Id, %BP_ICON_ID, %IDR_ICON
    '   ButtonPlus h_Dlg, Ctrl_Id, %BP_ICON_WIDTH, 24
    '   ButtonPlus h_Dlg, Ctrl_Id, %BP_ICON_POS, %BS_RIGHT
    Macro Btn_Set_Face_Color = ButtonPlus  hdlg, Id, %BP_FACE_BLEND, 255 : ButtonPlus hDlg, Id, %BP_FACE_COLOR, Btn_Face_Color ' &H008FDF8F
    '   ButtonPlus h_Dlg, Ctrl_Id, %BP_FACE_BLEND, &H6F
    '
    Macro Btn_Rnd_Bg_Color
      ctr5 = Rnd(LBound(Btn_bg_Colors()), UBound(Btn_bg_Colors()))
        Btn_Face_Color = Btn_bg_Colors(ctr5)
      Btn_Set_Face_Color  
    End Macro
    '
    ' *******************************************************
    '
    Sub Set_Up_at_Start
      Common_Locals
      Dim Btn_bg_Colors(1 To 10)
       Btn_bg_Colors(1) = %Black + 1
       Btn_bg_Colors(2) = %Blue    
       Btn_bg_Colors(3) = %Green   
       Btn_bg_Colors(4) = %Cyan    
       Btn_bg_Colors(5) = %Red     
       Btn_bg_Colors(6) = %Magenta 
       Btn_bg_Colors(7) = %Yellow  
       Btn_bg_Colors(8) = %White   
       Btn_bg_Colors(9) = %Gray    
       Btn_bg_Colors(10) = %LtGray  
        
        
       ctr3 = 50 'way way more than usually needed
       ReDim Btn_Id(1 To ctr3) 
       ReDim Btn_Flag(1 To ctr3) 'set when programmed/assigned
       ReDim Btn_Description$(1 To ctr3) 'set when assigning button
         'set up ID's
        ctr2 = %Button_Ids_Start_At 
        For ctr = LBound(Btn_Id()) To UBound(Btn_Id())
          Incr ctr2 'Id number
           Btn_Id(ctr) = ctr2 
           Incr ctr3                                      'no black
           If ctr3 > UBound(Btn_bg_Colors()) Then ctr3 =  2'LBound(Btn_bg_Colors())
           Btn_Flag(ctr) = ctr3'Actually will be set when button is assigned somewhere _
           Btn_Description$(ctr) = Using$("## Flag=# ", Ctr, ctr3)' actually will be set when button is assigned
        Next ctr
        Btn_Description$(UBound(Btn_Id())) = "Abandon Ship" 'last button for exit
        
    End Sub
    '
    ' *******************************************************
    '
    CallBack Function PB_Main_Dialog_Processor
       common_Locals
        Select Case CbMsg     'This is TO determine the message TYPE 
            '       
            Case %WM_INITDIALOG'<- Initialization when the program loads 
            '
            Case %WM_SYSCOMMAND 'Traps Any Alt key but only F4 closes              
            '     
            Case %WM_COMMAND  'processes command messages
                Select Case CbCtl 'determine which CONTROL 
                    '
                    Case Btn_Id(UBound(Btn_Id())) 'Abandon ship
                       Dialog End CB.Hndl
    '
                    Case Btn_Id(LBound(Btn_Id())) To Btn_Id(UBound(Btn_Id())) 
                     ' Control Set Text CbHndl, CbCtl, "Button Clicked"
                       Id = CB.Ctl
                      '  Btn_Text_Color = %Black: Btn_Set_Text_Color  
                       '  Control ReDraw CB.Hndl, CB.Ctl 'needed to chg color
                         winbeep 200, 1
                        'Sleep 100 'allow time to see "Button Clicked"  
                      Local Actual_Btn_Id As Long
                        Actual_Btn_Id = CB.Ctl - %Button_Ids_Start_At
                        'Note this next Select Case series would inside _
                         'whatever Sub/Function is called. _
                         'ie Call Button_Number_Clicked(Btn_Flag(Actual_Btn_Id))  
                       '  
                      Select Case Btn_Flag(Actual_Btn_Id) 
                        Case 0  'flag not set so do default action
                          t$ = "Default action"
                        Case 1 'flag set to 1 so do something here
                          t$ = "Case 1 used" 
                        Case 2 'flag set to 2 so do something else here
                          t$ = "Case 2 used"
                        Case 3 'flag set to 3 so do something different here 
                          t$ = "Case 4 used"
                        Case Else
                          t$ = Using$("Flag set at # ", Btn_Flag(Actual_Btn_Id)) 
                      End Select             
                      Btn_Face_Color = %Black + 1: Btn_Set_Face_Color
                      Btn_Text_Color = %White: Btn_Set_Text_Color
                       Control Set Text CbHndl, CB.Ctl, t$ '& Str$(ctr5)                 
                End Select      
        End Select
    End Function
    '
    ' *******************************************************
    '
    Sub Set_Up_Display
    'by keeping the displays in separate subs, it makes maintenance
    ' and programming changes easier to manage (at least for me).
        Common_Locals 
        
        t$ = Space$(150) '150 looks okay
        CSet t$ = "Multiple Button Use Demonstrator Version (0.000000001.3.5) {May 2009} " 
    '     Main dialog window     
       Dialog Font "Arial", 10
       Wdth = 460
       Hght = 280       
    '   
       Stile = %WS_CAPTION    
       Stile = Stile Or %WS_SYSMENU
       Stile = Stile Or %WS_THICKFRAME
       Stile = Stile Or %WM_HELP 
       Stile = Stile Or %WS_Border''doesn't do anything
    '   
       Dialog New hDlg, t$, _
           , , _ 'center it
           Wdth, Hght, _
           Stile, _
           %WS_Ex_WindowEdge, _
           To hDlg
    '                                          
      Btn_Width  = 100 'Len(Btn_Description$(1)) *  'most characters 5 units wide on average _
                                                 'so make wider
      Btn_Height = 12
      Stile = 0
      Row  = 1
      Row1 = Row 'remember top row
      Col  = 1 
    '  
      For ctr = LBound(Btn_Id()) To UBound(Btn_Id())
         GoSub Draw_Button           
         Id = Btn_Id(ctr) 'coloring does not accept array, use long
          'vary bg colors
             ctr4 = Btn_Flag(ctr)
             Btn_Face_Color = Btn_bg_Colors(ctr4) 'set color to flag just for demo
              Btn_Set_Face_Color
               Control Set Text hdlg, btn_Id(ctr), Btn_Description(ctr) & "  " & Str$(ctr4) 'Hex$(Btn_Face_Color)
           Select Case ctr4
             Case 1, 2, 9 
              Btn_Text_Color = %White 
             Case Else 
              Btn_Text_Color = %Black
           End Select
           Btn_Set_Text_Color
      Next ctr 
    '
     Exit Sub
    '***********
    Draw_Button:
    '  
      Control Add Button, hDlg, Btn_Id(ctr), Btn_Description$(ctr), _
         Col, Row, _
         Btn_Width, Btn_Height, _
         0' Stile
    '
      Row = Row + Btn_Height + 5 '5 leaves room in between
      If row > Hght - Btn_Height Then 'no more room so move over
         Col = col + Btn_Width + 15 '15 nice space between                        
         Row = Row1 'start back at top row
      End If
    Return
    End Sub
    '
    ' *******************************************************
    '
    Function PBMain    
       Call Set_Up_at_Start         
    '
       Call Set_UP_Display
    '      
       Dialog Show Modal hDlg     Call PB_Main_Dialog_Processor
    '
    End Function
    '
    ' *******************************************************
    '       
    '''
    '
    Last edited by Gösta H. Lovgren-2; 31 May 2009, 10:23 PM. Reason: Updated to include Button coloring
    It's a pretty day. I hope you enjoy it.

    Gösta

    JWAM: (Quit Smoking): http://www.SwedesDock.com/smoking
    LDN - A Miracle Drug: http://www.SwedesDock.com/LDN/

  • #2
    Just corrected a Dim error in code above - Had dimmed a color array as integer instead as Long which yielded incorrect results for colors.

    ================================================
    "A single, seemingly powerless person who dares
    to cry out the word of truth
    and to stand behind it
    with all of his person and all of his life,
    ready to pay a high price, has, surprisingly,
    greater power, though formally disenfranchised,
    than do thousands of anonymous voters."
    Vaclav Havel
    ================================================
    It's a pretty day. I hope you enjoy it.

    Gösta

    JWAM: (Quit Smoking): http://www.SwedesDock.com/smoking
    LDN - A Miracle Drug: http://www.SwedesDock.com/LDN/

    Comment

    Working...
    X