Oppure

Loading
26/09/21 9:59
bernie
Purtroppo Carlo non posso stampare in quanto non hanno ancora finito la gestione "inchiostro" .
Riesco solo a stampare a secco, quindi non vedo il risultato stampato.
Per questo pensavo di usare un bmp uguale al file di test del sistema.
Tra le altre cose, dopo l'ultimo aggiornamento il sistema non riconosce più i bmp a 4bpp...... :(
aaa
26/09/21 18:38
Carlo
Bene allora vai con l'Header con palette positiva: 0=Black, 255=White e scrivi i 255 che ti servono.
in programmazione tutto è permesso
28/09/21 16:35
bernie
Per adesso ho riempito il vettore di 255, poi disegno i vari rettangoli neri.
aaa
30/09/21 6:55
bernie
Stavo guardando l'esempio di Carlo per stirare le grafiche senza usare GDI+, è possibile usare anche moltiplicatori non interi?
aaa
30/09/21 15:33
bernie
Ho scritto in fretta, Carlo aveva scritto che era solo per numeri interi.
Ma oltre a stirare il bmp, posso anche ridurlo con la stessa maniera?
Invece di moltiplicare per il coefficiente dividere per il coefficiente?
aaa
30/09/21 20:25
Carlo
Se si perfeziona il codice per farlo funzionare anche con i decimali anche la riduzione diventerà possibile.
Per ora non ci ho pensato su più di tanto, una soluzione lampante non mi è sovvenuta, bisogna ragionarci un po'.
in programmazione tutto è permesso
01/10/21 8:28
Carlo
Ho introdotto un correttivo per far accettare anche i decimali, per avere uno zoom negativo si inserisce un valore minore di 1.
es: un valore di zoom 0.25 riduce di un quarto la dimensione.
Le variabili zoom dichiarate Single, nei cicli peggiorano un po' le prestazioni.

Imports System.IO

