1
Programmazione (Gambas 2) / Re: estrapolare dati da file Bitmap.. (10 piccoli endian)
« il: 06 Giugno 2015, 10:04:42 »
Le stampanti sla/dlp vanno molto bene e sono facili da costruire ma il proiettore costa un botto!
19/05/2023: A causa di un errore sono stati cancellati, insieme ad account creati da bot, alcuni account legittimi. Si prega di leggere qui: https://www.gambas-it.org/smf/index.php?topic=9733.0
Questa sezione ti permette di visualizzare tutti i post inviati da questo utente. N.B: puoi vedere solo i post relativi alle aree dove hai l'accesso.
Dim Testo As String
Dim Risultato As String
Dim Flg As String
Dim x, y As Integer
Dim xx, yy, somma As Integer
Dim im As Image
Dim xs, ys As String
im = Image.Load("/home/io/Scrivania/slice.bmp")
somma = 0
For x = 0 To im.W - 1
For y = 0 To im.h - 1
For yy = y To y + 10
somma = somma + im[x, yy]
If im[x, yy] = 0 Then
Flg = Flg & 0
Else
Flg = Flg & 1
Endif
Next
If somma > 0 Then
' Print "ci sono pixel colorati"
If Len(Str$(x)) = 1 Then xs = "00" & Str$(x)
If Len(Str$(x)) = 2 Then xs = "0" & Str$(x)
If Len(Str$(x)) = 3 Then xs = Str$(x)
If Len(Str$(y)) = 1 Then ys = "00" & Str$(y)
If Len(Str$(y)) = 2 Then ys = "0" & Str$(y)
If Len(Str$(y)) = 3 Then ys = Str$(y)
Risultato = Risultato & xs & " " & ys & " " & Flg & gb.NewLine
Else
' Print "non ci sono pixel colorati"
Endif
y = y + 9
somma = 0
Flg = ""
Next
Next
File.Save("/home/io/Scrivania/slice_mediaa.txt", Risultato)
TextArea1.text = Risultato
000 260 00000011111
000 270 11111111111
000 280 11111111111
000 290 11111111111
000 300 11111111111
000 310 11111111111
001 000 11111111111
001 010 11111111111
001 020 11111111111
001 030 11110000000
001 260 00000011111
001 270 11111111111
001 280 11111111111
001 290 11111111111
001 300 11111111111
001 310 11111111111
...
Pixel 12 x2 y1 on
Pixel 13 x3 y1 on
Pixel 14 x4 y1 off
...
Pixel 46 x6 y4 on
...
Dim alpha As Integer 'angolo
Dim pointx As Float 'x point da spostare
Dim pointy As Float 'y point da spostare
Dim pointz As Float 'z point da spostare
Dim Newpointx As Float
Dim Newpointy As Float
Dim Sinalpha As Float
Dim Cosalpha As Float
Dim NewpointStX As String
Dim NewpointStY As String
Dim X As Integer
Dim Y As Integer
Dim i As Integer
Dim HFile As File
Dim Sline As String
Dim intestazione As String
Dim testo As String
Dim trap As Integer
Dim a As String
Dim aa As String[]
Dim j As Byte
Dim esclusivo As Integer
Dim escludi As String
Dim Resto As String
alpha = 72
HFile = Open "/home/io/Scrivania/cloud_new.ply" For Input
While Not Eof(hFile)
Line Input #hFile, Sline
trap = trap + 1
If Trap < 13 Then Goto loop1
a = Replace(Sline, "\n", " ")
a = Replace(Sline, ".", ",")
aa = Split(a, " ", "", True)
escludi = aa[1]
esclusivo = Val(escludi)
If esclusivo > 20 Then 'Goto loop1
SLine = ""
Else
'''''''''''''''''''''''''''''''''''''''''''''''
pointx = Val(aa[0])
pointy = Val(aa[1])
X = InStr(Sline, " ")
Y = InStr(Sline, " ", X + 1)
Resto = Mid$(Sline, (y + 1))
Resto = Replace(resto, ".", ",")
Sinalpha = Sin(alpha * (Pi / 180))
Cosalpha = Cos(alpha * (Pi / 180))
newpointx = (pointx * Cosalpha) - (pointy * Sinalpha)
newpointy = (pointx * Sinalpha) + (pointy * Cosalpha)
NewpointStX = Left$(Str$(newpointx), 7)
NewpointStY = Left$(Str$(newpointy), 7)
Sline = Str$(newpointStX) & " " & Str$(newpointSTY) & " " & Resto
Testo = Testo & Sline & gb.NewLine
i = i + 1
Print escludi
End If
loop1:
Wend
intestazione = "ply\nformat ascii 1.0\nelement vertex " & Str$(i - 22)
intestazione = intestazione & "\nproperty float x\nproperty float y\nproperty float z\nproperty uchar diffuse_red\nproperty uchar diffuse_green\nproperty uchar diffuse_blue\nelement face 0\nproperty list uchar int vertex_indices\nend_header\n"
TextArea1.Text = intestazione & Testo
File.Save("/home/io/Scrivania/cloud_rot.ply", TextArea1.text)
ply
format ascii 1.0
element vertex 99
property float x
property float y
property float z
property uchar diffuse_red
property uchar diffuse_green
property uchar diffuse_blue
element face 0
property list uchar int vertex_indices
end_header
0,1 0,1 0,1 128 128 128
0,1 0,1 0,1 128 128 128
0,1 0,1 0,2 128 128 128
0,1 0,1 0,3 128 128 128
0,1 0,1 0,4 128 128 128
0,1 0,1 0,5 128 128 128
0,1 0,1 0,6 128 128 128
0,1 0,1 0,7 128 128 128
0,1 0,1 0,8 128 128 128
0,1 0,1 0,9 128 128 128
0,1 0,1 1 128 128 128
0,1 0,1 0,1 128 128 128
0,1 0,1 0,1 128 128 128
0,1 0,1 0,2 128 128 128
0,1 0,1 0,3 128 128 128
0,1 0,1 0,4 128 128 128
0,1 0,1 0,5 128 128 128
0,1 0,1 0,6 128 128 128
0,1 0,1 0,7 128 128 128
0,1 0,1 0,8 128 128 128
0,1 0,1 0,9 128 128 128
0,1 0,1 1 128 128 128
0,2 0,1 0,1 128 128 128
0,2 0,1 0,1 128 128 128
0,2 0,1 0,2 128 128 128
0,2 0,1 0,3 128 128 128
0,2 0,1 0,4 128 128 128
0,2 0,1 0,5 128 128 128
0,2 0,1 0,6 128 128 128
0,2 0,1 0,7 128 128 128
0,2 0,1 0,8 128 128 128
0,2 0,1 0,9 128 128 128
0,2 0,1 1 128 128 128
0,3 0,1 0,1 128 128 128
0,3 0,1 0,1 128 128 128
0,3 0,1 0,2 128 128 128
0,3 0,1 0,3 128 128 128
0,3 0,1 0,4 128 128 128
0,3 0,1 0,5 128 128 128
0,3 0,1 0,6 128 128 128
0,3 0,1 0,7 128 128 128
0,3 0,1 0,8 128 128 128
0,3 0,1 0,9 128 128 128
0,3 0,1 1 128 128 128
0,4 0,1 0,1 128 128 128
0,4 0,1 0,1 128 128 128
0,4 0,1 0,2 128 128 128
0,4 0,1 0,3 128 128 128
0,4 0,1 0,4 128 128 128
0,4 0,1 0,5 128 128 128
0,4 0,1 0,6 128 128 128
0,4 0,1 0,7 128 128 128
0,4 0,1 0,8 128 128 128
0,4 0,1 0,9 128 128 128
0,4 0,1 1 128 128 128
0,5 0,1 0,1 128 128 128
0,5 0,1 0,1 128 128 128
0,5 0,1 0,2 128 128 128
0,5 0,1 0,3 128 128 128
0,5 0,1 0,4 128 128 128
0,5 0,1 0,5 128 128 128
0,5 0,1 0,6 128 128 128
0,5 0,1 0,7 128 128 128
0,5 0,1 0,8 128 128 128
0,5 0,1 0,9 128 128 128
0,5 0,1 1 128 128 128
0,6 0,1 0,1 128 128 128
0,6 0,1 0,1 128 128 128
0,6 0,1 0,2 128 128 128
0,6 0,1 0,3 128 128 128
0,6 0,1 0,4 128 128 128
0,6 0,1 0,5 128 128 128
0,6 0,1 0,6 128 128 128
0,6 0,1 0,7 128 128 128
0,6 0,1 0,8 128 128 128
0,6 0,1 0,9 128 128 128
0,6 0,1 1 128 128 128
0,7 0,1 0,1 128 128 128
0,7 0,1 0,1 128 128 128
0,7 0,1 0,2 128 128 128
0,7 0,1 0,3 128 128 128
0,7 0,1 0,4 128 128 128
0,7 0,1 0,5 128 128 128
0,7 0,1 0,6 128 128 128
0,7 0,1 0,7 128 128 128
0,7 0,1 0,8 128 128 128
0,7 0,1 0,9 128 128 128
0,7 0,1 1 128 128 128
0,8 0,1 0,1 128 128 128
0,8 0,1 0,1 128 128 128
0,8 0,1 0,2 128 128 128
0,8 0,1 0,3 128 128 128
0,8 0,1 0,4 128 128 128
0,8 0,1 0,5 128 128 128
0,8 0,1 0,6 128 128 128
0,8 0,1 0,7 128 128 128
0,8 0,1 0,8 128 128 128
0,8 0,1 0,9 128 128 128
0,8 0,1 1 128 128 128
0,9 0,1 0,1 128 128 128
0,9 0,1 0,1 128 128 128
0,9 0,1 0,2 128 128 128
0,9 0,1 0,3 128 128 128
0,9 0,1 0,4 128 128 128
0,9 0,1 0,5 128 128 128
0,9 0,1 0,6 128 128 128
0,9 0,1 0,7 128 128 128
0,9 0,1 0,8 128 128 128
0,9 0,1 0,9 128 128 128
0,9 0,1 1 128 128 128
1 0,1 0,1 128 128 128
1 0,1 0,1 128 128 128
1 0,1 0,2 128 128 128
1 0,1 0,3 128 128 128
1 0,1 0,4 128 128 128
1 0,1 0,5 128 128 128
1 0,1 0,6 128 128 128
1 0,1 0,7 128 128 128
1 0,1 0,8 128 128 128
1 0,1 0,9 128 128 128
1 0,1 1 128 128 128
Public Sub Button11_Click()
Dim alpha As Integer 'angolo
Dim pointx As Float 'x point da spostare
Dim pointy As Float 'y point da spostare
Dim pointz As Float 'z point da spostare
Dim Newpointx As Float
Dim Newpointy As Float
Dim Sinalpha As Float
Dim Cosalpha As Float
Dim NewpointStX As String
Dim NewpointStY As String
Dim X As Integer
Dim Y As Integer
Dim i As Integer
Dim HFile As File
Dim Sline As String
Dim intestazione As String
Dim testo As String
Dim trap As Integer
Dim a As String
Dim aa As String[]
Dim j As Byte
Dim esclusivo As Integer
Dim escludi As String
Dim Resto As String
alpha = 72
HFile = Open "/home/io/Scrivania/cloud_new.ply" For Input
While Not Eof(hFile)
Line Input #hFile, Sline
trap = trap + 1
If Trap < 13 Then Goto loop1
a = Replace(Sline, "\n", " ")
a = Replace(Sline, ".", ",")
aa = Split(a, " ", "", True)
escludi = aa[1]
esclusivo = Val(escludi)
If esclusivo > 20 Then 'Goto loop1
SLine = ""
Else
'''''''''''''''''''''''''''''''''''''''''''''''
pointx = Val(aa[0])
pointy = Val(aa[1])
X = InStr(Sline, " ") 'trovo il primo separatore
Y = InStr(Sline, " ", X + 1) ' il secondo..
Resto = Mid$(Sline, (y + 1))
Resto = Replace(resto, ".", ",")
Sinalpha = Sin(alpha * (Pi / 180))
Cosalpha = Cos(alpha * (Pi / 180))
' qui ci andrà la traslazione
newpointx = (pointx * Cosalpha) - (pointy * Sinalpha)
newpointy = (pointx * Sinalpha) + (pointy * Cosalpha)
NewpointStX = Format(newpointx, "-##.#####")
Sline = Str$(newpointStX) & " " & Str$(newpointx) & " " & Resto
Testo = Testo & Sline & gb.NewLine
i = i + 1
End If
loop1:
Wend
intestazione = "ply\nformat ascii 1.0\nelement vertex " & Str$(i - 6000)
intestazione = intestazione & "\nproperty float x\nproperty float y\nproperty float z\nproperty uchar diffuse_red\nproperty uchar diffuse_green\nproperty uchar diffuse_blue\nelement face 0\nproperty list uchar int vertex_indices\nend_header\n"
TextArea1.Text = intestazione & Testo
File.Save("/home/io/Scrivania/cloud_rot.ply", TextArea1.text)
End