Система стиснення відеоданих на основі аналізу ентропійності (стр. 16 из 17)
begin
PixelFormat: = pf24bit;
hgt2m: = Height + 2 * dM + 1;
wdt2m: = Width + 2 * dM + 1;
SetLength (matrix, hgt2m, wdt2m);
for i: = 0 to 255 do
Histo [i]: = 0;
for i: = 0 to Height - 1 do
begin
ii: = i + dm;
p: = ScanLine [i] ;
for j: = 0 to Width - 1 do
begin
jj: = j + dm;
ts: = p [j] ; // ToTsvet ({p [j] } cc);
summt: = SummFTsvet (ts); // div 3;
matrix [ii, jj]: = summt;
inc (Histo [summt]);
p [j]: = GetTsvet (summt, summt, summt);
end;
for j: = 0 to dm - 1 do
begin
jj: = j + dm;
matrix [ii, Width + jj]: = matrix [ii, jj] ;
matrix [ii, (dm - 1) - j]: = matrix [ii, Width + dm - 1 - j] ;
end;
end;
for j: = 0 to Width - 1 do
for i: = 0 to dm - 1 do
begin
ii: = i + dm;
jj: = j + dm;
matrix [Height + ii, jj]: = matrix [ii, jj] ;
matrix [ (dm - 1) - i, jj]: = matrix [Height + dm - 1 - i, jj] ;
end;
end;
except
exit;
end;
Result: = true;
end;
// ********************************************
function MedianFilter (bmp_: Tbitmap): Tbitmap;
var
i, j: integer;
k, l, t, s: integer;
a: array [0. .8] of byte;
mid: integer;
p, p2: P3bArray;
begin
Result: = Tbitmap. Create;
with Result do
begin
PixelFormat: = pf24bit;
width: = bmp_. Width;
height: = bmp_. Height;
for i: = 1 to Height - 2 do
begin
p2: = ScanLine [i] ;
for j: = 1 to Width - 2 do
begin
t: = 0;
for k: = - 1 to 1 do
for l: = - 1 to 1 do
begin
p: = bmp_. ScanLine [i + k] ;
a [t]: = SummFTsvet (p [j + l]);
inc (t);
end;
for l: = 1 to 5 do
begin
mid: = 255;
s: = 0;
for k: = 0 to 8 do
if a [k] < mid then
begin
mid: = a [k] ;
s: = k;
end;
a [s]: = 255;
end;
p2 [j]: = GetTsvet (mid, mid, mid);
end;
end;
end;
end;
function GetSquere2 (var aa: a2x; i0, j0: integer): integer;
var
i, j: integer;
begin
Result: = 0;
for i: = - 1 to 1 do
for j: = - 1 to 1 do
begin
Result: = Result + aa [i0 + i, j0 + j] ;
end;
end;
function HistoToBmp (bmp_: Tbitmap; var Histo: a256w): Tbitmap;
var
i, j: integer;
p: P3bArray;
c: integer;
z: integer;
Left: a256w;
delta: a256w;
dc: integer;
R: longint; // Cardinal;
Hsum, Hmid: integer; // Cardinal;
begin
Hmid: = 0;
for z: = 0 to 255 do
Hmid: = Hmid + Histo [z] ;
Hmid: = Hmid shr 8;
R: = 0;
Hsum: = 0;
if Hmid > 0.0001 then
for z: = 0 to 255 do
begin
left [z]: = R;
Hsum: = Hsum + Histo [Z] ;
while Hsum > Hmid do
begin
Hsum: = Hsum - Hmid;
inc (R);
end;
Delta [z]: = R - Left [z] ;
end
else
for z: = 0 to 255 do
left [z]: = 0;
for z: = 0 to 255 do
Histo [z]: = 0;
Result: = Tbitmap. Create;
with Result do
begin
PixelFormat: = pf24bit;
Width: = bmp_. Width;
Height: = bmp_. Height;
for i: = 0 to Height - 1 do
begin
p: = ScanLine [i] ;
for j: = 0 to Width - 1 do
begin
c: = matrix [i + dm, j + dm] ;
dc: = Delta [c] ;
c: = Left [c] + dc shr 0; // + random (dc shr 1 + 1);
c: = InByte (c);
p [j]: = GetTsvet (c, c, c);
inc (Histo [c]);
end;
end;
end;
end;
{*********************}
function GetMedian (a: a256w; n1, n2: integer; prm: double): byte;
var
sum: longint;
b: a256w;
i: integer;
begin
if n1 < 0 then
n1: = 0;
if n1 > 255 then
n1: = 255;
if n2 < 0 then
n2: = 0;
if n2 > 255 then
n2: = 255;
if n2 - n1 <= 1 then
begin
Result: = (n1 + n2) div 2;
exit;
end;
b [n1]: = a [n1] ;
sum: = a [n1] ;
for i: = n1 + 1 to n2 do
begin
b [i]: = b [i - 1] + a [i] ;
sum: = sum + a [i] ;
end;
sum: = round (sum * prm);
i: = n1;
while (b [i] < sum) and (i < n2) do
inc (i);
if (i < n2) and (b [i + 1] - b [i] > b [i]) then inc (i);
Result: = i;
end;
function DecreaseColor3 (bmp_: Tbitmap; NCOld, NCNew: integer; cc: a256w; prg: double): Tbitmap;
var
maxlv: integer;
ic: integer;
procedure Delenie2na (a, b: integer; lv: integer);
var
mi: integer;
i: integer;
begin
if (ic = NCNew) then
exit;
if a > 255 then exit; // a: = 255;
mi: = GetMedian (cc, a, b, prg);
if (lv < maxlv) and (b - a > 0) then
begin
Delenie2na (a, mi - 1, lv + 1);
Delenie2na (mi, b, lv + 1);
end
else
if (ic = 0) or (Inbyte (mi) <> Palette_ [ic - 1]) then
begin
Palette_ [ic]: = Inbyte (mi);
for i: = a to b do
Sootvet [i]: = ic;
inc (ic);
end;
end;
var
i, j: integer;
mid: integer;
p, p2: P3bArray;
bb: a256w;
t: boolean;
c0: integer;
cpos: array [0. .16] of integer;
NCN, ccc: integer;
begin
Result: = Tbitmap. Create;
with Result do
begin
PixelFormat: = pf24bit;
width: = bmp_. Width;
height: = bmp_. Height;
if not ( (NCNew > 0) and (NCNew <= 16)) then
exit;
for i: = 0 to NCOld - 1 do
sootvet [i]: = - 1;
case NCNew of
2: maxlv: = 1;
4: maxlv: = 2;
8: maxlv: = 3;
16: maxlv: = 4;
else
maxlv: = 0;
end;
ic: = 0;
Delenie2na (0, 255, 0);
for i: = ic to 15 do Palette_ [i]: = 255;
i: = 255;
for i: = 1 to NCOld - 2 do
if Sootvet [i] < 0 then
begin
if i < NCOld shr 1
then Sootvet [i]: = 0
else Sootvet [i]: = NCNew - 1;
end;
Sootvet [0]: = 0;
for i: = 0 to NCNew - 1 do
begin
bb [i]: = 0;
cpos [i]: = - 1;
end;
cpos [16]: =255;
c0: = - 1;
for i: = 0 to NCOld - 1 do
begin
bb [Sootvet [i]]: = bb [Sootvet [i]] + cc [i] ;
if c0 <> Sootvet [i] then
begin
cpos [Sootvet [i]]: = i;
NCN: = Sootvet [i] ;
end;
c0: = Sootvet [i] ;
end;
for i: = 1 to NCNew - 1 do
if cpos [i] < 0 then cpos [i]: = cpos [i-1] ;
if prg < 0.5 - 0.0001 then
repeat
t: = true;
for i: = 1 to NCN do
if (bb [i] *prg < bb [i - 1] * (1-prg)) and (cpos [i] > i) and (cpos [i] > cpos [i-1]) then
begin
ccc: = cc [cpos [i]] ;
bb [i]: = bb [i] + ccc;
bb [i - 1]: = bb [i - 1] - ccc;
cpos [i]: = cpos [i] - 1;
Sootvet [cpos [i]]: = i;
Palette_ [i]: = InByte (GetMedian (cc, cpos [i], cpos [i+1], 0.5));
t: = false;
break;
end
until t;
if prg > 0.5 + 0.0001 then
repeat
t: = true;
for i: = NCN-1 downto 0 do
if (bb [i+1] * (prg) > bb [i] * (1-prg)) and (cpos [i+1] < NCOld - i) and (cpos [i] < cpos [i+1]) then
begin
ccc: = cc [cpos [i+1]] ;
bb [i + 1]: = bb [i + 1] - ccc;
bb [i]: = bb [i] + ccc;
cpos [i+1]: = cpos [i+1] + 1;
Sootvet [cpos [i+1]]: = i;
Palette_ [i]: = InByte (GetMedian (cc, cpos [i], cpos [i+1], 0.5));
t: = false;
break;
end
until t;
for i: = 0 to Height - 1 do
begin
p: = bmp_. ScanLine [i] ;
p2: = ScanLine [i] ;
for j: = 0 to Width - 1 do
begin
mid: = SummFTsvet (p [j]);
mid: = Palette_ [Inbyte (Sootvet [mid])] ;
p2 [j]: = GetTsvet (mid, mid, mid);
end;
end;
end;
end;
function SaveTo4bitBMP (bmp_: Tbitmap; fname: string; var prgrs: TProgressBar): boolean;
var
i, j, j0: integer;
mid: word;
c1, c2: byte;
p: P3bArray;
f2: file;
buf1: Pbyte;
buf2: Pword;
buf4: PCardinal;
fsize: Cardinal;
NWritten: integer;
wdt, wdt2: integer;
begin
Result: = false;
try
AssignFile (f2, fname);
Rewrite (f2,1);
except
exit;
end;
New (buf1);
New (buf2);
New (buf4);
with BMP_ do
begin
buf2^: = 19778; // must always be set to 'BM' to declare that this is a. bmp-file.
BlockWrite (f2, buf2^, 2, NWritten);
wdt: = width div 2 + width mod 2;
case (wdt mod 4) of
3: wdt: = wdt + 1;
2: wdt: = wdt + 2;
1: wdt: = wdt + 3;
end; // выравние до ширины кратной 4
fsize: = 54 + 16 * 4 + (wdt * height);
buf4^: = fsize;
BlockWrite (f2, buf4^,
4);
buf4^: = 0; // rezerved
BlockWrite (f2, buf4^,
4);
buf4^: = $0076; // offset from the beginning of the file to the bitmap data
BlockWrite (f2, buf4^,
4);
buf4^: = 40; // size of the BITMAPINFOHEADER structure,
BlockWrite (f2, buf4^,
4);
buf4^: = width; //
BlockWrite (f2, buf4^,
4);
buf4^: = height; //
BlockWrite (f2, buf4^,
4);
buf2^: = 1; // number of planes of the target device
BlockWrite (f2, buf2^,
2);
buf2^: = 4; // number of bits per pixel!
BlockWrite (f2, buf2^,
2);
buf4^: = 0;
BlockWrite (f2, buf4^,
4);
BlockWrite (f2, buf4^,
4);
BlockWrite (f2, buf4^,
4);
BlockWrite (f2, buf4^,
4);
BlockWrite (f2, buf4^,
4);
BlockWrite (f2, buf4^,
4);
for i: = 0 to 15 do
begin
mid: = Palette_ [i] ;
buf2^: = mid shl 8 + mid;
BlockWrite (f2, buf2^,
2);
buf2^: = mid shl 0;
BlockWrite (f2, buf2^,
2);
end;
for i: = Height - 1 downto 0 do
begin
p: = ScanLine [i] ;
wdt2: = Width div 2;
for j: = 0 to wdt2 - 1 do
begin
mid: = SummFTsvet (p [j shl 1]);
c1: = Inbyte (Sootvet [mid]);
mid: = SummFTsvet (p [j shl 1 + 1]);
c2: = Inbyte (Sootvet [mid]);
buf1^: = (c1 shl 4 or c2) and $FF;
BlockWrite (f2, buf1^, 1, NWritten);
if NWritten <> 1 then break;
end;
j0: = 1;
if width mod 2 <> 0 then
begin
mid: = SummFTsvet (p [Width - 1]);
c1: = Inbyte (Sootvet [mid]);
buf1^: = (c1 shl 4 or 0) and $FF;
BlockWrite (f2, buf1^, 1, NWritten);
j0: = 2;
end;
if NWritten <> 1 then break;
buf1^: = 0;
for j: = j0 to (wdt - wdt2) do
BlockWrite (f2, buf1^, 1, NWritten);
prgrs. Position: = 100 * (Height - i) div Height;
end;
end;
try
finally
CloseFile (f2);
end;
Dispose (buf1);
Dispose (buf2);
Dispose (buf4);
Result: = true;
end;
end.
3. Модуль UnitGisto. pas
unit UnitGisto;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, TeEngine, Series, ExtCtrls, TeeProcs, Chart;
type
TFormG = class (TForm)
Chart2: TChart;
BarSeries1: TBarSeries;
Chart1: TChart;
Series1: TBarSeries;
procedure FormShow (Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
FormG: TFormG;
implementation
{$R *. dfm}
uses Unit1, MathImage;
procedure TFormG. FormShow (Sender: TObject);
var
i: integer;
aw: a256w;
s: string;
begin
Chart1. Series [0]. Clear;
aw: = Mform. HistoVals;
for i: = 0 to 255 do
begin
if (i mod 5) = 0 then
Chart1. Series [0]. Add (aw [i], s)
else
Chart1. Series [0]. Add (aw [i]);
end;
Chart2. Series [0]. AssignValues (Chart1. Series [0]);
end;
end.
Керівництво оператора
1. ЗАГАЛЬНІ ВІДОМОСТІ
1.1 Позначення і найменування програми
Програмний продукт має найменування „Графічний кодер чорно-білих зображень ”. Модулі програмного продукту мають назву, яка відповідає діям, що в них виконуються.
1.2 Програмне забезпечення, необхідне для функціонування програми
Для функціонування програми необхідні:
операційна система Windows.
Програма створювалась мовою програмування Delphi 7.0. Обрання цієї мови програмування було зумовлено її швидкістю та зручністю у процесі розробки, великим обсягом засобів для створення багатовіконного інтерфейсу та для обробки зображень.
Область застосування програмного продукту - вищі учбові заклади, книжкові та газетні видавництва, служби охорони, та державна служба безпеки. Програмний продукт дозволяє будь-які 256-кольорові чорно-білі зображення, які зберігаються у форматі. jpeg або. bmp, у зображення. bmp з меншою кількістю кольорів (від 2 до 16) із зберіганням інформативності зображення. Для покращення результатів обробка зображення виконується декількома методами, з метою отримати найбільш вигідне зображення.
Програмний продукт відповідає поставленим до нього вимогам і у межах обумовлених ними не має функціональних обмежень.
3. ОПИС ЛОГІЧНОЇ СТРУКТУРИ ПРОГРАМИ
Розроблене програмне забезпечення функціонує за наступним загальним алгоритмом:
Завантажити зображення з файлу, зазначеного користувачем.
Якщо зображення має формат BMP, перейти на пункт 4.
Перетворити зображення у формат BMP.
Установити параметри пікселей для BMP в pf24bit
Розрахувати гістограму яскравості для зображення по формулах (1) - (3).
Якщо потрібно, вирівняти діаграму станів.
Розрахувати пороги областей квантування wi, з умов мінімізації їхніх внесків у значення цільової функції 
й розрахованих на етапі 5 компонентів вектора яскравості.
Значеннями елементів палітри pi взяти центри відповідних кластерів.
Замінити кожен піксель зображення на відповідний до нього, відповідно до рівнів квантування й розрахованій палітрі.
Відобразити зображення із застосованими рівнями квантування.
Зберегти зображення у файл формату BMP 16 квітів.
Завершення роботи програми.
Загальна схема алгоритму програми наведена у звіті в підрозділі 4.2
4. ВИКОРИСТАНІ ТЕХНІЧНІ ЗАСОБИ
Для роботи програмного продукту необхідна IBM PC/AT сумісна персональна ЕОМ, наявність процесору Pentium II 433МГц та вище з обсягом оперативної пам’яті 128Мб або більше, наявністю відео адаптеру VGA або SVGA.