Liberty BASIC Community Forum
« Search Results »

Welcome Guest. Please Login or Register.
Feb 22nd, 2018, 05:06am


Rules|Home|Help|Search|Recent Posts|Notification

--Liberty BASIC Resources--
Liberty BASIC Community WikiSpace
Frequently Asked Questions
Bay Six Software Forum
Liberty BASIC Home Page
Carl Gundel's Blog
Official Liberty BASIC Support
Liberty BASIC Programmer's Encyclopedia
Liberty BASIC on Rosetta Code

Search Results

Total results: 10


 1   Game and Graphic Programming / Re: draw it 2.0  on: Today at 04:38am
Started by bluatigro | Post by bluatigro
update try at triangles

triangle instructions :
choise color
click on 3 point's in screen

error :
nothing is drawn

Code:
''les 99g draw it


WindowWidth = DisplayWidth
WindowHeight = DisplayHeight
nomainwin
global mode , pixel , lijn , ellipse , box , tel
global triangle , text , text$ , font$
global ellipsefill , boxfill , ox , oy , nx , ny
global file$ , size , winx , winy , color$ , backolor$
dim x( 2 ) , y( 2 )
winx = WindowWidth
winy = WindowHeight
menu #m , "file" _
        , "new" , [new] _
        , "open" , [open] _
        , "save" , [save] _
        , "save as" , [saveAs] _
        , "print" , [print] _
        ,|, "exit" , [quit]
menu #m , "tools" _
        , "pixel" , [pixel] _
        , "line" , [line] _
        , "ellipse" , [ellipse] _
        , "ellipse fill" , [ellipsefill] _
        , "box" , [box] _
        , "box fill" , [boxfill] _
        , "triangle" , [triangle] _
        ,|, "font" , [font] _
        , "text" , [text] _
        ,|, "size" , [size] _
        ,|, "color" , [color] _
        , "backcolor" , [backcolor]
size = 1
pixel = 1
lijn = 2
ellipse = 3
ellipsefill = 4
box = 5
boxfill = 6
font$ = " 24 bold"
text$ = "type text here"
text = 7
triangle = 8
color$ = "black"
backcolor$ = "yellow"
mode = pixel
graphicbox #m.g , 0 , 0 , winx , winy
open "draw it 2.0" for graphics as #m
  #m "trapclose [quit]"
  #m "font " ; font$
  #m "when mouseMove [move]"
  #m "when leftButtonDown [leftdown]"
  #m "when leftButtonMove [leftmove]"
  #m "when leftButtonUp [leftup]"
  #m "setfocus"
wait
[move]
  nx = MouseX
  ny = MouseY
wait
[leftmove]
  nx = MouseX
  ny = MouseY
  #m "rule " ; _R2_NOTXORPEN
  #m "color black"
  select case mode
    case lijn
      #m "down"
      #m "line " ; ox ; " " ; oy ; " " ; nx ; " " ; ny
      #m "up"
      #m "down"
      #m "line " ; ox ; " " ; oy ; " " ; nx ; " " ; ny
      #m "up"
    case ellipse
      #m "goto " ; ( ox + nx ) / 2 ; " " ; ( oy + ny ) / 2
      #m "down"
      #m "ellipse " ; nx - ox ; " " ; ny - oy
      #m "up"
      #m "goto " ; ( ox + nx ) / 2 ; " " ; ( oy + ny ) / 2
      #m "down"
      #m "ellipse " ; nx - ox ; " " ; ny - oy
      #m "up"
    case ellipsefill
      #m "goto " ; ( ox + nx ) / 2 ; " " ; ( oy + ny ) / 2
      #m "down"
      #m "ellipse " ; nx - ox ; " " ; ny - oy
      #m "up"
      #m "goto " ; ( ox + nx ) / 2 ; " " ; ( oy + ny ) / 2
      #m "down"
      #m "ellipse " ; nx - ox ; " " ; ny - oy
      #m "up"
    case box
      #m "goto " ; ox ; " " ; oy
      #m "down"
      #m "box " ; nx ; " " ; ny
      #m "up"
      #m "goto " ; ox ; " " ; oy
      #m "down"
      #m "box " ; nx ; " " ; ny
      #m "up"
    case boxfill
      #m "goto " ; ox ; " " ; oy
      #m "down"
      #m "box " ; nx ; " " ; ny
      #m "up"
      #m "goto " ; ox ; " " ; oy
      #m "down"
      #m "box " ; nx ; " " ; ny
      #m "up"
    case else
      #m "rule " ; _R2_COPYPEN
      #m "color " ; color$ 
      #m "size " ; size
      #m "goto " ; nx ; " " ; ny
      #m "down"
      #m "set " ; nx ; " " ; ny
      #m "up"
  end select
