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?
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'.
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.
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.
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