' PixmapUtils.
bi
' Fonctions utilitaires pour les Pixmaps (MaskPixmap, XFlip, YFlip, Resize)
#ifndef __PIXMAP_UTILS_BI__
#define __PIXMAP_UTILS_BI__
#include once "[Link]"
' Masquer un pixmap (créer un canal alpha basé sur une couleur de masque)
Function MaskPixmap(ByVal pixmap As TPixmap Ptr, ByVal mask_red As Integer, ByVal mask_green
As Integer, ByVal mask_blue As Integer) As TPixmap Ptr
If pixmap = NULL Then Return NULL
Dim tmp As TPixmap Ptr = pixmap
Dim need_convert As Integer = 0
' Convertir en RGBA si nécessaire
If tmp->format <> PF_RGBA8888 Then
tmp = tmp->Convert(PF_RGBA8888)
need_convert = 1
End If
Dim out_pixmap As TPixmap Ptr = CreatePixmap(tmp->width, tmp->height, PF_RGBA8888)
If out_pixmap = NULL Then
If need_convert Then Delete tmp
Return NULL
End If
For y As Integer = 0 To pixmap->height - 1
Dim t As UByte Ptr = tmp->PixelPtr(0, y)
Dim o As UByte Ptr = out_pixmap->PixelPtr(0, y)
For x As Integer = 0 To pixmap->width - 1
If t[0] <> mask_red Or t[1] <> mask_green Or t[2] <> mask_blue Then
' Pixel normal
o[0] = t[0]
o[1] = t[1]
o[2] = t[2]
o[3] = 255
Else
' Pixel masqué - calculer la moyenne des voisins
Dim r As Integer = 0, g As Integer = 0, b As Integer = 0, n As Integer = 0
For ty As Integer = y - 1 To y + 1
For tx As Integer = x - 1 To x + 1
If tx >= 0 And tx < tmp->width And ty >= 0 And ty < tmp->height Then
Dim tp As UByte Ptr = tmp->PixelPtr(tx, ty)
If tp[0] <> mask_red Or tp[1] <> mask_green Or tp[2] <> mask_blue Then
r += tp[0]
g += tp[1]
b += tp[2]
n += 1
End If
End If
Next
Next
If n > 0 Then
o[0] = r \ n
o[1] = g \ n
o[2] = b \ n
Else
o[0] = 0
o[1] = 0
o[2] = 0
End If
o[3] = 0 ' Alpha = 0 (transparent)
End If
t += 4
o += 4
Next
Next
If need_convert Then Delete tmp
Return out_pixmap
End Function
' Retourner un pixmap horizontalement
Function XFlipPixmap(ByVal pixmap As TPixmap Ptr) As TPixmap Ptr
If pixmap = NULL Then Return NULL
Dim out_pixmap As TPixmap Ptr = CreatePixmap(pixmap->width, pixmap->height, pixmap-
>format)
If out_pixmap = NULL Then Return NULL
For x As Integer = 0 To pixmap->width - 1
Dim win As TPixmap Ptr = pixmap->Window(pixmap->width - x - 1, 0, 1, pixmap->height)
If win Then
out_pixmap->Paste(win, x, 0)
Delete win
End If
Next
Return out_pixmap
End Function
' Retourner un pixmap verticalement
Function YFlipPixmap(ByVal pixmap As TPixmap Ptr) As TPixmap Ptr
If pixmap = NULL Then Return NULL
Dim out_pixmap As TPixmap Ptr = CreatePixmap(pixmap->width, pixmap->height, pixmap-
>format)
If out_pixmap = NULL Then Return NULL
For y As Integer = 0 To pixmap->height - 1
Dim win As TPixmap Ptr = pixmap->Window(0, pixmap->height - y - 1, pixmap->width, 1)
If win Then
out_pixmap->Paste(win, 0, y)
Delete win
End If
Next
Return out_pixmap
End Function
' Redimensionner un pixmap (interpolation bilinéaire)
Function ResizePixmap(ByVal pixmap As TPixmap Ptr, ByVal width As Integer, ByVal height As
Integer) As TPixmap Ptr
If pixmap = NULL Or width <= 0 Or height <= 0 Then Return NULL
Dim in_pixmap As TPixmap Ptr = pixmap
Dim need_convert As Integer = 0
' Convertir en format standard si nécessaire
If in_pixmap->format <> PF_STDFORMAT Then
in_pixmap = pixmap->Convert(PF_STDFORMAT)
need_convert = 1
End If
Dim tmp(width * 4 - 1) As UByte
Dim x_sc As Single = CSng(in_pixmap->width) / width
Dim y_sc As Single = CSng(in_pixmap->height) / height
Dim out_pixmap As TPixmap Ptr = CreatePixmap(width, height, pixmap->format)
If out_pixmap = NULL Then
If need_convert Then Delete in_pixmap
Return NULL
End If
For y As Integer = 0 To height - 1
Dim ty As Single = (y + 0.5) * y_sc - 0.5
Dim iy As Integer = Int(ty)
Dim fy As Single = ty - iy
Dim in_pitch As Integer = in_pixmap->pitch
' Gestion des bords
If iy < 0 Then
iy = 0
fy = 0
in_pitch = 0
ElseIf iy >= in_pixmap->height - 1 Then
iy = in_pixmap->height - 1
fy = 0
in_pitch = 0
End If
Dim src As UByte Ptr = in_pixmap->PixelPtr(0, iy)
Dim dst As UByte Ptr = @tmp(0)
' Interpolation horizontale et verticale
For x As Integer = 0 To width - 1
Dim tx As Single = (x + 0.5) * x_sc - 0.5
Dim ix As Integer = Int(tx)
Dim fx As Single = tx - ix
Dim in_off As Integer = 4
' Gestion des bords
If ix < 0 Then
ix = 0
fx = 0
in_off = 0
ElseIf ix >= in_pixmap->width - 1 Then
ix = in_pixmap->width - 1
fx = 0
in_off = 0
End If
Dim p As UByte Ptr = src + ix * 4
' Interpolation bilinéaire pour chaque composante
For n As Integer = 0 To 3
Dim v0 As Single = p[n]
Dim v1 As Single = p[n + in_off]
Dim v2 As Single = p[n + in_pitch]
Dim v3 As Single = p[n + in_pitch + in_off]
Dim va As Single = (v1 - v0) * fx + v0
Dim vb As Single = (v3 - v2) * fx + v2
Dim vt As Single = (vb - va) * fy + va
dst[n] = CInt(vt)
Next
dst += 4
Next
' Convertir la ligne vers le format de sortie
ConvertPixels(@tmp(0), PF_STDFORMAT, out_pixmap->PixelPtr(0, y), out_pixmap->format,
width)
Next
If need_convert Then Delete in_pixmap
Return out_pixmap
End Function
' Faire pivoter un pixmap de 90 degrés (sens horaire)
Function RotatePixmap90(ByVal pixmap As TPixmap Ptr) As TPixmap Ptr
If pixmap = NULL Then Return NULL
Dim out_pixmap As TPixmap Ptr = CreatePixmap(pixmap->height, pixmap->width, pixmap-
>format)
If out_pixmap = NULL Then Return NULL
For y As Integer = 0 To pixmap->height - 1
For x As Integer = 0 To pixmap->width - 1
Dim pixel As UInteger = pixmap->ReadPixel(x, y)
out_pixmap->WritePixel(pixmap->height - y - 1, x, pixel)
Next
Next
Return out_pixmap
End Function
' Faire pivoter un pixmap de 180 degrés
Function RotatePixmap180(ByVal pixmap As TPixmap Ptr) As TPixmap Ptr
If pixmap = NULL Then Return NULL
Dim out_pixmap As TPixmap Ptr = CreatePixmap(pixmap->width, pixmap->height, pixmap-
>format)
If out_pixmap = NULL Then Return NULL
For y As Integer = 0 To pixmap->height - 1
For x As Integer = 0 To pixmap->width - 1
Dim pixel As UInteger = pixmap->ReadPixel(x, y)
out_pixmap->WritePixel(pixmap->width - x - 1, pixmap->height - y - 1, pixel)
Next
Next
Return out_pixmap
End Function
' Faire pivoter un pixmap de 270 degrés (sens horaire)
Function RotatePixmap270(ByVal pixmap As TPixmap Ptr) As TPixmap Ptr
If pixmap = NULL Then Return NULL
Dim out_pixmap As TPixmap Ptr = CreatePixmap(pixmap->height, pixmap->width, pixmap-
>format)
If out_pixmap = NULL Then Return NULL
For y As Integer = 0 To pixmap->height - 1
For x As Integer = 0 To pixmap->width - 1
Dim pixel As UInteger = pixmap->ReadPixel(x, y)
out_pixmap->WritePixel(y, pixmap->width - x - 1, pixel)
Next
Next
Return out_pixmap
End Function
#endif ' __PIXMAP_UTILS_BI__