wait
sub sleep ms
  CallDLL #kernel32, "Sleep" _
  , ms As long _
  , ret As void
end sub
[leftdown]
  ox = MouseX
  oy = MouseY
  if mode = triangle then
    x( tel ) = ox
    y( tel ) = oy
    tel = tel + 1
  end if
wait
[leftup]
  #m "rule " ; _R2_COPYPEN
  #m "color " ; color$
  #m "backcolor " ; backcolor$
  #m "size " ; size
  select case mode
    case lijn
      #m "down"
      #m "line " ; ox ; " " ; oy ; " " ; nx ; " " ; ny
      #m "up"
    case ellipse
      #m "goto " ; ( ox + nx ) / 2 ; " " ; ( oy + ny ) / 2
      #m "down"
      #m "ellipse " ; nx - ox ; " " ; ny - oy
      #m "up"
    case ellipsefill
      #m "goto " ; ( ox + nx ) / 2 ; " " ; ( oy + ny ) / 2
      #m "down"
      #m "ellipsefilled " ; nx - ox ; " " ; ny - oy
      #m "up"
    case box
      #m "goto " ; ox ; " " ; oy
      #m "down"
      #m "box " ; nx ; " " ; ny
      #m "up"
    case boxfill
      #m "goto " ; ox ; " " ; oy
      #m "down"
      #m "boxfilled " ; nx ; " " ; ny
      #m "up"
    case text
      #m "goto " ; ox ; " " ; oy
      #m "down"
      #m "\" ; text$
      #m "up"
    case triangle
      if tel = 3 then
        tel = 0
        call tri x(0),y(0),x(1),y(1),x(2),y(2),color$
      end if
    case else
  end select
wait
sub tri x1 , y1 , x2 , y2 , x3 , y3 , kl$
  #m "color "; kl$
  if y1 = y2 then y1 = y1 - 1e-10
  if y2 = y3 then y3 = y3 + 1e-10
  if y1 > y3 then
    call swap y1 , y3
    call swap x1 , x3
  end if
  if y1 > y2 then
    call swap y1 , y2
    call swap x1 , x2
  end if
  if y2 > y3 then
    call swap y2 , y3
    call swap x2 , x3
  end if
  for i = y1 to y3
    a = x1 + ( x3 - x1 ) * (i-y1) / ( y3 - y1 )
    if i < y2 then
      b = x1 + ( x2 - x1 ) * (i-y1) / ( y2 - y1 )
    else
      b = x2 + ( x3 - x2 ) * (i-y2) / ( y3 - y2 )
    end if
    #m "down"
    #m "line " ; a ; " " ; i ; " " ; b ; " " ; i
    #m "up"
  next i
end sub
[pixel]
  mode = pixel
wait
[line]
  mode = lijn
wait
[ellipse]
  mode = ellipse
wait
[ellipsefill]
  mode = ellipsefill
wait
[box]
  mode = box
wait
[boxfill]
  mode = boxfill
wait
[triangle]
  tel = 0
  mode = triangle
wait
[font]
  fontdialog font$ , font$
  #m "font " ; font$
wait
[text]
  prompt "text = " ; text$
  mode = text
wait
[size]
  s$ = str$( size )
  prompt "size = " ; s$
  size = val( s$ )
wait
[color]
  colordialog color$ , color$
