Code : Tout sélectionner
Structure MenuGadget
Array y0.f(0)
Array y.f(0)
index.i
count.i
xm.f
ym.f
pad.f
TextHeight.f
Menu.s
EndStructure
; Draw a single line of text with a vertical padding
Procedure.f DrawVectorLine(X.f, Y.f, Text.s, PaddingY.f, Color.q)
Protected hv.f, hoff.f, y0.f
Protected uline.f, bline.f
hv = VectorTextHeight(Text, #PB_VectorText_Visible)
hoff = VectorTextHeight(Text, #PB_VectorText_Visible | #PB_VectorText_Offset)
y0 = - hoff + PaddingY + Y
;Draw text
VectorSourceColor(Color)
MovePathCursor(x, y0)
DrawVectorText(Text)
;Draw outlines
; uline = PaddingY + Y
; bline = PaddingY + hv + Y
; MovePathCursor(x, uline)
; AddPathLine(450, uline)
; MovePathCursor(x, bline)
; AddPathLine(450, bline)
; StrokePath(1)
ProcedureReturn PaddingY + hv + Y
EndProcedure
; Draw a paragraph with line spacing
Procedure.f DrawTextMenu(X.f, Y.f, Text.s, PaddingY.f, Color.q, ColorLine.q = 0)
Protected *MenuGadget.MenuGadget = GetGadgetData(0)
Protected hv.f, hoff.f, y0.f
Protected uline.f, bline.f
Protected Count, i
Protected line$
count = CountString(Text, #LF$) + 1;:Debug count
line$ = StringField(Text, 1, #LF$)
hv = VectorTextHeight("ÎÇ", #PB_VectorText_Visible)
hoff = VectorTextHeight("ÎÇ", #PB_VectorText_Visible | #PB_VectorText_Offset)
y0 = - hoff + PaddingY + Y
With *MenuGadget
If \index = 0
ReDim \y0(count)
ReDim \y(count)
\y0(1) = y0
\y(1) = Y + PaddingY
\count = count
\Menu = Text
\xm = X
\ym = Y
\TextHeight = VectorTextHeight("ÎÇ")
EndIf
EndWith
;draw text
VectorSourceColor(Color)
MovePathCursor(x, y0)
DrawVectorText(line$)
; ;draw outlines
; uline = PaddingY + Y
; bline = PaddingY + hv + Y
; MovePathCursor(x, uline)
; AddPathLine(450, uline)
; MovePathCursor(x, bline)
; AddPathLine(450, bline)
; StrokePath(1)
For i = 2 To count
y + PaddingY + hv
line$ = StringField(Text, i, #LF$)
y0 = -hoff + PaddingY + Y
If *MenuGadget\index = 0
*MenuGadget\y0(i) = y0
*MenuGadget\y(i) = y
EndIf
;draw text
If line$
MovePathCursor(x, y0)
DrawVectorText(line$)
Else
;If the text to draw is "" and ColorLine>0 then draw a line
bline = PaddingY + hv / 2 + Y
If ColorLine
VectorSourceColor(ColorLine)
MovePathCursor(x, bline)
AddPathLine(VectorOutputWidth(), bline)
StrokePath(1)
VectorSourceColor(Color)
EndIf
EndIf
; ;draw outlines
; uline = PaddingY + Y
; bline = PaddingY + hv + Y
; MovePathCursor(x, uline)
; AddPathLine( VectorOutputWidth(), uline)
; MovePathCursor(x, bline)
; AddPathLine(VectorOutputWidth(), bline)
; StrokePath(1)
Next i
*MenuGadget\index = 1
hmax.f = PaddingY + hv + Y + 3
ProcedureReturn hmax
EndProcedure
Procedure Hover(Gadget, x.f, y.f, Menu.s, PaddingY.f, Font, FontSize, ColorHover.q = $FF800000, ColorLine.q = 0, Bkgcolor.q = $FFFFFFFF, TextHoverColor.q = $FFFFFFFF, TextColor.q = $FF000000, TextBkgcolor.q = $FF800000)
Protected *MenuGadget.MenuGadget = GetGadgetData(Gadget)
Protected mh
Protected m.f, y0.f, hh.f
Protected line$
mh = GetGadgetAttribute(Gadget, #PB_Canvas_MouseY ); -y-PaddingY
If mh < 0:mh = 0:EndIf
StartVectorDrawing(CanvasVectorOutput(Gadget))
VectorSourceColor(Bkgcolor)
FillVectorOutput()
VectorFont(FontID(Font), FontSize)
m = DrawTextMenu(X, Y, Menu, PaddingY, TextColor, ColorLine)
m - 3
hh = *MenuGadget\TextHeight
For i = 1 To *MenuGadget\count
If mh <= *MenuGadget\y(i)
Break
EndIf
Next i
i - 1
If i > 0
y0 = *MenuGadget\y0(i)
line$ = StringField(Menu, i, #LF$)
If line$
VectorSourceColor(Bkgcolor)
AddPathBox(0, y0, VectorOutputWidth(), hh)
FillPath()
VectorSourceColor(ColorHover)
AddPathBox(0, y0, VectorOutputWidth(), hh)
FillPath()
VectorSourceColor(TextHoverColor)
MovePathCursor(x, y0)
DrawVectorText(line$)
EndIf
EndIf
StopVectorDrawing()
EndProcedure
Procedure LClick()
Protected Gadget = EventGadget()
Protected *MenuGadget.MenuGadget = GetGadgetData(Gadget)
mh = GetGadgetAttribute(Gadget, #PB_Canvas_MouseY )
For i = 1 To *MenuGadget\count
If mh <= *MenuGadget\y(i)
Break
EndIf
Next i
i - 1
Debug StringField(*MenuGadget\Menu, i , #LF$)
Select i
Case 7
End
EndSelect
ProcedureReturn i
EndProcedure
If OpenWindow(0, 0, 0, 500, 450, "VectorDrawing", #PB_Window_SystemMenu | #PB_Window_ScreenCentered)
;LoadFont(0, "Monotype Corsiva", 20)
; LoadFont(0, "Times New Roman", 20)
LoadFont(0, "", 20)
; LoadFont(0, "Times New Roman", 20)
*MenuGadget.MenuGadget = AllocateMemory(SizeOf(MenuGadget))
InitializeStructure(*MenuGadget, MenuGadget)
Gadget = 0
Result = CanvasGadget(Gadget, 0, 0, 500, 450)
If Gadget = #PB_Any
Gadget = Result
EndIf
SetGadgetData(Gadget, *MenuGadget)
pad.f = 10
FontSize.f = 40
y.f = 0
x.f = 0
If StartVectorDrawing(CanvasVectorOutput(Gadget))
VectorFont(FontID(0), FontSize)
; Just a test with the procedure DrawVectorLine()
; ------------------------------------------------
; Menu = 0
; Texte$ = "Exemple"
; y = DrawVectorLine(0, 0, Texte$, pad, RGBA(0, 0, 0, 255))
; y = DrawVectorLine(0, y, "ÄÂÏÎÇ$g", pad, RGBA(0, 0, 0, 255))
; y = DrawVectorLine(0, y, Texte$, pad, RGBA(0, 0, 0, 255))
; DrawVectorLine(0, y, Texte$, pad, RGBA(0, 0, 0, 255))
;- Let's test the procedure DrawTextMenu()
; ------------------------------------------------------
Menu = 1
pad = 0;3
x = 20
y = 0
Menu$ = "New" + #LF$ + "Open" + #LF$ + "Save" + #LF$ + "Save as..." + #LF$ + "Close" + #LF$ + "" + #LF$ + "Quit"
;Menu$ = "NewÎÇ"+#LF$+"OpenÎÇ"+#LF$+"SaveÎÇ"+#LF$+"Save as...ÎÇ"+#LF$+"CloseÎÇ"+#LF$+""+#LF$+"QuitÎÇ"
hmax.f = DrawTextMenu(x, y, Menu$, pad, RGBA(0, 0, 0, 255), RGBA(128, 128, 200, 255))
StopVectorDrawing()
EndIf
If hmax
ResizeGadget(Gadget, #PB_Ignore, #PB_Ignore, #PB_Ignore, hmax)
EndIf
Repeat
Event = WaitWindowEvent()
Select Event
Case #PB_Event_Gadget
Select EventGadget()
Case Gadget
Select EventType()
Case #PB_EventType_MouseMove
If Menu
Hover(Gadget, x, y, Menu$, pad, 0, FontSize, $80800000, RGBA(128, 128, 200, 255))
EndIf
Case #PB_EventType_LeftClick
Debug LClick()
EndSelect
EndSelect
EndSelect
Until Event = #PB_Event_CloseWindow
EndIf