aparler/RosettaCodeData
1
0
Fork 0
Code Issues 12 Pull requests 3 Projects Releases Packages Wiki Activity Actions

Data update

Browse source
This commit is contained in:
Ingy döt Net 2025-02-27 18:35:13 -05:00
parent 8e4e15fa56
commit 72eb4943cb
1853 changed files with 35514 additions and 9441 deletions
Download patch file Download diff file Expand all files Collapse all files

31
Task/Bitmap-Write-a-PPM-file/FreeBASIC/bitmap-write-a-ppm-file.basic
View file

@ -1,7 +1,8 @@
Dim As Integer ancho = 150, alto = 200
Dim As Integer ancho, alto
ancho = 150: alto = 200
Dim As Integer x, y ' width, height
Dim As Ubyte kolor
Screenres ancho,alto,32
Dim As Ulong kolor
Screenres ancho, alto, 32
' Draw circles
Screenlock
@ -10,24 +11,26 @@ Circle (75, 100), 35, Rgb(0, 255, 0),,,, F
Circle (75, 100), 20, Rgb(0, 0, 255),,,, F
Screenunlock
' Create PPM file header
Dim encabezado As String
encabezado = "P6" & Chr(10) & Str(ancho) & " " & Str(alto) & Chr(10) & "255" & Chr(10)
' Open PPM file to write
Dim As Integer ff = Freefile
Open "i:\example.PPM" For Binary As #ff
Put #ff, , encabezado
Open "example.ppm" For Binary As #ff
If Err > 0 Then Print "Error opening output file": End
' Create PPM file header
Print #ff, "P6"
Print #ff, "# Created using FreeBASIC"
Print #ff, ancho & " " & alto
Print #ff, "255"
' Write image data to PPM file
For y = 0 To alto - 1
For x = 0 To ancho - 1
kolor = Point(x, y)
Put #ff, , Chr( kolor And &HFF) ' Red
Put #ff, , Chr((kolor Shr 8) And &HFF) ' Green
Put #ff, , Chr((kolor Shr 16) And &HFF) ' Blue
Next x
Next y
Put #ff, , Cbyte(kolor Shr 8) ' Green
Put #ff, , Cbyte(kolor) ' Blue
Put #ff, , Cbyte(kolor Shr 16) ' Red
Next
Next
Close #ff