screenres with a vertical scroll bar

[jaskin]

Is it possible to have a vertical scroll bar when using screenres to create a window?

[Lothar Schirm]

No, not really. You might try to use the Windows API, I found this code:

Code: Select all

#Include Once "windows.bi"

Dim As Integer style
Dim As HWND hWindow
Dim As RECT r

ScreenRes 400,300,32

hWindow = GetForegroundWindow()
style = GetWindowLong(hWindow, GWL_STYLE)
GetWindowRect(hWindow, @r)

SetWindowLong(hWindow, GWL_STYLE, style Or WS_VSCROLL Or WS_HSCROLL)
SetWindowPos(hWindow, HWND_TOP, r.left, r.top, r.right - r.left, r.bottom - r.top, SWP_DRAWFRAME)

Sleep

(https://forum.qbasic.at/viewtopic.php?t=8844).
But I would not recommend to mix Screenres and Windows API because FreeBASIC stuff for graphics or commands like Print, Input etc. are not compatible with Windows API.

[jaskin]

I can see what you mean, Although the scroll bar can be displayed, it's of no use after printing say 100 lines. Will have to resort to Win32 API calls only.

[dodicat]

You will have to make your own scrolling mechanism for fb screens.
this old code:

Code: Select all

 

#cmdline "-gen gcc -O 2"
'=============   FONTS SET UP ==========================
Function Filter(Byref tim As Ulong Pointer,_
    rad As Single,_
    destroy As Long=1,_
    fade As Long=0) As Ulong Pointer
    #define map(a,b,_x_,c,d) ((d)-(c))*((_x_)-(a))/((b)-(a))+(c)
    If fade<0 Then fade=0:If fade>100 Then fade=100
    Type p2
        As Long x,y
        As Ulong col
    End Type
    #macro ppoint(_x,_y,colour)
    pixel=row+pitch*(_y)+4*(_x)
    (colour)=*pixel
    #endmacro
    #macro ppset(_x,_y,colour)
    pixel=row+pitch*(_y)+4*(_x)
    *pixel=(colour)
    #endmacro
    #macro average()
    ar=0:ag=0:ab=0:inc=0
    xmin=x:If xmin>rad Then xmin=rad
    xmax=rad:If x>=(_x-1-rad) Then xmax=_x-1-x
    ymin=y:If ymin>rad Then ymin=rad
    ymax=rad:If y>=(_y-1-rad) Then ymax=_y-1-y
    For y1 As Long=-ymin To ymax
        For x1 As Long=-xmin To xmax
            inc=inc+1 
            ar=ar+(NewPoints(x+x1,y+y1).col Shr 16 And 255)
            ag=ag+(NewPoints(x+x1,y+y1).col Shr 8 And 255)
            ab=ab+(NewPoints(x+x1,y+y1).col And 255)
        Next x1
    Next y1
    If fade=0 Then
        averagecolour=Rgb(ar/(inc),ag/(inc),ab/(inc))
    Else
        averagecolour=Rgb(fd*ar/(inc),fd*ag/(inc),fd*ab/(inc))
    End If
    #endmacro
    Dim As Single fd=map(0,100,fade,1,0)
    Dim As Long _x,_y
    Imageinfo tim,_x,_y
    Dim  As Ulong Pointer im=Imagecreate(_x,_y)
    Dim As Long pitch
    Dim  As Any Pointer row
    Dim As Ulong Pointer pixel
    Dim As Ulong col
    Imageinfo tim,,,,pitch,row
    Dim As p2 NewPoints(_x-1,_y-1)
    For y As Long=0 To (_y)-1
        For x As Long=0 To (_x)-1
            ppoint(x,y,col)
            NewPoints(x,y)=Type<p2>(x,y,col)
        Next x
    Next y
    Dim As Ulong averagecolour
    Dim As Long ar,ag,ab
    Dim As Long xmin,xmax,ymin,ymax,inc
    Imageinfo im,,,,pitch,row
    For y As Long=0 To _y-1
        For x As Long=0 To _x-1  
            average()
            ppset((NewPoints(x,y).x),(NewPoints(x,y).y),averagecolour) 
        Next x
    Next y
    If destroy Then Imagedestroy tim: tim = 0
    Function= im
End Function
'basic dos fonts
Sub drawstring(xpos As Long,ypos As Long,text As String,colour As Ulong,size As Single,im As Any Pointer=0)
    Type D2
        As Double x,y
        As Ulong col
    End Type
    Static As d2 cpt(),XY()
    Static As Long runflag
    If runflag=0 Then   
        Redim  XY(128,127)
        Redim cpt(1 To 64*2)
        Screen 8
        Width 640\8,200\16 
        Dim As Ulong Pointer img
        Dim count As Long
        For ch As Long=1 To 127
            img=Imagecreate(640,200)
            Draw String img,(1,1),Chr(ch)
            For x As Long=1 To 8  
                For y As Long=1 To 16
                    If Point(x,y,img)<>0 Then
                        count=count+1
                        XY(count,ch)=Type<D2>(x,y)
                    End If 
                Next y
            Next x
            count=0
            Imagedestroy img
        Next ch
        runflag=1 
    End If
    If size=0 Then Exit Sub
    Dim As D2 np,t
    #macro Scale(p1,p2,d)
    np.col=p2.col
    np.x=d*(p2.x-p1.x)+p1.x
    np.y=d*(p2.y-p1.y)+p1.y
    #endmacro
    
    Dim As D2 c=Type<D2>(xpos,ypos)
    Dim As Long dx=xpos,dy=ypos,f
    If Abs(size)=1.5 Then f=3 Else f=2
    For z6 As Long=1 To Len(text)
        Var asci=text[z6-1]
        For _x1 As Long=1 To 64*2
            t=Type<D2>(XY(_x1,asci).x+dx,XY(_x1,asci).y+dy,colour)         
            Scale(c,t,size)
            cpt(_x1)=np
            
            If XY(_x1,asci).x<>0 Then 
                If Abs(size)>1 Then 
                    Line im,(cpt(_x1).x-size/f,cpt(_x1).y-size/f)-(cpt(_x1).x+size/f,cpt(_x1).y+size/f),cpt(_x1).col,bf
                Else
                    Pset im,(cpt(_x1).x,cpt(_x1).y),cpt(_x1).col
                End If
            End If
        Next _x1
        dx=dx+8
    Next z6 
End Sub
Sub init Constructor 'automatic loader
    drawstring(0,0,"",0,0)
    Screen 0, , ,&h80000000
End Sub
Function Colour(im As Any Pointer,newcol As Ulong,tweak As Long,fontsize As Single) As Any Pointer
    #macro ppset2(_x,_y,colour)
    pixel2=row2+pitch2*(_y)+(_x)*dpp2 
    *pixel2=(colour)
    #endmacro
    #macro ppoint(_x,_y,colour)
    pixel=row+pitch*(_y)+(_x)*dpp
    (colour)=*pixel
    #endmacro
    Dim As Long grade
    Select Case  fontsize
    Case 1 To 1.5:grade=205
    Case 2 :grade=225'225
    Case 2.5:grade=222
    Case 3 To 3.5:grade=200
    Case 4 To 4.5:grade=190
    Case 5 To 5.5:grade=165
    Case Else: grade=160
    End Select
    Dim As Long w,h
    Dim As Long pitch,pitch2
    Dim  As Any Pointer row,row2
    Dim As Ulong Pointer pixel,pixel2
    Dim As Ulong col
    Dim As Long dpp,dpp2
    Imageinfo im,w,h,dpp,pitch,row
    Dim As Any Pointer temp
    temp=Imagecreate(w,h)
    Imageinfo temp,,,dpp2,pitch2,row2
    For y As Long=0 To h-1
        For x As Long=0 To w-1
            ppoint(x,y,col)
            Var v=.299*((col Shr 16)And 255)+.587*((col Shr 8)And 255)+.114*(col And 255)
            If v>(grade+tweak) Then 
                ppset2(x,y,newcol)
            Else
                ppset2(x,y,Rgb(255,0,255))
            End If
        Next x
    Next y
    Return temp
End Function

Sub CreateFont(Byref myfont As Any Pointer,fontsize As Single,col As Ulong,tweak As Long=0)
    fontsize=Abs(fontsize)
    fontsize=Int(2*fontsize)/2
    If fontsize=0 Then fontsize=.5
    Dim As Long FIRSTCHAR =32,LASTCHAR=127
    Dim As Long NUMCHARS=(LASTCHAR-FIRSTCHAR)+1
    Dim As Ubyte Ptr p
    Dim As Any Pointer temp
    Dim As Long i
    temp = Imagecreate(NUMCHARS*8*FontSize,16*FontSize,Rgb(255,0,255))
    myfont=Imagecreate(NUMCHARS*8*FontSize,16*FontSize,Rgb(255,0,255))
    
    For i = FIRSTCHAR To LASTCHAR
        drawstring ((i - FIRSTCHAR) * 8*FontSize, 1,Chr(i),Rgb(255,255,255),FontSize,temp)
    Next i
    If fontsize<=0 Then fontsize=1
    If fontsize>1.5 Then
        For n As Single=0 To fontsize-2
            temp=filter(temp,1,1,0)
        Next n
    End If
    
    temp=Colour(temp,col,tweak,fontsize)
    Put myfont,(0,0),temp,trans
    Imageinfo( myfont,,,,, p )
    p[0]=0
    p[1]=FIRSTCHAR
    p[2]=LASTCHAR
    For i = FIRSTCHAR To LASTCHAR
        p[3+i-FIRSTCHAR]=8*FontSize
    Next i
    Imagedestroy(temp)
End Sub 
'=================== END FONT SETUP  ========================================


'========================= PRIME NUMBER GETTER ===========================================
Sub primes(prime() As Ulong,n As Long)
    #macro update(flag)
    counter=counter+1
    prime(counter)=(flag)
    #endmacro
    Redim prime(1 To n+1)
    prime(1)=3:prime(2)=5:prime(3)=7
    Dim As Ulong num=6,counter=3,ub=Ubound(prime),z,k,lFlag,Uflag,temp
    While counter<ub
        num=num+6  
        k=Sqr(num)+1
        lflag=1:Uflag=1
        For z =1 To counter 
            If prime(z)>=k Then Exit For
            If (num-1) Mod prime(z)=0 Then Lflag=0 
            If (num+1) Mod prime(z)=0 Then Uflag=0 
            If Lflag =0 And Uflag =0 Then Exit For
        Next z 
        If Lflag Then: update(num-1):End If
        If Uflag Then: update(num+1):End If
    Wend
End Sub


'regulate framerate

Function Regulate(Byval MyFps As Long,Byref fps As Long=0) As Long
    Static As Double timervalue,_lastsleeptime,t3,frames
    Var t=Timer
    frames+=1
    If (t-t3)>=1 Then t3=t:fps=frames:frames=0
    Var sleeptime=_lastsleeptime+((1/myfps)-T+timervalue)*1000
    If sleeptime<1 Then sleeptime=1
    _lastsleeptime=sleeptime
    timervalue=T
    Return sleeptime
End Function


#define map(a,b,x,c,d)  ((d)-(c))*((x)-(a))/((b)-(a))+(c)

Type box
    As Double x,y,w,h
    As Ulong col
    Declare Function inbox(As Long,As Long) As Long
    Declare Sub Draw()
End Type


Function box.inbox(x As Long,y As Long) As Long
    If x>this.x And x<this.x+this.w Then
        If y>this.y And y<this.y+this.h Then
            Return -1
        End If
    End If
End Function

Sub box.draw()
    Line(this.x,this.y)-(this.x+this.w,this.y+this.h),this.col,bf
End Sub

Dim As box b(1 To 5)
b(1)=Type<box>(780,20,20,560,Rgb(150,150,150))'sliders
b(2)=Type<box>(780,0,20,20,Rgb(0,0,200))
b(3)=Type<box>(780,580,20,20,Rgb(0,0,200))
b(4)=Type<box>(780,20,20,20,Rgb(200,0,0))

b(5)=Type<box>(0,0,800,600,0)'whole screen

#macro show()
Screenlock
Cls
For n As Long=1 To Ubound(b)-1
    b(n).draw()
Next n

Draw String(500,50),"FPS = " &fps,,font2
For z As Long=1 To Ubound(p)
    ypos=38*z-1*w
    If ypos>-50 And ypos<600 Then
        Draw String(5,ypos+10),"prime " &(z+2) & " =",,font2
        Draw String(150+2*8*Len(Str(z+2)),ypos),Str(p(z)),,font
    End If
Next z
Screenunlock
#endmacro

Dim As Long numberofprimes=50000

Redim As Ulong p(0)
Screen 19,32

Dim As Any Ptr font,font2

createfont font,3,Rgb(200,200,200)
createfont font2,2,Rgb(100,90,0)

Draw String(50,200),"Creating " &numberofprimes &" Primes",, font2
Draw String(50,300),"Please wait ...",,font2

primes(p(),numberofprimes)

Dim As Long x,y,mb,ypos,wheel,lastwheel
Dim As Double w,lastw
Dim As Long fps,sleeptime
Do
    sleeptime=regulate(64,fps)
    Getmouse x,y,wheel,mb
    If b(5).inbox(x,y) Then 'if mouse is on the screen
        w=w+100*(lastwheel-wheel)
        lastwheel=wheel
    End If
    If w<0 Then w=lastw
    If w>38*numberofprimes Then w=38*numberofprimes
    lastw=w
    For n As Long=1 To Ubound(b)-1
        If b(n).inbox(x,y)And mb=1 Then
            Select Case  n
            Case 3:w=w+10:b(4).y=map(0,38*numberofprimes,w,20+1,560-1)
            Case 2:w=w-10:b(4).y=map(0,38*numberofprimes,w,20+1,560-1)
            Case 1 
                If y<560 Then 
                    b(4).y=y
                    w=map(20+1,560-1,b(4).y,0,38*numberofprimes)
                End If
            End Select
        End If
    Next n
    
    show()
    
    Sleep sleeptime,1
Loop Until Len(Inkey)



 

[jaskin]

You will have to make your own scrolling mechanism for fb screens.
this old code:

Interesting. As discussed on the other thread I started, it's better to use just Win32 APIs to control everything, including the font. Makes it cleaner even though working with Win32 APIs is such a pain, IMHO

[dodicat]

The opengl screens are kind of bare bones, they can handle some win32 components.
I have not tried scrolling though, maybe sometime.
Here are a few: buttons, themes, disable fullscreen, tooltips, fonts.

Code: Select all

#include "windows.bi"
#Include once "/win/commctrl.bi"
#include "GL/gl.bi"

Declare Function SetWindowTheme Lib "UxTheme.dll" Alias "SetWindowTheme"(As Any Ptr,As zstring Ptr,As zstring Ptr) As Long

Sub setupgl
      Dim As Integer xres,yres
      Screeninfo xres,yres
      glDisable (GL_DEPTH_TEST)
      glBlendFunc(GL_SRC_ALPHA,GL_ONE_MINUS_SRC_ALPHA)
      glEnable (GL_BLEND)
      glEnable (GL_LINE_SMOOTH)
      glOrtho 0, xres, yres,0,-1, 1
      glclearcolor 1,1,1,1
End Sub
Screen 20,32,,2
setupgl
Dim Shared As Long wire,solid,glass

Type pt
      As Double x,y,z
End Type

Type triangle
      As pt p(0 To 2)
      As pt ctr
      As Ulong col
      As pt norm
End Type

Type angle3D             'FLOATS for angles
      As Single sx,sy,sz
      As Single cx,cy,cz
      Declare Static Function construct(As Single,As Single,As Single) As Angle3D
End Type

Function Angle3D.construct(x As Single,y As Single,z As Single) As Angle3D
      Return   Type (Sin(x),Sin(y),Sin(z), _
      Cos(x),Cos(y),Cos(z))
End Function

Function Rotate(c As pt,p As pt,a As Angle3D,scale As pt=Type(1,1,1)) As pt
      Dim As Single dx=p.x-c.x,dy=p.y-c.y,dz=p.z-c.z
      Return Type<pt>((scale.x)*((a.cy*a.cz)*dx+(-a.cx*a.sz+a.sx*a.sy*a.cz)*dy+(a.sx*a.sz+a.cx*a.sy*a.cz)*dz)+c.x,_
      (scale.y)*((a.cy*a.sz)*dx+(a.cx*a.cz+a.sx*a.sy*a.sz)*dy+(-a.sx*a.cz+a.cx*a.sy*a.sz)*dz)+c.y,_
      (scale.z)*((-a.sy)*dx+(a.sx*a.cy)*dy+(a.cx*a.cy)*dz)+c.z)
End Function

Function perspective(p As pt,eyepoint As pt) As pt
      Dim As Single   w=1+(p.z/eyepoint.z)
      Return Type<pt>((p.x-eyepoint.x)/w+eyepoint.x,_
      (p.y-eyepoint.y)/w+eyepoint.y,_
      (p.z-eyepoint.z)/w+eyepoint.z)
End Function

Function dot(p As pt,v2 As Pt) As Single 'dot product |v1| * |v2| *cos(angle between v1 and v2)
      Dim As Single d1=Sqr(p.x*p.x + p.y*p.y+ p.z*p.z),d2=Sqr(v2.x*v2.x + v2.y*v2.y +v2.z*v2.z)
      Dim As Single v1x=p.x/d1,v1y=p.y/d1,v1z=p.z/d1 'normalize
      Dim As Single v2x=v2.x/d2,v2y=v2.y/d2,v2z=v2.z/d2 'normalize
      Return (v1x*v2x+v1y*v2y+v1z*v2z)
End Function

Sub drawpolygon(p() As pt, c As Ulong) 
      Var col=Cptr(Ubyte Ptr,@c)
      glcolor4ub(col[2],col[1],col[0],255)
      Dim k As Long=Ubound(p)+1
      Dim As Long index,nextindex
      For n As Long=Lbound(p) To Ubound(p)
            index=n Mod k:nextindex=(n+1) Mod k
            If nextindex=0 Then nextindex=Lbound(p)
            glvertex2d(p(index).x,p(index).y)
            glvertex2d(p(nextindex).x,p(nextindex).y)
      Next
End Sub


Sub fill(p() As Pt,c As Ulong,im As Any Ptr=0,flag As Long)
      Var col=Cptr(Ubyte Ptr,@c)
      glcolor4ub(col[2],col[1],col[0],150)
      If glass Then glcolor4ub(0,0,50,55)
      glbegin gl_lines
      #define ub Ubound
      Dim As Long Sy=1e6,By=-1e6,i,j,y,k
      Dim As Single a(Ub(p)+1,1),dx,dy
      For i =0 To Ub(p)
            a(i,0)=p(i).x
            a(i,1)=p(i).y
            If Sy>p(i).y Then Sy=p(i).y
            If By<p(i).y Then By=p(i).y
      Next i
      Dim As Single xi(Ub(a,1)),S(Ub(a,1))
      a(Ub(a,1),0) = a(0,0)
      a(Ub(a,1),1) = a(0,1)
      For i=0 To Ub(a,1)-1
            dy=a(i+1,1)-a(i,1)
            dx=a(i+1,0)-a(i,0)
            If dy=0 Then S(i)=1
            If dx=0 Then S(i)=0
            If dy<>0 Andalso dx<>0 Then S(i)=dx/dy
      Next i
      For y=Sy-1 To By+1
            k=0
            For i=0 To Ub(a,1)-1
                  If (a(i,1)<=y Andalso a(i+1,1)>y) Orelse _
                  (a(i,1)>y Andalso a(i+1,1)<=y) Then
                  xi(k)=(a(i,0)+S(i)*(y-a(i,1)))
                  k+=1
            End If
      Next i
      For j=0 To k-2
            For i=0 To k-2
                  If xi(i)>xi(i+1) Then Swap xi(i),xi(i+1)
            Next i
      Next j
      
      For i = 0 To k - 2 Step 2
            If wire=0 Or glass=1 Then
                  glvertex2d(xi(i)+1,y)
                  glvertex2d(xi(i+1)+1-1,y)
            End If
      Next i
Next y
If wire=1 Then
      drawpolygon(p(),Rgb(0,0,0))
Else
      If flag =0 And solid=0 Then  drawpolygon(p(),Rgb(255,255,255))
End If
glend
End Sub

Sub blow(d() As pt,t As pt,m As Double)
      For n As Long=1 To 12
            d(n).x=(d(n).x)*m+t.x
            d(n).y=(d(n).y)*m+t.y
            d(n).z=(d(n).z)*m+t.z
      Next
End Sub

Sub setup(p() As triangle,d() As pt,colours() As Ulong)
      Dim As Long i
      Dim As Double cx,cy,cz
      Dim As pt centre=Type(1024\2,768\2,0)
      For n As Long=1 To 20
            cx=0:cy=0:cz=0
            For k As Long=0 To 2
                  Read i
                  p(n).p(k)=d(i)
                  cx+=d(i).x
                  cy+=d(i).y
                  cz+=d(i).z
            Next k
            p(n).ctr=Type(cx/3,cy/3,cz/3)
            p(n).norm=Type(p(n).ctr.x-centre.x,p(n).ctr.y-centre.y,p(n).ctr.z-centre.z)
            p(n).col=colours(n)
      Next n
      
End Sub

Sub show(p() As triangle)
      #define map(a,b,x,c,d) ((d)-(c))*((x)-(a))/((b)-(a))+(c)
      Dim As Long flag
      Dim As pt lightsource
      lightsource=Type(.5,0,.5)
      For n As Long=Lbound(p) To Ubound(p)
            If n<=10 Then flag=1 Else flag=0
            Var col=Cptr(Ubyte Ptr,@p(n).col)
            Dim As Single dt=dot(p(n).norm,lightsource)
            Var dtt=map(1,-1,dt,0,1)
            Dim As Ulong clr=Rgba(dtt*col[2],dtt*col[1],dtt*col[0],150)
            fill(p(n).p(),clr,0,flag)
      Next n
End Sub

Sub sort(p() As triangle)
      For n1 As Long =Lbound(p) To Ubound(p)-1
            For n2 As Long=n1+1 To Ubound(p)
                  If p(n1).ctr.z<p(n2).ctr.z Then Swap p(n1),p(n2)
            Next n2
      Next n1
End Sub

Function Regulate(Byval MyFps As Long,Byref fps As Long=0) As Long
    Static As Double timervalue,_lastsleeptime,t3,frames
    Var t=Timer
    frames+=1
    If (t-t3)>=1 Then t3=t:fps=frames:frames=0
    Var sleeptime=_lastsleeptime+((1/myfps)-T+timervalue)*1000
    If sleeptime<1 Then sleeptime=1
    _lastsleeptime=sleeptime
    timervalue=T
    Return sleeptime
End Function


Sub setcolours(colours() As Ulong,colour As Ulong=Rgb(100,255,0))
      Randomize 2
      For n As Long=1 To 20
            colours(n)=Rgba(Rnd*255,Rnd*255,Rnd*255,15)
      Next n
End Sub


Function Set_Font (Font As String,Size As Long,Bold As Long,Italic As Long,Underline As Long,StrikeThru As Long) As HFONT
      Dim As HDC hDC=GetDC(HWND_DESKTOP)
      Dim As Long CyPixels=GetDeviceCaps(hDC,LOGPIXELSY)
      ReleaseDC(HWND_DESKTOP,hDC)
      Return CreateFont(0-(Size*CyPixels)/72,0,0,0,Bold,Italic,Underline,StrikeThru,ANSI_CHARSET _
      ,OUT_TT_PRECIS,CLIP_DEFAULT_PRECIS,DEFAULT_QUALITY,FF_DONTCARE,Font)
End Function

Function CreateToolTip(X As hwnd,msg As String="") As hwnd
    Dim As hwnd  TT= CreateWindowEx(0,"ToolTips_Class32","",64,0,0,0,0,X,0,GetModuleHandle(0),0)
    SendMessage(TT, TTM_SETMAXTIPWIDTH, 0 , 280)
    SendMessage(TT, TTM_SETDELAYTIME, TTDT_INITIAL ,40)
    SendMessage(TT, TTM_SETDELAYTIME, TTDT_RESHOW  ,60)
    Dim bubble As TOOLINFO
    bubble.cbSize = Len(TOOLINFO)
    bubble.uFlags = TTF_IDISHWND Or TTF_SUBCLASS
    bubble.uId = Cast(Uinteger,X)
    bubble.lpszText = Strptr(msg)
    SendMessage(TT, TTM_ADDTOOL, 0,Cast(LPARAM,@bubble))
    Return TT
End Function

'===============================================================================
Dim As pt d(1 To 12)={ _
(0.000000,-0.525731,0.850651), _
(0.850651,0.000000,0.525731), _
(0.850651,0.000000,-0.525731), _
(-0.850651,0.000000,-0.525731), _
(-0.850651,0.000000,0.525731), _
(-0.525731,0.850651,0.000000), _
(0.525731,0.850651,0.000000), _
(0.525731,-0.850651,0.000000), _
(-0.525731,-0.850651,0.000000), _
(0.000000,-0.525731,-0.850651), _
(0.000000,0.525731,-0.850651), _
(0.000000,0.525731,0.850651)}

Dim As Ulong colours(1 To 20)
Dim As triangle p(1 To 20),rot(1 To 20)
blow(d(),Type(1024\2,768\2,0),200)
setcolours(colours())
setup(p(),d(),colours())

Dim  As Angle3D A3d
Dim As pt ang
Dim As pt c=Type(1024\2,768\2,0)
Dim As Long mx,my,btn
Color ,Rgb(255,255,255)

Dim Win As Any Ptr

Screencontrol 2, *Cptr(Integer Ptr,@Win )
Dim Shared As HFONT  ThisFont:ThisFont=Set_Font("Times new roman",16,0,0,0,0)
Var Cc=CreateWindowEx(0,"button","alpha", WS_VISIBLE Or WS_CHILD,0,0,70,30,win,0,0,0)
Var Dd=CreateWindowEx(0,"Button","solid", WS_VISIBLE Or WS_CHILD,70,0,70,30,win,0,0,0)
Var c1=CreateWindowEx(0,"STATIC","", WS_VISIBLE Or WS_CHILD ,150,650,300,40,win,0,0,0)
Var Ee=CreateWindowEx(0,"Button","wire",WS_BORDER Or WS_VISIBLE Or WS_CHILD,140,0,70,30,win,0,0,0)
Var Gg=CreateWindowEx(0,"Button","glass",WS_BORDER Or WS_VISIBLE Or WS_CHILD,210,0,70,30,win,0,0,0)
createtooltip(win,"Note: This is an OpenGL screen, showing buttons and fonts and tooltips from Win32 api")
SetWindowTheme(win," "," ")

SetWindowLong(win, GWL_STYLE, GetWindowLong(win, GWL_STYLE) and not WS_MAXIMIZEBOX) ' don't want full screen
              

SendMessage(Cc,WM_SETFONT,Cast(WPARAM,ThisFont),0)
SendMessage(Dd,WM_SETFONT,Cast(WPARAM,ThisFont),0)
SendMessage(Ee,WM_SETFONT,Cast(WPARAM,ThisFont),0)
SendMessage(Gg,WM_SETFONT,Cast(WPARAM,ThisFont),0)
ThisFont=Set_Font("Times new roman",26,0,0,0,0)
SendMessage(C1,WM_SETFONT,Cast(WPARAM,ThisFont),0)
Dim As msg msg
Dim As Long flag,fps
windowtitle "OpenGL with Win32"
While true
      While (PeekMessage (@Msg, NULL, 0, 0, PM_REMOVE) > 0)
            TranslateMessage (@Msg)
            DispatchMessage (@Msg)
            Select Case msg.hwnd
            Case Cc 'alpha
                  Select Case msg.message
                  
                  Case WM_LBUTTONDOWN
                        wire=0
                        solid=0
                        glass=0
                        glEnable (GL_BLEND)
                  End Select
                  
            Case Dd 'solid
                  Select Case msg.message
                  Case WM_LBUTTONDOWN
                        wire=0
                        solid=1
                        glass=0
                        gldisable (GL_BLEND)
                  End Select 
                  
            Case Ee
                  Select Case msg.message
                  Case WM_LBUTTONDOWN
                        wire=1
                        solid=0
                        glass=0
                  End Select
                  
            Case Gg 'glass
                  Select Case msg.message
                  Case WM_LBUTTONDOWN
                        wire=1
                        'solid=1
                        glass=1
                        glEnable (GL_BLEND)
                  End Select
                  
            Case Else
                  
                  setwindowtext(C1,"framerate = "+Str(fps))   
                  
            End Select
            
            If Inkey=Chr(255)+"k" Then End
      Wend
      ang.x+=.03/2  'the orbiting speed
      ang.y+=.02/2
      ang.z+=.01/2
      
      A3D=Angle3D.construct(ang.x,ang.y,ang.z)
      For n As Long=1 To 20
            For m As Long=0 To 2
                  rot(n).p(m)=Rotate(c,p(n).p(m),A3D)
                  rot(n).p(m)=perspective(rot(n).p(m),Type(1024\2,768\2,2000))
            Next m
            rot(n).ctr=Rotate(c,p(n).ctr,A3D)
            rot(n).norm=Type(rot(n).ctr.x-c.x,rot(n).ctr.y-c.y,rot(n).ctr.z)
            rot(n).col=p(n).col
      Next n
      
      sort(rot())
      
      glClear(GL_COLOR_BUFFER_BIT)
      show(rot())
      Flip
      Sleep regulate(60,fps),1
      if inkey=chr(32) then exit while
Wend

triangles:
Data _
2,3, 7, _
2, 8, 3, _
4, 5, 6, _
5, 4, 9, _
7, 6, 12, _
6, 7, 11, _
10, 11, 3, _
11, 10, 4, _
8, 9, 10, _
9, 8, 1, _
12, 1, 2, _
1, 12, 5, _
7, 3, 11, _
2, 7, 12, _
4, 6, 11, _
6, 5, 12, _
3, 8, 10, _
8, 2, 1, _
4, 10, 9, _
5, 9, 1



  
   

[jaskin]

The opengl screens are kind of bare bones, they can handle some win32 components.
I have not tried scrolling though, maybe sometime.
Here are a few: buttons, themes, disable fullscreen, tooltips, fonts.

Again, interesting but why bother? Win32 APIs are so much simpler despite their lack of user-friendliness. Boy, I do miss the old days when I worked with X-windows on other operating systems. It was so much easier.

[srvaldez]

hello jaskin
UEZ posted a Winn 11 console here viewtopic.php?p=301467#p301467
it might be of interest to you, also see Simple WinAPI GUI
dodicat, very nice demo

[jaskin]

hello jaskin
UEZ posted a Winn 11 console here viewtopic.php?p=301467#p301467
it might be of interest to you, also see Simple WinAPI GUI
dodicat, very nice demo

Very interesting, thanks. I found the examples in Simple WinAP GUI useful but I fail to see the point of yet another layer of complex instructions to create and modify windows. I rather go to the source and use Win32 API calls directly. At least that way I have complete control. I'll use the examples as a learning exercise on how to use Win32 API calls.

[srvaldez]

I rather go to the source and use Win32 API calls directly.

then perhaps the examples in Charles Petzold book "Programming Windows" will be of interest https://archive.org/details/programming ... mpanion-cd

[jaskin]

I rather go to the source and use Win32 API calls directly.

then perhaps the examples in Charles Petzold book "Programming Windows" will be of interest https://archive.org/details/programming ... mpanion-cd

Thank you, I will have a look.

[deltarho[1859]]

@dodicat

Really nice indeed.

Off-topic, but I had a look at fbc 1.20.0/gcc 11.2.0/clang vs fbc 1.10.1/gcc 9.3

Here are the binaries in KiB.

Code: Select all

      64-bit 32-bit
clang  142    148
gcc    135    125

clang likes 64-bit.

[BasicCoder2]

@jaskin

I rather go to the source and use Win32 API calls directly.

It depends on what you are programming and why. I spent time learning to use the Win32 API using C++ but found no advantage over using Visual Basic (at the time) with its GUI editor. I have always rolled my own GUI since the DOS days including simple GUI editors just for the challenge. It also depends if you want your program to run on Linux as well, in which case you would use a cross platform library.
viewtopic.php?t=24547

[Roland Chastain]

Is it possible to have a vertical scroll bar when using screenres to create a window?

You might take a look to the sGUI library, which has a scrollbar, and is multiplatform.

[jaskin]

@jaskin

I rather go to the source and use Win32 API calls directly.

It depends on what you are programming and why.

I am already programming using WinFBE for computational purposes. The program is many thousand lines long with hundreds of functions. I now just want to add a GUI window with a list of text, each line set to a specific color by the program, and is scrollable in case the list is too long to display all at once. I have no other requirement at this time but one day I might add widgets to my program, which WinFBE can do.