Was working on my main project when Pantcho(!!) had a few more questions on this code. So... being naturally curious about programming, I added and changed a few things. This was all done quickly so it's not as elegant as it could be. Please forgive me
Code: Select all
Enumeration
#WindowMain
EndEnumeration
Enumeration
#ImageScroll
EndEnumeration
#ScrollWidth = 400
;- Global Variables
Dim ArrayScroll.s(2)
Global HandleImage.l
Global HandleTimer.l
Global PositionText.l
Global DoBounce.b
Global BounceDirection.b
Global PauseScroll.b
Global ScrollClick.POINT
Global IsFinishedDrawing.b
;- Procedures
Procedure.l ScrollCallback(HandleWindow.l, Message.l, EventID.l, dwTime.l)
;
lImage.l
;
lBrush.l
;
IsMouseOver.b
;
LastPosition.l
;
HoldPosition.POINT
;
BrushProperties.LOGBRUSH
; Brush properties - color, brush type.
HoldRect.RECT
; Rectangular coordinates used to fill shapes.
HyperRect.RECT
;
FontSize.l
;
CellFont.l
;
CellText.s
;
If IsFinishedDrawing
;
GetCursorPos_(@HoldPosition)
;
lHold = WindowFromPoint_(HoldPosition\X, HoldPosition\Y)
;
MapWindowPoints_(0, GadgetID(#ImageScroll), @HoldPosition, 1)
;
If lHold = GadgetID(#ImageScroll) : IsMouseOver = #True : EndIf
;
If PauseScroll : ProcedureReturn : EndIf
;
IsFinishedDrawing = #False
;
UseImage(HandleImage)
;
lImage = StartDrawing(ImageOutput())
;
BrushProperties\lbStyle = #BS_SOLID
BrushProperties\lbColor = RGB(0, 0, 0)
;
lBrush = CreateBrushIndirect_(BrushProperties)
;
SelectObject_(lImage, lBrush)
;
HoldRect\Left = 0 : HoldRect\Top = 0 : HoldRect\Right = WindowWidth() : HoldRect\Bottom = 100
;
FillRect_(lImage, HoldRect, lBrush)
;
DeleteObject_(lBrush) : lBrush = 0
;
SetTextColor_(lImage, RGB(255, 0, 0)) : SetBkMode_(lImage, #TRANSPARENT)
;
CellText = ArrayScroll(0)
;
FontSize = -Int((16 * GetDeviceCaps_(lImage, #LOGPIXELSY)) / 72)
; Using 28 as the height.
CellFont = CreateFont_(FontSize,0,0,0,0,0,0,0,#ANSI_CHARSET,#OUT_DEFAULT_PRECIS,#CLIP_DEFAULT_PRECIS,#PROOF_QUALITY,0,"Arial")
; Set any font formatting here. Italics, bold, whatever.
SelectObject_(lImage, CellFont)
;
DrawText_(lImage, @CellText, Len(CellText), @HoldRect, #DT_NOCLIP | #DT_NOPREFIX | #DT_SINGLELINE | #DT_CALCRECT)
;
MoveToEx_(lImage, PositionText, Int((GadgetHeight(#ImageScroll) - HoldRect\Bottom) / 2), 0)
;
DrawText_(lImage, @CellText, Len(CellText), @HoldRect, #DT_NOCLIP | #DT_NOPREFIX | #DT_SINGLELINE)
; Draw the column header.
DeleteObject_(CellFont)
;
LastPosition = PositionText + HoldRect\Right
;
SetRect_(@HoldRect, 0, 0, 0, 0)
;
;- Begin Hyperlink Drawing
If IsMouseOver And ArrayScroll(0) <> ""
;
SetTextColor_(lImage, RGB(0, 0, 255)) : SetBkMode_(lImage, #TRANSPARENT)
;
CellText = ArrayScroll(1)
;
CellFont = CreateFont_(FontSize,0,0,0,0,1,1,0,#ANSI_CHARSET,#OUT_DEFAULT_PRECIS,#CLIP_DEFAULT_PRECIS,#PROOF_QUALITY,0,"Arial")
; Set any font formatting here. Italics, bold, whatever.
SelectObject_(lImage, CellFont)
;
DrawText_(lImage, @CellText, Len(CellText), @HyperRect, #DT_NOCLIP | #DT_NOPREFIX | #DT_SINGLELINE | #DT_CALCRECT)
;
If (HoldPosition\X > LastPosition And HoldPosition\X < LastPosition + HyperRect\Right)
;
MoveToEx_(lImage, LastPosition, Int((GadgetHeight(#ImageScroll) - HyperRect\Bottom) / 2), 0)
;
DrawText_(lImage, @CellText, Len(CellText), @HyperRect, #DT_NOCLIP | #DT_NOPREFIX | #DT_SINGLELINE)
; Draw the column header.
If ScrollClick\X <> -1 And ScrollClick\Y <> -1 : RunProgram(ArrayScroll(1)) : EndIf
;
Else
;
IsMouseOver = #False
;
EndIf
;
DeleteObject_(CellFont)
;
EndIf
;
If IsMouseOver = #False Or ArrayScroll(0) = ""
;
SetTextColor_(lImage, RGB(255, 0, 0)) : SetBkMode_(lImage, #TRANSPARENT)
;
CellText = ArrayScroll(1)
;
CellFont = CreateFont_(FontSize,0,0,0,0,0,0,0,#ANSI_CHARSET,#OUT_DEFAULT_PRECIS,#CLIP_DEFAULT_PRECIS,#PROOF_QUALITY,0,"Arial")
; Set any font formatting here. Italics, bold, whatever.
SelectObject_(lImage, CellFont)
;
DrawText_(lImage, @CellText, Len(CellText), @HyperRect, #DT_NOCLIP | #DT_NOPREFIX | #DT_SINGLELINE | #DT_CALCRECT)
;
MoveToEx_(lImage, LastPosition, Int((GadgetHeight(#ImageScroll) - HyperRect\Bottom) / 2), 0)
;
DrawText_(lImage, @CellText, Len(CellText), @HyperRect, #DT_NOCLIP | #DT_NOPREFIX | #DT_SINGLELINE)
; Draw the column header.
DeleteObject_(CellFont)
;
EndIf
;
LastPosition + HyperRect\Right
;-
If ArrayScroll(2) <> ""
;
SetTextColor_(lImage, RGB(255, 0, 0)) : SetBkMode_(lImage, #TRANSPARENT)
;
CellText = ArrayScroll(2)
;
CellFont = CreateFont_(FontSize,0,0,0,0,0,0,0,#ANSI_CHARSET,#OUT_DEFAULT_PRECIS,#CLIP_DEFAULT_PRECIS,#PROOF_QUALITY,0,"Arial")
; Set any font formatting here. Italics, bold, whatever.
SelectObject_(lImage, CellFont)
;
DrawText_(lImage, @CellText, Len(CellText), @HoldRect, #DT_NOCLIP | #DT_NOPREFIX | #DT_SINGLELINE | #DT_CALCRECT)
;
MoveToEx_(lImage, LastPosition, Int((GadgetHeight(#ImageScroll) - HoldRect\Bottom) / 2), 0)
;
DrawText_(lImage, @CellText, Len(CellText), @HoldRect, #DT_NOCLIP | #DT_NOPREFIX | #DT_SINGLELINE)
; Draw the column header.
DeleteObject_(CellFont)
;
EndIf
;
LastPosition + HoldRect\Right
;
StopDrawing()
;
SetGadgetState(#ImageScroll, ImageID())
;
If DoBounce
; Bouncing between boundaries.
If BounceDirection
; Scrolling left.
If LastPosition = 0 : PositionText + 1 : BounceDirection = 0 : Else : PositionText -1 : EndIf
;
Else
; Scrolling light.
If LastPosition >= GadgetWidth(#ImageScroll) : PositionText - 1 : BounceDirection = 1 : Else : PositionText + 1 : EndIf
;
EndIf
;
Else
; Wrapping.
If LastPosition >= 0 : PositionText - 1 : Else : PositionText = GadgetWidth(#ImageScroll) : EndIf
; Move the text to the left for the next call.
EndIf
;
ScrollClick\X = -1 : ScrollClick\Y = -1
;
IsFinishedDrawing = #True
;
EndIf
;
EndProcedure
;
;- Main Code
;
EventID.l
; Variable to hold the window message.
DoQuit.b
; Variable to control whether we quit the window or not. Automatically set to #False.
lHold.l
;
HoldString.s
;
ArrayScroll(0) = "From Xombie! - Go to "
ArrayScroll(1) = "http://www.seijin.net/"
ArrayScroll(2) = " and be happy!"
;
If OpenWindow(#WindowMain, 0, 0, 650, 310, #PB_Window_MinimizeGadget | #PB_Window_MaximizeGadget | #PB_Window_ScreenCentered | #PB_Window_SystemMenu | #PB_Window_TitleBar | #PB_Window_SizeGadget, "xGrid")
; Create the main window.
If CreateGadgetList(WindowID())
;
AdvancedGadgetEvents(#True)
; Enable advanced gadget events.
HandleImage = CreateImage(#PB_Any, #ScrollWidth - 1, 40)
;
ImageGadget(#ImageScroll, 0, 0, #ScrollWidth - 1, 100, UseImage(HandleImage), #PB_Image_Border)
;
EndIf
;
IsFinishedDrawing = #True
;
PositionText = GadgetWidth(#ImageScroll)
;
HandleTimer = SetTimer_(0, 0, 1, @ScrollCallback())
;
Repeat
;
;{ Event Loop
EventID = WaitWindowEvent()
;
If EventID = #PB_Event_CloseWindow
; Close the program.
DoQuit = #True
;
ElseIf EventID = #PB_Event_SizeWindow
;
;
ElseIf EventID = #PB_Event_Menu
; Menu Events
;
ElseIf EventID = #PB_Event_Gadget
; Control Events
If EventGadgetID() = #ImageScroll
;
If EventType() = #PB_EventType_LeftClick
;
GetCursorPos_(@ScrollClick) : MapWindowPoints_(0, GadgetID(#ImageScroll), @ScrollClick, 1)
;
; If PauseScroll : PauseScroll = #False : Else : PauseScroll = #True : EndIf
;
ElseIf EventType() = #PB_EventType_RightClick
;
Hold01.s = InputRequester("Scroll Test", "Please enter the first part of the message. This will either be the whole message or the message before the hyperlink. If using a hyperlink, please leave a space after this string.", "")
;
Hold02.s = InputRequester("Scroll Test", "Please enter the web address. Leave blank if no web address is needed.", "http://www.seijin.net/")
;
Hold03.s = InputRequester("Scroll Test", "Please enter the text that follows the web address. Leave blank if no web address was used. If using a hyperlink, please use a space at the beginning of this string.", "")
;
ArrayScroll(0) = Hold01 : ArrayScroll(1) = Hold02 : ArrayScroll(2) = Hold03
;
; If DoBounce : DoBounce = #False : Else : DoBounce = #True : BounceDirection = #True : EndIf
;
EndIf
;
EndIf
;
EndIf
;}
;
Until DoQuit = #True
;
KillTimer_(0, HandleTimer)
;
EndIf
" part and it should pretend to be a kind of hyperlink. Click it and it should launch the link. There is an array to control what text is displayed - ArrayScroll(). ArrayScroll(0) is the text before the hyperlink. ArrayScroll(1) is the hyperlink. ArrayScroll(2) is the text after the hyperlink. Be sure to put a space at the end of ArrayScroll(0) and before in ArrayScroll(2) or it will look weird
There are two other behaviors that you can turn on. Look for these lines...
The commented DoBounce line will make the text bounce between the boundary when it is enabled (not tested with the hyperlink code, sorry). The commented PauseScroll line will pause the display when enabled. I have not tested the pause or bounce functions with the hyperlink because the hyperlink stuff was added on after Pantcho requested it
So to test the bounce and pause functions, comment the hyperlink functions in the left and right click events. You can test changing the displayed text by right-clicking in the image gadget.
And remember - this was a quick & dirty thing I slapped together for Mr. Pantcho(!!!!!!) so it's kinda ugly and could use some clean up. However, it's 1am and I have work tomorrow so...
... basically it adds an ArrayScroll(3) that you can use to store the actual website address. ArrayScroll(1) can now contain something more friendly if you want to hide the full website address. Also, the hyperlink is now always underlined so they know to click on it.
Oh, and you can always change #ScrollWidth if you want a different width for the scrolling text thingie.
