Пример программы работы с изображениями:
Код:
MODULE МоиИзображ1;
IMPORT L := StdLog, In, Math, Gr := i21eduTPGraphics, F := i21eduFiles, Files;
TYPE Arr = POINTER TO ARRAY OF ARRAY OF INTEGER;
VAR pic, pic1 : Arr;
PROCEDURE RdPx() : INTEGER;
VAR a, b, c:SHORTCHAR;
BEGIN
F.ReadSChar(a); F.ReadSChar(b); F.ReadSChar(c);
RETURN ORD(c)+ORD(b)*256+ORD(a)*65536
END RdPx;
(* Процедура чтения картинки из файла *)
PROCEDURE ReadPict(name: Files.Name; VAR pic: Arr);
VAR i, j, h, w : INTEGER; sc:SHORTCHAR; c:CHAR;
BEGIN
F.Close;
F.Open(name);
FOR i := 1 TO 9 DO (* пропуск ненужных байтов заголовка *)
F.ReadChar( c );
END;
F.ReadInt( w );
L.String('ширина=');L.Int(w); (* ширина картинки, точек *)
F.ReadInt(h );
L.String(' высота='); L.Int(h); (* высота картинки, точек *)
pic := NIL; NEW(pic, h,w);
FOR i := 1 TO 14 DO (* пропуск ненужных байтов заголовка *)
F.ReadChar(c);
END;
FOR i := 0 TO h-1 DO
(* чтение троек байтов строки картинки *)
FOR j := 0 TO w-1 DO
pic[h-1- i, j] := RdPx();
END;
(* пропуск выравнивающих байтов в конце строки *)
j := 1;
WHILE j <= w*3 MOD 4 DO
F.ReadSChar( sc ); INC( j )
END;
END;
F.Close;
END ReadPict;
(* Процедура отрисовки картинки *)
PROCEDURE Picture(x, y :INTEGER; pic: Arr);
VAR i, j : INTEGER;
BEGIN
FOR i := 0 TO LEN(pic, 0)-1 DO
FOR j := 0 TO LEN(pic, 1)-1 DO
Gr.color := pic[i, j];
Gr.PutPixel(x + j, y + i);
END;
END;
END Picture;
(* Процедура перевода картинки в цветной негатив *)
PROCEDURE Negativ( pic: Arr; VAR pic1 : Arr);
VAR i, j, r, g, b, s : INTEGER;
BEGIN
NEW(pic1, LEN(pic, 0), LEN(pic, 1));
FOR i := 0 TO LEN(pic, 0)-1 DO
FOR j := 0 TO LEN(pic, 1)-1 DO
r := pic[i, j] MOD 256;
g := pic[i, j] DIV 256 MOD 256;
b := pic[i, j] DIV 256 DIV 256;
pic1[i, j] := 255 - r + 256 * (255 - g) + 256 * 256 * ( 255 - b)
END;
END;
END Negativ;
(* Процедура масштабирования картинки *)
PROCEDURE Scale(k :INTEGER; pic: Arr; VAR pic1 : Arr);
VAR i, j, m, n : INTEGER;
BEGIN
NEW(pic1, LEN(pic, 0)*k, LEN(pic, 1)*k);
FOR i := 0 TO LEN(pic, 0)-1 DO
FOR j := 0 TO LEN(pic, 1)-1 DO
FOR m := 0 TO k-1 DO
FOR n := 0 TO k-1 DO
pic1[i*k+m, j*k+n]:=pic[i, j]
END;
END;
END;
END;
END Scale;
(* Процедура поворота картинки *)
PROCEDURE Rotate(VAR a, b: Arr; right: BOOLEAN);
VAR i, j : INTEGER;
BEGIN
b:= NIL;
NEW(b, LEN(a, 1), LEN(a,0));
FOR i := 0 TO LEN(a, 0)-1 DO
FOR j := 0 TO LEN(a, 1)-1 DO
b[j, LEN(a, 0)-1-i]:=a[i,j]
END;
END;
END Rotate;
PROCEDURE Делать*;
VAR i, j, p, w, h,b,re,g : INTEGER; c: CHAR; r: REAL;
sc:SHORTCHAR;
cc: ARRAY 100 OF CHAR;
p1, p2, p3: Arr; ff : ARRAY 3 OF ARRAY 3 OF INTEGER;
BEGIN
Gr.Clear;
Gr.bkColor := 255;
ReadPict('LEGO 8885.bmp', p1);
Picture(10, 10, p1);
Negativ(p1, p2);
Picture(200, 10, p2);
Scale(2, p1, p2);
Picture(10, 200, p2);
Rotate(p1, p2, TRUE);
Picture(400, 10, p2);
Gr.Open
END Делать;
END МоиИзображ1.