1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247
|
UNIT Bmp_24_02S;
INTERFACE
USES Crt, E_Texte, U_Math;
CONST Dim_Max = 2000;
TYPE Pixel = ARRAY[1..3] OF Byte;
Tab_Pix = ARRAY[1..Dim_Max, 1..Dim_Max] OF Pixel;
F_Reel = FUNCTION(o: Reel): Reel;
F_Pixl = FUNCTION(o: Reel): Pixel;
VAR Haut_Image, Larg_Image, Prod_LaHa: Z_32;
Matr_Image: Tab_Pix;
// Creation_F
PROCEDURE Creation_F(La, Ha: Z_32);
// GraphBmp
PROCEDURE GraphBmp(Code_Cf: Word);
IMPLEMENTATION
CONST T_Entete = 54;
TYPE LstTeB = ARRAY[0..T_Entete-1] OF Byte;
VAR T_Image, T_Fichier: Z_32; En_Tete: LstTeB;
Nom_F: String; Fichier: FILE OF Byte;
(*****************************************************************************
Creation_F
*****************************************************************************)
PROCEDURE Compteur(x, y: Byte; l: Z_32);
VAR i: Word;
BEGIN
IF l<0 THEN We(x, y, -l, 8)
ELSE BEGIN
i:= l MOD 1000; IF i=0 THEN We(x, y, l, 8)
END
END;
PROCEDURE Aff_NomF(VAR Nf: String);
CONST C1 = 4; C2 = C1 + 47; C3 = C1 + 37; L1 = 12; L2 = L1 + 1;
Chem = 'D:\ZZZZZZ\'; Ext = '.bmp';
VAR Nom: String;
BEGIN
E(0015); Wt(C1, L1, 'Nom et emplacement du fichier image: ');
Write(Chem); E(0008);
Rt(C2, L1, Nom); Nf:= Chem + Nom + Ext;
E(0010); Wt(C3, L1, Nom_F)
END;
PROCEDURE Creation_F(La, Ha: Z_32);
CONST C1 = 71; L1 = 9; Lim = T_Entete - 1;
VAR Delta, n, Zero: Byte; k, x, y: Z_32;
BEGIN
Aff_NomF(Nom_F); Assign(Fichier, Nom_F); Rewrite(Fichier);
FOR k:= 0 TO Lim DO Write(Fichier, En_Tete[k]);
k:= Lim; Compteur(C1, L1-1, -k);
E(0012); Delta:= La MOD 4; Zero:= 0;
FOR y:= 1 TO Ha DO
BEGIN
FOR x:= 1 TO La DO
FOR n:= 1 TO 3 DO BEGIN
Inc(k); Write(Fichier, Matr_Image[x, y][n]);
Compteur(C1, L1, k)
END;
IF Delta>0 THEN FOR n:= 1 TO Delta DO BEGIN
Inc(k); Write(Fichier, Zero);
Compteur(C1, L1, k)
END
END;
Close(Fichier); Compteur(C1, L1, -k);
E(0008); Wt(4, L1, 'Rang du dernier octet:');
Compteur(39, L1, -k); E(0014); Wt(C1-1, L1+2, 'Û FIN Û')
END;
(*****************************************************************************
GraphBmp
*****************************************************************************)
PROCEDURE CalcOctet(Rang: Byte; Nombre: Z_32; VAR Li: LstTeB);
CONST B1 = 256;
VAR i, j: Byte; p, q: Z_32;
BEGIN
p:= Nombre;
FOR i:= 0 TO 3 DO BEGIN
j:= Rang + i; Li[j]:= p MOD B1;
q:= p DIV B1; p:= q
END
END;
PROCEDURE Init_Entete(VAR Ent: LstTeB);
CONST T_E_Image = 40;
VAR k: Byte; Liste: LstTeB;
BEGIN
FOR k:= 0 TO (T_Entete - 1) DO Liste[k]:= 0;
(* Caractristiques principales du fichier: type, taille,
adresse relative de l'image *)
Liste[00]:= 66; // 'B': 66 = hx42
Liste[01]:= 77; // 'M': 77 = hx4D
CalcOctet(02, T_Fichier, Liste); // Taille du fichier
CalcOctet(10, T_Entete, Liste); // Offset de l'image = 54 (dcalage)
(* Caractristiques principales de l'image *)
CalcOctet(14, T_E_Image, Liste); // Taille de la zone Bitmap info = 40
CalcOctet(18, Larg_Image, Liste); // Largeur de l'image
CalcOctet(22, Haut_Image, Liste); // Hauteur de l'image
Liste[26]:= 01; // Nombre de plans (fixs
1)
Liste[28]:= 24; // Nombre de bits / pixel (3 octets)
CalcOctet(34, T_Image, Liste); // Taille de l'image
(* CalcOctet(38, Resolution, Liste); // Rsolution horizontale
// facultative, 0 par dfaut
CalcOctet(42, Resolution, Liste); // Rsolution verticale
// facultative, 0 par dfaut *)
Ent:= Liste
END;
PROCEDURE AffT_ImFi;
CONST C1 = 4; L1 = 9; Ca = 11; Cb = 13; u = 8;
BEGIN
E(Ca); Wt(C1, L1-1, 'Taille de l''image: T_Im = ');
E(Cb); Write(T_Image:u, ' octets');
E(Ca); Wt(C1, L1+1, 'Taille du fichier: T_Fi = ');
E(Cb); Write(T_Fichier:u, ' octets');
END;
PROCEDURE CalcTaille(La, Ha: Z_32; VAR T_Im, T_Fi: Z_32);
VAR Ligne, Taille: Z_32;
BEGIN
Ligne:= 3 * La; Inc(Ligne, La MOD 4); Taille:= Ligne * Ha;
T_Im:= Taille; T_Fi:= Taille + T_Entete; AffT_ImFi
END;
PROCEDURE Calc_Cf_2(La, Ha, u, v: Z_32; VAR Cf: Pixel);
CONST Max = 255;
VAR p, q, r, s, t: Reel; Px: Pixel;
BEGIN
p:= u / La; q:= v / Ha;
r:= Sqr(p); s:= Sqr(q);
t:= (1 - r) * (1 - s); Px[2]:= Round(Max * t);
r:= Sqr(1 - p); Px[1]:= Round(Max * (1 - r));
s:= Sqr(1 - q); Px[3]:= Round(Max * (1 - s));
Cf:= Px
END;
PROCEDURE Calc_Cf_1(La, Ha, u, v: Z_32; VAR Cf: Pixel);
CONST Max = 255;
VAR p, q, r, s, t: Reel; Px: Pixel;
BEGIN
p:= u / La; q:= v / Ha;
r:= Sqr(p); s:= Sqr(q);
t:= 1 - (r + s) / 2; Px[2]:= Round(Max * t);
r:= Sqr(1 - p); Px[1]:= Round(Max * (1 - r));
s:= Sqr(1 - q); Px[3]:= Round(Max * (1 - s));
Cf:= Px
END;
PROCEDURE Calc_Cf(Indice: Word; VAR Cf: Pixel);
CONST B_08 = 256; Max = 13005;
VAR Ibl, Iro, Ive, j: Word; z: Reel; Coul: Pixel;
BEGIN
Ibl:= Indice DIV 100; j:= Indice MOD 100;
Ive:= j DIV 10; Iro:= j MOD 10;
z:= Sqrt(Max * Ibl); Coul[1]:= Round(z) MOD B_08;
z:= Sqrt(Max * Ive); Coul[2]:= Round(z) MOD B_08;
z:= Sqrt(Max * Iro); Coul[3]:= Round(z) MOD B_08; Cf:= Coul
END;
PROCEDURE In_MatrIm_1(La, Ha, x, y: Z_32; Co: Word; Cz, Cf: Pixel;
VAR Npix: Z_32; VAR Mxy: Pixel);
BEGIN
IF ((x>La) OR (y>Ha))
THEN Mxy:= Cz
ELSE BEGIN
Inc(Npix);
IF Co<556 THEN Mxy:= Cf
ELSE IF Co<650 THEN Calc_Cf_1(Larg_Image, Haut_Image,
x, y, Mxy)
ELSE Calc_Cf_2(Larg_Image, Haut_Image,
x, y, Mxy)
END
END;
PROCEDURE InitMatrIm(Y1: Byte; Code: Word; VAR Ma: Tab_Pix);
CONST u = 8; C1 = 61; C2 = C1 + 10;
C_Zero: Pixel = (0, 0, 0);
VAR k, N_Pixel, Ix, Iy: Z_32; C_Fond: Pixel;
BEGIN
Calc_Cf(Code, C_Fond); E(0012);
k:= 0; N_Pixel:= 0;
FOR Ix:= 1 TO Dim_Max DO
FOR Iy:= 1 TO Dim_Max DO
BEGIN
Inc(k); IF ((k MOD 1000)=0) THEN We(C2, Y1-1, k, u);
IF (Code=0) THEN Ma[Ix, Iy]:= C_Zero
ELSE In_MatrIm_1(Larg_Image, Haut_Image, Ix, Iy,
Code, C_Zero, C_Fond,
N_Pixel, Ma[Ix, Iy])
END;
We(C2, Y1-1, k, u);
E(0010); Wt(C1, Y1, 'La * Ha = '); Write(Prod_LaHa:u);
IF N_Pixel=0 THEN E(008) ELSE E(0015);
Wt(C1, Y1+1, 'Npixels = '); Write(N_Pixel:u)
END;
PROCEDURE Saisie_Dim_BMP(X1, Y1: Byte; VAR La, Ha, P_LaHa: Z_32);
CONST Ca = 15; Cb = 114; u = 4;
VAR X2, X3: Byte; p, q: Z_32; Test: Boolean;
BEGIN
X2:= X1 + 53; X3:= X2 - 12;
E(1010); F(X1, Y1-2, X2, Y1+2, 1);
Wt(X1+2, Y1-1, 'Largeur de l''image (La<= ');
Write(Dim_Max:4, '): La = ');
Wt(X1+2, Y1+1, 'Hauteur de l''image (Ha<= ');
Write(Dim_Max:4, '): Ha = ');
REPEAT
E(Ca); Rz4(X3, Y1-1, p);
E(Cb); We(X3, Y1-1, p, u); Write (' pixels ')
UNTIL p<=Dim_Max;
REPEAT
E(Ca); Rz4(X3, Y1+1, q);
E(Cb); We(X3, Y1+1, q, u); Write (' pixels ')
UNTIL q<=Dim_Max;
La:= p; Ha:= q; P_LaHa:= p * q
END;
PROCEDURE GraphBmp(Code_Cf: Word);
BEGIN
Saisie_Dim_BMP(2, 4, Larg_Image, Haut_Image, Prod_LaHa);
InitMatrIm(4, Code_Cf, Matr_Image);
CalcTaille(Larg_Image, Haut_Image, T_Image, T_Fichier);
Init_Entete(En_Tete);
END;
END. |
Partager