Another BCD-7 Rendering Example

Share your advanced PureBasic knowledge/code with the community.
Olli
Addict
Addict
Posts: 1198
Joined: Wed May 27, 2020 12:26 pm

Re: Another BCD-7 Rendering Example

Post by Olli »

Lazy ? So do I now ! :mrgreen:

Code: Select all

Define tempWin = OpenWindow(#PB_Any, ExamineDesktops(), 0, 0, 0, "", #PB_Window_Maximize | #PB_Window_BorderLess | #PB_Window_Invisible)
If DesktopWidth(0) <> WindowWidth(tempWin) * DesktopResolutionX()
    If #PB_Compiler_OS = #PB_OS_Windows And OSVersion() > 70
        MessageRequester("Don't forget to...", "switch the user option ! (menu Compiler)")
        End
    EndIf
    MessageRequester("Please switch...", "the dpi option on ! (menu Compiler)")
    End
EndIf
CloseWindow(tempWin)
Global Dim win.i(2047)
Global Dim hid.i(2047)
hid(3) = 1     
hid(7) = 1     
hid(8) = 1     
hid(10) = 1    
hid(11) = 1    
hid(13) = 1    
hid(15) = 1    
hid(19) = 1    
hid(22) = 1    
hid(25) = 1    
hid(28) = 1    
hid(32) = 1    
hid(34) = 1     
hid(37) = 1     
hid(39) = 1     
hid(44) = 1     
hid(50) = 1     
hid(52) = 1     
hid(53) = 1     
hid(55) = 1     
hid(67) = 1     
hid(76) = 1     
hid(77) = 1     
hid(79) = 1     
hid(84) = 1     
hid(85) = 1     
hid(86) = 1     
hid(89) = 1     
hid(91) = 1     
hid(92) = 1     
hid(100) = 1    
hid(103) = 1    
hid(107) = 1    
hid(110) = 1    
hid(111) = 1    

Procedure.i unscaX(x.i)
    ProcedureReturn DesktopUnscaledX(x)
EndProcedure

Procedure.i unscaY(y.i)
    ProcedureReturn DesktopUnscaledY(y)
EndProcedure

Global.I ctlWin = OpenWindow(#PB_Any, 16, 16, UnscaX(400), UnscaY(300), "", #PB_Window_SystemMenu | #PB_Window_Invisible ! #PB_Window_Invisible)

Procedure coloredBox(x, y, w, h, color)
    Define.i window
    window = OpenWindow(#PB_Any, UnscaX(x), UnscaY(y), unscax(w), UnscaY(h), "", #PB_Window_BorderLess | #PB_Window_NoGadgets | #PB_Window_NoActivate | #PB_Window_Invisible ! #PB_Window_Invisible, WindowID(ctlWin) )
    SetWindowColor(window, color)
    StickyWindow(window, 1)
    ProcedureReturn window
EndProcedure

ExamineDesktops()
Global dw = DesktopWidth(0)
Global dh = DesktopHeight(0)
Global gw = 16
Global gh = 9
Global cw = dw / gw
Global ch = dh / gh
Global Dim gx.d(2)
Global Dim gy.d(3)
Global Dim xx.d(2)
Global Dim yy.d(3)
 gx(0) = 1 / 8
 gy(0) = 1 / 10
 gx(1) = gx(0)
 gx(2) = 1 - gx(0)
 gy(1) = gy(0)
 gy(2) = 1 / 2
 gy(3) = 1 - gy(0)
Global Dim x.d(3)
Global Dim y.d(4)

Procedure bcd()
thi.d = 12
thi2.d = thi / 2
y = 4 * ch
id = 0
Repeat
    x = 0
    Repeat             
        For yy = 1 To 3
            For xx = 1 To 2                
                xx(xx) = x + cw * gx(xx)
                yy(yy) = y + ch * gy(yy)
            Next
        Next        
        cc = RGB((x * 255) / dw, ((dw - x) * 255) / dw, 0)
        For yy = 1 To 3
            For xx = 1 To 2                
                If xx < 2
                    If hid(id) = 0 And win(id) = 0
                        win(id) = coloredBox(xx(xx) + thi2, yy(yy) - thi2, xx(xx + 1) - xx(xx) - thi, thi, cc)
                    EndIf
                    If hid(id) And win(id)
                        CloseWindow(win(id) )
                        win(id) = 0
                    EndIf
                    id + 1
                EndIf
                If yy < 3
                    If hid(id) = 0 And win(id) = 0
                        win(id) = coloredBox(xx(xx) - thi2, yy(yy) + thi2, thi, yy(yy + 1) - yy(yy) - thi, cc)
                    EndIf
                    If hid(id) And win(id)
                        CloseWindow(win(id) )
                        win(id) = 0
                    EndIf
                    id + 1
                EndIf
            Next
        Next        
        x + cw
    Until x >= dw
    y + ch
Until y >= dh / 2
EndProcedure
dmx = DesktopMouseX()
Repeat
    t = ElapsedMilliseconds()
    If t > lap
        lap = t + 1000
        bcd()
        For i = 0 To 7
            hid(i + 16*7) = hid(i)
        Next
        For i = 0 To 16 * 7 - 1 Step 1
            hid(i) = hid((i + 7) )
        Next
    EndIf
    Delay(33)
    ev = WindowEvent()
    dmx0 = dmx
    dmx = DesktopMouseX()
Until ev = #PB_Event_CloseWindow ; dmx <> dmx0
User avatar
Mijikai
Addict
Addict
Posts: 1517
Joined: Sun Sep 11, 2016 2:17 pm

Re: Another BCD-7 Rendering Example

Post by Mijikai »

Thats flashy, nice scrolling effect i like it :D
So many windows... :shock:
Olli
Addict
Addict
Posts: 1198
Joined: Wed May 27, 2020 12:26 pm

Re: Another BCD-7 Rendering Example

Post by Olli »

and, theorically, cross platform...
bcd() procedure prevent the program from making more windows than required.
Mijikai wrote:So many windows... :shock:
This allows us to observe Microsoft makes fun of their clients. I hope Linux is quicker...
User avatar
Kwai chang caine
Always Here
Always Here
Posts: 5494
Joined: Sun Nov 05, 2006 11:42 pm
Location: Lyon - France

Re: Another BCD-7 Rendering Example

Post by Kwai chang caine »

Hi Mijikaï and Olli :D
Very nice your two codes :wink:
For olli code, my eyes can't read all the screen in one shot :shock: :lol:
Thanks for sharing 8)
ImageThe happiness is a road...
Not a destination
Post Reply