wait
[backcolor]
  colordialog backcolor$ , backcolor$
wait
[new]
  file$ = DefaultDir$ + "\unnamed.bmp"
  #m "fill white"
wait
[open]
  filedialog "open bmp" , "*.bmp" , file$
  loadbmp "drawing" , file$
  #m "background drawing"
wait
[saveAs]
  filedialog "save bmp" , "*.bmp" , file$
[save]
  #m "getbmp drawing 0 0 " ; winx ; " " ; winy
  bmpsave "drawing" , file$
wait
[print]
  #m "getbmp screen 0 0 " ; winx ; " " ; winy
  #m.g "cls"
  #m.g "drawbmp screen 0 0"
  #m.g "flush" 
  #m.g "print " ; winx + 2
wait
[quit]
  close #m
end

 

 
  Reply Quote Notify of replies

 2   Game and Graphic Programming / Re: draw it 2.0  on: Today at 04:15am
Started by bluatigro | Post by bluatigro
@ rod :
i added it . thanks

@ all :
i got no printer test it please

thinking about triangles :
i know how to draw them
but how do the user code look like ?

Code:
''les 99g draw it


WindowWidth = DisplayWidth
WindowHeight = DisplayHeight
nomainwin
global mode , pixel , lijn , ellipse , box , text , text$ , font$
global ellipsefill , boxfill , ox , oy , nx , ny
global file$ , size , winx , winy , color$ , backolor$
winx = WindowWidth
winy = WindowHeight
menu #m , "file" _
        , "new" , [new] _
        , "open" , [open] _
        , "save" , [save] _
        , "save as" , [saveAs] _
        , "print" , [print] _
        ,|, "exit" , [quit]
menu #m , "tools" _
        , "pixel" , [pixel] _
        , "line" , [line] _
        , "ellipse" , [ellipse] _
        , "ellipse fill" , [ellipsefill] _
        , "box" , [box] _
        , "box fill" , [boxfill] _
        ,|, "font" , [font] _
        , "text" , [text] _
        ,|, "size" , [size] _
        ,|, "color" , [color] _
        , "backcolor" , [backcolor]
size = 1
pixel = 1
lijn = 2
ellipse = 3
ellipsefill = 4
box = 5
boxfill = 6
font$ = " 24 bold"
text$ = "type text here"
text = 7
color$ = "black"
backcolor$ = "yellow"
mode = pixel
graphicbox #m.g , 0 , 0 , winx , winy
open "draw it 2.0" for graphics as #m
  #m "trapclose [quit]"
  #m "font " ; font$
  #m "when mouseMove [move]"
  #m "when leftButtonDown [leftdown]"
  #m "when leftButtonMove [leftmove]"
  #m "when leftButtonUp [leftup]"
  #m "setfocus"
wait
[move]
  nx = MouseX
  ny = MouseY
wait
[leftmove]
  nx = MouseX
  ny = MouseY
  #m "rule " ; _R2_NOTXORPEN
  #m "color black"
  select case mode
    case lijn
      #m "down"
      #m "line " ; ox ; " " ; oy ; " " ; nx ; " " ; ny
      #m "up"
      #m "down"
      #m "line " ; ox ; " " ; oy ; " " ; nx ; " " ; ny
      #m "up"
    case ellipse
      #m "goto " ; ( ox + nx ) / 2 ; " " ; ( oy + ny ) / 2
      #m "down"
      #m "ellipse " ; nx - ox ; " " ; ny - oy
      #m "up"
      #m "goto " ; ( ox + nx ) / 2 ; " " ; ( oy + ny ) / 2
      #m "down"
      #m "ellipse " ; nx - ox ; " " ; ny - oy
      #m "up"
    case ellipsefill
      #m "goto " ; ( ox + nx ) / 2 ; " " ; ( oy + ny ) / 2
      #m "down"
      #m "ellipse " ; nx - ox ; " " ; ny - oy
      #m "up"
      #m "goto " ; ( ox + nx ) / 2 ; " " ; ( oy + ny ) / 2
      #m "down"
      #m "ellipse " ; nx - ox ; " " ; ny - oy
      #m "up"
    case box
      #m "goto " ; ox ; " " ; oy
      #m "down"
      #m "box " ; nx ; " " ; ny
      #m "up"
      #m "goto " ; ox ; " " ; oy
      #m "down"
      #m "box " ; nx ; " " ; ny
      #m "up"
    case boxfill
      #m "goto " ; ox ; " " ; oy
      #m "down"
      #m "box " ; nx ; " " ; ny
      #m "up"
      #m "goto " ; ox ; " " ; oy
      #m "down"
      #m "box " ; nx ; " " ; ny
      #m "up"
    case else
      #m "rule " ; _R2_COPYPEN
      #m "color " ; color$ 
      #m "size " ; size
      #m "goto " ; nx ; " " ; ny
      #m "down"
      #m "set " ; nx ; " " ; ny
      #m "up"
  end select
