PureBasic

Code : Tout sélectionner

; German forum: http://robsite.de/php/pureboard/viewtopic.php?t=951&highlight=
; Author: FreeDimension
; Date: 09. May 2003

OpenWindow(1, 10, 150, 150, 80, "Button OwnerDraw", #PB_Window_TitleBar) 

CreateGadgetList(WindowID(1)) 

a.l = ButtonGadget(1, 5, 5, 50, 50, "Hallo", #BS_OWNERDRAW) 
b.l = ButtonGadget(2, 55, 5, 50, 50, "Hallo", #BS_OWNERDRAW) 

Global hBrButton1.l, hBrButton2.l, hBrButton3.l, hBrButton4.l 

normal        = LoadImage(1, "button test 1.bmp") 
normal_focus  = LoadImage(2, "button test 2.bmp") 
pressed       = LoadImage(3, "button test 3.bmp") 
pressed_focus = LoadImage(4, "button test 4.bmp") 

Procedure mcb(WindowID, Message, wParam, lParam) 
  Result = #PB_ProcessPureBasicEvents 
  If Message = #WM_DRAWITEM 
    *dis.DRAWITEMSTRUCT 
    *dis = lparam 
    If *dis\itemState & #ODS_SELECTED 
      If *dis\itemState & #ODS_FOCUS 
        FillRect_(*dis\hDC, *dis\rcItem, hBrButton4) 
      Else 
        FillRect_(*dis\hDC, *dis\rcItem, hBrButton2) 
      EndIf 
    Else 
      If *dis\itemState & #ODS_FOCUS 
        FillRect_(*dis\hDC, *dis\rcItem, hBrButton3) 
      Else 
        FillRect_(*dis\hDC, *dis\rcItem, hBrButton1) 
      EndIf 
    EndIf 
  EndIf 
  ProcedureReturn Result 
EndProcedure 

hBrButton1 = CreatePatternBrush_(normal) 
hBrButton2 = CreatePatternBrush_(normal_focus) 
hBrButton3 = CreatePatternBrush_(pressed) 
hBrButton4 = CreatePatternBrush_(pressed_focus) 

SetWindowCallback(@mcb()) 

Repeat 
  event = WaitWindowEvent() 
Until event = #PB_Event_CloseWindow 

Code : Tout sélectionner

; German forum: http://robsite.de/php/pureboard/viewtopic.php?t=1696&highlight=
; Author: Stefan Moebius
; Date: 15. July 2003


; Example for creating own control elements in PureBasic
; Beispiel für das Erstellen eigener Steuerelemente in PureBasic

#BTN_SETTEXTCOLOR=#WM_USER 
#BTN_SETLIGHTCOLOR=#WM_USER+1 
#BTN_SETSHADOWCOLOR=#WM_USER+2 
#BTN_SETBKCOLOR=#WM_USER+3 
#BTN_SETBKIMAGE=#WM_USER+4 

Procedure Button_CB(hwnd,message.l,wParam.l,lParam.l) 
  Addr=GetWindowLong_(hwnd,#GWL_USERDATA) 
  Dim NewRect(4) 
  RE.RECT 
  Paint.PAINTSTRUCT 
  pt.POINT 
  GetWindowRect_(hwnd,RE) 
  WindowLy=RE\bottom-RE\top  
  WindowLx=RE\right-RE\left 
  OldCB=PeekL(Addr+20) 
  
  If message<>#WM_LBUTTONUP And message<>#WM_LBUTTONDBLCLK And message<>#WM_NCDESTROY And message<>#WM_DESTROY 
    Result=CallWindowProc_(OldCB,hwnd,message,wParam,lParam) 
  EndIf 
  If message=#WM_NCPAINT:message=#WM_PAINT:EndIf 
  If message=#WM_LBUTTONDBLCLK:message=#WM_LBUTTONDOWN:EndIf 
  
  Select message 
    
  Case #BTN_SETBKIMAGE 
    DeleteObject_(PeekL(Addr+12)) 
    PokeL(Addr+12,CreatePatternBrush_(lParam)) 
    SendMessage_(hwnd,#WM_PAINT,0,0) 
    
  Case #BTN_SETBKCOLOR 
    DeleteObject_(PeekL(Addr+12)) 
    PokeL(Addr+12,CreateSolidBrush_(lParam)) 
    SendMessage_(hwnd,#WM_PAINT,0,0) 
    
  Case #BTN_SETSHADOWCOLOR 
    DeleteObject_(PeekL(Addr+8)) 
    PokeL(Addr+8,CreatePen_(0,1,lParam)) 
    SendMessage_(hwnd,#WM_PAINT,0,0) 
    
  Case #BTN_SETLIGHTCOLOR 
    DeleteObject_(PeekL(Addr+4)) 
    PokeL(Addr+4,CreatePen_(0,1,lParam)) 
    SendMessage_(hwnd,#WM_PAINT,0,0) 
    
  Case #BTN_SETTEXTCOLOR 
    PokeL(Addr,lParam) 
    SendMessage_(hwnd,#WM_PAINT,0,0) 
    
  Case #WM_SETFONT 
    PokeL(Addr+16,wParam) 
    SendMessage_(hwnd,#WM_PAINT,0,0) 
    
  Case #WM_LBUTTONDOWN 
    Ret=1 
    NewRect(0)=0:NewRect(1)=0:NewRect(2)=0:NewRect(3)=0 
    Text$=Space(GetWindowTextLength_(hwnd)+1)+Chr(0) 
    GetWindowText_(hwnd,Text$,GetWindowTextLength_(hwnd)+1) 
    ;----------------------------------------------------------- 
    hdc=GetDC_(hwnd) 
    TextCol=PeekL(Addr) 
    PenH=PeekL(Addr+4) 
    PenD=PeekL(Addr+8) 
    BkBrush=PeekL(Addr+12) 
    Font=PeekL(Addr+16) 
    oldBrush=SelectObject_(hdc,BkBrush) 
    Rectangle_(hdc,0,0,WindowLx+1,WindowLy+1) 
    SelectObject_(hdc,PenD) 
    MoveToEx_(hdc,0,WindowLy,0) 
    LineTo_(hdc,0,0) 
    LineTo_(hdc,WindowLx,0) 
    SelectObject_(hdc,PenH) 
    LineTo_(hdc,WindowLx,WindowLy) 
    LineTo_(hdc,0,WindowLy) 
    ;--------------------------- Text ------------------------------ 
    For M=1 To Len(Text$):If Mid(Text$,M,1)=Chr(13):Ret=Ret+1:EndIf:Next 
    OldFont=SelectObject_(hdc,Font) 
    Txtheight=DrawText_(hdc,Text$,Len(Text$),@NewRect(0),0)*Ret 
    NewRect(0)=1 
    NewRect(1)=WindowLy/2-Txtheight/2+1 
    NewRect(2)=WindowLx+1 
    NewRect(3)=WindowLy 
    OldTextCol=SetTextColor_(hdc,TextCol) 
    OldMode=SetBkMode_(hdc,1) 
    DrawText_(hdc,Text$,Len(Text$),@NewRect(0),#DT_CENTER|#DT_VCENTER) 
    ;----------------------------------------------------------------- 
    
    SelectObject_(hdc,oldPen) 
    SelectObject_(hdc,oldBrush) 
    SetBkMode_(hdc,OldMode) 
    SetTextColor_(hdc,OldTextCol) 
    SelectObject_(hdc,OldFont) 
    ReleaseDC_(hwnd,hdc) 
    Result=CallWindowProc_(OldCB,hwnd,message,wParam,lParam) 
    
    
  Case #WM_LBUTTONUP 
    ;MouseY=lParam>>16 
    ;MouseX=(lParam<<16)>>16 
    SendMessage_(hwnd,#WM_PAINT,0,0) 
    Result=CallWindowProc_(OldCB,hwnd,#WM_LBUTTONUP,wParam,lParam) 
    
    
  Case #WM_PAINT 
    ;-------------------------------------------------------------- 
    Ret=1 
    NewRect(0)=0:NewRect(1)=0:NewRect(2)=0:NewRect(3)=0 
    Text$=Space(GetWindowTextLength_(hwnd)+1)+Chr(0) 
    GetWindowText_(hwnd,Text$,GetWindowTextLength_(hwnd)+1) 
    ;-------------------------------------------------------------- 
    hdc=GetDC_(hwnd);BeginPaint_(hWnd,@Paint) 
    TextCol=PeekL(Addr) 
    PenH=PeekL(Addr+4) 
    PenD=PeekL(Addr+8) 
    BkBrush=PeekL(Addr+12) 
    Font=PeekL(Addr+16) 
    oldBrush=SelectObject_(hdc,BkBrush) 
    Rectangle_(hdc,0,0,WindowLx+1,WindowLy+1) 
    SelectObject_(hdc,PenH) 
    MoveToEx_(hdc,0,WindowLy,0) 
    LineTo_(hdc,0,0) 
    LineTo_(hdc,WindowLx,0) 
    SelectObject_(hdc,PenD) 
    LineTo_(hdc,WindowLx,WindowLy) 
    LineTo_(hdc,0,WindowLy) 
    
    ;--------------------------- Text ----------------------------- 
    For M=1 To Len(Text$):If Mid(Text$,M,1)=Chr(13):Ret=Ret+1:EndIf:Next 
    OldFont=SelectObject_(hdc,Font) 
    Txtheight=DrawText_(hdc,Text$,Len(Text$),@NewRect(0),0)*Ret 
    NewRect(0)=0 
    NewRect(1)=WindowLy/2-Txtheight/2 
    NewRect(2)=WindowLx 
    NewRect(3)=WindowLy 
    OldTextCol=SetTextColor_(hdc,TextCol) 
    OldMode=SetBkMode_(hdc,1) 
    DrawText_(hdc,Text$,Len(Text$),@NewRect(0),#DT_CENTER|#DT_VCENTER) 
    ;------------------------------------------------------------------------- 
    SelectObject_(hdc,oldPen) 
    SelectObject_(hdc,oldBrush) 
    SetBkMode_(hdc,OldMode) 
    SetTextColor_(hdc,OldTextCol) 
    SelectObject_(hdc,OldFont) 
    ReleaseDC_(hwnd,hdc) 
    ;EndPaint_(hWnd,@Paint) 
    Result=0 
    
  Case #WM_DESTROY 
    If Addr<>0 
      DeleteObject_(PeekL(Addr+4));Pen 
      DeleteObject_(PeekL(Addr+8));Pen 
      DeleteObject_(PeekL(Addr+12));Brush 
      GlobalFree_(Addr) 
    EndIf 
    Result=CallWindowProc_(OldCB,hwnd,message,wParam,lParam) 
  Default 
    Result = DefWindowProc_(hwnd,message,wParam,lParam) 
EndSelect 
ProcedureReturn Result 
EndProcedure 


Procedure OwnButtonGadget(hMenu,x,y,lx,ly,Text$) 
  Handle=ButtonGadget(hMenu,x,y,lx,ly,Text$,#WS_CHILD|#WS_VISIBLE|#BS_OWNERDRAW) 
  ;Handle=CreateWindowEx_(0,"button",Text$,#WS_CHILD|#WS_VISIBLE|#BS_OWNERDRAW,x,y,lx,ly,Win,hMenu,0,0) 
  OldCB=SetWindowLong_(Handle,#GWL_WNDPROC,@Button_CB()) 
  Addr=GlobalAlloc_(#GMEM_FIXED,24) 
  PokeL(Addr,0)   ; Farbe 
  PokeL(Addr+4,CreatePen_(0,1,GetSysColor_(#COLOR_3DHILIGHT))) 
  PokeL(Addr+8,CreatePen_(0,1,GetSysColor_(#COLOR_3DSHADOW))) 
  PokeL(Addr+12,CreateSolidBrush_(GetSysColor_(#COLOR_BTNFACE))) 
  PokeL(Addr+16,GetStockObject_(#ANSI_VAR_FONT)) 
  PokeL(Addr+20,OldCB) 
  SetWindowLong_(Handle,#GWL_USERDATA,Addr) 
  ShowWindow_(Handle,#SW_NORMAL) 
  ProcedureReturn Handle 
EndProcedure 








;Beispiel: 

OpenWindow(1,0,0,200,150,"Eigene Steuerelemente",#PB_Window_ScreenCentered|#PB_Window_SystemMenu) 
CreateGadgetList(WindowID(1)) 
Font=LoadFont(1,"Arial",15) 


Gadget1=OwnButtonGadget(1, 5, 5, 76, 22,"&Button 1") 
Gadget2=OwnButtonGadget(2, 5,35, 76, 22,"&Button 2") 
Gadget3=OwnButtonGadget(3, 5,65, 76, 22,"&Button 3") 
Gadget4=OwnButtonGadget(4, 5,95, 76, 22,"&Button 4") 
OwnButtonGadget(5,85,10,100,100,"&Button 5"+Chr(13)+"&Button 5"+Chr(13)+"&Button 5") 


SendMessage_(Gadget1,#BTN_SETTEXTCOLOR,0,RGB(0,255,0)) 
SendMessage_(Gadget1,#BTN_SETBKCOLOR,0,RGB(0,128,255)) 
SendMessage_(Gadget1,#BTN_SETSHADOWCOLOR,0,RGB(0,0,0)) 
SendMessage_(Gadget1,#BTN_SETLIGHTCOLOR,0,RGB(255,255,255)) 

SendMessage_(Gadget2,#WM_SETFONT,Font,0) 

SendMessage_(Gadget3,#BTN_SETBKCOLOR,0,RGB(220,220,220)) 
SendMessage_(Gadget3,#BTN_SETSHADOWCOLOR,0,RGB(128,128,128)) 
SendMessage_(Gadget3,#BTN_SETLIGHTCOLOR,0,RGB(255,255,255)) 

SendMessage_(Gadget4,#BTN_SETTEXTCOLOR,0,RGB(0,96,0)) 
SendMessage_(Gadget4,#BTN_SETSHADOWCOLOR,0,RGB(0,96,0)) 
SendMessage_(Gadget4,#BTN_SETLIGHTCOLOR,0,RGB(164,255,164)) 
SendMessage_(Gadget4,#BTN_SETBKCOLOR,0,RGB(0,191,0)) 


Repeat 
  Erg=WaitWindowEvent() 
  If Erg=#PB_Event_Gadget:MessageRequester("","Button "+Str(EventGadget()),0):EndIf 
Until Erg=#PB_Event_CloseWindow 

End 

Code : Tout sélectionner

; ComboBox OwnerDraw in PureBasic by Fred
;

Enumeration
  #Window_0
EndEnumeration

Enumeration
  #Gadget_0
EndEnumeration


Procedure Open_Window_0()
  If OpenWindow(#Window_0, 0, 0, 400, 100 , "New window ( 0 )", #PB_Window_SystemMenu | #PB_Window_ScreenCentered | #PB_Window_SizeGadget | #PB_Window_TitleBar)
    If CreateGadgetList(WindowID(#Window_0))
      ComboBoxGadget(#Gadget_0, 60, 40, 330, 200,  #CBS_OWNERDRAWFIXED)
      
    EndIf
  EndIf
EndProcedure

Open_Window_0()

#DI_NORMAL = $0003

Procedure WindowCallback(WindowID, message, wParam, lParam)
  Result = #PB_ProcessPureBasicEvents
  
  Select message
    
    Case #WM_DRAWITEM
      *DrawItem.DRAWITEMSTRUCT = lParam
      
      If *DrawItem\CtlType = #ODT_COMBOBOX
        SetBkMode_(*DrawItem\hdc, #TRANSPARENT) ; Text is rendered transparent
        
        If *DrawItem\itemState & #ODS_FOCUS
          Brush = CreateSolidBrush_($FFEEFF)
          FillRect_(*DrawItem\hdc, *DrawItem\rcItem, Brush)
          DeleteObject_(Brush)
          
          SetTextColor_(*DrawItem\hdc, $FF)
        Else
          FillRect_(*DrawItem\hdc, *DrawItem\rcItem, GetStockObject_(#WHITE_BRUSH))
        EndIf
        
        If *DrawItem\itemID <> -1
          Text$ = Space(512)
          SendMessage_(*DrawItem\hwndItem, #CB_GETLBTEXT, *DrawItem\itemID, @Text$)
          
          DrawIconEx_(*DrawItem\hdc, *DrawItem\rcItem\left+2   , *DrawItem\rcItem\top+1, LoadIcon_(0, #IDI_ASTERISK), 16, 16, 0, 0, #DI_NORMAL)
          TextOut_   (*DrawItem\hdc, *DrawItem\rcItem\left+2+20, *DrawItem\rcItem\top+1, Text$, Len(Text$))
        EndIf
      EndIf
      
  EndSelect
  
  ProcedureReturn Result
EndProcedure


SetWindowCallback(@WindowCallback())

AddGadgetItem(#Gadget_0, -1, "Test1")
AddGadgetItem(#Gadget_0, -1, "Test2")
AddGadgetItem(#Gadget_0, -1, "Test3")
 
Repeat
Until WaitWindowEvent() = #PB_Event_CloseWindow

End 

Code : Tout sélectionner

;/ CostumButtons 2
;/    GPI - 28.07.2003
;/
;/ The black color (rgb(0,0,0)) is set as transparent
;/ so when you want a black boarder, use rgb(1,1,1) instead of rgb(0,0,0)
;/
;/ because the buttons ARE normal buttons, you can use
;/ DisableGadget()
;/ SetGadgetFont()
;/ Also you can use the normal PB-Message-System with WaitWindowEvent() and #PB_Event_Button
;/
;/ SetGadgetText() won't work, use SetCostumButtonText()
;/ same for SetGadgetState() and GetGadgetState(), use SetCostumButtonState() and GetCostumButtonState()
;/ ResizeGadgetText() has problems with the background, so use ResizeCostumButton()
;/
;/ Original Costum Buttons by freedimension

;-
#CostumBotton_Toggle=1
#CostumBotton_CheckBox=2
#CostumBotton_Option=4

Global CButton_OptionOffset_
Structure CostumButton
  id.l
  hwnd.l
  text.s
  NormalTColor.l
  FocusTColor.l
  PressedTcolor.l
  DisabledTcolor.l
  normal.l
  focus.l
  pressed.l
  PFocus.l
  disabled.l
  state.l
  Type.l
  OptionOffset.l
EndStructure
Global NewList CButton_.CostumButton()
Procedure FreeCostumButton(id)
  ResetList(CButton_())
  ok=#False
  Repeat
    If NextElement(CButton_())
      If CButton_()\id=id
        FreeGadget(id)
        CButton_()\text=""
        DeleteElement(CButton_())
        ok=#True
      EndIf
    Else
      ok=#True
    EndIf
  Until ok
EndProcedure
Procedure FreeAllCostumButton()
  While FirstElement(CButton_())
    FreeCostumButton(CButton_()\id)
  Wend
EndProcedure

Procedure CostumButton(id,x,y,w,h,text.s,NormalTColor,FocusTColor,PressedTcolor,DisabledTcolor,FontId,normal,focus,pressed,PFocus,disabled,Type); for tcolor and fontid you can use -1 (#pb_default) for Systemdefaults
  ResetList(CButton_())
  ok=#False
  Repeat
    If NextElement(CButton_())
      If CButton_()\id=id
        FreeCostumButton(id)
        ok=#True
      EndIf
    Else
      ok=#True
    EndIf
  Until ok
  AddElement(CButton_())
  CButton_()\id=id
  CButton_()\text=text
  CButton_()\NormalTColor=NormalTColor
  CButton_()\FocusTColor=FocusTColor
  CButton_()\PressedTcolor=PressedTcolor
  CButton_()\DisabledTcolor=DisabledTcolor
  CButton_()\normal  =normal
  CButton_()\focus   =focus
  CButton_()\pressed =pressed
  CButton_()\PFocus  =PFocus
  CButton_()\disabled=disabled
  CButton_()\Type    =Type
  CButton_()\OptionOffset=CButton_OptionOffset_
  CButton_()\hwnd=ButtonGadget(id,x,y,w,h,"",#BS_OWNERDRAW|$4000);bs_notify
  SetGadgetFont(id,FontId)
  ProcedureReturn CButton_()\hwnd
EndProcedure  
Procedure SetCostumButtonImage(id,normal,focus,pressed,PFocus,disabled) ; -1=no change!
  ResetList(CButton_())
  ok=#False
  Repeat
    If NextElement(CButton_())
      If CButton_()\id=id
        If normal<>-1
          CButton_()\normal  = normal
        EndIf
        If pressed<>-1
          CButton_()\pressed = pressed
        EndIf
        If focus<>-1
          CButton_()\focus   = focus
        EndIf
        If PFocus<>-1
          CButton_()\PFocus  = PFocus
        EndIf
        If disabled<>-1
          CButton_()\disabled= disabled
        EndIf
        RedrawWindow_(CButton_()\hwnd, 0, 0,#RDW_INTERNALPAINT|#RDW_INVALIDATE|#RDW_ALLCHILDREN )
        ok=#True
      EndIf
    Else
      ok=#True
    EndIf
  Until ok
EndProcedure
Procedure SetCostumButtonText(id,text.s)
  ResetList(CButton_())
  ok=#False
  Repeat
    If NextElement(CButton_())
      If CButton_()\id=id
        CButton_()\text=text
        RedrawWindow_(CButton_()\hwnd, 0, 0,#RDW_INTERNALPAINT|#RDW_INVALIDATE|#RDW_ALLCHILDREN )
        ok=#True
      EndIf
    Else
      ok=#True
    EndIf
  Until ok
EndProcedure
Procedure GetCostumButtonState(id)
  Result=0
  ResetList(CButton_())
  ok=#False
  Repeat
    If NextElement(CButton_())
      If CButton_()\id=id
        Result=CButton_()\state
        ok=#True
      EndIf
    Else
      ok=#True
    EndIf
  Until ok
  ProcedureReturn Result
EndProcedure
Procedure SetCostumButtonState(id,state)
  If state: state=1 : EndIf
  ResetList(CButton_())
  ok=#False
  Repeat
    If NextElement(CButton_())
      If CButton_()\id=id
        CButton_()\state=state
        RedrawWindow_(CButton_()\hwnd, 0, 0,#RDW_INTERNALPAINT|#RDW_INVALIDATE|#RDW_ALLCHILDREN )
        ok=#True
      EndIf
    Else
      ok=#True
    EndIf
  Until ok
EndProcedure
Procedure SetCostumButtonTextColor(id,NormalTColor,FocusTColor,PressedTcolor,DisabledTcolor); -1=Default: -2=nochange
  ResetList(CButton_())
  ok=#False
  Repeat
    If NextElement(CButton_())
      If CButton_()\id=id
        If NormalTColor>-2
          CButton_()\NormalTColor=NormalTColor
        EndIf
        If FocusTColor>-2
          CButton_()\FocusTColor=FocusTColor
        EndIf
        If PressedTcolor>-2
          CButton_()\PressedTcolor=PressedTcolor
        EndIf
        If DisabledTcolor>-2
          CButton_()\DisabledTcolor=DisabledTcolor
        EndIf
        RedrawWindow_(CButton_()\hwnd, 0, 0,#RDW_INTERNALPAINT|#RDW_INVALIDATE|#RDW_ALLCHILDREN )
        ok=#True
      EndIf
    Else
      ok=#True
    EndIf
  Until ok
EndProcedure
Procedure ResizeCostumButton(id,x,y,w,h)
  If GetFocus_()=GadgetID(id)
    ok=#True
  EndIf
  HideGadget(id,#True)
  ResizeGadget(id,x,y,w,h)
  HideGadget(id,#False)
  If ok
    SetFocus_(GadgetID(id))
  EndIf
EndProcedure
Procedure StartCostumButtonOption()
  CButton_OptionOffset_+1
EndProcedure
;-
Procedure Callback(WindowID, Message, wParam, lParam) 
  Result = #PB_ProcessPureBasicEvents 
  If Message = #WM_COMMAND And wParam>>16&$ffff=#BN_CLICKED
    ResetList(CButton_())
    ok=#False
    Repeat
      If NextElement(CButton_())
        If CButton_()\hwnd=lParam
          
          If CButton_()\Type&#CostumBotton_Option
            id          =CButton_()\id
            OptionOffset=CButton_()\OptionOffset
            CButton_()\state=1
            RedrawWindow_(CButton_()\hwnd, 0, 0,#RDW_INTERNALPAINT|#RDW_INVALIDATE|#RDW_ALLCHILDREN )
            ResetList(CButton_())
            While NextElement(CButton_())
              If CButton_()\Type=#CostumBotton_Option And CButton_()\OptionOffset=OptionOffset And CButton_()\id<>id And CButton_()\state
                CButton_()\state=0
                RedrawWindow_(CButton_()\hwnd, 0, 0,#RDW_INTERNALPAINT|#RDW_INVALIDATE|#RDW_ALLCHILDREN )
              EndIf
            Wend
          ElseIf CButton_()\Type&(#CostumBotton_Toggle|#CostumBotton_CheckBox)
            CButton_()\state=1-CButton_()\state
            RedrawWindow_(CButton_()\hwnd, 0, 0,#RDW_INTERNALPAINT|#RDW_INVALIDATE|#RDW_ALLCHILDREN )
          EndIf
          ok=#True
        EndIf
      Else 
        ok=#True
      EndIf
    Until ok
  EndIf
      
  If Message = #WM_DRAWITEM 
    *dis.DRAWITEMSTRUCT = lParam 
    If *dis\CtlType=#ODT_BUTTON	
      ResetList(CButton_())
      ok=#False
      Repeat
        If NextElement(CButton_())
          If CButton_()\hwnd=*dis\hwndItem
            pic=CButton_()\normal
            TColor=CButton_()\NormalTColor
            If *dis\itemState & #ODS_DISABLED
              ;{Disabled
              pic=CButton_()\disabled
              If CButton_()\DisabledTcolor>-1
                TColor=CButton_()\DisabledTcolor
              EndIf
              ;}
            ElseIf CButton_()\Type=#CostumBotton_Toggle
              ;{Toggle-Button
              state=CButton_()\state
              If *dis\itemState & #ODS_SELECTED: state=1-state : EndIf
              
              If state=0
                If *dis\itemState & #ODS_FOCUS
                  pic=CButton_()\focus
                  If CButton_()\FocusTColor>-1
                    TColor=CButton_()\FocusTColor
                  EndIf
                EndIf
              Else
                If *dis\itemState & #ODS_FOCUS
                  pic=CButton_()\PFocus
                  If CButton_()\FocusTColor>-1
                    TColor=CButton_()\FocusTColor
                  EndIf
                Else
                  pic=CButton_()\pressed
                  If CButton_()\FocusTColor>-1
                    TColor=CButton_()\FocusTColor
                  EndIf
                EndIf
              EndIf
              ;}
            ElseIf CButton_()\Type&(#CostumBotton_CheckBox|#CostumBotton_Option)
              ;{Checkbox
              If *dis\itemState & #ODS_FOCUS
                If CButton_()\FocusTColor>-1
                  TColor=CButton_()\FocusTColor
                EndIf
              EndIf
              state=CButton_()\state
              If state=0
                If *dis\itemState & #ODS_SELECTED
                  pic=CButton_()\focus
                EndIf
              Else
                If *dis\itemState & #ODS_SELECTED
                  pic=CButton_()\PFocus
                Else
                  pic=CButton_()\pressed
                EndIf
              EndIf
              ;}
            ElseIf *dis\itemState & #ODS_SELECTED 
              ;{normal
              pic=CButton_()\PFocus
              If CButton_()\PressedTcolor>-1
                TColor=CButton_()\PressedTcolor
              EndIf
            ElseIf *dis\itemState & #ODS_FOCUS 
              pic=CButton_()\focus
              If CButton_()\FocusTColor>-1
                TColor=CButton_()\FocusTColor
              EndIf
              ;}
            EndIf
            
            oldmode=SetBkMode_(*dis\hDC, #TRANSPARENT)
            
            point.POINT\x=0:point\y=0
            MapWindowPoints_(GetParent_(CButton_()\hwnd),CButton_()\hwnd,point,1)
            
            BackBrush=GetClassLong_(WindowID, #GCL_HBRBACKGROUND)
            SetBrushOrgEx_(*dis\hDC,point\x,point\y,oldpoint.POINT)
            FillRect_(*dis\hDC,*dis\rcItem,BackBrush)
            SetBrushOrgEx_(*dis\hDC,oldpoint\x,oldpoint\y,0)
            
            GetObject_(pic,SizeOf(BITMAP),bmp.BITMAP)
            
            If pic
              imglist=ImageList_Create_(bmp\bmWidth,bmp\bmHeight,#ILC_COLORDDB|#ILC_MASK,1,0) 
              ImageList_AddMasked_(imglist,pic,0)
              ImageList_Draw_(imglist,0,*dis\hDC,*dis\rcItem\left,*dis\rcItem\top,#ILD_TRANSPARENT	) 
              ImageList_Destroy_(imglist) 
            EndIf
            
            
            GetTextExtentPoint32_(*dis\hDC,@CButton_()\text,Len(CButton_()\text),size.SIZE)
            
            h=((*dis\rcItem\bottom-*dis\rcItem\top      )-size\cy)/2
            
            If CButton_()\Type&( #CostumBotton_CheckBox|#CostumBotton_Option)
              w=bmp\bmWidth+2
              
              If *dis\itemState & #ODS_FOCUS
                hpen=CreatePen_(#PS_DOT,1,TColor)
                SelectObject_(*dis\hDC,hpen)
                x1=*dis\rcItem\left+w-1
                y1=*dis\rcItem\top+h-1
                x2=*dis\rcItem\left+w+size\cx+1
                y2=*dis\rcItem\top+h+size\cy+1 
                MoveToEx_(*dis\hDC,x1,y1,oldpoint.POINT)
                LineTo_(*dis\hDC,x2,y1)
                LineTo_(*dis\hDC,x2,y2)
                LineTo_(*dis\hDC,x1,y2)
                LineTo_(*dis\hDC,x1,y1)
                
                DeleteObject_(hpen)
              EndIf
              
              
            Else
              w=((*dis\rcItem\right -*dis\rcItem\left)-size\cx)/2
            EndIf 
            
            
             
            If TColor>-1
              SetTextColor_(*dis\hDC, TColor)
            EndIf
            
            TextOut_(*dis\hDC,*dis\rcItem\left+w,*dis\rcItem\top+h,@CButton_()\text,Len(CButton_()\text))
            SetBkMode_(*dis\hDC,oldmode)
            
            
            Result=#True
            ok=#True
          EndIf
        Else
          ok=#True
        EndIf
      Until ok
    EndIf
  EndIf
  ProcedureReturn Result 
EndProcedure 

OpenWindow(1, 10, 150, 256, 256, "Button OwnerDraw",#PB_Window_TitleBar|#PB_Window_SystemMenu) 

SetWindowCallback(@Callback()) 

normal   = LoadImage(1, "lang-normal.bmp") 
focus    = LoadImage(2, "lang-normal-focus.bmp") 
pressed  = LoadImage(3, "lang-pressed.bmp") 
disabled = LoadImage(4, "lang-disabled.bmp") 
PFocus   = LoadImage(5, "lang-pressed-focus.bmp")
back     = LoadImage(6, "background2.bmp")

chk_normal  = LoadImage( 7,"check-normal.bmp")
chk_Pnormal = LoadImage( 8,"check-normal-pressed.bmp")
chk_checked = LoadImage( 9,"check-checked.bmp")
chk_Pchecked= LoadImage(10,"check-checked-pressed.bmp")
chk_disabled= LoadImage(11,"check-disabled.bmp")

opt_normal  = LoadImage(12,"option-normal.bmp")
opt_Pnormal = LoadImage(13,"option-normal-pressed.bmp")
opt_select  = LoadImage(14,"option-select.bmp")
opt_Pselect = LoadImage(15,"option-select-pressed.bmp")
opt_disabled= LoadImage(16,"option-disabled.bmp")


 BackBrush= CreatePatternBrush_(back) 
 SetClassLong_(WindowID(1), #GCL_HBRBACKGROUND, BackBrush)

CreateGadgetList(WindowID(1)) 


CostumButton(1,  5,     5,100, 20,"Button 1",RGB(255,255,255),#PB_Default   ,#PB_Default   ,#PB_Default     ,LoadFont(1,"Courier New",10) , normal,focus ,pressed,PFocus,disabled,0) 
CostumButton(2,  5,25*1+5,100, 20,"unpressed",RGB(255,255,255),#PB_Default   ,RGB(0,0,0)    ,#PB_Default     ,         #PB_Default         , normal,focus ,pressed,PFocus,disabled,#CostumBotton_Toggle) 
CostumButton(3,  5,25*2+5,100, 20,"Disabled",RGB(255,255,255),RGB(255,255,0),RGB(128,128,0),RGB(0,0,0)      ,         #PB_Default         , normal,focus ,pressed,PFocus,disabled,Type) 
CostumButton(4,  5,25*3+5,100, 20,"uncheck" ,RGB(255,255,255),RGB(255,255,0),RGB(255,255,0),RGB(128,128,128),         #PB_Default         ,chk_normal,chk_Pnormal,chk_checked,chk_Pchecked,chk_disabled,#CostumBotton_CheckBox)
StartCostumButtonOption()
CostumButton(5,  5,25*4+5,100, 20,"Option 1",RGB(255,255,255),RGB(255,255,0),RGB(255,255,0),RGB(128,128,128),         #PB_Default         ,opt_normal,opt_Pnormal,opt_select ,opt_Pselect ,opt_disabled,#CostumBotton_Option)
CostumButton(6,  5,25*5+5,100, 20,"Option 1",RGB(255,255,255),RGB(255,255,0),RGB(255,255,0),RGB(128,128,128),         #PB_Default         ,opt_normal,opt_Pnormal,opt_select ,opt_Pselect ,opt_disabled,#CostumBotton_Option)
CostumButton(7,  5,25*6+5,100, 20,"Option 1",RGB(255,255,255),RGB(255,255,0),RGB(255,255,0),RGB(128,128,128),         #PB_Default         ,opt_normal,opt_Pnormal,opt_select ,opt_Pselect ,opt_disabled,#CostumBotton_Option)
StartCostumButtonOption()
CostumButton(8,  5,25*7+5,100, 20,"Option 2",RGB(255,255,255),RGB(255,255,0),RGB(255,255,0),RGB(128,128,128),         #PB_Default         ,opt_normal,opt_Pnormal,opt_select ,opt_Pselect ,opt_disabled,#CostumBotton_Option)
CostumButton(9,  5,25*8+5,100, 20,"Option 2",RGB(255,255,255),RGB(255,255,0),RGB(255,255,0),RGB(128,128,128),         #PB_Default         ,opt_normal,opt_Pnormal,opt_select ,opt_Pselect ,opt_disabled,#CostumBotton_Option)
CostumButton(10, 5,25*9+5,100, 20,"Option 2",RGB(255,255,255),RGB(255,255,0),RGB(255,255,0),RGB(128,128,128),         #PB_Default         ,opt_normal,opt_Pnormal,opt_select ,opt_Pselect ,opt_disabled,#CostumBotton_Option)

;ButtonGadget(4,  5,200,100, 20,"Button 4",#PB_Button_Toggle)

;SetGadgetFont(1,LoadFont(1,"Courier New",10))
DisableGadget(3,#True)
SetCostumButtonState(5,#True)
SetCostumButtonState(8,#True)


Repeat 
  event = WaitWindowEvent() 
  If event=#PB_Event_Gadget
    ;Debug "Pressed"
    If EventType()=#PB_EventType_LeftClick
      Select EventGadget()
        Case 2
          SetCostumButtonText(2, StringField("unpressed pressed",GetCostumButtonState(2)+1," "))
        Case 4
          SetCostumButtonText(4, StringField("unchecked checked",GetCostumButtonState(4)+1," "))
      EndSelect
    EndIf
  EndIf
Until event = #PB_Event_CloseWindow 

DeleteObject_(BackBrush)
FreeAllCostumButton()

Code : Tout sélectionner

;Custom draw ListView par Justin

#LVS_OWNERDRAWFIXED=1024
#NM_CUSTOMDRAW=#NM_FIRST-12

#CDDS_ITEM=65536
#CDDS_PREPAINT=1
;#CDDS_ITEMPREPAINT=#CDDS_ITEM|#CDDS_PREPAINT
#CDRF_NOTIFYITEMDRAW=32
#CDRF_NEWFONT=2

; Structure NMCUSTOMDRAW
;   hdr.NMHDR
;   dwDrawStage.l
;   hdc.l
;   rc.RECT
;   dwItemSpec.l
;   uItemState.l
;   lItemlParam.l
; EndStructure
; 
; Structure NMLVCUSTOMDRAW
;   nmcd.NMCUSTOMDRAW
;   clrText.l
;   clrTextBk.l
;   iSubItem.l
; EndStructure

Procedure listproc(hwnd,msg,wParam,lParam)
  ret=#PB_ProcessPureBasicEvents
  Select msg
    
    Case #WM_NOTIFY
      *ptr.NMLVCUSTOMDRAW=lParam
      
      Select *ptr\nmcd\hdr\code
        Case #NM_CUSTOMDRAW
          
          Select *ptr\nmcd\dwDrawStage
            Case #CDDS_PREPAINT
              ret=#CDRF_NOTIFYITEMDRAW
              
            Case #CDDS_ITEM | #CDDS_PREPAINT
              ;set text color
              *ptr\clrText=RGB(Random(255),Random(255),Random(255))
              ret=#CDRF_NEWFONT
          EndSelect
          
      EndSelect
      
  EndSelect
  ProcedureReturn ret
EndProcedure


hwnd=OpenWindow(0,10,10,500,500,"Custom Draw List View",#PB_Window_SystemMenu)
CreateGadgetList(hwnd)

hl=ListIconGadget(1,10,10,400,400,"",100,#PB_ListIcon_GridLines|#LVS_OWNERDRAWFIXED)
ChangeListIconGadgetDisplay(1,2)

ButtonGadget(2, 20, 450, 50, 20,"Add")

SetWindowCallback(@listproc())

Repeat
  eid=WaitWindowEvent()
  If eid=#PB_Event_Gadget
    Select EventGadget()
      
      Case 2
        AddGadgetItem(1,-1,"Customdrawing!")
    EndSelect
  EndIf
Until eid=#PB_Event_CloseWindow

Code : Tout sélectionner

; by preacher

#ODS_SELECTED=1
#ODS_GRAYED=2
#ODS_DISABLED=4
#ODS_CHECKED=8
#ODS_FOCUS=16
#ODS_DEFAULT= 32
#ODS_COMBOBOXEDIT= 4096

#ODT_STATIC  = 5
#SS_OWNERDRAW=13

;This are needed for PB's drawing functions to work.
Structure PBDrawingStruct
  Type.l
  WindowHandle.l
  DC.l
  ReleaseProcedure.l
EndStructure

Global mydraw.PBDrawingStruct
mydraw\Type=1




;listicon stuff
#LVM_GETSUBITEMRECT=4152
#LVM_SUBITEMHITTEST=4153
#NM_CUSTOMDRAW = #NM_FIRST - 12
#CDDS_ITEM = $10000
#CDDS_SUBITEM = $20000
#CDDS_PREPAINT = $1
#CDDS_ITEMPREPAINT = #CDDS_ITEM | #CDDS_PREPAINT
#CDDS_SUBITEMPREPAINT = #CDDS_SUBITEM | #CDDS_ITEMPREPAINT
#CDRF_DODEFAULT = $0
#CDRF_NEWFONT = $2
#CDRF_NOTIFYITEMDRAW = $20
#CDRF_NOTIFYSUBITEMDRAW = $20
#CDRF_SKIPDEFAULT=4
Structure lvwMsgInfo
  x.l
  y.l
  Flgs.l
  Itm.l
  SubItm.l
EndStructure
; Structure NMCUSTOMDRAW
;   hdr.NMHDR
;   dwDrawStage.l
;   hdc.l
;   rc.RECT 
;   dwItemSpec.l
;   uItemState.l
;   lItemlParam.l
; EndStructure
; Structure NMLVCUSTOMDRAW
;   nmcd.NMCUSTOMDRAW
;   clrText.l
;   clrTextBk.l
;   iSubItem.l
;   dwItemType.l
;   clrFace.l
;   iIconEffect.l
;   iIconPhase.l
;   iPartId.l
;   iStateId.l
;   rcText.RECT
;   uAlign.l
; EndStructure


#panel      =0
#od_panel   =1
#listicon   =2
#combo      =3
#listview   =4
#buttonimage=5
#button     =6
#text       =7

Procedure Open_mainwindow()
  If OpenWindow(0, 222, 49, 400, 400 , "OwnerDrawing ",  #PB_Window_SystemMenu | #PB_Window_TitleBar)
    
    If CreateGadgetList(WindowID(0))
      PanelGadget(#panel,0,0,400,400)
      AddGadgetItem(#panel,0,"ListIconGadget")
      
      ListIconGadget(#listicon,5,5,385,370,"List",50);LBS_OWNERDRAWFIXED)
      AddGadgetColumn(#listicon,1,"Icon",50)
      AddGadgetColumn(#listicon,2,"Gadget",50)
      AddGadgetItem(#listicon,0,Str(RGB(0,0,0))+Chr(10)+Str(RGB(100,100,100))+Chr(10)+Str(RGB(0,0,0)))
      AddGadgetItem(#listicon,1,Str(RGB(255,0,0))+Chr(10)+Str(RGB(0,255,255))+Chr(10)+Str(RGB(25,25,25)))
      AddGadgetItem(#listicon,2,Str(RGB(0,255,0))+Chr(10)+Str(RGB(255,255,0))+Chr(10)+Str(RGB(50,50,50)))
      AddGadgetItem(#listicon,3,Str(RGB(0,0,255))+Chr(10)+Str(RGB(255,0,255))+Chr(10)+Str(RGB(75,75,75)))
      AddGadgetItem(#listicon,4,Str(RGB(255,0,255))+Chr(10)+Str(RGB(0,0,255))+Chr(10)+Str(RGB(100,100,100)))
      AddGadgetItem(#listicon,5,Str(RGB(255,255,0))+Chr(10)+Str(RGB(0,255,0))+Chr(10)+Str(RGB(150,150,150)))
      AddGadgetItem(#listicon,6,Str(RGB(0,255,255))+Chr(10)+Str(RGB(255,0,0))+Chr(10)+Str(RGB(200,200,200)))
      AddGadgetItem(#listicon,7,Str(RGB(100,100,100))+Chr(10)+Str(RGB(0,0,0))+Chr(10)+Str(RGB(255,255,255)))
      
      AddGadgetItem(#panel,1,"Listview")
      
      ListViewGadget(#listview,5,5,385,370,#LBS_OWNERDRAWFIXED)
      AddGadgetItem(#listview,0,Str(RGB(0,0,0)))
      AddGadgetItem(#listview,1,Str(RGB(255,0,0)))
      AddGadgetItem(#listview,2,Str(RGB(0,255,0)))
      AddGadgetItem(#listview,3,Str(RGB(0,0,255)))
      AddGadgetItem(#listview,4,Str(RGB(255,0,255)))
      AddGadgetItem(#listview,5,Str(RGB(255,255,0)))
      AddGadgetItem(#listview,6,Str(RGB(0,255,255)))
      AddGadgetItem(#listview,7,Str(RGB(100,100,100)))
      
      AddGadgetItem(#panel,2,"PanelGadget")
      
      PanelGadget(#od_panel,5,5,385,370)
      old_style=GetWindowLong_(GadgetID(#od_panel),#GWL_STYLE)
      SetWindowLong_(GadgetID(#od_panel),#GWL_STYLE,old_style | #TCS_OWNERDRAWFIXED)
      AddGadgetItem(#od_panel,0,"Panel 1")
      AddGadgetItem(#od_panel,1,"Panel 2")
      AddGadgetItem(#od_panel,2,"Panel 3")
      CloseGadgetList()
      
      AddGadgetItem(#panel,3,"ComboGadget & Others")
      
      ComboBoxGadget(#combo,5,5,385,100,#CBS_OWNERDRAWFIXED)
      AddGadgetItem(#combo,0,Str(RGB(0,0,0)))
      AddGadgetItem(#combo,1,Str(RGB(255,0,0)))
      AddGadgetItem(#combo,2,Str(RGB(0,255,0)))
      AddGadgetItem(#combo,3,Str(RGB(0,0,255)))
      AddGadgetItem(#combo,4,Str(RGB(255,0,255)))
      AddGadgetItem(#combo,5,Str(RGB(255,255,0)))
      AddGadgetItem(#combo,6,Str(RGB(0,255,255)))
      AddGadgetItem(#combo,7,Str(RGB(100,100,100)))
      
      ButtonGadget(#button,5,35, 190,200,"TEST",#BS_OWNERDRAW)
      TextGadget(#text,200,35,190,200,"TEST",#PB_Text_Border|#SS_OWNERDRAW)
      CloseGadgetList()
      
    EndIf
  EndIf
EndProcedure


Open_mainwindow()
Procedure.l callback(WindowID, Message, wParam, lParam)
  mygadget.PBDrawingstruct
  Result = #PB_ProcessPureBasicEvents
  Select Message
    
    ;listicongadget
    Case #WM_NOTIFY
      *ptr.NMLVCUSTOMDRAW=lparam
      If lparam
        Select *ptr\nmcd\hdr\code
          Case #NM_CUSTOMDRAW
            Select *ptr\nmcd\dwDrawStage
              Case #CDDS_PREPAINT
                result=#CDRF_NOTIFYITEMDRAW
              Case #CDDS_ITEMPREPAINT
                result=#CDRF_NOTIFYSUBITEMDRAW
              Case #CDDS_SUBITEMPREPAINT
                Row.l = *ptr\nmcd\dwItemSpec
                Col.l = *ptr\iSubItem
                rc.RECT:rc\left=#LVIR_BOUNDS:rc\top=col:SendMessage_(*ptr\nmcd\hdr\hwndfrom,#LVM_GETSUBITEMRECT,*ptr\nmcd\dwItemSpec,@rc)
                x=rc\left
                y=rc\top
                w=rc\right-rc\left
                h=rc\bottom-rc\top
                mydraw\WindowHandle=*ptr\nmcd\hdr\hwndfrom
                mydraw\type=1
                color=Val(GetGadgetItemText(#listicon,row,col))
                StartDrawing(mydraw)
                DrawingMode(0):Box(x,y,w,h,color)
                StopDrawing()
                result=#CDRF_SKIPDEFAULT
            EndSelect
        EndSelect
      EndIf
      
      
      
    Case #WM_MEASUREITEM
      Debug hmenu
      Debug wparam
      
      result=#True
      
      
    Case #WM_DRAWITEM
      *lpdis.DRAWITEMSTRUCT=lparam
      x=*lpdis\rcItem\left
      y=*lpdis\rcItem\top
      w=*lpdis\rcItem\right-*lpdis\rcItem\left
      h=*lpdis\rcItem\bottom-*lpdis\rcItem\top
      
      Select *lpdis\CtlType
        
        Case #ODT_STATIC
          mydraw\WindowHandle=*lpdis\hwndItem
          StartDrawing(mydraw)
          DrawingMode(0):Box(x,y,w,h,RGB(Random(255),Random(255),Random(255)))

          DrawText(10,h/2,"Ownerdraw Textgadget")
          StopDrawing()
          result=#True
          
          ;PanelGadget
        Case #ODT_TAB
          If *lpdis\hwndItem=GadgetID(#od_panel)
            mydraw\WindowHandle=*lpdis\hwndItem
            StartDrawing(mydraw)
            DrawingMode(0):Box(x+2,y+2,w-4,h-4,RGB(Random(255),Random(255),Random(255)))
            StopDrawing()
            result=#True
          EndIf
          
          ;buttongadget
        Case #ODT_BUTTON
          mydraw\WindowHandle=*lpdis\hwndItem
          StartDrawing(mydraw)
          DrawingMode(0):Box(x,y,w,h,RGB(Random(255),Random(255),Random(255)))
          DrawText(10,h/2,"Ownerdraw Button")
          StopDrawing()
          result=#True
          
          ;listviewgadget
        Case #ODT_LISTBOX
          buffer.s=Space(255):SendMessage_(GadgetID(#listview),#LB_GETTEXT,*lpdis\itemID,@buffer):col=Val(buffer)
          mydraw\WindowHandle=*lpdis\hwndItem
          StartDrawing(mydraw)
          Select *lpdis\itemaction
            Case #ODA_SELECT
              Box(x,y,w,h,col)
            Case #ODA_FOCUS
              DrawingMode(2 | 4):Box(x+1,y+1,w-1,h-1,0):DrawingMode(0)
            Case #ODA_DRAWENTIRE
              Box(x,y,w,h,col)
          EndSelect
          StopDrawing()
          result=#True
          
          ;combogadget           
        Case #ODT_COMBOBOX
          Select *lpdis\hwndItem
            
            Case GadgetID(#combo)
              mydraw\WindowHandle=WindowFromDC_(*lpdis\hdc)
              If *lpdis\itemID=-1
              Else
                Buffer=Space(255):SendMessage_(GadgetID(#combo),#CB_GETLBTEXT,*lpdis\itemID,@Buffer)
                Col=Val(Buffer)
                StartDrawing(mydraw)
                Select *lpdis\itemAction
                  Case #ODA_SELECT
                    Box(x,y,w,h,Col)
                  Case #ODA_FOCUS
                    DrawingMode(2 | 4):Box(x+1,y+1,w-1,h-1,0):DrawingMode(0)
                  Case #ODA_DRAWENTIRE
                    Box(x,y,w,h,Col)
                EndSelect
                StopDrawing()
                Result=#True
              EndIf
              
          EndSelect
          
      EndSelect
  EndSelect
  
  
  ProcedureReturn Result
EndProcedure
SetWindowCallback(@callback())

Repeat
  Event = WaitWindowEvent()
Until Event = #PB_Event_CloseWindow
End

Code : Tout sélectionner

; Structure NMCUSTOMDRAW 
;     hdr.NMHDR 
;     dwDrawStage.l 
;     hdc.l 
;     rc.RECT 
;     dwItemSpec.l 
;     uItemState.l 
;     lItemlParam.l 
; EndStructure 

; Structure NMLVCUSTOMDRAW 
;     nmcd.NMCUSTOMDRAW 
;     clrText.l 
;     clrTextBk.l 
;     iSubItem.l 
;     dwItemType.l 
;     clrFace.l 
;     iIconEffect.l 
;     iIconPhase.l 
;     iPartId.l 
;     iStateId.l 
;     rcText.RECT 
;     uAlign.l 
; EndStructure 

#NM_CUSTOMDRAW = #NM_FIRST-12 

#CDDS_ITEM = $10000 
#CDDS_SUBITEM = $20000 
#CDDS_PREPAINT = $1 
#CDDS_ITEMPREPAINT = #CDDS_ITEM|#CDDS_PREPAINT 
#CDDS_SUBITEMPREPAINT = #CDDS_SUBITEM|#CDDS_ITEMPREPAINT 
#CDRF_DODEFAULT = $0 
#CDRF_NEWFONT = $2 
#CDRF_NOTIFYITEMDRAW = $20 
#CDRF_NOTIFYSUBITEMDRAW = $20 

; Structure LVHITTESTINFO 
;   pt.POINT 
;   flags.l 
;   iItem.l 
;   iSubItem.l 
; EndStructure 

#LVM_SUBITEMHITTEST = #LVM_FIRST+57 
#LVM_GETSUBITEMRECT = #LVM_FIRST+56 

Global ListGadget, OldLViewProc, OldEditProc, hEdit, rct.RECT, CellSelectOn, CurItem, CurSubItem, CurSelItem, CurSelSubItem 

Declare EditProc(hWnd, uMsg, wParam, lParam) 
Declare LViewProc(hWnd, uMsg, wParam, lParam) 
Declare WndProc(hWnd, uMsg, wParam, lParam) 
Declare KillFocus() 
Declare DrawRectangle(hWnd, *rc.RECT) 

#CCM_SETVERSION = #CCM_FIRST+7 

Global FontReg, FontBold 
FontReg = LoadFont(1, "Tahoma", 9) 
FontBold = LoadFont(2, "Tahoma", 9, #PB_Font_Bold) 

If OpenWindow(0, 0, 0, 400, 260, "Color List View Rows", #PB_Window_ScreenCentered|#PB_Window_SystemMenu)=0:End:EndIf 
If CreateGadgetList(WindowID(0))=0:End:EndIf 

ListGadget = ListIconGadget(1, 10, 10, 380, 240, "", 70, #PB_ListIcon_GridLines|#LVS_NOSORTHEADER) 

SendMessage_(ListGadget, #CCM_SETVERSION, 5, 0) 

AddGadgetColumn(1, 1, "Sun", 35) 
AddGadgetColumn(1, 2, "Mon", 35) 
AddGadgetColumn(1, 3, "Tue", 35) 
AddGadgetColumn(1, 4, "Wed", 35) 
AddGadgetColumn(1, 5, "Thu", 35) 
AddGadgetColumn(1, 6, "Fri", 35) 
AddGadgetColumn(1, 7, "Sat", 35) 

For i=18 To 34 
  hour12 = i 
  If hour12>25 
    hour12-24 
    Hour$ = " pm" 
  Else 
    Hour$ = " am" 
  EndIf 
  If hour12&1 
    Hour$=LSet(Str(hour12/2)+":30"+Hour$, 9, " ") 
  Else 
    Hour$=LSet(Str(hour12/2)+":00"+Hour$, 9, " ") 
  EndIf 
  AddGadgetItem(1, -1, Hour$+Chr(10)+Str(hour12/2)+"1"+Chr(10)+Str(hour12/2)+"2"+Chr(10)+Str(hour12/2)+"3"+Chr(10)+Str(hour12/2)+"4"+Chr(10)+Str(hour12/2)+"5"+Chr(10)+Str(hour12/2)+"6"+Chr(10)+Str(hour12/2)+"7") 
Next i 

SendMessage_(ListGadget, #LVM_SETBKCOLOR, 0, RGB(255, 255, 223)) 

CreateGadgetList(ListGadget) 
OldLViewProc = SetWindowLong_(ListGadget, #GWL_WNDPROC, @LViewProc()) 
SetWindowCallback(@WndProc()) 

For i=0 To 7 
  SendMessage_(ListGadget, #LVM_SETCOLUMNWIDTH, i, #LVSCW_AUTOSIZE_USEHEADER) 
Next i 

Repeat 
Until WaitWindowEvent()=#PB_Event_CloseWindow 

End 

Procedure LoWord(value) 
  ProcedureReturn value & $FFFF 
EndProcedure 

Procedure HiWord(value) 
  ProcedureReturn value >> 16 & $FFFF 
EndProcedure 
 
Procedure KillFocus() 
  If hEdit 
    SetGadgetItemText(1, CurItem, GetGadgetText(2), CurSubItem) 
    FreeGadget(2) 
    hEdit = 0 
  EndIf 
EndProcedure 

Procedure DrawRectangle(hWnd, *rc.RECT) 
  hDC = GetDC_(hWnd) 
  OldPen = SelectObject_(hDC, GetStockObject_(#BLACK_PEN)) 
  OldBrush = SelectObject_(hDC, GetStockObject_(#NULL_BRUSH)) 
  Rectangle_(hDC, *rc\left, *rc\top, *rc\right, *rc\bottom) 
  SelectObject_(hDC, OldBrush) 
  SelectObject_(hDC, OldPen) 
  ReleaseDC_(hWnd, hDC) 
EndProcedure 

Procedure EditProc(hWnd, uMsg, wParam, lParam) 
  result = 0 
  Select uMsg 
    Case #WM_KEYDOWN 
      result = CallWindowProc_(OldEditProc, hWnd, uMsg, wParam, lParam) 
      If wParam=#VK_RETURN 
        KillFocus() 
      EndIf 
    Default 
      result = CallWindowProc_(OldEditProc, hWnd, uMsg, wParam, lParam) 
  EndSelect 
  ProcedureReturn result 
EndProcedure 

Procedure LViewProc(hWnd, uMsg, wParam, lParam) 
  result = 0 
  Select uMsg 
    Case #WM_LBUTTONDBLCLK 
      If hWnd<>hEdit 
        KillFocus() 
        pInfo.LVHITTESTINFO 
        pInfo\pt\x = LoWord(lParam) 
        pInfo\pt\y = HiWord(lParam) 
        SendMessage_(hWnd, #LVM_SUBITEMHITTEST, 0, pInfo) 
        rc.RECT 
        rc\top = pInfo\iSubItem 
        rc\left = #LVIR_BOUNDS 
        SendMessage_(hWnd, #LVM_GETSUBITEMRECT, pInfo\iItem, rc) 
        If hEdit=0 
          UseGadgetList(hWnd) 
          CurItem = pInfo\iItem 
          CurSubItem = pInfo\iSubItem 
          Text$ = GetGadgetItemText(1, CurItem, CurSubItem) 
          If CurSubItem=0 
            rc\right = rc\left+SendMessage_(hWnd, #LVM_GETCOLUMNWIDTH, 0, 0) 
          EndIf 
          hEdit = StringGadget(2, rc\left+1, rc\top, rc\right-rc\left-1, rc\bottom-rc\top-1, Text$, #PB_String_BorderLess) 
          If CurSubItem=0 
            SendMessage_(hEdit, #WM_SETFONT, FontBold, #True) 
          Else 
            SendMessage_(hEdit, #WM_SETFONT, FontReg, #True) 
          EndIf 
          OldEditProc = SetWindowLong_(hEdit, #GWL_WNDPROC, @EditProc()) 
          SetFocus_(hEdit) 
        EndIf 
      Else 
        result = CallWindowProc_(OldLViewProc, hWnd, uMsg, wParam, lParam) 
      EndIf 
    Case #WM_LBUTTONDOWN 
      If hWnd<>hEdit 
        KillFocus() 
        pInfo.LVHITTESTINFO 
        pInfo\pt\x = LoWord(lParam) 
        pInfo\pt\y = HiWord(lParam) 
        SendMessage_(hWnd, #LVM_SUBITEMHITTEST, 0, pInfo) 
        rc.RECT 
        rc\top = pInfo\iSubItem 
        rc\left = #LVIR_BOUNDS 
        SendMessage_(hWnd, #LVM_GETSUBITEMRECT, pInfo\iItem, rc) 
        rc\left+1 
        rc\bottom-1 
        If CellSelectOn 
          InvalidateRect_(hWnd, rct, #TRUE) 
        EndIf 
        CellSelectOn = 1 
        CurSelItem = pInfo\iItem 
        CurSelSubItem = pInfo\iSubItem 
        If CurSelSubItem=0 
          rc\right = rc\left+SendMessage_(hWnd, #LVM_GETCOLUMNWIDTH, 0, 0) 
        EndIf 
        DrawRectangle(hWnd, rc) 
        CopyMemory(rc, rct, SizeOf(RECT)) 
      Else 
        SetFocus_(hEdit) 
        result = CallWindowProc_(OldLViewProc, hWnd, uMsg, wParam, lParam) 
      EndIf 
    Case #WM_CTLCOLOREDIT 
      If GetFocus_()=lParam 
        SetBkMode_(wParam, #TRANSPARENT) 
        If CurItem&1=0 
          TextBkColor = RGB(255, 255, 223) 
          If CurSubItem=3 
            TextColor = RGB(255, 0, 0) 
          EndIf 
        Else 
          TextBkColor = RGB(208, 208, 176) 
          If CurSubItem=3 
            TextColor = RGB(0, 0, 255) 
          EndIf 
        EndIf 
        SetTextColor_(wParam, TextColor) 
        result = CreateSolidBrush_(TextBkColor) 
      Else 
        result = CallWindowProc_(OldLViewProc, hWnd, uMsg, wParam, lParam) 
      EndIf 
    Case #WM_VSCROLL 
      result = CallWindowProc_(OldLViewProc, hWnd, uMsg, wParam, lParam) 
      rc.RECT 
      TopVisibleItem = SendMessage_(hWnd, #LVM_GETTOPINDEX, 0, 0) 
      If CellSelectOn 
        rc\top = CurSelSubItem 
        rc\left = #LVIR_BOUNDS 
        SendMessage_(hWnd, #LVM_GETSUBITEMRECT, CurSelItem, rc) 
        rct\top = rc\top 
        rct\bottom = rc\bottom-1 
        If TopVisibleItem<=CurSelItem 
          DrawRectangle(hWnd, rct) 
        EndIf 
      EndIf 
      If hEdit 
        If TopVisibleItem<=CurItem 
          ResizeGadget(2, -1, rc\top, -1, -1) 
          HideGadget(2, #FALSE) 
          RedrawWindow_(hEdit, 0, 0, #RDW_INTERNALPAINT|#RDW_ERASE|#RDW_INVALIDATE) 
        Else 
          HideGadget(2, #TRUE) 
        EndIf 
        SetFocus_(hEdit) 
      EndIf 
    Case #WM_HSCROLL 
      result = CallWindowProc_(OldLViewProc, hWnd, uMsg, wParam, lParam) 
      rc.RECT 
      TopVisibleItem = SendMessage_(hWnd, #LVM_GETTOPINDEX, 0, 0) 
      If CellSelectOn 
        rc\top = CurSelSubItem 
        rc\left = #LVIR_BOUNDS 
        SendMessage_(hWnd, #LVM_GETSUBITEMRECT, CurSelItem, rc) 
        rct\left = rc\left+1 
        rct\right = rc\right 
        If TopVisibleItem<=CurSelItem 
          DrawRectangle(hWnd, rct) 
        EndIf 
      EndIf 
      If hEdit 
        If TopVisibleItem<=CurItem 
          ResizeGadget(2, rc\left, -1, -1, -1) 
          HideGadget(2, #FALSE) 
          RedrawWindow_(hEdit, 0, 0, #RDW_INTERNALPAINT|#RDW_ERASE|#RDW_INVALIDATE) 
        Else 
          HideGadget(2, #TRUE) 
        EndIf 
        SetFocus_(hEdit) 
      EndIf 
    Default 
      result = CallWindowProc_(OldLViewProc, hWnd, uMsg, wParam, lParam) 
  EndSelect 
  ProcedureReturn result 
EndProcedure 

Procedure WndProc(hWnd, uMsg, wParam, lParam) 
  result = #PB_ProcessPureBasicEvents 
  Select uMsg 
    Case #WM_NOTIFY 
      *pnmh.NMHDR = lParam 
      Select *pnmh\code 
        Case #NM_CUSTOMDRAW 
          *LVCDHeader.NMLVCUSTOMDRAW = lParam 
          If *LVCDHeader\nmcd\hdr\hWndFrom=ListGadget 
            Select *LVCDHeader\nmcd\dwDrawStage 
              Case #CDDS_PREPAINT 
                result = #CDRF_NOTIFYITEMDRAW 
              Case #CDDS_ITEMPREPAINT 
                result = #CDRF_NOTIFYSUBITEMDRAW 
              Case #CDDS_SUBITEMPREPAINT 
                Row = *LVCDHeader\nmcd\dwItemSpec 
                Col = *LVCDHeader\iSubItem 
                If Col=0 
                  SelectObject_(*LVCDHeader\nmcd\hDC, FontBold) 
                Else 
                  SelectObject_(*LVCDHeader\nmcd\hDC, FontReg) 
                EndIf 
                If Row&1=0 
                  *LVCDHeader\clrTextBk = RGB(255, 255, 223) 
                  If Col=3 
                    *LVCDHeader\clrText = RGB(255, 0, 0) 
                  Else 
                    *LVCDHeader\clrText = RGB(0, 0, 0) 
                  EndIf 
                Else 
                  *LVCDHeader\clrTextBk = RGB(208, 208, 176) 
                  If Col=3 
                    *LVCDHeader\clrText = RGB(0, 0, 255) 
                  Else 
                    *LVCDHeader\clrText = RGB(0, 0, 0) 
                  EndIf 
                EndIf 
                result = #CDRF_NEWFONT 
            EndSelect 
          EndIf 
      EndSelect 
  EndSelect 
  ProcedureReturn result 
EndProcedure