It is currently Sat Oct 31, 2020 10:50 am

All times are UTC + 1 hour




Post new topic Reply to topic  [ 17 posts ]  Go to page Previous  1, 2
Author Message
 Post subject: Re: URHELP
PostPosted: Wed Jul 08, 2020 3:28 am 
Offline
PureBasic Expert
PureBasic Expert

Joined: Sun Apr 12, 2009 6:27 am
Posts: 3711
Hi olli
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:
;**********************************************************************************************************************************************************************
; 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()


_________________
Egypt my love


Top
 Profile  
Reply with quote  
 Post subject: Re: URHELP
PostPosted: Wed Jul 08, 2020 8:21 am 
Offline
Enthusiast
Enthusiast

Joined: Wed May 27, 2020 12:26 pm
Posts: 171
@RASHAD

Dw... What ? You lock the... And unlock the... OKAY ! Okay Rashad : when my fingers will approach the symbols of a keyboard, a powered-on keyboard, I will test your changes !!

I am surprised by the bad resizing results, you report. It belongs to the main features of this code.

Thank you anyway for the time you allocated to read and modify this code !


Top
 Profile  
Reply with quote  
Display posts from previous:  Sort by  
Post new topic Reply to topic  [ 17 posts ]  Go to page Previous  1, 2

All times are UTC + 1 hour


Who is online

Users browsing this forum: No registered users and 7 guests


You cannot post new topics in this forum
You cannot reply to topics in this forum
You cannot edit your posts in this forum
You cannot delete your posts in this forum

Search for:
Jump to:  

 


Powered by phpBB © 2008 phpBB Group
subSilver+ theme by Canver Software, sponsor Sanal Modifiye