wait
sub Pause ms
  t = time$( "milliseconds" )
  while time$( "milliseconds" ) < t + ms
  wend
end sub
[leftdown]
  ox = MouseX
  oy = MouseY
wait
[leftup]
  #m "rule " ; _R2_COPYPEN
  #m "color " ; color$
  #m "backcolor " ; backcolor$
  #m "size " ; size
  select case mode
    case lijn
      #m "down"
      #m "line " ; ox ; " " ; oy ; " " ; nx ; " " ; ny
      #m "up"
    case ellipse
      #m "goto " ; ( ox + nx ) / 2 ; " " ; ( oy + ny ) / 2
      #m "down"
      #m "ellipse " ; nx - ox ; " " ; ny - oy
      #m "up"
    case ellipsefill
      #m "goto " ; ( ox + nx ) / 2 ; " " ; ( oy + ny ) / 2
      #m "down"
      #m "ellipsefilled " ; nx - ox ; " " ; ny - oy
      #m "up"
    case box
      #m "goto " ; ox ; " " ; oy
      #m "down"
      #m "box " ; nx ; " " ; ny
      #m "up"
    case boxfill
      #m "goto " ; ox ; " " ; oy
      #m "down"
      #m "boxfilled " ; nx ; " " ; ny
      #m "up"
    case text
      #m "goto " ; ox ; " " ; oy
      #m "down"
      #m "\" ; text$
      #m "up"
    case else
  end select
wait
[pixel]
  mode = pixel
wait
[line]
  mode = lijn
wait
[ellipse]
  mode = ellipse
wait
[ellipsefill]
  mode = ellipsefill
wait
[box]
  mode = box
wait
[boxfill]
  mode = boxfill
wait
[font]
  fontdialog font$ , font$
  #m "font " ; font$
wait
[text]
  prompt "text = " ; text$
  mode = text
wait
[size]
  s$ = str$( size )
  prompt "size = " ; s$
  size = val( s$ )
wait
[color]
  colordialog color$ , color$
wait
[backcolor]
  colordialog backcolor$ , backcolor$
wait
[new]
  file$ = DefaultDir$ + "\unnamed.bmp"
  #m "fill white"
wait
[open]
  filedialog "open bmp" , "*.bmp" , file$
  loadbmp "drawing" , file$
  #m "background drawing"
wait
[saveAs]
  filedialog "save bmp" , "*.bmp" , file$
[save]
  #m "getbmp drawing 0 0 " ; winx ; " " ; winy
  bmpsave "drawing" , file$
wait
[print]
  #m "getbmp screen 0 0 " ; winx ; " " ; winy
  #m.g "cls"
  #m.g "drawbmp screen 0 0"
  #m.g "flush" 
  #m.g "print " ; winx + 2
wait

wait
[quit]
  close #m
end
 

 
  Reply Quote Notify of replies

 3   API/DLL / Re: Get File Details?  on: Today at 04:00am
Started by BradB | Post by Rod
Ok, perhaps the time info was not ms. I added a line to set the time format to ms before asking what the time length was.

Does it make a difference?


