PureBasic

Code : Tout sélectionner

;MLD le 20/1/2012
;PB 4.60
InitSprite()
Enumeration
#fenstat = 1
EndEnumeration
Global drap = 0
Global largwinscrenn.l = 240
Global FontID2 = LoadFont(2,"Courier New",8 ,#PB_Font_HighQuality)
;nbligech.l = nb ligne de léchelle ligcoul = couleur des lignes etic = lettre aprés les chiffrs de ligne
;coulfond= couleur du fond x.l Emplacement du batonnet y.l hauteur de la grille dans le screen
;htbatmax.l = hauteur de la grille hbat.l = hauteur du batonnet coulbtf1 = couleur du batonnet face 1
;typebt.b type de batonnet hbat2.l= haut de recouvrement coulbtf2 = couleur de recouvrement
;hbat3.l = 2em hauteut de recouvrement ; coulbtf3 = 2em couleur de recouvrement
Procedure batstat(nbligech.l,ligcoul,etic.s,coulfond,x.l,y.l,htbatmax.l,htbat.l,coulbtf1,typebt.w,htbat2.l,coulbtf2 ,htbat3.l,coulbtf3)
hbat.l = htbat.l *2
hbat2.l = htbat2.l *2
hbat3.l = htbat3.l *2

If hbat.l > htbatmax:hbat = htbatmax : EndIf 
If hbat2.l > htbatmax :hbat2 = htbatmax : EndIf 
If hbat3.l > htbatmax :hbat3 = htbatmax : EndIf 

 
  Dim ps.l(8);face1
  ps(0)=40 : ps(1)=0
  ps(2)=40 : ps(3)= hbat.l
  ps(4)=0 :ps(5) = hbat.l

  Dim ps2.l(8);face2(coté)
  ps2(0)=10 : ps2(1)=-10
  ps2(2)=10 : ps2(3)= (hbat.l-10)
  ps2(4)=0 :ps2(5) = hbat.l

  Dim ps3.l(8);dessus
  ps3(0)=10 : ps3(1)=-10
  ps3(2)=50 : ps3(3)=-10
  ps3(4)=40 :ps3(5) = 0
 
 If typebt >1
  Dim ps4.l(8);nface2
  ps4(0)=40 : ps4(1)= 0
  ps4(2)=40 : ps4(3)= hbat2.l
  ps4(4)=0 :ps4(5) = hbat2.l

  Dim ps5.l(8);nface2(coté)
  ps5(0)= 10 : ps5(1)= -10
  ps5(2)=10 : ps5(3)= (hbat2.l - 10)
  ps5(4)=0 :ps5(5) = hbat2.l
 EndIf
 If typebt =3
  Dim ps6.l(8);nface3
  ps6(0)=40 : ps6(1)= 0
  ps6(2)=40: ps6(3)= hbat3.l
  ps6(4)=0: ps6(5) = hbat3.l 
  
  Dim ps7.l(8);nface3(coté)
  ps7(0)=10 : ps7(1)=-10
  ps7(2)=10 : ps7(3)= (hbat3.l - 10)
  ps7(4)=0 :ps7(5) = hbat3.l  
EndIf
;color le fond et trace l'échelle une fois seulement
If drap = 0
 ClearScreen(coulfond)
 drap = 1
StartDrawing(ScreenOutput())
;====echelle====
DrawingFont(FontID2)
htl = htbatmax /nbligech.l
For yz = 0 To nbligech.l
Line(5, (y-htbatmax) +(htl*yz) ,10,-10,ligcoul)
Line(15,  (y-htbatmax) + ((htl*yz)-10),largwinscrenn.l - 55,1,ligcoul)
DrawText(largwinscrenn.l - 38, (y-htbatmax) +((htl*yz)-17),Str(100-(yz*10)) + etic.s ,$0 ,coulfond)
Next
StopDrawing()
EndIf 
;====batonnets====
;calcul de la hauteur du batonnet dans le screen
   y.l = (y-hbat)
   hDC = StartDrawing(ScreenOutput())
   brush=CreateSolidBrush_(coulbtf1)
   pen=CreatePen_(PS_SOLID,0,$0)   
   SelectObject_(hDC,brush)
   SelectObject_(hDC,pen)
   SetWindowOrgEx_(hDC,-x,-y,#Null) ; Départ du batonnet
   Polygon_(hDC,@ps(0),5);face1

   brush2=CreateSolidBrush_(RGB(Red(coulbtf1)/2,Green(coulbtf1/2),Blue(coulbtf1/2)))
   SelectObject_(hDC,brush2)
   SetWindowOrgEx_(hDC,-(x+40),-y,#Null) 
   Polygon_(hDC,@ps2(0),5);face2(coté)

   SetWindowOrgEx_(hDC,-x,-y,#Null)
   Polygon_(hDC,@ps3(0),5);dessus
  
  If typebt >1
   ;calcul le recouvrement du batonnet principale
   y2.l = ((y+hbat)-hbat2)
   brush3=CreateSolidBrush_(coulbtf2)
   SelectObject_(hDC,brush3)
   SetWindowOrgEx_(hDC,-x,-y2 ,#Null) 
   Polygon_(hDC,@ps4(0),5);nface
   brush4=CreateSolidBrush_(RGB(Red(coulbtf2)/2,Green(coulbtf2/2),Blue(coulbtf2/2)))
   SelectObject_(hDC,brush4)
   SetWindowOrgEx_(hDC,-(x+40),-y2,#Null) 
   Polygon_(hDC,@ps5(0),5);nface2(coté)
  EndIf 

 If typebt = 3 
   ;2em calcul de recouvrement du batonnet principale
   y3.l = ((y+hbat)-(hbat2+hbat3))
   brush5=CreateSolidBrush_(coulbtf3)
   SelectObject_(hDC,brush5)
   SetWindowOrgEx_(hDC,-x,-y3 ,#Null) 
   Polygon_(hDC,@ps6(0),5);nface
   brush5=CreateSolidBrush_(RGB(Red(coulbtf3)/2,Green(coulbtf3/2),Blue(coulbtf3/2)))
   SelectObject_(hDC,brush5)
   SetWindowOrgEx_(hDC,-(x+40),-y3,#Null) 
   Polygon_(hDC,@ps7(0),5);nface2(coté) 
 EndIf
StopDrawing()

FreeArray(ps.l())
FreeArray(ps2.l())
FreeArray(ps3.l())
FreeArray(ps4.l())
FreeArray(ps5.l())
FreeArray(ps6.l())
FreeArray( ps7.l())
DeleteObject_(brush)
DeleteObject_(brush2)
DeleteObject_(brush3)
DeleteObject_(brush4)
DeleteObject_(brush5)
DeleteObject_(pen)
EndProcedure 
OpenWindow(#fenstat,0, 0, 500, 400, "Test", #PB_Window_SystemMenu | #PB_Window_ScreenCentered | #PB_Window_MinimizeGadget)
OpenWindowedScreen(WindowID(#fenstat),20, 20,largwinscrenn.l,280, 0,0,0)
batstat(10,$8C8C8C,".%",$C5C5C5,130,240,200,100,RGB(205, 100, 108),3,50,RGB(10,140,140),30,RGB(154,205,50))

batstat(10,$8C8C8C,".%",0,60,240,200,80,RGB(151, 203, 174),2,20,RGB(226, 124, 38),0,0)

Repeat
   Event = WaitWindowEvent()

   Select Event
      Case #PB_Event_Menu
      Select EventMenu() ; Menus

      EndSelect

      Case #PB_Event_Gadget
      Select EventGadget() ; Gadgets

      EndSelect
   EndSelect

Until Event = #PB_Event_CloseWindow
End