PureBasic

Ce matin, alors que je fouillait dans l'excellent Cognitio, je me suis dit qu'il était honteux de piquer allègrement dans vos code en partageant relativement peu des miens. Alors voilà, je me met au partage de mes fonctions "utiles" en commençant par tout ce que j'ai qui peut permettre d'obtenir des applications plus "design" sous Windows (API oblige). Tout a été testé sur mes différentes machines, qui tournent sous XP et/ou 2003.

Notez bien que je ne revendique en aucun cas la paternité de ces codes! Il s'agit souvent de petites choses que j'ai récupérées et modifiées pour qu'elles correspondent plus à mes besoins. Si vous reconnaissez un de vos codes là dedans, n'hésitez pas à me prévenir pour que je vous donne le crédit ou que je le supprime (à votre choix)!

1] Skinner une fenêtre

Code : Tout sélectionner

Procedure SkinWindow(Window,Skin,Transparent_Color = #Magenta)
  Define Region,x1,y1,y2,Region_Temp,brush
  
  Region = CreateRectRgn_(0, 0, WindowWidth(Window) + 1, WindowHeight(Window) + 1)
  StartDrawing( ImageOutput (Skin))
    For x1 = 0 To WindowWidth(Window)-1
      For y1 = 0 To WindowHeight(Window)-1
        If Point(x1, y1) = Transparent_Color
          y2 = y1
          While y2 < WindowHeight(Window)-1 And Point(x1, y2 + 1) = Transparent_Color
            y2 + 1
          Wend
          Region_Temp = CreateRectRgn_(x1, y1, x1 + 1, y2 + 1)
          CombineRgn_ (Region, Region, Region_Temp, #RGN_DIFF )
          y1 = y2
        EndIf
      Next
    Next
  StopDrawing()
  SetWindowRgn_(WindowID(Window), Region, #True )
  brush=CreatePatternBrush_(ImageID(Skin))
  SetClassLong_(WindowID(Window),#GCL_HBRBACKGROUND,brush)
  InvalidateRect_(WindowID(Window),0,1)
EndProcedure

Cette fonction permet de skinner une fenêtre tout en la déformant. La forme de la fenêtre sera définie par l'image (par défaut, transparent_color est fixée sur 255,0,255).

Petit exemple pour l'utiliser:

Code : Tout sélectionner

#Skin = 0
#Window = 0
If LoadImage(#Skin,OpenFileRequester("Selection du skin","","Bitmap|*.bmp",0))
  OpenWindow(#Window,0,0,ImageWidth(0),ImageHeight(0),"Fenêtre skinée",#PB_Window_ScreenCentered|#PB_Window_BorderLess)
  SkinWindow(#Window,#Skin)
  Repeat
    
  Until WaitWindowEvent() = #PB_Event_CloseWindow
  FreeImage(0)
EndIf

Et une image pour se donner une idée d'une fenêtre avec une forme "spéciale":

Informations supplémentaires a écrit :Testé sur PB 4.30; c'est probablement incompatible avec le chanel Alpha des PNG qu'apporte PB4.40; je me pencherais dessus à l'occasion.

2] Skinner des boutons

Code : Tout sélectionner

#Enter           = #WM_APP+$100
#Leave           = #WM_APP+$101
#CB_Button_Click = #WM_APP+$102
#CB_SolidBrush   = -2

Procedure Monitor(hwnd)
  Protected cp1.POINT
  Protected cp2.POINT
  Define hRgn,lastbutton
  
  Repeat
    If IsWindowEnabled_(hwnd)
      If GetProp_(hwnd,"cb_status") = 2
        SetProp_(hwnd,"cb_status",0)
        If IsImage(GetProp_(hwnd,"cb_disab"))
          SetGadgetState(GetDlgCtrlID_(hwnd),ImageID(GetProp_(hwnd,"cb_cold")))
        EndIf
      EndIf
      hRgn = GetProp_(hwnd,"cb_region")
      GetCursorPos_(@cp1)
      GetCursorPos_(@cp2)
      MapWindowPoints_(0,hwnd,@cp1,1)
      If WindowFromPoint_(cp2\x|cp2\y<<32) = hwnd
        If PtInRegion_(hRgn,cp1\x,cp1\y)
          If GetProp_(hwnd,"cb_status") = 0 
            SetProp_(hwnd,"cb_status", 1)
            If lastbutton = 0 Or lastbutton = hwnd Or GetAsyncKeyState_(#VK_LBUTTON) & 32768 = 0
              PostMessage_(hwnd,#Enter,0,0)
              lastbutton = 0
            EndIf
          EndIf
        Else
          If GetProp_(hwnd,"cb_status") = 1
            SetProp_(hwnd,"cb_status", 0)
            PostMessage_(hwnd,#Leave,0,0)
            If GetAsyncKeyState_(#VK_LBUTTON) & 32768
              If lastbutton = 0
                lastbutton = hwnd
              EndIf
            Else
              lastbutton = 0
            EndIf
          EndIf
        EndIf
      Else
        If GetProp_(hwnd,"cb_status") = 1
          SetProp_(hwnd,"cb_status", 0)
          PostMessage_(hwnd,#Leave,0,0)
          If GetAsyncKeyState_(#VK_LBUTTON) & 32768
            If lastbutton = 0
              lastbutton = hwnd
            EndIf
          Else
            lastbutton = 0
          EndIf
        EndIf
      EndIf     
    Else
      If IsWindow_(hwnd)
        If IsWindowEnabled_(hwnd)=0
          SetProp_(hwnd,"cb_status",2)
          If IsImage(GetProp_(hwnd,"cb_disab"))
            SetGadgetState(GetDlgCtrlID_(hwnd),ImageID(GetProp_(hwnd,"cb_disab")))
          EndIf
        EndIf 
      EndIf 
    EndIf
    Delay(10)
  ForEver
EndProcedure

Procedure CustomButtonProc(hwnd, msg, wParam, lParam)
  Protected cp1.POINT
  Protected oldproc = GetProp_(hwnd,"cb_oldproc")
  Protected monitor_tid = GetProp_(hwnd, "cb_monitor_tid")
  Define hRgn, lastbutton
  hRgn = GetProp_(hwnd, "cb_region")
  GetCursorPos_(@cp1)
  MapWindowPoints_(0,hwnd,@cp1,1)   
  Select msg
    Case #WM_NCDESTROY
      If IsThread(monitor_tid)
        KillThread(monitor_tid)
        WaitThread(monitor_tid)
      EndIf
      RemoveProp_(hwnd, "cb_status")
      RemoveProp_(hwnd, "cb_disab")
      RemoveProp_(hwnd, "cb_cold")
      RemoveProp_(hwnd, "cb_warm")
      RemoveProp_(hwnd, "cb_hot")
      RemoveProp_(hwnd, "cb_parent")
      RemoveProp_(hwnd, "cb_oldproc")
      RemoveProp_(hwnd, "cb_region")
      RemoveProp_(hwnd, "cb_monitor_tid")
    Case #WM_LBUTTONDOWN
      If PtInRegion_(hRgn,cp1\x,cp1\y) 
        SetGadgetState(GetDlgCtrlID_(hwnd),ImageID(GetProp_(hwnd,"cb_hot")))
      EndIf
    Case #WM_LBUTTONUP
      If PtInRegion_(hRgn,cp1\x,cp1\y) 
        SetGadgetState(GetDlgCtrlID_(hwnd),ImageID(GetProp_(hwnd,"cb_warm")))
        If lastbutton = 0 Or lastbutton= hwnd
          PostMessage_(GetProp_(hwnd,"cb_parent"), #CB_Button_Click, GetDlgCtrlID_(hwnd), 0)
        EndIf
        lastbutton = 0
      EndIf
    Case #Enter
      If GetAsyncKeyState_(#VK_LBUTTON) & 32768
        SetGadgetState(GetDlgCtrlID_(hwnd),ImageID(GetProp_(hwnd,"cb_hot")))
      Else
        SetGadgetState(GetDlgCtrlID_(hwnd),ImageID(GetProp_(hwnd,"cb_warm")))
      EndIf
    Case #Leave
      SetGadgetState(GetDlgCtrlID_(hwnd),ImageID(GetProp_(hwnd,"cb_cold")))
  EndSelect
  ProcedureReturn CallWindowProc_(oldproc,hwnd,msg,wParam,lParam)
EndProcedure

Procedure GrabRegion(ImageID, TransColor)
  
  Structure RECTARRAY
    rect.RECT[0]
  EndStructure
  
  Protected bmp.BITMAP,width.l,height.l,hVisibleRgn.l,combineresult.l=0, returnvalue.l = 0
  Protected BmiInfo.BITMAPINFOHEADER,rowbytes.l,*ColorBits,hdc.l,iRes.l,Structure_Max.l
  Protected *Buffer.RGNDATAHEADER,*rd.RECTARRAY,rectcount.l,y.l,x.l,pxcount.l,*px.Long
  Protected transcount.l,firsttrans.l,RegionSize.l,hTransparentRgn.l
  
  If GetObject_(ImageID, SizeOf(BITMAP), @bmp.BITMAP) And bmp
    width = bmp\bmWidth
    height = bmp\bmHeight
    hVisibleRgn=CreateRectRgn_(0, 0, width, height)
    If hVisibleRgn
      With BmiInfo
        \biSize         = SizeOf(BITMAPINFOHEADER)
        \biWidth        = width
        \biHeight       = -height
        \biPlanes       = 1
        \biBitCount     = 32
        \biCompression  = #BI_RGB
      EndWith   
      rowbytes =  SizeOf(Long)*width
      *ColorBits = AllocateMemory(rowbytes*height)
      If *ColorBits
        hdc   = GetWindowDC_(#Null)
        If hdc
          iRes  = GetDIBits_(hdc, ImageID, 0, height, *ColorBits, @BmiInfo, #DIB_RGB_COLORS)
          If iRes
            ReleaseDC_(#Null, hdc)
            Structure_Max=(width*height*16)+SizeOf(RGNDATAHEADER)
            *Buffer=AllocateMemory(Structure_Max)
            If *Buffer
              *rd=*Buffer+SizeOf(RGNDATAHEADER)
              rectcount = 0
              For y=0 To height-1
                pxcount=0
                For x=0 To rowbytes-1 Step 4
                  *px = *ColorBits + rowbytes * y + x
                  If *px\l = TransColor
                    transcount = 1 : firsttrans = pxcount
                    x+SizeOf(Long) : *px.Long = *ColorBits + rowbytes * y + x
                    While *px\l = TransColor And x <= rowbytes-1
                      transcount+1 : pxcount+1 : x+SizeOf(Long)
                      *px = *ColorBits + rowbytes * y + x
                    Wend
                    x-SizeOf(Long) : *px.Long = *ColorBits + rowbytes * y + x
                    With *rd\rect[rectcount]
                      \left   = firsttrans           
                      \top    = y                     
                      \right  = firsttrans+transcount
                      \bottom = y+1     
                    EndWith
                    rectcount+1
                  EndIf
                  pxcount+1
                Next
              Next
              With *Buffer
                \dwSize         = SizeOf(RGNDATAHEADER)
                \iType          = #RDH_RECTANGLES
                \nCount         = rectcount
                \nRgnSize       = rectcount * SizeOf(RECT)
                \rcBound\left   = 0
                \rcBound\top    = 0
                \rcBound\right  = width
                \rcBound\bottom = height
              EndWith
              RegionSize=SizeOf(RGNDATAHEADER)+(rectcount * SizeOf(RECT))
              hTransparentRgn = ExtCreateRegion_(0, RegionSize, *Buffer)
              If hTransparentRgn
                combineresult = CombineRgn_(hVisibleRgn, hVisibleRgn, hTransparentRgn, #RGN_XOR)
                If combineresult = #SIMPLEREGION Or combineresult = #COMPLEXREGION
                  returnvalue = hVisibleRgn
                Else
                  returnvalue = 0
                EndIf
                DeleteObject_(hTransparentRgn)
              EndIf
              FreeMemory(*Buffer)
            EndIf
          EndIf
        EndIf
        FreeMemory(*ColorBits)
      EndIf
    EndIf
    DeleteObject_(bmp)
  EndIf
  ProcedureReturn returnvalue
EndProcedure

Procedure CustomButton(parent, button, x, y, w, h, image)
  Define disab, cold, warm, hot, mask, Region, tmp1, tmp2, dc, CustomButtonID, Handle, old, monitor_tid
  disab=GrabImage(image,#PB_Any, 0,   0, w, h)
  cold=GrabImage(image,#PB_Any, w,   0, w, h)
  warm=GrabImage(image, #PB_Any, w*2, 0, w, h)
  hot=GrabImage(image, #PB_Any, w*3, 0, w, h) 
  
  If w*5 = ImageWidth(image)
    mask=GrabImage(image, #PB_Any, w*4, 0, w, h)
    Region = GrabRegion(ImageID(mask), #Black)
  EndIf
  If Not Region
    Region = CreateRectRgn_(0,0,w,h)
  EndIf
  
  CustomButtonID = ImageGadget(button,x,y,w,h,ImageID(cold))
  If button=#PB_Any
    Handle = GadgetID(CustomButtonID)
  Else
    Handle = CustomButtonID
  EndIf
  
  old = SetWindowLong_(Handle, #GWL_WNDPROC, @CustomButtonProc())
  
  SetProp_(Handle,"cb_oldproc", old)
  SetProp_(Handle,"cb_status",0)
  SetProp_(Handle,"cb_disab",disab) 
  SetProp_(Handle,"cb_cold",cold)
  SetProp_(Handle,"cb_warm",warm)
  SetProp_(Handle,"cb_hot",hot)
  SetProp_(Handle,"cb_parent",parent)
  SetProp_(Handle,"cb_region",Region)
  
  monitor_tid = CreateThread(@Monitor(),Handle)
  SetProp_(Handle,"cb_monitor_tid",monitor_tid)
  
  ProcedureReturn CustomButtonID
  
EndProcedure

Cette fonction permet d'avoir des boutons skinnés. Les boutons réagissent aux états habituels de windows et peuvent avoir des formes variées (via l'option région).

Petit exemple pour l'utiliser:

Code : Tout sélectionner

#Image_Buttons = 0
#Button_0 = 0
#Button_1 = 1
#Button_2 = 2
UsePNGImageDecoder()
If LoadImage(#Image_Buttons,OpenFileRequester("Selection du button","","PNG|*.png",0))

  OpenWindow(0,0,0,400,150,"Test boutons",#PB_Window_ScreenCentered)
  
  CustomButton(WindowID(0),#Button_0,40,20,48,48,#Image_Buttons)
  CustomButton(WindowID(0),#Button_1,120,20,48,48,#Image_Buttons)
  CustomButton(WindowID(0),#Button_2,200,20,48,48,#Image_Buttons)
  DisableGadget(0,1)
  
  Repeat
    Select WaitWindowEvent()
      Case #CB_Button_Click
        Select EventwParam()
          Case #Button_1
            Debug "Bouton 1!"
          Case #Button_2
            Debug "Bouton 2!"
        EndSelect
      Case #WM_CLOSE
        FreeImage(#Image_Buttons)
        End
    EndSelect
  ForEver
EndIf

Et une image pour l'utiliser (avec transparence):

Informations supplémentaires a écrit :Uniquement PB4.40 et plus: on a besoin du support du chanel Alpha. Il est tout à fait utilisable avec le skin windows, il a même été pensé dans ce sens.

Autre détail: les boutons réagissent bizarrement dans un environnement multi-écran, quand ils sont ouvert dans un écran aillant des coordonnées négatives. Je comprends bien le pourquoi, mais je n'arrive pas à régler le problème...

3]Skinner une Progress Bar

Bon, j'ai un gros bug sur celle là, je la règlerais prochainement et on passe à la suite en attendant

4]Progresse Circle

Code : Tout sélectionner

Procedure ProgressCircle(gadgetNumber.l,x.l,y.l,Size.l,segments.l,bg.l)
  Protected radius.l,n.l,x2.l,y2.l,img.l, beta_in_rad.d
  
  img = CreateImage(#PB_Any,Size,Size)
  StartDrawing(ImageOutput(img))
    Box(0,0,Size,Size,bg)
    radius = Size/2
    Circle(radius,radius,radius)
    Circle(radius,radius,radius-8,bg)   
    
    For n = 0 To segments-1
      beta_in_rad = (2*#PI*n)/segments
      x2.l = radius *(1 + Cos(beta_in_rad))
      y2.l = radius *(1 + Sin(beta_in_rad))
      LineXY(radius,radius,x2,y2,bg)
    Next
    
  StopDrawing()
  ImageGadget(gadgetNumber,x,y,Size,Size,ImageID(img))
  SetGadgetData(gadgetNumber, img)
EndProcedure
Procedure SetProgressCircleState(progressbar.l,segments.l, State.l, color.l, bg.l)
  Static progCirc_font.l
  Protected IW2.l,TW2.l,TH2.l,x.l,y.l,sp_to_clear.l
  Protected img.l = GetGadgetData(progressbar)
  Protected beta_in_rad.d
  
  
  StartDrawing(ImageOutput(img))
    
    IW2.l = ImageWidth(img)/2
    State - 1
    beta_in_rad.d = (2*#PI*State)/segments - #PI/2
    x = IW2 + (IW2 - 4)*Cos(beta_in_rad)
    y = IW2 + (IW2 - 4)*Sin(beta_in_rad)
    If State < segments/4
      x + 2
      y + 2
    ElseIf State < segments/2
      x - 2
      y + 2
    ElseIf State < 3*segments/4
      x - 2
      y - 2
    Else
      x + 2
      y - 2
    EndIf
    
    FillArea(x,y,bg,color)
    
  StopDrawing()
  SetGadgetState(progressbar,ImageID(img))
  
  While WindowEvent():Wend
  ProcedureReturn 1
EndProcedure

Le progress circle, c'est comme une progress bar, mais en cercle (ahah). Ca a plusieurs avantages: premièrement, on est pas forcé d'indiquer une réel progression (en % par exemple), on peut juste l'animer pour montrer que le programme n'a pas freezé; pas d'inquiétudes, on on peut quand même s'en servir pour montrer une véritable progression. Deuxième avantage: c'est plus compacte qu'une barre: selon la gueule de votre application, ça peut être plus ou moins pratique de n'avoir à caser qu'un petit carré plutôt qu'une longue barre; et enfin, ça change de la barre et un peu de variété ne fait jamais de mal ^^.

Petit exemple pour s'en servir:

Code : Tout sélectionner

#Window_Processing = 0
#ProgressCircle = 0
#ProgressText = 1
OpenWindow(#Window_Processing,0,0,200,60,"Test du progress Circle",#PB_Window_SystemMenu|#PB_Window_ScreenCentered)
ProgressCircle(#ProgressCircle,5,5,50,8,$F1F1F1)
TextGadget(#ProgressText,60,22,135,15,"Processing",#PB_Text_Center)
      
temp$ = EventDropFiles()
      
r=10
g=150
b=10
Repeat
  For m= 1 To 8
    SetProgressCircleState(#ProgressCircle,8,m,RGB(r, g, b),$F1F1F1)
    Delay(100)
    WindowEvent()
  Next
  
  r+20
  g+25
  b+10
  If g>240
    r=10
    g=150
    b=10
  EndIf
ForEver

Informations supplémentaires a écrit :Niveau intégration dans une fenêtre skinnée, c'est pas encore ça, faudrait que je bosse la dessus (mais en ce moment, c'est pas ma priorité, faudra attendre un peu :p)

Aussi, mon exemple est un peu foireux. Pour l'utiliser correctement, il faut plaquer l'avancement du progress circle dans un thread; cela dit, je pense que l'exemple est assez parlant en soit et que vous saurez broder autour.

PureBasic

[Windows] design et autre joyeuseries.

[Windows] design et autre joyeuseries.