Sorry mate I don't want to hijack your thread
- Added Mouse wheel
- Right mouse click to Unlock the mouse
- Keyboard Return to Lock the mouse again
- No resize to eliminate the problems
Tested with PB 5.72 x86 - Windows 10 x64
Code: Select all
;**********************************************************************************************************************************************************************
; Thanks to :
;
; Dräc
; Graph100
; RASHAD
;**********************************************************************************************************************************************************************
#SpriteMax = 255
#FontMax = 15
Structure Char ;- struc Char
I.I ; Sprite
W.I
H.I
EndStructure
Structure Font ;- struc Font
I.I ; index de fonte
ID.I
Lap.I ; instant de chargement
Name.S
Size.I
Style.I
Char.Char[65536] ; numéro de sprite ; 65536 = Unicode available
EndStructure
Structure Window ;- struc Window
I.I ; Index
Xe.I ; external
Ye.I
Wi.I ; internal
Hi.I
Flags.I
Sticky.I
EndStructure
Structure Sprite ;- struc Sprite
I.I
W.I
H.I
EndStructure
Structure Screen ;- struc Screen
Devices.I
DevKeyboard.I
Handle.I
Window.Window
Gadget.I
Image.I
Sprite.Sprite[#SpriteMax + 1]
Lap.D
LapOld.D
LapDelta.D
DurationOS.I
WindowEvent.I
EventQuit.I
Font.Font[#FontMax + 1]
FontMask.I
ColorGndBack.I
Wmax.I
Hmax.I
Already.I
Page.I[256]
PageY.I[256]
PageH.I[256]
PageWrite.I ; Index de page en cours d'écriture
PageOffsetY.I
PageBottom.I
PageRead.I ; Index de page en cours de lecture
ScrollOffsetY.D
ScrollOffsetAccY.D
EndStructure
Procedure ScreenNewPage(*S.Screen, *X.Integer, *Y.Integer)
Define I.I
Define Dir.I
Define DataDirName.S = GetCurrentDirectory() + "ChannelP\"
Define FileName.S
With *S
*X\I = 0
*Y\I = 0
\PageWrite - 1
For I = 0 To \PageWrite
If IsSprite(\Page[I])
FreeSprite(\Page[I] )
EndIf
Next
\PageWrite = 0
\PageOffsetY = 0
If FileSize(DataDirName) = -1
CreateDirectory(DataDirName)
EndIf
If FileSize(DataDirName) = -2
Dir = ExamineDirectory(#PB_Any, DataDirName, "*.*")
While NextDirectoryEntry(Dir)
FileName = DirectoryEntryName(Dir)
If Left(FileName, 4) = "PAGE"
DeleteFile(FileName)
EndIf
Wend
EndIf
EndWith
EndProcedure
Procedure ScreenGrabPage(*S.Screen, *X.Integer, *Y.Integer)
Define FileName.S = GetCurrentDirectory() + "ChannelP\" + "PAGE"
With *S
\Page[\PageWrite] = GrabSprite(#PB_Any, 0, 0, \Window\Wi, \PageBottom, #PB_Sprite_AlphaBlending)
If IsSprite(\Page[\PageWrite])
SaveSprite(\Page[\PageWrite], FileName + Str(\PageWrite) + ".BMP")
EndIf
If \PageWrite > 1
If IsSprite(\Page[\PageWrite])
FreeSprite(\Page[\PageWrite] )
EndIf
EndIf
\PageY[\PageWrite] = \PageOffsetY
\PageH[\PageWrite] = \PageBottom
\PageOffsetY + \PageBottom
\PageWrite + 1
EndWith
EndProcedure
Procedure ScreenDisplayPage(*S.Screen)
Define DataDirName.S = GetCurrentDirectory() + "ChannelP\"
Define.I A, B, Max, I, J
With *S
If \ScrollOffsetY < 0
\ScrollOffsetY = 0
EndIf
Max = \PageY[\PageWrite - 1] + \PageH[\PageWrite - 1] - \Window\Hi
If \ScrollOffsetY => Max
\ScrollOffsetY = Max
EndIf
J = \PageRead
For I = 0 To \PageWrite - 2
If \ScrollOffsetY >= \PageY[I]
If \ScrollOffsetY < \PageY[I] + \PageH[I]
\PageRead = I
Break
EndIf
EndIf
Next
Select \PageRead - J
Case 0:
Case 1: FreeSprite(\Page[J] )
\Page[\PageRead + 1] = LoadSprite(#PB_Any, DataDirName + "PAGE" + Str(\PageRead + 1) + ".BMP")
Case -1: FreeSprite(\Page[J + 1] )
\Page[\PageRead] = LoadSprite(#PB_Any, DataDirName + "PAGE" + Str(\PageRead) + ".BMP")
Default
For I = J To J + 1
If IsSprite(\Page[I])
FreeSprite(\Page[I] )
EndIf
Next
For I = \PageRead To \PageRead + 1
\Page[I] = LoadSprite(#PB_Any, DataDirName + "PAGE" + Str(I) + ".BMP")
Next
EndSelect
If \PageWrite - 1 = 0
DisplaySprite(\Page[0], 0, 0)
Else
A = \PageRead
B = A + 1
DisplaySprite(\Page[A], 0, \PageY[A] - \ScrollOffsetY)
DisplaySprite(\Page[B], 0, \PageY[B] - \ScrollOffsetY)
EndIf
EndWith
EndProcedure
Procedure ScreenSetFont(*S.Screen, Font.I, Name.S, Size.I, Style.I = 0)
With *S\Font[Font]
\Name = Name
\Size = Size
\Style = Style
EndWith
EndProcedure
Procedure ScreenFreeFont(*S.Screen)
For Font = 0 To #FontMax
With *S\Font[Font]
If \I
If *S\Lap > \Lap + 1000
FreeFont(\I)
\I = 0
*S\FontMask ! (1 << Font) ; /!\
EndIf
EndIf
EndWith
Next
EndProcedure
Procedure ScreenLoadChar(*S.Screen, Font.I, Char.I)
Img = CreateImage(#PB_Any, 1, 1)
With *S\Font[Font]
If \I = 0
\I = LoadFont(#PB_Any, \Name, \Size, \Style)
\ID = FontID(\I)
\Lap = *S\Lap
*S\FontMask | (1 << Font)
EndIf
EndWith
With *S\Font[Font]\Char[Char]
If StartDrawing(ImageOutput(Img) )
DrawingFont(*S\Font[Font]\ID)
\W = TextWidth(Chr(Char) )
\H = TextHeight(Chr(Char) )
EndIf
StopDrawing()
\I = CreateSprite(#PB_Any, \W, \H, #PB_Sprite_AlphaBlending)
If StartDrawing(SpriteOutput(\I) )
DrawingFont(*S\Font[Font]\ID)
DrawingMode(#PB_2DDrawing_AllChannels)
DrawText(0, 0, Chr(Char), RGBA(0, 0, 0, 255), RGBA(255, 255, 255, 0) )
EndIf
StopDrawing()
EndWith
FreeImage(Img)
EndProcedure
Procedure ScreenDisplayChar(*S.Screen, *X.Integer, *Y.Integer, Char.I, Font.I, Color.I)
With *S\Font[Font]\Char[Char]
If \I = 0
ScreenLoadChar(*S, Font, Char)
EndIf
If *Y\I + \H > *S\Window\Hi
ScreenGrabPage(*S.Screen, *X, *Y)
ClearScreen(*S\ColorGndBack)
*X\I = 0
*Y\I - *S\PageBottom
EndIf
If IsSprite(\I)
DisplayTransparentSprite(\I, *X\I, *Y\I, 255, Color)
*X\I + \W
*S\PageBottom = *Y\I + \H
EndIf
EndWith
EndProcedure
Procedure ScreenGetTextWidth(*S.Screen, *X.Integer, *Y.Integer, A$, Font.I, Color)
Define R.I
With *S
LA = Len(A$)
For I = 1 To LA
A = Asc(Mid(A$, I, 1) )
R + *S\Font[Font]\Char[A]\W
Next
EndWith
ProcedureReturn R
EndProcedure
Procedure ScreenDisplayText(*S.Screen, *X.Integer, *Y.Integer, A$, Font.I, Color)
With *S
LA = Len(A$)
For I = 1 To LA
A = Asc(Mid(A$, I, 1) )
ScreenDisplayChar(*S, *X, *Y, A, Font, Color)
Next
EndWith
EndProcedure
Procedure ScreenDisplayPara(*S.Screen, *X.Integer, *Y.Integer, A$, Font.I, Color)
With *S
ScreenDisplayText(*S, *X, *Y, " " + A$, Font, Color)
*X\I = 0
*Y\I + *S\Font[Font]\Char[32]\H
EndWith
EndProcedure
Procedure ScreenDisplayParag(*S.Screen, *X.Integer, *Y.Integer, A$, Font.I, Color.I)
With *S
For I = 1 To CountString(A$, " ") + 1
If *X\I + ScreenGetTextWidth(*S, *X, *Y, " " + StringField(A$, I, " "), Font, Color) >= *S\Window\Wi
*X\I = 0
*Y\I + *S\Font[Font]\Char[32]\H
EndIf
ScreenDisplayText(*S, *X, *Y, " " + StringField(A$, I, " "), Font, Color)
Next
*X\I = 0
*Y\I + *S\Font[Font]\Char[32]\H
*X\I = 0
*Y\I + 16
EndWith
EndProcedure
Procedure ScreenDisplaySourceCode(*S.Screen, *X.Integer, *Y.Integer, Font.I, Color.I)
Define Name.S
Define File.I
Define Format.I
Define TextLine.S
With *S
Name = #PB_Compiler_File
If FileSize(Name) > 0
File = OpenFile(#PB_Any, Name)
If File
Format = ReadStringFormat(File)
While Not Eof(File)
TextLine = ReadString(File)
ScreenDisplayPara(*S.Screen, *X, *Y, TextLine, Font, Color)
Wend
CloseFile(File)
EndIf
EndIf
EndWith
EndProcedure
Procedure Screen_Init()
Define *S.Screen
*S = AllocateMemory(SizeOf(Screen) )
With *S
ExamineDesktops()
\Window\Xe = 0
\Window\Ye = 0
\Window\Wi = DesktopWidth(0)
\Window\Hi = DesktopHeight(0)
\Window\Flags = #PB_Window_SystemMenu; | #PB_Window_MaximizeGadget
\Window\Sticky = #True
\Wmax = DesktopWidth(0)
\Hmax = DesktopHeight(0)
\ColorGndBack = RGB(255, 255, 255)
\EventQuit = #PB_Event_CloseWindow
\DurationOS = 8
\Devices = InitSprite()
\Image = CreateImage(#PB_Any, \Wmax, \Hmax, 32, \ColorGndBack)
\Window\I = OpenWindow(#PB_Any, \Window\Xe, \Window\Ye, \Wmax, \Hmax, "", \Window\Flags)
;WindowBounds(\Window\I,\Window\Wi,\Window\Hi,\Wmax,\Hmax)
\Gadget = ImageGadget(#PB_Any, 0, 0, \Wmax, \Hmax, ImageID(\Image) )
\Handle = OpenWindowedScreen(WindowID(\Window\I), 0, 0, \Wmax, \Hmax, 0, 0, 0, #PB_Screen_SmartSynchronization)
\Sprite[0]\I = CreateSprite(#PB_Any, 16, 16, #PB_Sprite_AlphaBlending)
;ResizeWindow(\Window\I, #PB_Ignore, #PB_Ignore, \Window\Wi, \Window\Hi)
\Lap = ElapsedMilliseconds()
\DevKeyboard = InitKeyboard()
InitMouse()
EndWith
ProcedureReturn *S
EndProcedure
Procedure Screen_Event(*S.Screen)
With *S
If \FontMask
ScreenFreeFont(*S)
EndIf
FlipBuffers()
\LapOld = \Lap
\Lap = ElapsedMilliseconds()
\LapDelta = \Lap - \LapOld
Repeat
\WindowEvent = WindowEvent()
Delay(\DurationOS)
If \WindowEvent = #PB_Event_SizeWindow
\Window\Wi = WindowWidth(\Window\I)
\Window\Hi = WindowHeight(\Window\I)
\Already = 0
EndIf
If \WindowEvent = \EventQuit
End
EndIf
Until Not \WindowEvent
ClearScreen(\ColorGndBack)
EndWith
EndProcedure
Procedure Main()
Define *Scr.Screen = Screen_Init()
Define X.I, Y.I
With *Scr
ScreenSetFont(*Scr, 0, "verdana", 10)
ScreenSetFont(*Scr, 1, "courier", 10, #PB_Font_Bold)
ScreenSetFont(*Scr, 2, "verdana", 10, #PB_Font_Italic)
ScreenSetFont(*Scr, 3, "verdana", 30, #PB_Font_Bold)
ScreenSetFont(*Scr, 4, "verdana", 20, #PB_Font_Bold)
ScreenSetFont(*Scr, 5, "verdana", 15, #PB_Font_Bold)
Repeat
Screen_Event(*Scr)
If \Already
ScreenDisplayPage(*Scr)
Else
ScreenNewPage(*Scr, @X, @Y)
ScreenDisplayParag(*Scr, @X, @Y, "URHELP", 3, RGB(0, 64, 0) )
ScreenDisplayParag(*Scr, @X, @Y, "Introduction", 4, RGB(0, 64, 0) )
ScreenDisplayParag(*Scr, @X, @Y, "Hello world! Welcome to URHELP. This program allows you to give a documentation of your programs to your own users.", 0, RGB(0, 0, 0) )
ScreenDisplayParag(*Scr, @X, @Y, "We will see the main feature of URHELP : how to display a simple text. In the future, we could see any others characteristics. My first advise is to use the MACROS to display the text. Using MACROS will allows you not to have big problems in the way I update URHELP.", 0, RGB(0, 0, 0) )
ScreenDisplayParag(*Scr, @X, @Y, "I. Handling this help", 4, RGB(0, 64, 0) )
ScreenDisplayParag(*Scr, @X, @Y, "Well, to use URHELP, there is, actually, only one technic, and this technic, actually will be the same for your own users : press [Up key] to scroll up, and press [Down key] to scroll down. If you want to quit, you click on the closing button in the title bar. You can too press on [Alt]+[F4] to quit. You can resize the URHELP window, and you can move this last one, thank to the mouse.", 0, RGB(0, 0, 0) )
ScreenDisplayPara(*Scr, @X, @Y, "Fig.1 Any actually available handling", 2, RGB(0, 0, 255) )
ScreenDisplayPara(*Scr, @X, @Y, "[UP] key : scroll up", 1, RGB(0, 0, 0) )
ScreenDisplayPara(*Scr, @X, @Y, "[DOWN] key : scroll down", 1, RGB(0, 0, 0) )
ScreenDisplayPara(*Scr, @X, @Y, "[Alt]+[F4] combination keys : quit", 1, RGB(0, 0, 0) )
ScreenDisplayPara(*Scr, @X, @Y, "Drag the window borders : resize the window", 1, RGB(0, 0, 0) )
ScreenDisplayParag(*Scr, @X, @Y, "Drag the window title bar : move the window", 1, RGB(0, 0, 0) )
ScreenDisplayParag(*Scr, @X, @Y, "Any others characteristics could appear.", 0, RGB(0, 0, 0) )
ScreenDisplayParag(*Scr, @X, @Y, "II. How to write your documentation ?", 4, RGB(0, 64, 0) )
ScreenDisplayParag(*Scr, @X, @Y, "So, now you know how to scroll. Sorry if have not inserted mouse wheeling to scroll, or others features. It was to simplify the source code. Why ? Because the answer of the question << How to write your own documentation ? >> is << By modifying my source code ! >>.", 0, RGB(0, 0, 0) )
ScreenDisplayParag(*Scr, @X, @Y, "1. Clean the work place", 5, RGB(0, 64, 0) )
ScreenDisplayParag(*Scr, @X, @Y, "You need to search this following source code line:", 0, RGB(0, 0, 0) )
ScreenDisplayParag(*Scr, @X, @Y, "ScreenNewPage(*Scr, @X, @Y)", 1, RGB(0, 0, 0) )
ScreenDisplayParag(*Scr, @X, @Y, "Normally, it is on line 404. You keep this line, but you remove the next line just after ScreenNewPage(*Scr). And you remove all the source code lines prefixed by << ScreenDisplay... >>. Normally, the result seems to the following one:", 0, RGB(0, 0, 0) )
ScreenDisplayPara(*Scr, @X, @Y, "404 ScreenNewPage(*Scr, @X, @Y)", 1, RGB(0, 0, 0) )
ScreenDisplayParag(*Scr, @X, @Y, "405 \Already = 1", 1, RGB(0, 0, 0) )
ScreenDisplayParag(*Scr, @X, @Y, "Now, if you have these two lines which are neighbours themselves, we are saved : the place is clean to work.", 0, RGB(0, 0, 0) )
ScreenDisplayParag(*Scr, @X, @Y, "2. Start to YOUR help", 5, RGB(0, 64, 0) )
ScreenDisplayParag(*Scr, @X, @Y, "To see your first help, you will insert the following statement between the lines 404 and 405:", 0, RGB(0, 0, 0) )
ScreenDisplayParag(*Scr, @X, @Y, "ScreenDisplayParag(*Scr, @X, @Y, " + Chr(34) + "your text" + Chr(34) + ", Font, Color)", 1, RGB(0, 0, 0) )
ScreenDisplayParag(*Scr, @X, @Y, "Now, you are ready to work with URHELP.", 0, RGB(0, 0, 0) )
ScreenDisplayParag(*Scr, @X, @Y, "Good luck ! (olli)", 0, RGB(0, 0, 0) )
ScreenDisplayPara(*Scr, @X, @Y, "Fig.2 URHELP program listing", 2, RGB(0, 0, 255) )
ScreenDisplaySourceCode(*Scr, @X, @Y, 1, RGB(0, 0, 0) )
\Already = 1
ScreenGrabPage(*Scr, @X, @Y)
EndIf
ExamineKeyboard()
If KeyboardPushed(#PB_Key_Down)
\ScrollOffsetAccY + 0.2
ElseIf KeyboardPushed(#PB_Key_Up)
\ScrollOffsetAccY - 0.2
ElseIf KeyboardPushed(#PB_Key_Return)
ReleaseMouse(0)
Else
\ScrollOffsetAccY * 0.9
EndIf
ExamineMouse()
If MouseButton(#PB_MouseButton_Right)
ReleaseMouse(1)
ElseIf MouseWheel() > 0
\ScrollOffsetAccY + 10
ElseIf MouseWheel() < 0
\ScrollOffsetAccY - 10
Else
\ScrollOffsetAccY * 0.9
EndIf
\ScrollOffsetY + \ScrollOffsetAccY
ForEver
EndWith
EndProcedure
Main()
