|
|
Post by Marco Kurvers on Dec 15, 2023 13:53:35 GMT
Here I have templates and modules that I have made.
Insert this in your program. Choose File and then Insert File...
|
|
|
|
Post by Marco Kurvers on Dec 15, 2023 13:58:18 GMT
This module is a Filemanager module. All the subroutines and functions begins with the name File. You can see in the comment how you can use the module.
'The File module with a demo. Save the module without the demo.
'Insert the module in an another program.
'Do not copy and paste the module, but only insert this.
'==============================================================
dim filemanager$(0, 0)
path$ = "" 'use your path here
if not(File.FillInfo(path$)) then
if filemanager$(0, 3) = "" then
print "Directory not found."
end
end if
end if
print "Number of files: "; File.FilesFound()
print "File Tabstrip1.lbf ";
if File.Exist("Tabstrip1.lbf") then
print "exist."
else
print "does not exist."
end if
print "Subdirectory's: "; File.SubDirsFound()
print "Filename 10: "; File.Name$(10)
print File.DirPath$()
print File.FullPath$()
print File.SubDir$()
'=============================================================
function File.FillInfo(pathSpec$)
files pathSpec$, filemanager$()
File.FillInfo = val(filemanager$(0, 0)) > 0
end function
function File.Exist(file$)
'files path$, file$, filemanager$()
'File.Exist = val(filemanager$(0, 0)) > 0
found = 0
i = 1
while i <= val(filemanager$(0, 0)) and not(found)
found = filemanager$(i, 0) = file$
i = i + 1
wend
File.Exist = found
end function
function File.FilesFound()
files$ = filemanager$(0, 0)
File.FilesFound = val(files$)
end function
function File.SubDirsFound()
subDirs$ = filemanager$(0, 1)
File.SubDirsFound = val(subDirs$)
end function
function File.DriveSpec$()
File.DriveSpec$ = filemanager$(0, 2)
end function
function File.DirPath$()
File.DirPath$ = filemanager$(0, 3)
end function
function File.Name$(fileNr)
if fileNr <= File.FilesFound() then
File.Name$ = filemanager$(fileNr, 0)
else
File.Name$ = "Filenumber index out of range!"
end if
end function
function File.Size(fileNr)
fileSize = val(filemanager$(fileNr, 1))
File.Size = fileSize
end function
function File.DateTime$(fileNr)
File.DateTime$ = filemanager$(fileNr, 2)
end function
function File.Attribute(fileNr)
File.Attribute = val(filemanager$(fileNr, 3))
end function
function File.FullPath$()
count = val(filemanager$(0, 0))
File.FullPath$ = filemanager$(count + 1, 0)
end function
function File.SubDir$()
count = val(filemanager$(0, 0))
File.SubDir$ = filemanager$(count + 1, 1)
end function
|
|
|
|
Post by Marco Kurvers on Dec 15, 2023 14:07:42 GMT
This module is a Canvas module to make it easier to draw. There is a function as a private function. Do not call this function. The Canvas use it self.
You can use the Canvas with a graphics window or a graphicbox control.
The module is not complete. There will be new updates every time with more functionality.
'Don't forget to call the Canvas.Init with the window handle first ...
'... as parameter.
'Example: call Canvas.Init "#g"
global False : False = 0 ' Place these globals on the top of your program
global True : True = 1
sub Quit handle$
close #g
end
end sub
sub Canvas.Init handle$
struct Canvas,_
handle$ as ptr
Canvas.handle$.struct = handle$
struct Pen,_
size as ulong,_
color$ as ptr,_
backcolor$ as ptr
Pen.size.struct = 1
Pen.color$.struct = "black"
Pen.backcolor$.struct = "black"
struct RGB,_
red as word,_
green as word,_
blue as word,_
string$ as ptr
end sub
function GetHandle$() 'private in the Canvas: do not call this function
GetHandle$ = winstring(Canvas.handle$.struct)
end function
sub Canvas.WindowPos x, y
UpperLeftX = x
UpperLeftY = y
end sub
sub Canvas.WindowSize w, h
WindowWidth = w
WindowHeight = h
end sub
sub Canvas.Cls
handle$ = GetHandle$()
#handle$ "cls"
end sub
sub Canvas.SetPen size, color$
handle$ = GetHandle$()
#handle$ "size "; size
#handle$ "color "; color$
Pen.size.struct = size
Pen.color$.struct = color$
end sub
sub Canvas.GetPen byref size, byref color$
size = Pen.size.struct
color$ = winstring(Pen.color$.struct)
end sub
sub Canvas.SetRGB r, g, b
RGB.red.struct = r
RGB.green.struct = g
RGB.blue.struct = b
RGB.string$ = r; " "; g; " "; b
end sub
function Canvas.GetRGB$()
Canvas.GetRGB$ = winstring(RGB.string$.struct)
end function
sub Canvas.Down
handle$ = GetHandle$()
#handle$ "down"
end sub
sub Canvas.Up
handle$ = GetHandle$()
#handle$ "up"
end sub
sub Canvas.SetPenDown x, y
call Canvas.Down
call Canvas.Place x, y
end sub
sub Canvas.Rule ruleConst
handle$ = GetHandle$()
#handle$ "rule "; ruleConst
end sub
function Canvas.TextWidth(string$)
handle$ = GetHandle$()
#handle$ "stringwidth? string$ width"
Canvas.TextWidth = width
end function
sub Canvas.SetText string$
handle$ = GetHandle$()
#handle$ "|"; string$
end sub
sub Canvas.BackColor color$
handle$ = GetHandle$()
#handle$ "backcolor "; color$
Pen.backcolor$.struct = color$
end sub
function Canvas.BackColor$()
Canvas.BackColor$ = winstring(Pen.backcolor$.struct)
end function
sub Canvas.Color color$
handle$ = GetHandle$()
#handle$ "color "; color$
Pen.color$.struct = color$
end sub
function Canvas.Color$()
Canvas.Color$ = winstring(Pen.color$.struct)
end function
sub Canvas.Place x, y
handle$ = GetHandle$()
#handle$ "place "; x; " "; y
end sub
sub Canvas.Point x, y
handle$ = GetHandle$()
#handle$ "set "; x; " "; y
end sub
sub Canvas.LineTo x2, y2
handle$ = GetHandle$()
call Canvas.GetPos x1, y1
#handle$ "line "; x1; " "; y1; " "; x2; " "; y2
end sub
sub Canvas.Line x1, y1, x2, y2
handle$ = GetHandle$()
#handle$ "line "; x1; " "; y1; " "; x2; " "; y2
end sub
sub Canvas.Box x1, y1, x2, y2, filled
call Canvas.Place x1, y1
handle$ = GetHandle$()
if filled then
#handle$ "boxfilled "; x2; " "; y2
else
#handle$ "box "; x2; " "; y2
end if
end sub
sub Canvas.Rectangle x, y, w, h, filled
call Canvas.Place x, y
handle$ = GetHandle$()
if filled then
#handle$ "boxfilled "; x + w; " "; y + h
else
#handle$ "box "; x + w; " "; y + h
end if
end sub
sub Canvas.Circle x, y, r, f
call Canvas.Place x, y
handle$ = GetHandle$()
if f then
#handle$ "circlefilled "; r
else
#handle$ "circle "; r
end if
end sub
sub Canvas.Ellipse x, y, w, h, filled
call Canvas.Place x, y
handle$ = GetHandle$()
if filled then
#handle$ "ellipsefilled "; w; " "; h
else
#handle$ "ellipse "; w; " "; h
end if
end sub
sub Canvas.GotoXY x, y, withPen
if withPen then
call Canvas.Down
else
call Canvas.Up
end if
handle$ = GetHandle$()
#handle$ "goto "; x; " "; y
end sub
sub Canvas.Center
handle$ = GetHandle$()
#handle$ "home"
end sub
sub Canvas.Home
call Canvas.Place 0, 0
end sub
sub Canvas.HScrollBar visible, min, max, withMinMax
handle$ = GetHandle$()
if visible then
if withMinMax then
#handle$ "horizscrollbar on "; min; " "; max
else
#handle$ "horizscrollbar on"
end if
else
#handle$ "horizscrollbar off"
end if
end sub
sub Canvas.VScrollBar visible, min, max, withMinMax
handle$ = GetHandle$()
if visible then
if withMinMax then
#handle$ "vertscrollbar on "; min; " "; max
else
#handle$ "vertscrollbar on"
end if
else
#handle$ "vertscrollbar off"
end if
end sub
sub Canvas.GetPos byref x, byref y
handle$ = GetHandle$()
#handle$ "posxy x y"
end sub
sub Canvas.Pie x, y, w, h, angle1, angle2, filled
handle$ = GetHandle$()
call Canvas.Place x, y
if filled then
#handle$ "piefilled "; w; " "; h; " "; angle1; " "; angle2
else
#handle$ "pie "; w; " "; h; " "; angle1; " "; angle2
end if
end sub
sub Canvas.DrawBmp bmpName$, x, y
handle$ = GetHandle$()
#handle$ "drawbmp "; bmpName$; " "; x; " "; y
end sub
function Canvas.GetBmp$(x, y, w, h)
handle$ = GetHandle$()
#handle$ "getbmp bmpName$ "; x; " "; y; " "; w; " "; h
Canvas.GetBmp$ = bmpName$
end function
|
|
|
|
Post by Marco Kurvers on Dec 15, 2023 21:43:41 GMT
Here, I have a new Canvas module update included.
In these new update you find the follow:
- The PI is inserted in the Canvas
- There is a new Pie method with the Methodname Canvas.PieAngle
I will fix a problem with filling the PieAngle, because there are open lines in the filling. With a size of 5 it will fill correct only with a good width and a good height, but it wll not correct with a greater width and a greater height. Also, with a small width and a small height, you can see rounds in de pie.
The solutions comes in the next update.
|
|
|
|
Post by Marco Kurvers on Dec 15, 2023 21:45:02 GMT
Here is the update.
'Don't forget to call the Canvas.Init with the window handle first ...
'... as parameter.
'Example: call Canvas.Init "#g"
global False : False = 0
global True : True = 1
sub Canvas.Init handle$
struct Canvas,_
handle$ as ptr,_
PI as double
Canvas.handle$.struct = handle$
Canvas.PI.struct = atn(1) * 4
struct Pen,_
size as ulong,_
color$ as ptr,_
backcolor$ as ptr
Pen.size.struct = 1
Pen.color$.struct = "black"
Pen.backcolor$.struct = "black"
struct RGB,_
red as word,_
green as word,_
blue as word,_
string$ as ptr
end sub
function GetHandle$() 'private in de Canvas: roep deze niet aan
GetHandle$ = winstring(Canvas.handle$.struct)
end function
sub Canvas.WindowPos x, y
UpperLeftX = x
UpperLeftY = y
end sub
sub Canvas.WindowSize w, h
WindowWidth = w
WindowHeight = h
end sub
sub Canvas.Cls
handle$ = GetHandle$()
#handle$ "cls"
end sub
sub Canvas.SetPen size, color$
handle$ = GetHandle$()
#handle$ "size "; size
#handle$ "color "; color$
Pen.size.struct = size
Pen.color$.struct = color$
end sub
sub Canvas.GetPen byref size, byref color$
size = Pen.size.struct
color$ = winstring(Pen.color$.struct)
end sub
sub Canvas.SetRGB r, g, b
RGB.red.struct = r
RGB.green.struct = g
RGB.blue.struct = b
RGB.string$ = r; " "; g; " "; b
end sub
function Canvas.GetRGB$()
Canvas.GetRGB$ = winstring(RGB.string$.struct)
end function
sub Canvas.Down
handle$ = GetHandle$()
#handle$ "down"
end sub
sub Canvas.Up
handle$ = GetHandle$()
#handle$ "up"
end sub
sub Canvas.SetPenDown x, y
call Canvas.Down
call Canvas.Place x, y
end sub
sub Canvas.Rule ruleConst
handle$ = GetHandle$()
#handle$ "rule "; ruleConst
end sub
function Canvas.TextWidth(string$)
handle$ = GetHandle$()
#handle$ "stringwidth? string$ width"
Canvas.TextWidth = width
end function
sub Canvas.SetText string$
handle$ = GetHandle$()
#handle$ "|"; string$
end sub
sub Canvas.BackColor color$
handle$ = GetHandle$()
#handle$ "backcolor "; color$
Pen.backcolor$.struct = color$
end sub
function Canvas.BackColor$()
Canvas.BackColor$ = winstring(Pen.backcolor$.struct)
end function
sub Canvas.Color color$
handle$ = GetHandle$()
#handle$ "color "; color$
Pen.color$.struct = color$
end sub
function Canvas.Color$()
Canvas.Color$ = winstring(Pen.color$.struct)
end function
sub Canvas.Place x, y
handle$ = GetHandle$()
#handle$ "place "; x; " "; y
end sub
sub Canvas.Point x, y
handle$ = GetHandle$()
#handle$ "set "; x; " "; y
end sub
sub Canvas.LineTo x2, y2
handle$ = GetHandle$()
call Canvas.GetPos x1, y1
#handle$ "line "; x1; " "; y1; " "; x2; " "; y2
end sub
sub Canvas.Line x1, y1, x2, y2
handle$ = GetHandle$()
#handle$ "line "; x1; " "; y1; " "; x2; " "; y2
end sub
sub Canvas.Box x1, y1, x2, y2, filled
call Canvas.Place x1, y1
handle$ = GetHandle$()
if filled then
#handle$ "boxfilled "; x2; " "; y2
else
#handle$ "box "; x2; " "; y2
end if
end sub
sub Canvas.Rectangle x, y, w, h, filled
call Canvas.Place x, y
handle$ = GetHandle$()
if filled then
#handle$ "boxfilled "; x + w; " "; y + h
else
#handle$ "box "; x + w; " "; y + h
end if
end sub
sub Canvas.Circle x, y, r, f
call Canvas.Place x, y
handle$ = GetHandle$()
if f then
#handle$ "circlefilled "; r
else
#handle$ "circle "; r
end if
end sub
sub Canvas.Ellipse x, y, w, h, filled
call Canvas.Place x, y
handle$ = GetHandle$()
if filled then
#handle$ "ellipsefilled "; w; " "; h
else
#handle$ "ellipse "; w; " "; h
end if
end sub
sub Canvas.GotoXY x, y, withPen
if withPen then
call Canvas.Down
else
call Canvas.Up
end if
handle$ = GetHandle$()
#handle$ "goto "; x; " "; y
end sub
sub Canvas.Center
handle$ = GetHandle$()
#handle$ "home"
end sub
sub Canvas.Home
call Canvas.Place 0, 0
end sub
sub Canvas.HScrollBar visible, min, max, withMinMax
handle$ = GetHandle$()
if visible then
if withMinMax then
#handle$ "horizscrollbar on "; min; " "; max
else
#handle$ "horizscrollbar on"
end if
else
#handle$ "horizscrollbar off"
end if
end sub
sub Canvas.VScrollBar visible, min, max, withMinMax
handle$ = GetHandle$()
if visible then
if withMinMax then
#handle$ "vertscrollbar on "; min; " "; max
else
#handle$ "vertscrollbar on"
end if
else
#handle$ "vertscrollbar off"
end if
end sub
sub Canvas.GetPos byref x, byref y
handle$ = GetHandle$()
#handle$ "posxy x y"
end sub
sub Canvas.Size size
handle$ = GetHandle$()
#handle$ "size "; size
end sub
sub Canvas.Pie x, y, w, h, angle1, length, filled
handle$ = GetHandle$()
call Canvas.Place x, y
if filled then
#handle$ "piefilled "; w; " "; h; " "; angle1; " "; length
else
#handle$ "pie "; w; " "; h; " "; angle1; " "; length
end if
end sub
sub Canvas.PieAngle size, x, y, width, height, start, ending, filled
call Canvas.Size size
for i = start to ending
w1 = i * (Canvas.PI.struct / 180)
if i = start then
x1 = int(x + width * Cos(w1))
y1 = int(y - height * Sin(w1))
call Canvas.Line x, y, x1, y1
else
x2 = int(x + width * Cos(w1))
y2 = int(y - height * Sin(w1))
call Canvas.Line x1, y1, x2, y2
if filled then
call Canvas.Size 5
call Canvas.Line x, y, x2, y2
call Canvas.Size size
end if
x1 = x2
y1 = y2
end if
next i
call Canvas.LineTo x, y
end sub
sub Canvas.DrawBmp bmpName$, x, y
handle$ = GetHandle$()
#handle$ "drawbmp "; bmpName$; " "; x; " "; y
end sub
function Canvas.GetBmp$(x, y, w, h)
handle$ = GetHandle$()
#handle$ "getbmp bmpName$ "; x; " "; y; " "; w; " "; h
Canvas.GetBmp$ = bmpName$
end function
|
|
|
|
Post by Marco Kurvers on Dec 15, 2023 22:13:26 GMT
Here is a template Window Default. You can insert this so you have a complete empty window with a trapclose sub.
open "" for window as #w
#w "trapclose Quit"
wait
sub Quit handle$
close #handle$
end
end sub
|
|
|
|
Post by Marco Kurvers on Jan 15, 2024 11:38:13 GMT
The next template that I have is with a resize handler. In the next post I give you a demo how it works. The characters <w>, <h>, <pX> and <pY> must be values that you can assign to the WIDTH, HEIGHT, UpperLeftX and UpperLeftY variables. You see also the numbers 16 and 39 in the Anchor subroutine. You can't only use the constants WIDTH and HEIGHT for correct testing the width and height of the window. GLOBAL WIDTH: WIDTH = <w>
GLOBAL HEIGHT: HEIGHT = <h>
UpperLeftX = <pX>
UpperLeftY = <pY>
WindowWidth = WIDTH
WindowHeight = HEIGHT
CALL Main
SUB Main
'place here controls
OPEN "" FOR window AS #w
#w "trapclose Quit"
#w "resizehandler Anchor"
WAIT
END SUB
SUB Anchor handle$
IF WindowWidth < WIDTH - 16 OR WindowHeight < HEIGHT - 39 THEN
WindowWidth = WIDTH
WindowHeight = HEIGHT
CLOSE #w
CALL Main
END IF
'locate the controls here
#w "refresh"
END SUB
|
|
|
|
Post by Marco Kurvers on Jan 15, 2024 11:42:37 GMT
Here is the demo. You can change the comment code to see what they does. Also, try understand the different of UL and LR options of the buttons. Note that the LR button is not placed in the Anchor subroutine.
GLOBAL WIDTH: WIDTH = 400
GLOBAL HEIGHT: HEIGHT = 300
UpperLeftX = 200
UpperLeftY = 200
WindowWidth = WIDTH
WindowHeight = HEIGHT
CALL Main
SUB Main
'TEXTBOX #w.txtAnchor, 0, 100, WindowWidth - 16, 35
TEXTBOX #w.txtAnchor, 100, 0, 35, WindowHeight - 39
'TEXTBOX #w.txtAnchor, 0, 0, WindowWidth - 16, WindowHeight - 39
BUTTON #w.btnAnchor1, "Anchor 1", btnAnchor1, UL, WindowWidth - 210, WindowHeight - 105, 80, 45
BUTTON #w.btnAnchor2, "Anchor 2", btnAnchor2, LR, 80, 40, 80, 45
OPEN "Anchor" FOR window AS #w
#w "trapclose Quit"
#w "resizehandler Anchor"
print WindowWidth, WindowHeight
WAIT
END SUB
SUB Anchor handle$
print WindowWidth, WindowHeight, WIDTH, HEIGHT
IF WindowWidth < WIDTH - 16 OR WindowHeight < HEIGHT - 39 THEN
WindowWidth = WIDTH
WindowHeight = HEIGHT
CLOSE #w
CALL Main
END IF
'#w.txtAnchor "!locate 0 100 "; WindowWidth; " 35"
#w.txtAnchor "!locate 100 0 35 "; WindowHeight
'#w.txtAnchor "!locate 0 0 "; WindowWidth; " "; WindowHeight
#w.btnAnchor1 "!locate "; WindowWidth - 194; " "; WindowHeight - 67; " 80 45"
#w "refresh"
END SUB
SUB Quit handle$
CLOSE #handle$
END
END SUB
|
|
|
|
Post by Marco Kurvers on Nov 9, 2024 16:35:10 GMT
|
|
|
|
Post by frizhd on Nov 9, 2024 18:00:04 GMT
De canvasmodule werkt niet Marco. Ik krijg een foutmelding (SyntaX error)
Foutje? Even Apeldoorn bellen. Zal een bugje zijn.
|
|
|
|
Post by Marco Kurvers on Nov 9, 2024 20:09:17 GMT
De foutjes heb ik gevonden en zijn eruit.
Dank je wel Friz. Ik zal het bericht vernieuwen en ook moet ik de download op mijn website vernieuwen.
|
|
|
|
Post by Marco Kurvers on Nov 9, 2024 20:11:49 GMT
Hier komt de verbeterde Canvas module zonder de foutjes. Op de website moet ik het nog verbeteren. Canvas module v2.lbf (18.42 KB) Mocht er toch wat fout gaan, dan kun je het melden. Dan zal ik er naar kijken en verbeteren. Waarschijnlijk werkt het nu wel. N.B. Mocht er een DLL fout verschijnen run dan het programma nog eens, totdat je zal zien dat de fout ineens niet meer verschijnt en alles het gewoon doet. Ik krijg af en toe de DLL fout wel, maar misschien jullie niet. Ik weet het nog niet waarom dat gebeurd. Het is geen fout in de module. Ik zou een bericht kunnen versturen in de Liberty BASIC forum. |
|
