screenres with a vertical scroll bar
screenres with a vertical scroll bar
Is it possible to have a vertical scroll bar when using screenres to create a window?
-
- Posts: 438
- Joined: Sep 28, 2013 15:08
- Location: Germany
Re: screenres with a vertical scroll bar
No, not really. You might try to use the Windows API, I found this code:
(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.
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
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.
Re: screenres with a vertical scroll bar
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.
Re: screenres with a vertical scroll bar
You will have to make your own scrolling mechanism for fb screens.
this old code:
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)
Re: screenres with a vertical scroll bar
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
Re: screenres with a vertical scroll bar
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.
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
Re: screenres with a vertical scroll bar
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.
Re: screenres with a vertical scroll bar
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
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
Re: screenres with a vertical scroll bar
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 wrote: ↑Mar 21, 2024 15:34 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
Re: screenres with a vertical scroll bar
then perhaps the examples in Charles Petzold book "Programming Windows" will be of interest https://archive.org/details/programming ... mpanion-cd
Re: screenres with a vertical scroll bar
Thank you, I will have a look.srvaldez wrote: ↑Mar 21, 2024 20:32then perhaps the examples in Charles Petzold book "Programming Windows" will be of interest https://archive.org/details/programming ... mpanion-cd
-
- Posts: 4313
- Joined: Jan 02, 2017 0:34
- Location: UK
- Contact:
Re: screenres with a vertical scroll bar
@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.
clang likes 64-bit.
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
-
- Posts: 3909
- Joined: Jan 01, 2009 7:03
- Location: Australia
Re: screenres with a vertical scroll bar
@jaskin
viewtopic.php?t=24547
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.I rather go to the source and use Win32 API calls directly.
viewtopic.php?t=24547
-
- Posts: 1007
- Joined: Nov 24, 2011 19:49
- Location: France
- Contact:
Re: screenres with a vertical scroll bar
You might take a look to the sGUI library, which has a scrollbar, and is multiplatform.
Re: screenres with a vertical scroll bar
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.BasicCoder2 wrote: ↑Mar 22, 2024 6:26 @jaskin
It depends on what you are programming and why.I rather go to the source and use Win32 API calls directly.