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