Imports System.IO
Public Class Form1
Private Sub Form1_Load(sender As Object, e As EventArgs) Handles MyBase.Load
Dim NomeFileOriginale As String = "bandind2.bmp"
Dim NomeFileStirato As String = "zoombandind2.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 = 5 ' solo interi, per i decimali bisogna pensarci un po'
Dim ZoomW As Single = 1 ' solo interi, per i decimali bisogna pensarci un po'
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
' lettura e scrittura con zoom impostato
For rig = 0 To Originale.Height - 1
Dim limite As UInt32 = rig * bmpDataOriginale.Stride
Dim rig2 As Single = rig * ZoomH
For col = 0 To Originale.Width - 1
Dim indOriginale = col + limite
Dim livello As Byte = levelValuesOriginale(indOriginale)
Dim col2 As Single = col * ZoomW
For H = 0 To ZoomH - 1
For W = 0 To ZoomW - 1
Dim indStirata As UInt32 = col2 + W + (rig2 + H) * bmpDataStirata.Stride ' calcolo l'indice
levelValuesStirata(indStirata) = livello
Next
Next
Next
Next
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 dell'Header di un BMP 8bpp
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()
End Sub
End Class