PureBasic

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