Code:
   filedialog "Open media file", "*.mp3", fileName$

    open fileName$ for binary as #title
        s$=input$(#title,1028)
        t=instr(s$,"TIT2")
        a=instr(s$,"TALB")
        p=instr(s$,"TPE1")
        if p>0 then
            l=asc(mid$(s$,p+7,1))+asc(mid$(s$,p+6,1))*256+asc(mid$(s$,p+5,1))*65536+asc(mid$(s$,p+4,1))*16777216
            perfo$=mid$(s$,p+11,l-1)
        else
            perfo$="Unknown"
        end if
        if t>0 then
            l=asc(mid$(s$,t+7,1))+asc(mid$(s$,t+6,1))*256+asc(mid$(s$,t+5,1))*65536+asc(mid$(s$,t+4,1))*16777216
            title$=mid$(s$,t+11,l-1)
        else
            title$="Unknown"
        end if
        if a>0 then
            l=asc(mid$(s$,a+7,1))+asc(mid$(s$,a+6,1))*256+asc(mid$(s$,a+5,1))*65536+asc(mid$(s$,a+4,1))*16777216
            album$=mid$(s$,a+11,l-1)
        else
            album$="Unknown"
        end if
        close #title


    m$=GetShortPathName$(fileName$)

    'open song
    r$=mciSendString$("open "+m$+" alias song")
    'r$=mciSendString$("open "+m$+" type MpegVideo alias song")

    'set song volume
    vol=500

    'get song length
    r$=mciSendString$("set song time format ms") 'milliseconds
    songlength = VAL(mciSendString$("status song length"))
    min=int(songlength/1000/60)
    sec=int(songlength/1000-min*60)
    songmin$=right$("00"+str$(min),2)
    songsec$=right$("00"+str$(sec),2)
    'play song
    r$=mciSendString$("setaudio song volume to ";vol)
    r$=mciSendString$("play song")
    wait

function GetShortPathName$(lPath$)
    lPath$=lPath$+chr$(0)
    sPath$=space$(256)
    lenPath=len(sPath$)
    calldll #kernel32, "GetShortPathNameA",lPath$ as ptr,_
    sPath$ as ptr,lenPath as long,r as long
    GetShortPathName$=left$(sPath$,r)
    end function

function mciSendString$(s$)
    buffer$=space$(1024)+chr$(0)
    calldll #winmm,"mciSendStringA",s$ as ptr,buffer$ as ptr,_
    1028 as long, 0 as long, r as long
    buffer$=trim$(buffer$)
    if r>0 then
        mciSendString$="error"
    else
        mciSendString$=buffer$
    end if
    end Function

 

 
  Reply Quote Notify of replies

 4   API/DLL / Re: Get File Details?  on: Yesterday at 8:03pm
Started by BradB | Post by BradB
Thanks for the edit into the code box, Stefan. I'm new to this.

Rod, I tried your code. An .mp3 file with a length of 2:10 returned a songlength of 238775, which computes to 3:58. So I'm not sure what is going on.

I'll keep on searching around as Stefan suggests.

Thanks again.
 
  Reply Quote Notify of replies

 5   Open Source Projects / Re: Aplomb Scribe  on: Yesterday at 10:42am
Started by hooshnik | Post by hooshnik
Well it seems the slow death of wikispaces has forced my hand to make a post. I never got a single message about Aplomb Scribe making me think it has near zero interest out there. I have made 1 unreleased bugfix (a problem parsing the minus sign in the cli arguments) and forked the code to another language as LB was simply not cutting it for me. I have at least doubled the speed of the preprocessor and added code to fix the DPI problem in LB. The DPI problem isn't really THAT bad if you design your program with only 1 main window in mind and use a tabbed interface with modal/dialog windows. However with my forked program you don't even have to think about it as it will add the necessary code for you by using preprocessor directives. Also the file depth has been increased from 2 to 254 (I think).

For now things will stay as they are until Aplomb Scribe is kicked off wikispaces.
 
  Reply Quote Notify of replies

 6   Game and Graphic Programming / Re: draw it 2.0  on: Yesterday at 05:59am
Started by bluatigro | Post by Rod
The printerdialog has a bug, depends what you want to do with the dialog. As it stands you don't need it because Liberty will use the default printer by "default" smiley

To send a bmp to the printer you must draw it to a graphicbox and then use the graphics print command as I showed in my last post.

The bmp can be large, you don't need to see it all on screen. Use the optional size parameter to scale the drawing to the printed page So if it is 3000 pixels wide use size 3000 to get a full width print.

If this does not help you need to tell us what is not working.
 
  Reply Quote Notify of replies

 7   Liberty BASIC Code / Re: quatum computer sim  on: Yesterday at 05:59am
Started by bluatigro | Post by bluatigro
update :
fount some info on YouTube :
Quote:
s = sqr( 1 / 2 )
s^2 = 1/2

H( 1 |0> ) = s |0> + s |1>
H( 1 |1> ) = s |0> - s |1>

H( s |0> + s |1> ) = s * H( |0> ) + s * H( |1> )
= s * ( s |0> + s |1> ) + s * ( s |0> - s|1> )
= 1/2 * |0> + 1/2 * |1> + 1/2 * |0> - 1/2 * |1>
= 1 |0> + 0 |1>

Not( a |0> + b |1> ) = -a |0> - b |1>

e ^ ( i * x ) = cos( x ) + i * sin( x )

qureg x[1]
x = a |0> + b |1>
V(t,x) = x = b |0> + a * ( e ^ i * t ) |1>


i m not sure how to use this
we wil need compex number's i think
 
  Reply Quote Notify of replies

 8   Game and Graphic Programming / Re: draw it 2.0  on: Yesterday at 03:35am
Started by bluatigro | Post by bluatigro
how do i use priterdialog
and how do i sent a bmp to the printer ?
 
  Reply Quote Notify of replies

 9   Game and Graphic Programming / Re: BluaRay.dll  on: Yesterday at 03:13am
Started by bluatigro | Post by bluatigro
@ rod :
i don't know how and where i can post the compiled dll
and i m learning writing dll's
the code was made in code::blocks
this is a tutorial on writing dll's too
i don't know if the BluaRay.dll is whitout error's
i probely made many
and i m not sure about the LB code too

@ anyone :
please look for error's in c++ and LB code

on the moment there are diffuse colored spheres only
if this is good then i wil expand this whit triangles

 
  Reply Quote Notify of replies

 10   API/DLL / Re: Get File Details?  on: Feb 20th, 2018, 8:57pm
Started by BradB | Post by BradB
Thank you, all!

Rod, I'll give your code a try when time permits.

Here is the VBA code:

Code:
Sub FileInfo()
    Dim c As Long, r As Long, i As Long
    Dim FileName As Object 'FolderItem2
    Dim objShell As Object 'IShellDispatch4
    Dim objFolder As Object 'Folder3
'   Create the object
    Set objShell = CreateObject("Shell.Application")
    Worksheets.Add
    r = 0
'   Prompt for the folder
    Do
        Set objFolder = objShell.Namespace(getafolder("C:\"))
        If objFolder Is Nothing Then Exit Do
'   Loop through the files
        For Each FileName In objFolder.Items
            r = r + 1
            Cells(r, 1) = objFolder
            Cells(r, 2) = objFolder.GetDetailsOf(FileName, 0)
            Cells(r, 3) = objFolder.GetDetailsOf(FileName, 27) [length]
            Cells(r, 4) = objFolder.GetDetailsOf(FileName, 20)
            Cells(r, 5) = objFolder.GetDetailsOf(FileName, 21)
        Next FileName
    Loop
End Sub 

 
  Reply Quote Notify of replies


Rules|Home|Help|Search|Recent Posts|Notification



Donate $6.99 for 50,000 Ad-Free Pageviews!

| |

This forum powered for FREE by Conforums ©
Sign up for your own Free Message Board today!
Terms of Service | Privacy Policy | Conforums Support | Parental Controls