Public Class Form1
    Dim sw As New Stopwatch
    Private Sub Form1_Load(sender As Object, e As EventArgs) Handles MyBase.Load
        Dim NomeFileOriginale As String = "bandind2_BlackWhite.bmp"
        Dim NomeFileStirato As String = "zoombandind2_BlackWhite.bmp"
        Dim Originale As New Bitmap(NomeFileOriginale)
        Dim paletteOriginale As Imaging.ColorPalette = Originale.Palette
        Dim f As Integer = Originale.Palette.Flags '2=scalagrigio
        Dim areaOriginale As New Rectangle(0, 0, Originale.Width, Originale.Height)
        Dim bmpDataOriginale As Imaging.BitmapData = Originale.LockBits(areaOriginale, Imaging.ImageLockMode.ReadWrite, Originale.PixelFormat)
        Dim ptrOriginale As IntPtr = bmpDataOriginale.Scan0 ' conterrà l'indirizzo di memoria
        Dim bytesOriginale As Integer = Math.Abs(bmpDataOriginale.Stride) * Originale.Height
        Dim levelValuesOriginale(bytesOriginale - 1) As Byte
        System.Runtime.InteropServices.Marshal.Copy(ptrOriginale, levelValuesOriginale, 0, bytesOriginale)

        Dim ZoomH As Single = 6.3 ' zoom verticale
        Dim ZoomW As Single = 4.2 ' zoom orizzontale

        Dim Stirata As New Bitmap(Originale.Width * ZoomW, Originale.Height * ZoomH, Imaging.PixelFormat.Format8bppIndexed)
        Stirata.Palette = Originale.Palette

        Dim areaStirata As New Rectangle(0, 0, Stirata.Width, Stirata.Height)
        Dim bmpDataStirata As Imaging.BitmapData = Stirata.LockBits(areaStirata, Imaging.ImageLockMode.ReadWrite, Stirata.PixelFormat)
        Dim ptrStirata As IntPtr = bmpDataStirata.Scan0 ' conterrà l'indirizzo di memoria
        Dim bytesStirata As Integer = Math.Abs(bmpDataStirata.Stride) * Stirata.Height
        Dim levelValuesStirata(bytesStirata - 1) As Byte

        sw.Restart()

        ' lettura e scrittura con zoom impostato
        Dim stepW As Single = ZoomW ' se lo zoom è decimale
        Dim stepH As Single = ZoomH ' se lo zoom è decimale
        If Math.Truncate(ZoomH) = ZoomH Then stepH = ZoomH - 1 ' se lo zoom non è decimale
        If Math.Truncate(ZoomW) = ZoomW Then stepW = ZoomW - 1 ' se lo zoom non è decimale
        For rig = 0 To Originale.Height - 1
            Dim limite As UInt32 = rig * bmpDataOriginale.Stride
            Dim rig2 As UInt32 = Math.Truncate(rig * ZoomH)
            For col = 0 To Originale.Width - 1
                Dim indOriginale As UInt32 = col + limite
                Dim livello As Byte = levelValuesOriginale(indOriginale)
                Dim col2 As UInt32 = Math.Truncate(col * ZoomW)
                For H As Single = 0 To stepH
                    For W As Single = 0 To stepW
                        Dim indStirata As UInt32 = col2 + W + (rig2 + H) * bmpDataStirata.Stride ' calcolo l'indice
                        If indStirata < bytesStirata Then levelValuesStirata(indStirata) = livello
                    Next
                Next
            Next
        Next
        Dim conciclo As Integer = sw.ElapsedMilliseconds
        System.Runtime.InteropServices.Marshal.Copy(levelValuesStirata, 0, ptrStirata, bytesStirata)
        Stirata.UnlockBits(bmpDataStirata) 'sblocco bit
        Stirata.Save(NomeFileStirato, Imaging.ImageFormat.Bmp)

        ' copio tutto l'Header del file d'origine nel file stirato
        Dim fsO As New FileStream(NomeFileOriginale, FileMode.Open, FileAccess.Read)
        Dim fsS As New FileStream(NomeFileStirato, FileMode.Open, FileAccess.Write)
        Dim br As New BinaryReader(fsO)
        Dim bw As New BinaryWriter(fsS)
        Dim Byteletto As Byte ' lettura Byte
        ' copio pari pari l'header d'origine
        Do While fsO.Position <= &H435 '  fino alla fine all HEX scelto, termine Header di un BMP
            Byteletto = br.ReadByte() ' lettura byte dall'origine
            bw.Seek(CInt(fsO.Position - 1), SeekOrigin.Begin) ' posizione di destinazione
            bw.Write(Byteletto) ' scrittura del byte letto in pari posizione
        Loop

        ' aggiusto i parametri che potrebbero essere variati
        bw.Seek(&H2, SeekOrigin.Begin) ' in posizione &H2 = lunghezza file
        bw.Write(fsS.Length) ' metto la lunghezza del file
        bw.Seek(&H12, SeekOrigin.Begin) ' in posizione &H12 = larghezza
        bw.Write(Stirata.Width) ' scrivo la larghezza
        bw.Seek(&H16, SeekOrigin.Begin) ' in posizione &H16 = altezza
        bw.Write(Stirata.Height) ' scrivo l'altezza
        fsO.Close()
        fsS.Close()

        Originale.UnlockBits(bmpDataOriginale)
        Originale.Dispose()
        Stirata.Dispose()

        Me.Text = conciclo 

    End Sub
End Class
Ultima modifica effettuata da Carlo 01/10/21 11:22
in programmazione tutto è permesso
02/10/21 7:32
bernie
Ti riferisci al tempo di elaborazione?
Considerando che la grafica la devo stirare due volte,affettarla e a volte anche ruotarla, l'aumento di qualche secondo nel processo non è rilevante. Considerando che tutte queste operazioni non sono in streaming, il tempo di processo non è così limitativo.
Ho adattato il tuo esempio e dalle prime prove "va come una viola" ( espressione locale per dire che una cosa va benissimo)
Grazie, continuo fino al prossimo ostacolo.
aaa