un extrait de code qui peut servir.
Il permet de dessiner un onglet avec du texte dedans.
Les bords sont arrondis
Besoin de ma librairie Effect
Si vous ne l'avez pas, il faut décommenter les 2 fonctions dans le code
Code : Tout sélectionner
; Auteur : Le Soldat Inconnu
; Version de PB : 4
;
; Explication du programme :
; Dessiner un onglet pour un logiciel
; Utilisation d'un code pour dessiner des cercles avec anti-aliazing
; Utilisation d'un code pour récupérer la police des fenêtres de Window
; Utilisation de la librairie Effect (Activer les 2 procédures en commentaire si vou n'avez pas cette librairie)
Procedure CircleAA(x, y, Radius, Color, Thickness = 1, Mode = #PB_2DDrawing_Default)
Protected n, nn, Distance.f, Application.f, Couleur_Fond.l
If Mode & #PB_2DDrawing_Outlined ; Cercle vide
; on dessine 1/4 du cercle et on duplique pour le reste
For n = 0 To Radius
For nn = 0 To Radius
Distance.f = Sqr(n * n + nn * nn)
If Distance <= Radius And Distance > Radius - 1
Application.f = Abs(Radius - 1 - Distance)
Couleur_Fond = Point(x + n, y + nn)
Plot(x + n, y + nn, ColorBlending(Couleur_Fond, Color, Application))
Couleur_Fond = Point(x - n, y + nn)
Plot(x - n, y + nn, ColorBlending(Couleur_Fond, Color, Application))
Couleur_Fond = Point(x + n, y - nn)
Plot(x + n, y - nn, ColorBlending(Couleur_Fond, Color, Application))
Couleur_Fond = Point(x - n, y - nn)
Plot(x - n, y - nn, ColorBlending(Couleur_Fond, Color, Application))
ElseIf Distance <= Radius - Thickness And Distance > Radius - Thickness - 1
Application.f = Abs(Radius - Thickness - Distance)
Couleur_Fond = Point(x + n, y + nn)
Plot(x + n, y + nn, ColorBlending(Couleur_Fond, Color, Application))
Couleur_Fond = Point(x - n, y + nn)
Plot(x - n, y + nn, ColorBlending(Couleur_Fond, Color, Application))
Couleur_Fond = Point(x + n, y - nn)
Plot(x + n, y - nn, ColorBlending(Couleur_Fond, Color, Application))
Couleur_Fond = Point(x - n, y - nn)
Plot(x - n, y - nn, ColorBlending(Couleur_Fond, Color, Application))
ElseIf Distance <= Radius - 1 And Distance > Radius - Thickness
Plot(x + n, y + nn, Color)
Plot(x - n, y + nn, Color)
Plot(x + n, y - nn, Color)
Plot(x - n, y - nn, Color)
EndIf
Next
Next
Else ; Cercle plein
; on dessine 1/4 du cercle et on duplique pour le reste
For n = 0 To Radius
For nn = 0 To Radius
Distance.f = Sqr(n * n + nn * nn)
If Distance <= Radius And Distance > Radius - 1
Application.f = 1 - (Radius - Distance)
Couleur_Fond = Point(x + n, y + nn)
Plot(x + n, y + nn, ColorBlending(Couleur_Fond, Color, Application))
Couleur_Fond = Point(x - n, y + nn)
Plot(x - n, y + nn, ColorBlending(Couleur_Fond, Color, Application))
Couleur_Fond = Point(x + n, y - nn)
Plot(x + n, y - nn, ColorBlending(Couleur_Fond, Color, Application))
Couleur_Fond = Point(x - n, y - nn)
Plot(x - n, y - nn, ColorBlending(Couleur_Fond, Color, Application))
ElseIf Distance <= Radius - 1
Plot(x + n, y + nn, Color)
Plot(x - n, y + nn, Color)
Plot(x + n, y - nn, Color)
Plot(x - n, y - nn, Color)
EndIf
Next
Next
EndIf
EndProcedure
Procedure.l LoadWindowFont(Bold = -1, Italic = -1, UnderLine = -1, Size.f = -1)
Protected ncm.NONCLIENTMETRICS
ncm\cbSize = SizeOf(NONCLIENTMETRICS)
SystemParametersInfo_(#SPI_GETNONCLIENTMETRICS, SizeOf(NONCLIENTMETRICS), @ncm, 0)
If Bold = 0
ncm\lfMessageFont\lfWeight = 0
ElseIf Bold = 1
ncm\lfMessageFont\lfWeight = 700
EndIf
If Italic = 0
ncm\lfMessageFont\lfItalic = 0
ElseIf Italic = 1
ncm\lfMessageFont\lfItalic = 1
EndIf
If UnderLine = 0
ncm\lfMessageFont\lfUnderline = 0
ElseIf UnderLine = 1
ncm\lfMessageFont\lfUnderline = 1
EndIf
If Size > 0
ncm\lfMessageFont\lfheight * Size
EndIf
ProcedureReturn CreateFontIndirect_(@ncm\lfMessageFont)
EndProcedure
;{ Librairie Effect
; ProcedureDLL.l ColorBlending(Couleur1.l, Couleur2.l, Echelle.f) ; Mélanger 2 couleurs
; Protected Rouge, Vert, Bleu, Rouge2, Vert2, Bleu2
;
; Rouge = Couleur1 & $FF
; Vert = Couleur1 >> 8 & $FF
; Bleu = Couleur1 >> 16
; Rouge2 = Couleur2 & $FF
; Vert2 = Couleur2 >> 8 & $FF
; Bleu2 = Couleur2 >> 16
;
; Rouge = Rouge * Echelle + Rouge2 * (1-Echelle)
; Vert = Vert * Echelle + Vert2 * (1-Echelle)
; Bleu = Bleu * Echelle + Bleu2 * (1-Echelle)
;
; ProcedureReturn (Rouge | Vert <<8 | Bleu << 16)
; EndProcedure
; ProcedureDLL.l ColorLuminosity(Couleur, Echelle.f) ; Eclaicir ou foncer une couleur
; Protected Rouge, Vert, Bleu
;
; Rouge = Couleur & $FF
; Vert = Couleur >> 8 & $FF
; Bleu = Couleur >> 16
; Rouge * Echelle
; Vert * Echelle
; Bleu * Echelle
;
; If Rouge > 255 : Rouge = 255 : EndIf
; If Vert > 255 : Vert = 255 : EndIf
; If Bleu > 255 : Bleu = 255 : EndIf
;
; ProcedureReturn (Rouge | Vert <<8 | Bleu << 16)
; EndProcedure
;}
; Création de la fenêtre et de la GadgetList
If OpenWindow(0, 0, 0, 300, 300, "Onglet", #PB_Window_SystemMenu | #PB_Window_ScreenCentered | #PB_Window_MinimizeGadget) = 0
End
EndIf
Police = LoadWindowFont(1, 0, 0, 1.4)
;- Création de l'image qui va contenir l'onglet
Largeur = 256
Hauteur = 32
Texte.s = "Texte de l'onglet"
CreateImage(0, Largeur, Hauteur)
StartDrawing(ImageOutput(0))
Box(0, 0, Largeur, Hauteur, GetSysColor_(#COLOR_3DFACE))
CircleAA(10, 10, 10, $000000)
CircleAA(10, 10, 9, $FFFFFF)
CircleAA(Largeur - 1 - 10, 10, 10, $000000)
CircleAA(Largeur - 1 - 10, 10, 9, $FFFFFF)
Box(11, 1, Largeur - 22, 20, $FFFFFF)
; Bord haut avec un petit effet
For x = 10 To Largeur - 10
Couleur = ColorLuminosity($999999, 4 *(x / Largeur - x * x / Largeur / Largeur))
Plot(x, 1, Couleur)
Next
Box(1, 10, Largeur - 2, 50, $FFFFFF)
For y = 10 To Hauteur - 1
; Bord gauche et droit en dégradé
Couleur = ColorBlending($FFFFFF, $000000, (y - 10) / 40)
Plot(1, y, Couleur)
Plot(Largeur - 2, y, Couleur)
; Fond en dégradé
Couleur = ColorBlending(GetSysColor_(#COLOR_3DFACE), $FFFFFF, (y - 10) / (Hauteur - 10))
Line(2, y, Largeur - 4, 0, Couleur)
Next
DrawingFont(Police)
DrawingMode(#PB_2DDrawing_Transparent)
DrawText((Largeur - TextWidth(Texte)) / 2, (Hauteur - TextHeight(Texte)) / 2, Texte)
StopDrawing()
ImageGadget(0, 10, 10, Largeur, Hauteur, ImageID(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
If Police
DeleteObject_(Police)
EndIf
