PureBoard

Code: Alles auswählen

;####################################
; Ownerdraw - Buttons
; Author : Andreas Januar 2007
;####################################

Enumeration 
;Windows
  #Main
;ButtonGadgets
  #Button1
  #Button2
EndEnumeration

Structure ButtonData
  Col.l
  TextCol.l
  SelCol.l
  SelTextCol.l
  DisCol.l
  DisTextCol.l
  HotCol.l
  HotTextCol.l
EndStructure

Global G

Procedure BCB(wnd,msg,wParam,lParam)
  Select msg
    Case #WM_MOUSEMOVE
      If G = 0
        *B.ButtonData = GetProp_(wnd,"COLS")
        dc = GetDC_(wnd)
        GetWindowRect_(wnd,rcItem.RECT)
        MapWindowPoints_(GetDesktopWindow_(),wnd,rcItem,2)

        DrawFrameControl_(dc,rcItem,#DFC_BUTTON,#DFCS_BUTTONPUSH)
        Brush = CreateSolidBrush_(*B\HotCol)
        r.Rect
        SetRect_(r,rcItem\left+1,rcItem\top+1,rcItem\right-1,rcItem\Bottom-1)
        FillRect_(dc,r,Brush)
        SetBkMode_(dc,#TRANSPARENT)
        SetTextColor_(dc,*B\HotTextCol)
        SelectObject_(dc,GetStockObject_(#ANSI_VAR_FONT))
        Text$ = GetGadgetText(GetDlgCtrlID_(wnd))
        DrawText_(DC,Text$,Len(Text$),rcItem,#DT_CENTER|#DT_SINGLELINE|#DT_VCENTER)
        SelectObject_(dc,Old)
        DeleteObject_(Brush)
        If GetFocus_() = wnd
          r.Rect
          SetRect_(r,2,2,rcItem\right-2,rcItem\bottom-2)
          DrawFocusRect_(dc,r)       
        EndIf
        G = 1
      EndIf
  EndSelect
ProcedureReturn CallWindowProc_(GetProp_(wnd,"BCB"),wnd,msg,wParam,lParam)
EndProcedure

Procedure RemoveProp(wnd,lParam)
   RemoveProp_(wnd,"COLS")
   RemoveProp_(wnd,"BCB")
ProcedureReturn #True
EndProcedure

Procedure SetButtonData(wnd,lparam)
   SendMessage_(wnd,#WM_SETFONT,GetStockObject_(#ANSI_VAR_FONT),#True)
   SetProp_(wnd,"COLS",lparam)
   SetProp_(wnd,"BCB",SetWindowLong_(wnd,#GWL_WNDPROC,@BCB()))
EndProcedure


Procedure WCB(wnd,msg,wparam,lparam)
  Result = #PB_ProcessPureBasicEvents
  Select msg
    Case #WM_MOUSEMOVE
      If G = 1
        InvalidateRect_(wnd,0,0)
        G = 0
      EndIf
    Case #WM_NCDESTROY
      EnumChildWindows_(WindowID(0),@RemoveProp(),0)
    Case #WM_DRAWITEM
      *lpdis.DRAWITEMSTRUCT = lParam
      *B.ButtonData = GetProp_(*lpdis\hwndItem,"COLS")
      Text$ = GetGadgetText(*lpdis\CtlID)
      If *b
      If *lpdis\CtlType = #ODT_BUTTON
        DrawFrameControl_(*lpdis\hdc,*lpdis\rcItem,#DFC_BUTTON,#DFCS_BUTTONPUSH)
        Brush = CreateSolidBrush_(*B\Col)
        r.Rect
        SetRect_(r,*lpdis\rcItem\left+1,*lpdis\rcItem\top+1,*lpdis\rcItem\right-1,*lpdis\rcItem\Bottom-1)
        FillRect_(*lpdis\hdc,r,Brush)
        SetBkMode_(*lpdis\hdc,#TRANSPARENT)
        SetTextColor_(*lpdis\hdc,*B\TextCol)
        DrawText_(*lpdis\hDC,Text$,Len(Text$),*lpdis\rcItem,#DT_CENTER|#DT_SINGLELINE|#DT_VCENTER)
        SelectObject_(*lpdis\hdc,Old)
        DeleteObject_(Brush)
      EndIf

      If *lpdis\itemState & #ODS_SELECTED 
        DrawFrameControl_(*lpdis\hdc,*lpdis\rcItem,#DFC_BUTTON,#DFCS_BUTTONPUSH|#DFCS_PUSHED)
        Brush = CreateSolidBrush_(*B\SelCol)
        r.Rect
        SetRect_(r,*lpdis\rcItem\left+2,*lpdis\rcItem\top+2,*lpdis\rcItem\right-2,*lpdis\rcItem\Bottom-2)
        FillRect_(*lpdis\hdc,r,Brush)
        SetBkMode_(*lpdis\hdc,#TRANSPARENT)
        SetTextColor_(*lpdis\hdc,*B\SelTextCol)
        DrawText_(*lpdis\hDC,Text$,Len(Text$),*lpdis\rcItem,#DT_CENTER|#DT_SINGLELINE|#DT_VCENTER)
        SelectObject_(*lpdis\hdc,Old)
        DeleteObject_(Brush)
      EndIf

      If *lpdis\itemState & #ODS_DISABLED
        DrawFrameControl_(*lpdis\hdc,*lpdis\rcItem,#DFC_BUTTON,#DFCS_BUTTONPUSH)
        Brush = CreateSolidBrush_(*B\DisCol)
        r.Rect
        SetRect_(r,*lpdis\rcItem\left+2,*lpdis\rcItem\top+2,*lpdis\rcItem\right-2,*lpdis\rcItem\Bottom-2)
        FillRect_(*lpdis\hdc,r,Brush)
        Old = SelectObject_(*lpdis\hdc,Brush)
        SetBkMode_(*lpdis\hdc,#TRANSPARENT)
        SetTextColor_(*lpdis\hdc,*B\DisTextCol)
        DrawText_(*lpdis\hDC,Text$,Len(Text$),*lpdis\rcItem,#DT_CENTER|#DT_SINGLELINE|#DT_VCENTER)
        SelectObject_(*lpdis\hdc,Old)
        DeleteObject_(Brush)
      EndIf
      If *lpdis\itemState & #ODS_FOCUS
        ReleaseDC_(wnd,*lpdis\hDC)
        r.Rect
        SetRect_(r,2,2,*lpdis\rcItem\right-2,*lpdis\rcItem\bottom-2)
        DrawFocusRect_(*lpdis\hDC,r)       
      EndIf
      EndIf
  EndSelect
  ProcedureReturn Result
EndProcedure

If OpenWindow(#Main, 100, 200, 400, 420, "Ownerdraw-Buttons",#PB_Window_SizeGadget|#PB_Window_MinimizeGadget|#PB_Window_MaximizeGadget)
If CreateGadgetList(WindowID(0))
  ButtonGadget(#Button1, 10,10,80,24,"Ende",#BS_OWNERDRAW)
  ButtonGadget(#Button2, 10,50,80,24,"Cancel",#BS_OWNERDRAW)
  BD.ButtonData
  BD\Col = RGB(0,0,128)
  BD\TextCol = RGB(255,255,255)
  BD\SelCol = RGB(0,255,0)
  BD\SelTextCol = RGB(0,0,0)
  BD\DisCol = RGB(222,222,222)
  BD\DisTextCol = RGB(255,255,255)
  BD\HotCol = RGB(0,255,255)
  BD\HotTextCol = RGB(0,0,0)
  SetButtonData(GadgetID(#Button1),BD)
  BD1.ButtonData
  BD1\Col = RGB(0,0,196)
  BD1\TextCol = RGB(255,255,0)
  BD1\SelCol = RGB(255,0,0)
  BD1\SelTextCol = RGB(0,0,0)
  BD1\DisCol = RGB(222,222,222)
  BD1\DisTextCol = RGB(255,255,255)
  BD1\HotCol = RGB(255,0,255)
  BD1\HotTextCol = RGB(0,0,0)
  SetButtonData(GadgetID(#Button2),BD1)
EndIf
DisableGadget(#Button1,1)
SetWindowCallback(@WCB())
SetForegroundWindow_(WindowID(#Main))
Repeat
  EventID = WaitWindowEvent()
  Select EventID
    Case #PB_Event_Gadget
    Select EventGadget()
      Case 1
        SendMessage_(WindowID(0),#WM_CLOSE,0,0)
      Case 2
        DisableGadget(#Button1,0)
    EndSelect
      Case #PB_Event_CloseWindow
        Quit = 1
  EndSelect
Until Quit = 1
EndIf
End

Code: Alles auswählen

EnableExplicit 

Global DisableButton 

Structure IntParts 
    Part1.w 
    Part2.w 
EndStructure 

OpenLibrary(1,"Msimg32.dll")    ;load te Command GradientFill_() because it's missing in the PB predeclared Api Things 
Prototype GradientFill_(hdc,*Vert,Int,*Rect,Int2,Flags) 
Global GradientFill_.GradientFill_=GetFunction(1,"GradientFill") 

Procedure DrawButton(hwnd,hdc,*Coor.RECT,State)
  Protected Dim Vert.TRIVERTEX(1)       ;Allocate an array with 2 Element. One is the top the other one the bottom color 
  Protected TCol.l 
  Protected Rect.GRADIENT_RECT 
  Protected x.l 
  Protected y.l 
  Protected w.l 
  Protected h.l  
  Protected SysCol.l 
  Protected Text.s{255} ;Allocating the Text for getting the Text 
  Protected Pen 
  Protected OldPen 
  
  With *Coor 
    x.l=\Left 
    y.l=\top 
    w.l=\right-\left 
    h.l=\bottom-\top 
  EndWith 
  
  If  State & #ODS_SELECTED     ;{ Button down (selected)    
     With Vert(0)    ;Set the Colors 
        \x=1 
        \y=1                            
        \Blue=$FF00              
    EndWith 
  
    With Vert(1) 
        \x=w-1 
        \y=h-1            
        \Red=$9700 
        \Green=$BF00 
        \Blue=$F000 
    EndWith 
        
    TCol=$DDDDDD 
    ;} 
  ElseIf State & #ODS_HOTLIGHT ;{ Mouseover 
     With Vert(0)    ;Set the Colors 
      \x=w-1 
      \y=h-1                  
      \Blue=$FF00  
    EndWith 
  
    With Vert(1) 
      \x=1 
      \y=1 
      \Red=$9700 
      \Green=$BF00 
      \Blue=$F000      
    EndWith    
    
    TCol=$DDDDDD 
  ;} 
  ElseIf State & #ODS_FOCUS ;{ Focus 
     With Vert(0)    ;Set the Colors 
      \x=w-1 
      \y=h-1                  
      \Blue=$FF00  
    EndWith 
  
    With Vert(1) 
      \x=1 
      \y=1 
      \Red=$9700 
      \Green=$BF00 
      \Blue=$F000      
    EndWith    
    
    TCol=$DDDDDD 
    

  ;} 
  ElseIf State & #ODS_DISABLED  ;{ Disabled
     With Vert(1)
        \x=1
        \y=1
        \Red=$FF00
        \Green=$FF00
        \Blue=$FF00
    EndWith
    
    With Vert(0)    ;Set the Colors 
        \x=1 
        \y=1                              
        \Red=$EE00 
        \Green=$E400 
        \Blue=$E900 
    EndWith 
        
    TCol=$CCCCCC 
  ;} 
  Else                               ;{ Normal
    With Vert(0)
        \x=1
        \y=1
        \Red=$EE00
        \Green=$E400
        \Blue=$E900
    EndWith
    
    With Vert(1)
        \x=w-1
        \y=h-1
        \Red=$C700
        \Green=$B900
        \Blue=$C200
    EndWith
    
    TCol=$222222
    ;}
  EndIf
  
  ;Set the Elements of te Array wich are used (here 0 and 1)
  With Rect
    \UpperLeft  = 0
    \LowerRight = 1
  EndWith
  
  Rectangle_(hdc,0,0,w,h)        ;Draw a black rectangle on te hdc of the Gadget
  GradientFill_(hdc,@Vert(),2,Rect,1,#GRADIENT_FILL_RECT_V)    ;Make the gradiant 2 and 1 stands for the Elements of the Array
  
  SysCol=$FFFFFF;GetSysColor_(COLOR_WINDOW+6)       ;Choose a color for te Edges of the Button
  SetPixelV_(hdc,0,0,SysCol)         ;Draw the 4 Pixels at the Edges
  SetPixelV_(hdc,w-1,0,SysCol)
  SetPixelV_(hdc,0,h-1,SysCol)
  SetPixelV_(hdc,w-1,h-1,SysCol)
  
  SetBkMode_(hdc,#TRANSPARENT)   ;Make the Background Transparent
  SetTextColor_(hdc,TCol)     ;Set a Text Color
  SendMessage_(hwnd,#WM_GETTEXT,255,Text.s)                        ;Get the Text
  DrawText_(hdc,Text.s,-1,*Coor,#DT_CENTER|#DT_VCENTER|#DT_SINGLELINE)         ;Draw the Text u want to draw, -1 sows that it's 0 terminated.
  
  If State & #ODS_FOCUS
    Pen=CreatePen_(#PS_DOT,1,0)
    oldpen=GetCurrentObject_(hdc,#OBJ_PEN)
    SelectObject_(hdc,Pen)
      ;Rectangle_(hdc,2,2,w-3,h-3)
      MoveToEx_(hdc,2,2,0)
      LineTo_(hdc,w-3,2)
      LineTo_(hdc,w-3,h-3)
      LineTo_(hdc,2,h-3)
      LineTo_(hdc,2,2)
    SelectObject_(hdc,oldpen)
    DeleteObject_(Pen)
  EndIf
EndProcedure

Procedure WindowCallback(Window, Message, wParam, lParam)
  Protected Result
  Protected *Item.DRAWITEMSTRUCT
  Protected *Parts.IntParts
  
  Select Message      ;selecting the Message of the callback
    Case #WM_CLOSE    ;If the [x] is pressed
      DestroyWindow_(Window)
      
    Case #WM_DESTROY  ;If close Is made
      PostQuitMessage_(0)
      Result  = 0
      
    Case #WM_INITDIALOG   ;initializing of the Button
      Debug "Init" 
      
    Case #WM_DRAWITEM   ;if the Gadget has to be redrawn
      Debug "Draw"
      
      *Item=lParam       ;Set the Pointer To the Structure
      With *Item
        DrawButton(\hwndItem,\hdc,\rcItem,\itemState)
      EndWith
      Result=1
    Case #WM_COMMAND
      *Parts=@wParam
      Select *Parts\Part2
        Case #BN_CLICKED
          Debug "Click"
          If IsWindowEnabled_(DisableButton)
            EnableWindow_(DisableButton,0)
          Else
            EnableWindow_(DisableButton,1)
          EndIf
        Case #BN_SETFOCUS
          Debug "Focus"
      EndSelect
      
      ProcedureReturn 0
    Default
      Result  = DefWindowProc_(Window, Message, wParam, lParam)
  EndSelect
  
  ProcedureReturn Result
EndProcedure

#Style  = #WS_VISIBLE | #WS_BORDER | #WS_SYSMENU
#StyleEx  = #WS_EX_OVERLAPPEDWINDOW

Define WindowClass.s
Define wc.WNDCLASSEX
Define hWndMain
Define msg.MSG
Define Init.INITCOMMONCONTROLSEX


With Init
  \dwSize=SizeOf(INITCOMMONCONTROLSEX)
  \dwICC=#ICC_STANDARD_CLASSES
EndWith
InitCommonControlsEx_(Init)

WindowClass.s  = "My Window"    ;register a Window
wc\cbSize  = SizeOf(WNDCLASSEX)
wc\lpfnWndProc  = @WindowCallback()
wc\hCursor  = LoadCursor_(0, #IDC_ARROW); #IDC_ARROW   = Arrow
wc\hbrBackground  = CreateSolidBrush_($FFFFFF)
wc\lpszClassName  = @WindowClass
RegisterClassEx_(@wc)

hWndMain  = CreateWindowEx_(#StyleEx, WindowClass, "Test-Window", #Style, 10, 10, 500, 500, 0, 0, 0, 0) ;Crerate the MainWindow
CreateWindowEx_(0, "Button", "Button 1", #WS_CHILD | #WS_VISIBLE|#WS_TABSTOP|#BS_OWNERDRAW  , 10, 10, 60,60, hWndMain, 1337,0, 0) ;Create the Button 1
DisableButton=CreateWindowEx_(0, "Button", "Button 2", #WS_CHILD|#WS_TABSTOP| #WS_VISIBLE|#BS_OWNERDRAW  , 100, 100, 200,30, hWndMain, 1338,0, 0) ;Create the Button 2
CreateWindowEx_(0, "Button", "Button 3", #WS_CHILD | #WS_VISIBLE|#WS_TABSTOP|#BS_OWNERDRAW  , 300, 300, 100,100, hWndMain, 1339,0, 0) ;Create the Button 3

ShowWindow_(hWndMain,  #SW_SHOWDEFAULT) ;U Don't need it but it's saver
UpdateWindow_(hWndMain)

While GetMessage_(msg, #Null, 0, 0 ) ;Windowevent()
  TranslateMessage_(msg)
  DispatchMessage_(msg)
Wend

Code: Alles auswählen

........
Case #WM_COMMAND 
      *Parts=@wParam 
      Select *Parts\Part2 
        Case #BN_CLICKED 
          Debug "Click"
.......

Code: Alles auswählen

Procedure.b rectscollide(x1,y1,w1,h1,x2,y2,w2,h2)
  If w1 < 0
    w1 = -w1
    x1 = x1 - w1
  EndIf
  If h1 < 0
    h1 = -h1
    y1 = y1 - h1
  EndIf
  If w2 < 0
    w2 = -w2
    x2 = x2 - w2
  EndIf
  If h2 < 0
    h2 = -h2
    y2 = y2 - h2
  EndIf
  If (x1 + w1 >= x2 And x2+w2 >= x1 And y1 + h1 >= y2 And y2+h2 >= y1)
    ProcedureReturn 1
  EndIf
EndProcedure

Dim button(2)
button(0) = CreateImage(#PB_Any,100,20)
StartDrawing(ImageOutput(button(0)))

Box(0,0,100,20,RGB(0,0,255))
StopDrawing()

button(1) = CreateImage(#PB_Any,100,20)
StartDrawing(ImageOutput(button(1)))

Box(0,0,100,20,RGB(0,155,255))
StopDrawing()

button(2) = CreateImage(#PB_Any,100,20)
StartDrawing(ImageOutput(button(2)))

Box(0,0,100,20,RGB(0,0,100))
StopDrawing()

OpenWindow(0,0,0,200,200,"Test", #PB_Window_ScreenCentered)
CreateGadgetList(WindowID(0))

ImageGadget(0,20,20,100,20,ImageID(button(0)))
ImageGadget(1,20,50,100,20,ImageID(button(0)))
ButtonGadget(2,20,80,100,20,"Button")

overbutton = -1
downbutton = -1
Repeat
  
  If GetSystemMetrics_(#SM_SWAPBUTTON)
    key = 0
  Else
    key = 1
  EndIf
  
  omx = mx
  omy = my
  mx = DesktopMouseX()
  my = DesktopMouseY()
  
  If (omx <> mx Or omy <> my) And (GetAsyncKeyState_(key) = 0 Or downbutton <> -1)
    over = 0
    For i = 0 To 1
      If rectscollide(20,20+i*30,100,20,WindowMouseX(0),WindowMouseY(0),0,0)
        over = 1
        If downbutton = i
          SetGadgetState(i,ImageID(button(2)))
        ElseIf  downbutton = -1 
          If overbutton <> -1 And overbutton <> i
            SetGadgetState(overbutton,ImageID(button(0)))
          EndIf
          overbutton  = i
          SetGadgetState(i,ImageID(button(1)))
        EndIf
        
      EndIf
    Next
    
    If over = 0 And (overbutton <> -1 Or  downbutton <> -1)
      If overbutton <> -1
        SetGadgetState(overbutton,ImageID(button(0)))
      Else
        SetGadgetState(downbutton,ImageID(button(1)))
      EndIf   
    EndIf
  EndIf
  
  If GetAsyncKeyState_(key) = 0
    If downbutton <> -1
      If rectscollide(20,20+downbutton*30,100,20,WindowMouseX(0),WindowMouseY(0),0,0)
        Select  downbutton
          Case 0
            MessageRequester("Pressed","Button :" +Str(downbutton+1))
        EndSelect 
        
        overbutton  = downbutton
        SetGadgetState(overbutton,ImageID(button(1)))
        
      Else
        overbutton = -1
        SetGadgetState(downbutton,ImageID(button(0)))
      EndIf
      downbutton = -1
    EndIf 
  EndIf
  
  Select WindowEvent()
    Case 0
      Delay(10)
    Case #PB_Event_CloseWindow
      End
    Case #PB_Event_Gadget
      Select EventGadget()
        Case 0
          If EventType() = #PB_EventType_LeftClick Or EventType() = #PB_EventType_LeftDoubleClick
            overbutton = -1
            downbutton = 0
            SetGadgetState(0,ImageID(button(2)))
          EndIf
        Case 1
          If EventType() = #PB_EventType_LeftClick Or EventType() = #PB_EventType_LeftDoubleClick
            overbutton  = -1
            downbutton = 1
            SetGadgetState(1,ImageID(button(2)))
          EndIf
      EndSelect
  EndSelect
  
ForEver  

Code: Alles auswählen

Case #WM_COMMAND
      *Parts=@wParam
      Select *Parts\Part2
        Case #BN_CLICKED, #BN_DOUBLECLICKED