Active text on a 2DDrawing window

BackupUser · Post by **BackupUser** » Fri Oct 25, 2002 3:04 pm

Code updated for 5.20+

Restored from previous forum. Originally posted by fweil.

I post this sample code here (coming first from beginners section) as it looks interesting in featuring an active label in 2DDrawing. The label changes its color when moving the pointer over, and moves the window when clicking this text to drag it.

Code: Select all

#background = $602020

Procedure.l MyActiveLabel(Text.s, FontName.s, FontSize.l, Color1.l, Color2.l, x1.l, y1.l)
  Pt.POINT
  TextSize.POINT
  
  FontID.l = LoadFont(0, FontName, FontSize)
  
  StartDrawing(WindowOutput(0))
  DrawingFont(FontID)
  Result = GetTextExtentPoint32_(GetWindowDC_(WindowFromPoint_(Pt)), Text, Len(Text), TextSize)
  x2 = TextWidth(Text)
  y2 = FontSize * TextSize\y / 8
  WMX.l = WindowMouseX(0)
  WMY.l = WindowMouseY(0) - 20
  State.l = Bool(WMX > x1 And WMX <> y1 And WMY < (y1 + y2))
  Color.l = State * Color2 + (1 - State) * Color1
  FrontColor(RGB(Red(Color), Green(Color), Blue(Color)))
  DrawingMode(1)
  DrawText(x1, y1, Text)
  DrawingMode(4)
  Box(x1 - 2, y1, x2 + 2, y2, State * Color2 + (1 - State) * #background)
  StopDrawing()
  ProcedureReturn State
EndProcedure

Procedure MyWindowCallBack(WindowID.l, Message.l, wParam.l, lParam.l)
  Result.l = #PB_ProcessPureBasicEvents
  If Message = #PB_Event_Repaint Or Message = #PB_Event_MoveWindow
    StartDrawing(WindowOutput(0))
    DrawImage(ImageID(0), 0, 0)
    StopDrawing()
  EndIf
  ProcedureReturn Result 
EndProcedure

;
; Main starts here
;
Quit.l = #False
Over.l = #False
WindowXSize.l = 640
WindowYSize.l = 480

If OpenWindow(0, 640, 480, WindowXSize, WindowYSize, "MyWindow", #PB_Window_SystemMenu | #PB_Window_MinimizeGadget | #PB_Window_MaximizeGadget | #PB_Window_SizeGadget | #PB_Window_TitleBar)
  
  AddKeyboardShortcut(0, #PB_Shortcut_Escape, 99)
  SetWindowCallback(@MyWindowCallBack())
  
  If CreateImage(0, WindowXSize, WindowYSize)
    StartDrawing(ImageOutput(0))
      Box(0, 0, WindowXSize, WindowYSize, #background)
    
      For i.l = 1 To 1000
        ; Plot starts at ZERO so subtract one pixel...
        Plot(Random(WindowXSize - 1), Random(WindowYSize - 1), RGB(Random(256), Random(256), Random(256)))
      Next
    
    StopDrawing()
  EndIf
  
  StartDrawing(WindowOutput(0))
    DrawImage(ImageID(0), 0, 0)
  StopDrawing()
  
  Repeat
    Select WaitWindowEvent()
      Case #PB_Event_CloseWindow
        Quit = #True
        
      Case #PB_Event_Menu
        If EventMenu() = 99
          Quit = #True
        EndIf
        
      Case #WM_LBUTTONDOWN
        If Over1
          ReleaseCapture_()
          SendMessage_(WindowID(0), #WM_NCLBUTTONDOWN, #HTCAPTION, 0)
        EndIf
        
        Quit = Over2
        
        If Over3
          ShellExecute_(0,"open","http:\\[url]http://www.purebasic.com[/url]","","",#SW_SHOWNORMAL)
        EndIf
        
      Default
        Over1 = MyActiveLabel("The quick brown fox ....", "Arial", 24, #Yellow, #Red, WindowXSize / 2, WindowYSize / 2)
        Over2 = MyActiveLabel(".... jumps over the lazy dog!", "Courier", 10, #Green, #Blue, 20, 20)
        Over3 = MyActiveLabel("Do the best coding in Purebasic ...", "Times", 8, #Red, #Green, 100, 100)
        
    EndSelect
  Until Quit
  
EndIf

End

Francois Weil
14, rue Douer
F64100 Bayonne

BackupUser · Post by **BackupUser** » Fri Oct 25, 2002 5:14 pm

Restored from previous forum. Originally posted by plouf.

Hello fweil

#PB_EventRepaint and #WM_PAINT are the same you need only once to check once [;-0]

Christos

BackupUser · Post by **BackupUser** » Sat Oct 26, 2002 7:33 am

Restored from previous forum. Originally posted by fweil.

I am somtime stamming when coding !

Francois Weil
14, rue Douer
F64100 Bayonne

BackupUser · Post by **BackupUser** » Sat Oct 26, 2002 12:57 pm

Restored from previous forum. Originally posted by fweil.

I come back with this idea ... some updates to make a more generic way to code an active label in a 2D drawing.

Now you have a procedure MyActiveLabel(Text.s, FontName.s, FontSize.l, Color1.l, Color2.l, x1.l, y1.l) that make possible to put an active Text with a switching Color1/Color2 state, placed at location x1, y1, drawn using FontName and FontSize.

The procedure calculates the Text length and height in pixels to automate the MouseOver effect.

This procedure is a function returning 0 / 1 depending on the MouseOver status corresponding to the given label.

It is handy to manage events in the main event loop.

I found some difficulties to adapt the pointer position because of some differences between the window and drawing area pixels. If you change the window to a borderless one, you will have to change the y position processing.

...

Code: Select all

#background = $602020

Procedure.l MyActiveLabel(Text.s, FontName.s, FontSize.l, Color1.l, Color2.l, x1.l, y1.l)
Pt.POINT
TextSize.POINT
  StartDrawing(WindowOutput())
    FontID.l = LoadFont(0, FontName, FontSize)
    DrawingFont(FontID)
    Result = GetTextExtentPoint32_(GetWindowDC_(WindowFromPoint_(Pt\x, Pt\y)), Text, Len(Text), TextSize)
    x2 = TextLength(Text)
    y2 = FontSize * TextSize\y / 8
    WMX.l = WindowMouseX()
    WMY.l = WindowMouseY() - 20
    State.l = WMX > x1 And WMX  y1 And WMY < (y1 + y2)
    Color.l = State * Color2 + (1 - State) * Color1
    FrontColor(Red(Color), Green(Color), Blue(Color))
    DrawingMode(1)
    Locate(x1, y1)
    DrawText(Text)
    DrawingMode(4)
    Box(x1 - 2, y1, x2 + 2, y2, State * Color2 + (1 - State) * #background)
  StopDrawing()
  ProcedureReturn State
EndProcedure

Procedure MyWindowCallBack(WindowID.l, Message.l, wParam.l, lParam.l)
  Result.l = #PB_ProcessPureBasicEvents
  If Message = #PB_EventRepaint Or Message = #PB_EventMoveWindow
      StartDrawing(WindowOutput())
        DrawImage(UseImage(0), 0, 0)
      StopDrawing()
  EndIf
  ProcedureReturn Result  
EndProcedure

;
; Main starts here
;
  Quit.l = #FALSE
  Over.l = #FALSE
  WindowXSize.l = 640
  WindowYSize.l = 480
  If OpenWindow(0, 200, 200, WindowXSize, WindowYSize, #PB_Window_SystemMenu | #PB_Window_MinimizeGadget | #PB_Window_MaximizeGadget | #PB_Window_SizeGadget | #PB_Window_TitleBar, "MyWindow")
      AddKeyboardShortcut(0, #PB_Shortcut_Escape, 99)
      SetWindowCallback(@MyWindowCallBack())
      If CreateImage(0, WindowXSize, WindowYSize)
          ImageID.l = ImageID()
          StartDrawing(ImageOutput())
            Box(0, 0, WindowXSize, WindowYSize, #background)
            For i.l = 1 To 1000
              Plot(Random(WindowXSize), Random(WindowYSize), RGB(Random(256), Random(256), Random(256)))
            Next
          StopDrawing()
      EndIf
      StartDrawing(WindowOutput())
        DrawImage(UseImage(0), 0, 0)
      StopDrawing()
      Repeat
        Select WaitWindowEvent()
          Over1 = MyActiveLabel("The quick brown fox ....", "Arial", 24, #yellow, #red, WindowXSize / 2, WindowYSize / 2)
          Over2 = MyActiveLabel(".... jumps over the lazy dog!", "Courier", 10, #green, #blue, 20, 20)
          Over3 = MyActiveLabel("Do the best coding in Purebasic ...", "Times", 8, #red, #green, 100, 100)
          Case #PB_EventCloseWindow
            Quit = #TRUE
          Case #PB_EventMenu
            If EventMenuID() = 99
                Quit = #TRUE
            EndIf
          Case #WM_LBUTTONDOWN
            If Over1
                ReleaseCapture_()
                SendMessage_(WindowID(), #WM_NCLBUTTONDOWN, #HTCAPTION, 0)
            EndIf
            Quit = Over2
            If Over3
                shellexecute_(0,"open","http:\\[url]http://www.purebasic.com[/url]","","",#SW_SHOWNORMAL)
            EndIf
        EndSelect
      Until Quit
  EndIf
End

Francois Weil
14, rue Douer
F64100 Bayonne