unit con18u5;
//by chrs format: +0="chr$",+4=width,+5=height,+6=chr size(8,8+1,8+1+8+1)

//sqr для integer сильно быстрее, чем abs
//floyd скорости не отнимает
//двумерный массив обрабатывается медленнее одномерного
{
5.пустые знакоместа подкрашены. что делать?

6.вот если бы можно подсвечивать/подтемнять участки инструментом и
сразу видеть результат конверсии...

12.В темных черно-синих знакоместах (img) возникают белые(!) пиксели.
иногда не только в черно-синих

13.почему ecoimg с dith level<1 пакуются хуже?

15.как найти лучшие 256 атрибутов для img/emg?

16.чтобы можно было выбирать области bright/nobright в 6912?

19. штриховку на знакоместах с пропорциональным набором цветов
давать и между уровнями 1 и 2.

20. надо произвольный размер экрана, хотя бы 384x304 и АТМовский мультиколор.

21. знакоместа чёрный+белый не конвертятся! (только в IMG/MCX?)

22. bright only в mcx нет

23. почему palette centering и color projecting в MC ухудшают картинку?

24. почему R-Mode уходит в сиреневый при дизеринге, хотя в модели всё ок? (убралось перестановкой слоёв?)

25. в R-Mode ярко-жёлтый не генерируется (вырожденный базис?)

26. ошибка представления цвета считается неверно при вычитании W (угол при этом должен меняться)
}
interface

uses
  Windows, SysUtils, Graphics, Controls, Forms, tgapng,
  Dialogs, StdCtrls, Classes, ExtCtrls, ExtDlgs, ComCtrls, jpeg, gifimage;

type
  palarray=array[0..15]of integer;

const
  RPALS=7; //число палитр в R-Mode
  R48PALS=8; //число палитр в R48-Mode
 rpaltab:array[0..7,0..2]of byte{r,g,b}=(
   ($00,$00,$00),
   ($00,$00,$ff),
   ($ff,$00,$00),
   ($ff,$00,$ff),
   ($00,$ff,$00),
   ($00,$ff,$ff),
   ($ff,$ff,$00),
   ($ff,$ff,$ff)
 );

 datcnt={255{}1707{};//palettes=datcnt+1
{ n0=20;n255=235;}
  bmpn255=255;
 zro={-10}0;
 b75={70}63;
 b127={137}126;
 b0=0;b1=b75;b2=b127;b3=b127+b75;b4=b127+b127;
// bdiv=60;{на него делим цвет для приведения к 0..4}
 Cbrb:palarray=(zro,b75,zro,b75,zro,b75,zro,b75,zro,b127,zro,b127,zro,b127,zro,b127);
 Cbrg:palarray=(zro,zro,zro,zro,b75,b75,b75,b75,zro,zro,zro,zro,b127,b127,b127,b127);
 Cbrr:palarray=(zro,zro,b75,b75,zro,zro,b75,b75,zro,zro,b127,b127,zro,zro,b127,b127);
{если уровни 0,4,8,c,10 - то цветов 83;
если уровни 0,5,8,a,d,10 - то цветов 102;
если уровни 0,4,7,8,a,c - то цветов 102}
 icol:array[0..82,0..2]of byte{r,g,b}=(
(b0,b1,b2),(b0,b2,b1),(b1,b0,b2),(b1,b2,b0),(b2,b0,b1),(b2,b1,b0),
(b0,b1,b3),(b0,b3,b1),(b1,b0,b3),(b1,b3,b0),(b3,b0,b1),(b3,b1,b0),{B}
(b0,b2,b3),(b0,b3,b2),(b2,b0,b3),(b2,b3,b0),(b3,b0,b2),(b3,b2,b0),{B}
(b0,b2,b4),(b0,b4,b2),(b2,b0,b4),(b2,b4,b0),(b4,b0,b2),(b4,b2,b0),{BB}
(b1,b2,b3),(b1,b3,b2),(b2,b1,b3),(b2,b3,b1),(b3,b1,b2),(b3,b2,b1),{B}
{014,124,234,034,134 нет}
(b0,b0,b1),(b0,b1,b0),(b1,b0,b0),(b0,b1,b1),(b1,b0,b1),(b1,b1,b0),
(b0,b0,b2),(b0,b2,b0),(b2,b0,b0),(b0,b2,b2),(b2,b0,b2),(b2,b2,b0),
(b0,b0,b3),(b0,b3,b0),(b3,b0,b0),(b0,b3,b3),(b3,b0,b3),(b3,b3,b0),{B}
(b0,b0,b4),(b0,b4,b0),(b4,b0,b0),(b0,b4,b4),(b4,b0,b4),(b4,b4,b0),{BB}
(b1,b1,b2),(b1,b2,b1),(b2,b1,b1),(b1,b2,b2),(b2,b1,b2),(b2,b2,b1),
(b1,b1,b3),(b1,b3,b1),(b3,b1,b1),(b1,b3,b3),(b3,b1,b3),(b3,b3,b1),{B}
(b2,b2,b3),(b2,b3,b2),(b3,b2,b2),(b2,b3,b3),(b3,b2,b3),(b3,b3,b2),{B}
(b2,b2,b4),(b2,b4,b2),(b4,b2,b2),(b2,b4,b4),(b4,b2,b4),(b4,b4,b2),{BB}
{14,34 нет}
(b0,b0,b0),(b1,b1,b1),(b2,b2,b2),(b3,b3,b3),(b4,b4,b4));
 chtab:array[0..7,0..7]of byte=(
        ($1E,$9E,$3E,$BE,$12,$92,$32,$B2),
        ($DE,$5E,$FE,$7E,$D2,$52,$F2,$72),
        ($26,$A6,$06,$86,$2A,$AA,$0A,$8A),
        ($E6,$66,$C6,$46,$EA,$6A,$CA,$4A),
        ($16,$96,$36,$B6,$1A,$9A,$3A,$BA),
        ($D6,$56,$F6,$76,$DA,$5A,$FA,$7A),
        ($2E,$AE,$0E,$8E,$22,$A2,$02,$82),
        ($EE,$6E,$CE,$4E,$E2,$62,$C2,$42)
        );
(*        ($06,$B6,$26,$86,$0A,$BA,$2A,$8A),
        ($C6,$46,$E6,$66,$CA,$4A,$EA,$6A),
        ($36,$96,$16,$A6,$3A,$9A,$1A,$AA),
        ($F6,$76,$D6,$56,$FA,$7A,$DA,$5A),
        ($0E,$BE,$2E,$8E,$02,$B2,$22,$82),
        ($CE,$4E,$EE,$6E,$C2,$42,$E2,$62),
        ($3E,$9E,$1E,$AE,$32,$92,$12,$A2),
        ($FE,$7E,$DE,$5E,$F2,$72,$D2,$52));
 ($1E,$B6,$42,$9A,$E6,$2E,$A2,$FA),
   ($DA,$76,$F6,$0A,$56,$CA,$4A,$66),
   ($86,$26,$92,$C2,$4E,$AE,$9E,$0E),
   ($3E,$D2,$6E,$3A,$F2,$22,$7E,$EE),
   ($DE,$02,$BE,$8E,$12,$BA,$62,$32),
   ($72,$AA,$2A,$EA,$7A,$46,$D6,$8A),
   ($36,$FE,$52,$5A,$A6,$E2,$06,$C6),
   ($96,$16,$CE,$82,$1A,$5E,$B2,$6A));*)

type
  array32=array[0..31]of byte;
  TForm1 = class(TForm)
    imFrom: TImage;
    imTo: TImage;
    Memo1: TMemo;
    ScrollBox1: TScrollBox;
    Image1: TImage;
    edBrightness: TEdit;
    edContrast: TEdit;
    Label1: TLabel;
    Label2: TLabel;
    btConvMCX: TButton;
    btOpen: TButton;
    OpenDialog1: TOpenPictureDialog;
    btConvGiga: TButton;
    btConv6912: TButton;
    Label3: TLabel;
    edColor: TEdit;
    btConvMC: TButton;
    Label4: TLabel;
    edPrior: TEdit;
    Button1: TButton;
    zxOpenDialog: TOpenDialog;
    Label5: TLabel;
    Label6: TLabel;
    cbDith: TCheckBox;
    edDithLevel: TEdit;
    Label8: TLabel;
    btSaveDraw: TButton;
    edRadius: TEdit;
    udRadius: TUpDown;
    btLoadZX: TButton;
    lbIP2: TLabel;
    lbIP1: TLabel;
    cbChunk5: TCheckBox;
    cbEcoImg: TCheckBox;
    cbBrightOnly: TCheckBox;
    edXmin: TEdit;
    edWidth: TEdit;
    edYmin: TEdit;
    edHeight: TEdit;
    Label7: TLabel;
    Label9: TLabel;
    cbFix: TCheckBox;
    btConv8col: TButton;
    cbCHRS: TCheckBox;
    cbMCFilter: TCheckBox;
    cbProjecting: TCheckBox;
    cbLimitMC: TCheckBox;
    OpenDialog2: TOpenDialog;
    Button2: TButton;
    cbEvenMC: TCheckBox;
    cbBrightGrey: TCheckBox;
    btConvRMode: TButton;
    edkcolerr: TEdit;
    Label10: TLabel;
    imToTmp: TImage;
    Label11: TLabel;
    Label12: TLabel;
    btConvR48Mode: TButton;
    ImToTmpGrey: TImage;
    ImToTmpGrey2: TImage;
    cbRModeNoise: TCheckBox;
    procedure FormCreate(Sender: TObject);
    procedure conv8col;
    procedure convMCX;
    procedure convGiga;
    procedure conv6912;
    procedure convMC;
    procedure convRMode;
    procedure convR48Mode;
    procedure edBrightnessChange(Sender: TObject);
    procedure btConvMCXClick(Sender: TObject);
    procedure btOpenClick(Sender: TObject);
    procedure btConvGigaClick(Sender: TObject);
    procedure btConv6912Click(Sender: TObject);
    procedure btConvMCClick(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure ImLoadClick(Sender: TObject);
    procedure imToMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure drawchr(Button: TMouseButton;X, Y: Integer);
    procedure imToMouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure btSaveDrawClick(Sender: TObject);
    procedure edDithLevelChange(Sender: TObject);
    procedure edWidthChange(Sender: TObject);
    procedure edHeightChange(Sender: TObject);
    procedure edXminChange(Sender: TObject);
    procedure Image1MouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure Image1MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure btConv8colClick(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure btConvRModeClick(Sender: TObject);
    procedure btConvR48ModeClick(Sender: TObject);
  public
    pic,pic256,pic8,pictotmp,pictotmpgrey,pictotmpgrey2:tbitmap;
    brightness,contrast,colority,topprior,dithlevel,height,width,xmin,ymin:real;
    bx,gx,rx,c1x,c2x,c3x,c4x,bxmaster,gxmaster,rxmaster,ditlev1,ditlev2:array[0..199,-1..263]of integer;
    atb,atg,atr:array[0..3]of integer;
    amb,amg,amr:array[0..31,0..3]of integer;
    aa,ab,sa,sb:array32;
    scr1,scr2,scr1master,scr2master:array[0..383]of array32;
    attr1,attr2,attr3,attr4:array[0..199,0..31] of byte;
    faa,fab,fsa,fsb:file;
    fname,s,mainname:string;
    palname,mainpalname:string;
    tablo:array[0..7777,0..7]of byte;{[4..7]=0..82}
    dislo:array[0..82,0..7,0..7]of integer;
    editable,editimg:boolean; //true для img
    n0,n255,kletkamask:byte;
    code256:array[0..624]of byte;
    deco256:array[0..511]of byte;
    emg:array[0..6144+768+768]of byte;
    dithon,projon,bronly,clicking:boolean;
    oldfname:string;
 brb:palarray;
 brg:palarray;
 brr:palarray;
  end;

var
  Form1: TForm1;
  time1:ttime;
  k1,k2,k3,k1real,k2real,k3real,x,y,z,xreal,yreal,zreal:real;
  kcolerr:real;

implementation

{$R *.dfm}

function nomerln(y:integer):integer;
begin
 nomerln:=(y and 192)+(y and 7)shl 3+(y and 56)shr 3;
end;

{
function min2(x1,x2:real):real;
begin
  if x1<x2 then min2:=x1 else min2:=x2;
end;
{}
function min3(x1,x2,x3:real):real;
var t:real;
begin
 if x2<x1 then t:=x2 else t:=x1;
 if x3<t then min3:=x3 else min3:=t;
end;

function det(x1,y1,z1,x2,y2,z2,x3,y3,z3:real):real;
begin
  det:= (
	x1*((y2*z3) - (y3*z2)) +
	y1*((z2*x3) - (z3*x2)) +
	z1*((x2*y3) - (y2*x3))
  );
end;

function tobyte(x:real):byte; //x=0..1
var
  xmul256:real;
  t:integer;
begin
  xmul256:=x*255.4;
  t:=trunc(xmul256+0.5);
  if t<0 then t:=0;
  if t>255 then t:=255;
  tobyte:=t;
end;

function findbase(x,y,z,x1,y1,z1,x2,y2,z2:real):real;
begin
end;

function checkcoord(dx,dy,dz:real;var err:real; x1,y1,z1,x2,y2,z2,x3,y3,z3:real):boolean;
//dx,dy,dz равны -1,-1,-1 для добавленного белого сверх заданного базиса
var
  detbase:real;
  xyzlen,xyzreallen:real;
  errlight:real;
begin
  detbase:=det(x1,y1,z1,x2,y2,z2,x3,y3,z3);
  if abs(detbase)<1e-6
  then begin //вырожденный базис
    detbase:=1e-6;
    //либо используем 12, либо 23
    //err1:=findbase(x+dx,y+dy,z+dz,x1,y1,z1,x2,y2,z2);
    //err2:=findbase(x+dx,y+dy,z+dz,x3,y3,z3,x2,y2,z2);
    k1:=0;
    if x1>0 then k2:=(x+dx)/x1;
    if y1>0 then k2:=(y+dy)/y1;
    if z1>0 then k2:=(z+dz)/z1;

    k3:=0;
  //флаг попадания:
  checkcoord:= false;
  end
  else begin
    k1:=det(x+dx,y+dy,z+dz,x2,  y2,  z2,  x3,  y3,  z3  )/detbase;
    k2:=det(x1,  y1,  z1,  x+dx,y+dy,z+dz,x3,  y3,  z3  )/detbase;
    k3:=det(x1,  y1,  z1,  x2,  y2,  z2,  x+dx,y+dy,z+dz)/detbase;
  //флаг попадания:
  checkcoord:= (
	(k1>=0)and(k1<=1) and
	(k2>=0)and(k2<=1) and
	(k3>=0)and(k3<=1)
  );
  end;
  //вернуть ошибку представления точки в этом базисе:
  k1real:=k1; if (k1real<0) then k1real:=0; if (k1real>1) then k1real:=1;
  k2real:=k2; if (k2real<0) then k2real:=0; if (k2real>1) then k2real:=1;
  k3real:=k3; if (k3real<0) then k3real:=0; if (k3real>1) then k3real:=1;
  xreal:=k1real*x1 + k2real*x2 + k3real*x3 -dx;
  yreal:=k1real*y1 + k2real*y2 + k3real*y3 -dy;
  zreal:=k1real*z1 + k2real*z2 + k3real*z3 -dz;
  err:=sqr(xreal-x) + sqr(yreal-y) + sqr(zreal-z); //до 2020 без коэффициентов - разницы не видно
  //ошибка в цветовом тоне хуже всего! как найти?
  //нормировать векторы xyz и xyzreal и смотреть разницу
  xyzlen:=sqrt(sqr(x)+sqr(y)+sqr(z));
  xyzreallen:=sqrt(sqr(xreal)+sqr(yreal)+sqr(zreal));
//  if (xyzlen>(1e-9)) and (xyzreallen>(1e-9))
//  then err:=err+kcolerr*({kr*}sqr((xreal)/xyzreallen-x/xyzlen) + {kg*}sqr((yreal)/xyzreallen-y/xyzlen) + {kb*}sqr((zreal)/xyzreallen-z/xyzlen));
  //недостаток яркости ещё хуже?
  errlight:=kcolerr*(xyzlen-xyzreallen);
  if errlight>0 then err:=err+errlight;
end;


{function mi(x,y,z,t:real):real;
var m:real;
begin
 if y<x then m:=y else m:=x;
 if z<m then m:=z;
 if t<m then mi:=t else mi:=m;
end;
}
function mi9i(a0,a1,a2,a3,a4,a5,a6,a7,a8:integer):integer;
var m:integer;
begin
 if a1<a0 then m:=a1 else m:=a0;
 if a2<m then m:=a2;
 if a3<m then m:=a3;
 if a4<m then m:=a4;
 if a5<m then m:=a5;
 if a6<m then m:=a6;
 if a7<m then m:=a7;
 if a8<m then mi9i:=a8 else mi9i:=m;
end;

function mi5i(a0,a1,a2,a3,a4:integer):integer;
var m:integer;
begin
 if a1<a0 then m:=a1 else m:=a0;
 if a2<m then m:=a2;
 if a3<m then m:=a3;
 if a4<m then mi5i:=a4 else mi5i:=m;
end;

{function mn(x,y,z,t:real):integer;
//return order 0..3 or minimal num
var
 m:real;
 i:integer;
begin
 if x<y then begin m:=x;i:=0 end else begin m:=y;i:=1 end;
 if z<m then begin m:=z;i:=2 end;
 if t<m then mn:=3 else mn:=i;
end;
}
function mni(x,y,z,t:integer):integer;
//return order 0..3 or minimal num
var
 m:integer;
 i:integer;
begin
 if x<y then begin m:=x;i:=0 end else begin m:=y;i:=1 end;
 if z<m then begin m:=z;i:=2 end;
 if t<m then mni:=3 else mni:=i;
end;

function m2(x,y:real):integer;
begin
 if x<y then m2:=0 else m2:=1;
end;

function m2i(x,y:integer):integer;
begin
 if x<y then m2i:=0 else m2i:=1;
end;

function min2(x,y:real):real;
begin
 if x<y then min2:=x else min2:=y;
end;

function min2i(x,y:byte):byte;
begin
//ord?
 if x<y then min2i:=x else min2i:=y;
end;

function min3i(x,y,z:integer):integer;
var m:integer;
begin
 if x<y then m:=x else m:=y;
 if z<m then min3i:=z else min3i:=m;
end;

function max2i(x,y:byte):byte;
begin
 if x>y then max2i:=x else max2i:=y;
end;

procedure TForm1.FormCreate(Sender: TObject);
var
 i,nr:integer;
begin
 editable:=false;

 height:=0;width:=0;xmin:=0;ymin:=0;

 brb:=Cbrb;
 brg:=Cbrg;
 brr:=Cbrr;

 opendialog1.InitialDir:=getcurrentdir;
 zxopendialog.InitialDir:=getcurrentdir;
 oldfname:='&';fname:='';mainname:='noname';
 palname:='';mainpalname:='noname';
 pic8:=tbitmap.create;
 pic8.PixelFormat:=pf24bit;
 pic8.Height:=192;pic8.Width:=256;
 pictotmp:=tbitmap.create;
 pictotmp.PixelFormat:=pf24bit;
 pictotmp.Height:=192;pictotmp.Width:=256;
 pictotmpgrey:=tbitmap.create;
 pictotmpgrey.PixelFormat:=pf24bit;
 pictotmpgrey.Height:=192;pictotmpgrey.Width:=256;
 pictotmpgrey2:=tbitmap.create;
 pictotmpgrey2.PixelFormat:=pf24bit;
 pictotmpgrey2.Height:=192;pictotmpgrey2.Width:=256;
 imTo.Height:=pic8.Height;imTo.Width:=pic8.Width;
 edbrightness.OnChange(sender);
 eddithlevel.OnChange(sender);

 assignfile(fsa,'code256.dat');reset(fsa,1);
 blockread(fsa,code256,625);
 closefile(fsa);
 assignfile(fsa,'deco256.dat');reset(fsa,1);
 blockread(fsa,deco256,512);
 closefile(fsa);

 assignfile(fsa,'tablo.dat');reset(fsa,1);
 for i:=0 to 1707 do begin
  blockread(fsa,tablo[i,0],1);{p1}
  blockread(fsa,tablo[i,1],1);{i1}
  blockread(fsa,tablo[i,2],1);{p2}
  blockread(fsa,tablo[i,3],1);{i2}
  for nr:=0 to 82 do begin
{pp}if(icol[nr,0]=brr[tablo[i,0]]+brr[tablo[i,2]])
   and(icol[nr,1]=brg[tablo[i,0]]+brg[tablo[i,2]])
   and(icol[nr,2]=brb[tablo[i,0]]+brb[tablo[i,2]])then tablo[i,4]:=nr;
{ip}if(icol[nr,0]=brr[tablo[i,1]]+brr[tablo[i,2]])
   and(icol[nr,1]=brg[tablo[i,1]]+brg[tablo[i,2]])
   and(icol[nr,2]=brb[tablo[i,1]]+brb[tablo[i,2]])then tablo[i,5]:=nr;
{pi}if(icol[nr,0]=brr[tablo[i,0]]+brr[tablo[i,3]])
   and(icol[nr,1]=brg[tablo[i,0]]+brg[tablo[i,3]])
   and(icol[nr,2]=brb[tablo[i,0]]+brb[tablo[i,3]])then tablo[i,6]:=nr;
{ii}if(icol[nr,0]=brr[tablo[i,1]]+brr[tablo[i,3]])
   and(icol[nr,1]=brg[tablo[i,1]]+brg[tablo[i,3]])
   and(icol[nr,2]=brb[tablo[i,1]]+brb[tablo[i,3]])then tablo[i,7]:=nr;
  end;
 end;
 closefile(fsa);

end;

//############################## !!!! MCX !!!! ###################
procedure TForm1.convMCX;
var
 i,j,i1,i2,i3,i4,mini1,mini2,mini3,mini4,c,c8:byte;
 nr1,nr2,nr3,nr4,i7:byte;
 min,ercol0:integer;
 bb,bg,br, cb,cg,cr, ti:integer;
 atb0,atb1,atb2,atb3,atb4,
 atg0,atg1,atg2,atg3,atg4,
 atr0,atr1,atr2,atr3,atr4:byte;
 midpixb,midpixg,midpixr,erazbr:integer;
 limitmc,evenmc:boolean;
 linemax,linemaxcount,reg_max:integer;
 divs:array[0..31]of real;
 reg_divsi,reg_divsmax:real;
 mins,minups,mini1s,mini2s,mini3s,mini4s,mini1u,mini2u,mini3u,mini4u:array[0..31]of integer;
begin
 erazbr:=ord(cbMCFilter.Checked)*4; //palette centering
 limitmc:=cbLimitMC.Checked;
 evenmc:=cbEvenMC.Checked;
 for c:=0 to 31 do begin aa[c]:=7;ab[c]:=71 end;

 for j:=0 to 191 do begin
  for c:=0 to 31 do begin c8:=c shl 3;
   //COUNT MIN: FROM previous LINE
   i2:=aa[c]and 7+(aa[c]and 64)shr 3; i1:=aa[c]shr 3;
   i4:=ab[c]and 7+(ab[c]and 64)shr 3; i3:=ab[c]shr 3;
   mini1:=i1;mini2:=i2;mini3:=i3;mini4:=i4;min:=0;
   atb0:=brb[i1]+brb[i3];atg0:=brg[i1]+brg[i3];atr0:=brr[i1]+brr[i3];
   atb1:=brb[i2]+brb[i3];atg1:=brg[i2]+brg[i3];atr1:=brr[i2]+brr[i3];
   atb2:=brb[i1]+brb[i4];atg2:=brg[i1]+brg[i4];atr2:=brr[i1]+brr[i4];
   atb3:=brb[i2]+brb[i4];atg3:=brg[i2]+brg[i4];atr3:=brr[i2]+brr[i4];
   atb4:=(atb0+atb3)shr 1;atg4:=(atg0+atg3)shr 1;atr4:=(atr0+atr3)shr 1;
   for i:=c8 to c8+7 do begin
    cb:=bx[j,i];cg:=gx[j,i];cr:=rx[j,i];
    inc(min,
    mi5i(
      {kb*}sqr(atb0-cb)+{kg*}sqr(atg0-cg)+sqr(atr0-cr),
      {kb*}sqr(atb1-cb)+{kg*}sqr(atg1-cg)+sqr(atr1-cr),
      {kb*}sqr(atb2-cb)+{kg*}sqr(atg2-cg)+sqr(atr2-cr),
      {kb*}sqr(atb3-cb)+{kg*}sqr(atg3-cg)+sqr(atr3-cr),
      {kb*}sqr(atb4-cb)+{kg*}sqr(atg4-cg)+sqr(atr4-cr)));
   end; //i
   minups[c]:=min;mini1u[c]:=mini1;mini2u[c]:=mini2;mini3u[c]:=mini3;mini4u[c]:=mini4;
   //
   midpixb:=0; midpixg:=0; midpixr:=0;
   for i7:=0 to 7 do begin i:=i7+c8;
    cb:=bx[j,i];cg:=gx[j,i];cr:=rx[j,i];
    inc(midpixb,cb);
    inc(midpixg,cg);
    inc(midpixr,cr);
    for ti:=0 to 82 do dislo[ti,0,i7]:={kb*}sqr(icol[ti,0]-cr)+{kg*}sqr(icol[ti,1]-cg)+sqr(icol[ti,2]-cb);
   end;
   midpixb:=midpixb div 8;
   midpixg:=midpixg div 8;
   midpixr:=midpixr div 8;
   //
   if j and 7<>0 then min:=trunc(min*topprior) else min:=1000000000; //top color to be most freqly
   //
   for ti:=0 to datcnt{1707} do begin
    i1:=tablo[ti,0];i2:=tablo[ti,1];i3:=tablo[ti,2];i4:=tablo[ti,3];
    ercol0:=0;
    atb4:=(brb[i1]+brb[i3]+brb[i2]+brb[i4])shr 1;
    atg4:=(brg[i1]+brg[i3]+brg[i2]+brg[i4])shr 1;
    atr4:=(brr[i1]+brr[i3]+brr[i2]+brr[i4])shr 1;
    if erazbr*(sqr(atb4-midpixb)+sqr(atg4-midpixg)+sqr(atr4-midpixr))<min then begin
      nr1:=tablo[ti,4];nr2:=tablo[ti,5];nr3:=tablo[ti,6];nr4:=tablo[ti,7];
      for i7:=0 to 7 do begin i:=i7+c8;
       cb:=bx[j,i];cg:=gx[j,i];cr:=rx[j,i];
       inc(ercol0,mi5i(
         dislo[nr1,0,i7],dislo[nr2,0,i7],dislo[nr3,0,i7],dislo[nr4,0,i7],
         {kb*}sqr(atb4-cb)+{kg*}sqr(atg4-cg)+sqr(atr4-cr)));
       if ercol0>min then break;
      end; //i
      if ercol0<min then begin min:=ercol0;mini1:=i1;mini2:=i2;mini3:=i3;mini4:=i4;end;
    end;
   end; //i4i3i2i1bri2bri1 {for ti}
   mins[c]:=min;mini1s[c]:=mini1;mini2s[c]:=mini2;mini3s[c]:=mini3;mini4s[c]:=mini4;
  end; //c
  //
  //!!!ограничиваем число мультиколорных знакомест!!!
  //оставляем те, у которых верхний цвет хуже всего подходит (minups[c]/mins[c] больше)
  if(limitmc){and(j and 7<>0){ДАЁТ ПОЛОСКИ}
  then linemax:=8
  else linemax:=16;
  for i:=0 to 15 do divs[i]:=(minups[i+i]+minups[i+i+1]+1e3)/(mins[i+i]+mins[i+i+1]+1e3);
  //ищем и обрабатываем linemax максимальных divs
  for linemaxcount:=0 to 15 do
  begin
   reg_max:=0;
   reg_divsmax:=divs[linemaxcount];
   for i:=0 to 15 do
   begin
    reg_divsi:=divs[i];
    if reg_divsi>=reg_divsmax
    then begin reg_max:=i;reg_divsmax:=reg_divsi end;
   end;
   divs[reg_max]:=-1e38;

   for c:=reg_max*2 to reg_max*2+1 do begin
    c8:=c shl 3;
    if linemaxcount{0..15}<linemax{8 или 16}
    then begin mini1:=mini1s[c];mini2:=mini2s[c];mini3:=mini3s[c];mini4:=mini4s[c];end
    else begin mini1:=mini1u[c];mini2:=mini2u[c];mini3:=mini3u[c];mini4:=mini4u[c];end;
    aa[c]:=mini2 and 7+mini1 shl 3; ab[c]:=mini4 and 7+mini3 shl 3;
    {pp}atb0:=brb[mini1]+brb[mini3];atg0:=brg[mini1]+brg[mini3];atr0:=brr[mini1]+brr[mini3];
    {ip}atb1:=brb[mini2]+brb[mini3];atg1:=brg[mini2]+brg[mini3];atr1:=brr[mini2]+brr[mini3];
    {pi}atb2:=brb[mini1]+brb[mini4];atg2:=brg[mini1]+brg[mini4];atr2:=brr[mini1]+brr[mini4];
    {ii}atb3:=brb[mini2]+brb[mini4];atg3:=brg[mini2]+brg[mini4];atr3:=brr[mini2]+brr[mini4];
    {pp}atb[0]:=atb0;atg[0]:=atg0;atr[0]:=atr0;
    {ip}atb[1]:=atb1;atg[1]:=atg1;atr[1]:=atr1;
    {pi}atb[2]:=atb2;atg[2]:=atg2;atr[2]:=atr2;
    {ii}atb[3]:=atb3;atg[3]:=atg3;atr[3]:=atr3;
    for i:=c8 to c8+7 do begin
     cb:=bx[j,i];cg:=gx[j,i];cr:=rx[j,i];
     if cb>n255 then cb:=255;if cg>n255 then cg:=255;if cr>n255 then cr:=255;
     if cb<n0 then cb:=0;if cg<n0 then cg:=0;if cr<n0 then cr:=0;
     mini1:=mni(
       {kb*}sqr(atb0-cb)+{kg*}sqr(atg0-cg)+sqr(atr0-cr),
       {kb*}sqr(atb1-cb)+{kg*}sqr(atg1-cg)+sqr(atr1-cr),
       {kb*}sqr(atb2-cb)+{kg*}sqr(atg2-cg)+sqr(atr2-cr),
       {kb*}sqr(atb3-cb)+{kg*}sqr(atg3-cg)+sqr(atr3-cr));
     sa[c]:=sa[c]shl 1+mini1 and 1; sb[c]:=sb[c]shl 1+mini1 shr 1; //здесь range error, т.к. sa[c],sb[c] не инициализированы нулем
     bb:=atb[mini1];bg:=atg[mini1];br:=atr[mini1];
     cb:=cb-bb;cg:=cg-bg;cr:=cr-br;
     bx[j,i+1]:=bx[j,i+1]+cb div 2;gx[j,i+1]:=gx[j,i+1]+cg div 2;rx[j,i+1]:=rx[j,i+1]+cr div 2;
     bx[j+1,i]:=bx[j+1,i]+cb div 4;gx[j+1,i]:=gx[j+1,i]+cg div 4;rx[j+1,i]:=rx[j+1,i]+cr div 4;
     bx[j+1,i-1]:=bx[j+1,i-1]+cb div 8;gx[j+1,i-1]:=gx[j+1,i-1]+cg div 8;rx[j+1,i-1]:=rx[j+1,i-1]+cr div 8;
     bx[j+1,i+1]:=bx[j+1,i+1]+cb div 8;gx[j+1,i+1]:=gx[j+1,i+1]+cg div 8;rx[j+1,i+1]:=rx[j+1,i+1]+cr div 8;
     pic8.Canvas.Pixels[i,j]:=(bb shl 16)+(bg shl 8)+br;
    end; //i
   end //c
  end; //linemaxcount
  scr1[j]:=sa;scr1[j+192]:=aa;scr2[j]:=sb;scr2[j+192]:=ab;
  //application.ProcessMessages; application.Title:=inttostr(192-j)+' lines';
 end; //j (line)
end;

//qqqqqqqqqqqqqqqqqqq 8col qqqqqqqqqqqqqqqqqqq
procedure TForm1.conv8col;
var
 row,i,j,minib,minir,minig,c,c8:byte;
 bb,bg,br, cb,cg,cr:integer;
begin
 for j:=0 to 191 do begin
  for c:=0 to 31 do begin c8:=c shl 3;
   for i:=c8 to c8+7 do begin
    cb:=bx[j,i];cg:=gx[j,i];cr:=rx[j,i];
    if cb>n255 then cb:=255;if cg>n255 then cg:=255;if cr>n255 then cr:=255;
    if cb<n0 then cb:=0;if cg<n0 then cg:=0;if cr<n0 then cr:=0;
    minib:=ord(cb>127);sa[c]:=sa[c]shl 1+minib;
    minir:=ord(cr>127);aa[c]:=aa[c]shl 1+minir;
    minig:=ord(cg>127);sb[c]:=sb[c]shl 1+minig;
    bb:=255*minib;br:=255*minir;bg:=255*minig;
    cb:=cb-bb;cg:=cg-bg;cr:=cr-br;
    bx[j,i+1]:=bx[j,i+1]+cb div 2;gx[j,i+1]:=gx[j,i+1]+cg div 2;rx[j,i+1]:=rx[j,i+1]+cr div 2;
    bx[j+1,i]:=bx[j+1,i]+cb div 4;gx[j+1,i]:=gx[j+1,i]+cg div 4;rx[j+1,i]:=rx[j+1,i]+cr div 4;
    bx[j+1,i-1]:=bx[j+1,i-1]+cb div 8;gx[j+1,i-1]:=gx[j+1,i-1]+cg div 8;rx[j+1,i-1]:=rx[j+1,i-1]+cr div 8;
    bx[j+1,i+1]:=bx[j+1,i+1]+cb div 8;gx[j+1,i+1]:=gx[j+1,i+1]+cg div 8;rx[j+1,i+1]:=rx[j+1,i+1]+cr div 8;
    pic8.Canvas.Pixels[i,j]:=(bb shl 16)+(bg shl 8)+br;
   end; //i
  end; //c
  row:=(j and 7)shl 3+(j and 56)shr 3+(j and $c0);
  scr1[row]:=sa;scr1[row+192]:=aa;scr2[row]:=sb;
 end; //j
end;

//************************GIGASCREEN*****************************
procedure TForm1.convGiga;
var
 row,i,j,i1,i2,i3,i4,mini1,mini2,mini3,mini4,mini1lev,c,c8,r8:byte;
 nr1,nr2,nr3,nr4,i7,j7:byte;
 otn1,otn2, min,ercol0:integer;
 cb,cg,cr, ti ,pals, ax,ay,az, cx,cy,cz, mx,my,mz, vx,vy,vz, zx,zy,zz:integer;
 atb0,atb1,atb2,atb3,atb4,
 atg0,atg1,atg2,atg3,atg4,
 atr0,atr1,atr2,atr3,atr4:byte;
 midpixb,midpixg,midpixr,erazbr:integer;
 k,divisor:real; //перевод в integer (+-23.8) немного портит картинку
begin
 brb:=Cbrb;
 brr:=Cbrr;
 brg:=Cbrg;
 erazbr:=ord(cbMCFilter.Checked)*32;
 dithon:=cbDith.Checked; editable:=dithon;
 for c:=0 to 31 do begin aa[c]:=7;ab[c]:=71 end;

 for row:=0 to 23 do begin r8:=row shl 3;
  for c:=0 to 31 do begin c8:=c shl 3;
   //COUNT MIN: FROM previous LINE
   i2:=aa[c]and 7+(aa[c]and 64)shr 3; i1:=aa[c]shr 3;
   i4:=ab[c]and 7+(ab[c]and 64)shr 3; i3:=ab[c]shr 3;
   mini1:=i1;mini2:=i2;mini3:=i3;mini4:=i4;min:=0;
   atb0:=brb[i1]+brb[i3];atg0:=brg[i1]+brg[i3];atr0:=brr[i1]+brr[i3];
   atb1:=brb[i2]+brb[i3];atg1:=brg[i2]+brg[i3];atr1:=brr[i2]+brr[i3];
   atb2:=brb[i1]+brb[i4];atg2:=brg[i1]+brg[i4];atr2:=brr[i1]+brr[i4];
   atb3:=brb[i2]+brb[i4];atg3:=brg[i2]+brg[i4];atr3:=brr[i2]+brr[i4];
   atb4:=(atb0+atb3)shr 1;atg4:=(atg0+atg3)shr 1;atr4:=(atr0+atr3)shr 1;
   for i:=c8 to c8+7 do for j:=r8 to r8+7 do begin
    cb:=bx[j,i];cg:=gx[j,i];cr:=rx[j,i];
    inc(min,mi5i(
      {kb*}sqr(atb0-cb)+{kg*}sqr(atg0-cg)+sqr(atr0-cr),
      {kb*}sqr(atb1-cb)+{kg*}sqr(atg1-cg)+sqr(atr1-cr),
      {kb*}sqr(atb2-cb)+{kg*}sqr(atg2-cg)+sqr(atr2-cr),
      {kb*}sqr(atb3-cb)+{kg*}sqr(atg3-cg)+sqr(atr3-cr),
      {kb*}sqr(atb4-cb)+{kg*}sqr(atg4-cg)+sqr(atr4-cr)));
   end; //ij
   midpixb:=0; midpixg:=0; midpixr:=0;
   for i7:=0 to 7 do begin i:=i7+c8; for j7:=0 to 7 do begin j:=j7+r8;
    cb:=bx[j,i];cg:=gx[j,i];cr:=rx[j,i];
    inc(midpixb,cb);
    inc(midpixg,cg);
    inc(midpixr,cr);
    for ti:=0 to 82 do dislo[ti,j7,i7]:={kb*}sqr(icol[ti,0]-cr)+{kg*}sqr(icol[ti,1]-cg)+sqr(icol[ti,2]-cb);
   end;end;
   midpixb:=midpixb div 64;
   midpixg:=midpixg div 64;
   midpixr:=midpixr div 64;
   //pals:=0;
   for ti:=0 to datcnt{1707} do begin
    i1{p1}:=tablo[ti,0];i2{i1}:=tablo[ti,1];i3{p2}:=tablo[ti,2];i4{i2}:=tablo[ti,3];
    if i2-i1<>i4-i3{цвета не на одной линии,кроме осевой в 4 цвета}then begin
     //inc(pals);
     atb4:=(brb[i1]+brb[i3]+brb[i2]+brb[i4])shr 1;
     atg4:=(brg[i1]+brg[i3]+brg[i2]+brg[i4])shr 1;
     atr4:=(brr[i1]+brr[i3]+brr[i2]+brr[i4])shr 1;
     if erazbr*(sqr(atb4-midpixb)+sqr(atg4-midpixg)+sqr(atr4-midpixr))<min then begin
      nr1:=tablo[ti,4];nr2:=tablo[ti,5];nr3:=tablo[ti,6];nr4:=tablo[ti,7];
      ercol0:=0;
//перебор только 16 точек сильно портит картинку
      for i7:=0 to 7 do begin i:=i7+c8;for j7:=0 to 7 do begin j:=j7+r8;
       inc(ercol0,
       mi5i(
         dislo[nr1,j7,i7],dislo[nr2,j7,i7],dislo[nr3,j7,i7],dislo[nr4,j7,i7],
         {kb*}sqr(atb4-bx[j,i])+{kg*}sqr(atg4-gx[j,i])+sqr(atr4-rx[j,i])//1.2s//через * по скорости то же самое
         ));
       if ercol0>min then break;
      end;end; //ij
      if ercol0<min then begin min:=ercol0;mini1:=i1;mini2:=i2;mini3:=i3;mini4:=i4;end;
     end;
    end;
   end; //i4i3i2i1bri2bri1 {for ti}
   aa[c]:=mini2 and 7+mini1 shl 3; ab[c]:=mini4 and 7+mini3 shl 3;
   //prefiltering ('05)
   {pp}atb0:=brb[mini1]+brb[mini3];atg0:=brg[mini1]+brg[mini3];atr0:=brr[mini1]+brr[mini3];
   {ip}atb1:=brb[mini2]+brb[mini3];atg1:=brg[mini2]+brg[mini3];atr1:=brr[mini2]+brr[mini3];
   {pi}atb2:=brb[mini1]+brb[mini4];atg2:=brg[mini1]+brg[mini4];atr2:=brr[mini1]+brr[mini4];
   {ii}atb3:=brb[mini2]+brb[mini4];atg3:=brg[mini2]+brg[mini4];atr3:=brr[mini2]+brr[mini4];
   for j:=r8 to r8+7 do for i:=c shl 3 to c shl 3+7 do begin
     cb:=bxmaster[j,i];cg:=gxmaster[j,i];cr:=rxmaster[j,i];
     if(atb2<>2*atb1)or(atg2<>2*atg1)or(atr2<>2*atr1)
     then begin //ищем проекцию на параллелограмм: H=M+kV
       //v=A x C={AyCz-AzCy;AzCx-AxCz;AxCy-AyCx}, где A=at?1-at?0, C=at?2-at?0
       //k=det|M C A|/det|V A C|
       mx:=cb-atb0;my:=cg-atg0;mz:=cr-atr0;
       ax:=atb1-atb0;ay:=atg1-atg0;az:=atr1-atr0;
       cx:=atb2-atb0;cy:=atg2-atg0;cz:=atr2-atr0;
       vx:=ay*cz-az*cy;vy:=az*cx-ax*cz;vz:=ax*cy-ay*cx;
       divisor:=vx*ay*cz+vy*az*cx+vz*ax*cy-vz*ay*cx-vy*ax*cz-vx*az*cy;
       //if abs(divisor)<1 then divisor:=1;
       k:=(mz*ay*cx+my*ax*cz+mx*az*cy-mx*ay*cz-my*az*cx-mz*ax*cy)/divisor;
       cb:=atb0+mx+trunc(k*vx);cg:=atg0+my+trunc(k*vy);cr:=atr0+mz+trunc(k*vz);
     end else begin //цвета на осевой линии (пропорционально 0,1,2,3)
       otn1:=128+(128*(sqr(atb0-cb)+sqr(atg0-cg)+sqr(atr0-cr)-sqr(atb3-cb)-sqr(atg3-cg)-sqr(atr3-cr)))div(sqr(atb3-atb0)+sqr(atg3-atg0)+sqr(atr3-atr0));
       cb:=(otn1*atb3)div 256;cg:=(otn1*atg3)div 256;cr:=(otn1*atr3)div 256;
     end;
     if cb>255 then cb:=255;if cg>255 then cg:=255;if cr>255 then cr:=255;
     if cb<0 then cb:=0;if cg<0 then cg:=0;if cr<0 then cr:=0;
     bxmaster[j,i]:=cb;gxmaster[j,i]:=cg;rxmaster[j,i]:=cr;
     bx[j,i]:=cb;gx[j,i]:=cg;rx[j,i]:=cr;
     //pic8.Canvas.Pixels[i,j]:=(cb shl 16)+(cg shl 8)+cr;
   end; //end of prefiltering
  end; //c
  scr1[192+row]:=aa; scr2[192+row]:=ab;
  //application.ProcessMessages; application.Title:=inttostr(192-r8)+' lines';
 end; //row

 for row:=0 to 23 do begin r8:=row shl 3;
  aa:=scr1[192+row]; ab:=scr2[192+row];
  for j:=r8 to r8+7 do for c:=0 to 31 do begin
   mini2:=aa[c]and 7+(aa[c]and 64)shr 3; mini1:=aa[c]shr 3;
   mini4:=ab[c]and 7+(ab[c]and 64)shr 3; mini3:=ab[c]shr 3;
   {pp}atb0:=brb[mini1]+brb[mini3];atg0:=brg[mini1]+brg[mini3];atr0:=brr[mini1]+brr[mini3];
   {ip}atb1:=brb[mini2]+brb[mini3];atg1:=brg[mini2]+brg[mini3];atr1:=brr[mini2]+brr[mini3];
   {pi}atb2:=brb[mini1]+brb[mini4];atg2:=brg[mini1]+brg[mini4];atr2:=brr[mini1]+brr[mini4];
   {ii}atb3:=brb[mini2]+brb[mini4];atg3:=brg[mini2]+brg[mini4];atr3:=brr[mini2]+brr[mini4];
   atb[0]:=atb0;atg[0]:=atg0;atr[0]:=atr0;
   atb[1]:=atb1;atg[1]:=atg1;atr[1]:=atr1;
   atb[2]:=atb2;atg[2]:=atg2;atr[2]:=atr2;
   atb[3]:=atb3;atg[3]:=atg3;atr[3]:=atr3;
   ax:=atb1-atb0;ay:=atg1-atg0;az:=atr1-atr0;
   cx:=atb2-atb0;cy:=atg2-atg0;cz:=atr2-atr0;
   zz:=cx*ay-cy*ax; zy:=cx*az-cz*ax; zx:=cy*az-cz*ay;
   for i:=c shl 3 to c shl 3+7 do begin
//----was only when dithon=false------------------------------------------------
     cb:=bxmaster[j,i];cg:=gxmaster[j,i];cr:=rxmaster[j,i];
     mx:=cb-atb0;my:=cg-atg0;mz:=cr-atr0;
     if(atb2<>2*atb1)or(atg2<>2*atg1)or(atr2<>2*atr1)
     then begin //цвета на параллелограмме
       if zz<>0 then{не || оси z=r}   begin otn2:=trunc(256*(mx*ay-my*ax)/zz); otn1:=trunc(256*(my*cx-mx*cy)/zz); end
       else if zy<>0 then{не||оси y=g}begin otn2:=trunc(256*(mx*az-mz*ax)/zy); otn1:=trunc(256*(mz*cx-mx*cz)/zy); end
                     else {|| оси y=g}begin otn2:=trunc(256*(my*az-mz*ay)/zx); otn1:=trunc(256*(mz*cy-my*cz)/zx); end;
     end else begin //цвета на осевой линии (пропорционально 0,1,2,3)
       otn1:=384+384*((sqr(atb0-cb)+sqr(atg0-cg)+sqr(atr0-cr)-sqr(atb3-cb)-sqr(atg3-cg)-sqr(atr3-cr)))div(sqr(atb3-atb0)+sqr(atg3-atg0)+sqr(atr3-atr0));
       if(otn1<0)then otn1:=0;if(otn1>767)then otn1:=767;
       if(otn1<256)then otn2:=0
       else if(otn1<512)then begin otn2:=(otn1-256)div 2; otn1:=255; end
                        else begin otn2:=255; otn1:=otn1-512; end;
     end;
     ditlev1[j,i]:=otn1; ditlev2[j,i]:=otn2;//меньшие значения ближе к ord(false)=0 (т.е. к paper'у)
//------------------------------------------------------------------------------
     cb:=bx[j,i];cg:=gx[j,i];cr:=rx[j,i];
     if cb>255 then cb:=255;if cg>255 then cg:=255;if cr>255 then cr:=255;
     if cb<0 then cb:=0;if cg<0 then cg:=0;if cr<0 then cr:=0;
     if dithon then {пиксель для floyd}
      mini1:=mni(
       {kb*}sqr(atb0-cb)+{kg*}sqr(atg0-cg)+sqr(atr0-cr),{pp}
       {kb*}sqr(atb1-cb)+{kg*}sqr(atg1-cg)+sqr(atr1-cr),{ip}
       {kb*}sqr(atb2-cb)+{kg*}sqr(atg2-cg)+sqr(atr2-cr),{pi}
       {kb*}sqr(atb3-cb)+{kg*}sqr(atg3-cg)+sqr(atr3-cr)){ii}
     else {пиксель для diamond}
      mini1:=ord(otn2>chtab[(i+2)and kletkamask,(j+3)and kletkamask])shl 1{sb}
            +ord(otn1>chtab[i and kletkamask,j and kletkamask]);{sa}
     mini1lev:=mini1;
     if otn2<n0 then mini1lev:=mini1lev and 1;if otn2>n255 then mini1lev:=mini1lev or 2;//отсечение по dith.lev.
     if otn1<n0 then mini1lev:=mini1lev and 2;if otn1>n255 then mini1lev:=mini1lev or 1;//отсечение по dith.lev.
     sa[c]:=sa[c]shl 1+mini1lev and 1; sb[c]:=sb[c]shl 1+mini1lev shr 1; //здесь range error, т.к. sa[c],sb[c] не инициализированы нулем
     pic8.Canvas.Pixels[i,j]:=(atb[mini1lev] shl 16)+(atg[mini1lev] shl 8)+atr[mini1lev];
     if dithon then begin
      cb:=cb-atb[mini1];cg:=cg-atg[mini1];cr:=cr-atr[mini1];
      bx[j,i+1]:=bx[j,i+1]+cb div 2;gx[j,i+1]:=gx[j,i+1]+cg div 2;rx[j,i+1]:=rx[j,i+1]+cr div 2;
      bx[j+1,i]:=bx[j+1,i]+cb div 4;gx[j+1,i]:=gx[j+1,i]+cg div 4;rx[j+1,i]:=rx[j+1,i]+cr div 4;
      bx[j+1,i-1]:=bx[j+1,i-1]+cb div 8;gx[j+1,i-1]:=gx[j+1,i-1]+cg div 8;rx[j+1,i-1]:=rx[j+1,i-1]+cr div 8;
      bx[j+1,i+1]:=bx[j+1,i+1]+cb div 8;gx[j+1,i+1]:=gx[j+1,i+1]+cg div 8;rx[j+1,i+1]:=rx[j+1,i+1]+cr div 8;
     end; //if dithon//shr 3 вместо div 8 не пашет
   end; //i
   scr1[(j and 7)shl 3+row and 7+(row and $18)shl 3]:=sa;
   scr2[(j and 7)shl 3+row and 7+(row and $18)shl 3]:=sb;
  end; //jc
  //application.ProcessMessages; application.Title:=inttostr(192-r8)+' lines';
 end; //row
// memo1.Lines.add(inttostr(pals));
end;

//%%%%%%$%$%$%$%$%$%............... 6912 ...........%$%$%$%$%$%$%$$$$$$
procedure TForm1.conv6912;
var
 row,i,j,k,bri1,i1,i2,mini1,mini2,mini1lev,c,c8,r8:byte{integer{};
 min,ercol0:integer;
 oa,otn1, cb,cg,cr:integer;
 atb0,atb1,atb2,atb3,atb4,
 atg0,atg1,atg2,atg3,atg4,
 atr0,atr1,atr2,atr3,atr4:byte;
 midpixb,midpixg,midpixr,erazbr:integer;
begin
 erazbr:=ord(cbMCFilter.Checked)*32;
 dithon:=cbDith.Checked; editable:=dithon;
 projon:=cbProjecting.Checked;
 for c:=0 to 31 do aa[c]:=7+64*ord(bronly);

 for row:=0 to 23 do begin r8:=row shl 3;
  for c:=0 to 31 do begin c8:=c shl 3;
   //COUNT MIN: FROM previous LINE
   i2:=aa[c]and 7+(aa[c]and 64)shr 3; i1:=aa[c]shr 3;
   mini1:=i1;mini2:=i2;min:=0;
   atb0:=brb[i1]shl 1;atg0:=brg[i1]shl 1;atr0:=brr[i1]shl 1;
   atb1:=brb[i2]shl 1;atg1:=brg[i2]shl 1;atr1:=brr[i2]shl 1;
   atb2:=brb[i1]+brb[i2];atg2:=brg[i1]+brg[i2];atr2:=brr[i1]+brr[i2];
   atb3:=(atb0+atb2)shr 1;atg3:=(atg0+atg2)shr 1;atr3:=(atr0+atr2)shr 1;
   atb4:=(atb1+atb2)shr 1;atg4:=(atg1+atg2)shr 1;atr4:=(atr1+atr2)shr 1;
   for i:=c8 to c8+7 do for j:=r8 to r8+7 do begin
    cb:=bx[j,i];cg:=gx[j,i];cr:=rx[j,i];
    inc(min,mi5i(
      {kb*}sqr(atb0-cb)+{kg*}sqr(atg0-cg)+sqr(atr0-cr),
      {kb*}sqr(atb1-cb)+{kg*}sqr(atg1-cg)+sqr(atr1-cr),
      {kb*}sqr(atb2-cb)+{kg*}sqr(atg2-cg)+sqr(atr2-cr),
      {kb*}sqr(atb3-cb)+{kg*}sqr(atg3-cg)+sqr(atr3-cr),
      {kb*}sqr(atb4-cb)+{kg*}sqr(atg4-cg)+sqr(atr4-cr)));
   end; //ij
   midpixb:=0; midpixg:=0; midpixr:=0;
   for i:=c8 to c8+7 do for j:=r8 to r8+7 do begin
    cb:=bx[j,i];cg:=gx[j,i];cr:=rx[j,i];
    inc(midpixb,cb);
    inc(midpixg,cg);
    inc(midpixr,cr);
   end;
   midpixb:=midpixb div 64;
   midpixg:=midpixg div 64;
   midpixr:=midpixr div 64;
   for bri1:=ord(bronly){0} to 1 do
   for i1:=bri1 shl 3 to bri1 shl 3+6 do for i2:=i1+1 to bri1 shl 3+7 do begin
    atb0:=brb[i1]shl 1;atg0:=brg[i1]shl 1;atr0:=brr[i1]shl 1;
    atb1:=brb[i2]shl 1;atg1:=brg[i2]shl 1;atr1:=brr[i2]shl 1;
    atb2:=brb[i1]+brb[i2];atg2:=brg[i1]+brg[i2];atr2:=brr[i1]+brr[i2];
//здесь это сравнение просто для скорости (на картинку почти не влияет)
    if erazbr*(sqr(atb2-midpixb)+sqr(atg2-midpixg)+sqr(atr2-midpixr))<min then begin
      atb3:=(atb0+atb2)shr 1;atg3:=(atg0+atg2)shr 1;atr3:=(atr0+atr2)shr 1;
      atb4:=(atb1+atb2)shr 1;atg4:=(atg1+atg2)shr 1;atr4:=(atr1+atr2)shr 1;
      ercol0:=0;
      for i:=c8 to c8+7 do for j:=r8 to r8+7 do begin
       cb:=bx[j,i];cg:=gx[j,i];cr:=rx[j,i];
       inc(ercol0,mi5i(
         {kb*}sqr(atb0-cb)+{kg*}sqr(atg0-cg)+sqr(atr0-cr),
         {kb*}sqr(atb1-cb)+{kg*}sqr(atg1-cg)+sqr(atr1-cr),
         {kb*}sqr(atb2-cb)+{kg*}sqr(atg2-cg)+sqr(atr2-cr),
         {kb*}sqr(atb3-cb)+{kg*}sqr(atg3-cg)+sqr(atr3-cr),
         {kb*}sqr(atb4-cb)+{kg*}sqr(atg4-cg)+sqr(atr4-cr)));
       if ercol0>min then break;
      end; //ij
      if ercol0<min then begin min:=ercol0;mini1:=i1;mini2:=i2;end;
    end;
   end; //i2i1bri1
   aa[c]:=mini2 and 7+mini1 shl 3;
   if projon then begin
     //prefiltering ('05)
     {pap}amb[c,0]:=brb[mini2]+brb[mini2];amg[c,0]:=brg[mini2]+brg[mini2];amr[c,0]:=brr[mini2]+brr[mini2];
     {ink}amb[c,1]:=brb[mini1]+brb[mini1];amg[c,1]:=brg[mini1]+brg[mini1];amr[c,1]:=brr[mini1]+brr[mini1];
     oa:=sqr(amb[c,1]-amb[c,0])+sqr(amg[c,1]-amg[c,0])+sqr(amr[c,1]-amr[c,0]);
     if oa=0 then oa:=1;
     for j:=r8 to r8+7 do for i:=c8 to c8+7 do begin
       cb:=bxmaster[j,i];cg:=gxmaster[j,i];cr:=rxmaster[j,i];
       otn1:=128+(128*(sqr(amb[c,0]-cb)+sqr(amg[c,0]-cg)+sqr(amr[c,0]-cr){OM}-sqr(amb[c,1]-cb)-sqr(amg[c,1]-cg)-sqr(amr[c,1]-cr){AM}))div oa;
       if(otn1<0)then otn1:=0;if(otn1>255)then otn1:=255;
       cb:=amb[c,0]+(otn1*(amb[c,1]-amb[c,0]))div 256;
       cg:=amg[c,0]+(otn1*(amg[c,1]-amg[c,0]))div 256;
       cr:=amr[c,0]+(otn1*(amr[c,1]-amr[c,0]))div 256;
       bxmaster[j,i]:=cb;gxmaster[j,i]:=cg;rxmaster[j,i]:=cr;
       bx[j,i]:=cb;gx[j,i]:=cg;rx[j,i]:=cr;
       //pic8.Canvas.Pixels[i,j]:=(cb shl 16)+(cg shl 8)+cr;
     end; //end of prefiltering
   end; //projon
  end; //c
  scr1[192+row]:=aa;
 end; //row

 for row:=0 to 23 do begin r8:=row shl 3;
  aa:=scr1[192+row];
  for j:=r8 to r8+7 do begin
   for c:=0 to 31 do begin
    mini1:=aa[c]and 7+(aa[c]and 64)shr 3; mini2:=aa[c]shr 3;
    {pap}amb[c,0]:=brb[mini2]+brb[mini2];amg[c,0]:=brg[mini2]+brg[mini2];amr[c,0]:=brr[mini2]+brr[mini2];
    {ink}amb[c,1]:=brb[mini1]+brb[mini1];amg[c,1]:=brg[mini1]+brg[mini1];amr[c,1]:=brr[mini1]+brr[mini1];
    oa:=sqr(amb[c,1]-amb[c,0])+sqr(amg[c,1]-amg[c,0])+sqr(amr[c,1]-amr[c,0]);
    if oa=0 then oa:=1;
    for i:=c shl 3 to c shl 3+7 do begin
//----was only when dithon=false------------------------------------------------
     cb:=bxmaster[j,i];cg:=gxmaster[j,i];cr:=rxmaster[j,i];
     otn1:=trunc(128*(1+(sqr(amb[c,0]-cb)+sqr(amg[c,0]-cg)+sqr(amr[c,0]-cr){OM}-sqr(amb[c,1]-cb)-sqr(amg[c,1]-cg)-sqr(amr[c,1]-cr){AM})/oa));
     ditlev1[j,i]:=otn1;//меньшие значения ближе к ord(false)=0 (т.е. к paper'у)
//------------------------------------------------------------------------------
     cb:=bx[j,i];cg:=gx[j,i];cr:=rx[j,i];
     if cb>255 then cb:=255;if cg>255 then cg:=255;if cr>255 then cr:=255;
     if cb<0 then cb:=0;if cg<0 then cg:=0;if cr<0 then cr:=0;
     if dithon then mini1:=m2i({kb*}sqr(amb[c,0]-cb)+{kg*}sqr(amg[c,0]-cg)+sqr(amr[c,0]-cr),
                               {kb*}sqr(amb[c,1]-cb)+{kg*}sqr(amg[c,1]-cg)+sqr(amr[c,1]-cr))
     else mini1:=ord(otn1>chtab[i and kletkamask,j and kletkamask]);
     mini1lev:=mini1;if otn1<n0 then mini1lev:=0;if otn1>n255 then mini1lev:=1;//отсечение по dith.lev.
     sa[c]:=sa[c]shl 1+mini1lev; //здесь range error, т.к. sa[c] не инициализировано нулем
     pic8.Canvas.Pixels[i,j]:=(amb[c,mini1lev] shl 16)+(amg[c,mini1lev] shl 8)+amr[c,mini1lev];
     if dithon then begin
      cb:=cb-amb[c,mini1];cg:=cg-amg[c,mini1];cr:=cr-amr[c,mini1];
      if projon or ((i and 7)<7) then
        bx[j,i+1]:=bx[j,i+1]+(cb*3)div 8;gx[j,i+1]:=gx[j,i+1]+(cg*3)div 8;rx[j,i+1]:=rx[j,i+1]+(cr*3)div 8;
      if projon or ((j and 7)<7) then begin
        bx[j+1,i]:=bx[j+1,i]+(cb*3)div 8;gx[j+1,i]:=gx[j+1,i]+(cg*3)div 8;rx[j+1,i]:=rx[j+1,i]+(cr*3)div 8;
        bx[j+1,i-1]:=bx[j+1,i-1]+cb div 8;gx[j+1,i-1]:=gx[j+1,i-1]+cg div 8;rx[j+1,i-1]:=rx[j+1,i-1]+cr div 8;
        bx[j+1,i+1]:=bx[j+1,i+1]+cb div 8;gx[j+1,i+1]:=gx[j+1,i+1]+cg div 8;rx[j+1,i+1]:=rx[j+1,i+1]+cr div 8;
      end;
     end; //if dithon
    end; //i
   end; //c
   scr1[(j and 7)shl 3+row and 7+(row and $18)shl 3]:=sa;
  end; //j
 end; //row
end;

//______,,,,______===============MULTICOLOR==========='''''''''''''
procedure TForm1.convMC;
var
 i,j,i7,bri1,i1,i2,mini1,mini2,c,c8:byte{integer{};
 cb,cg,cr:integer;
 oa,otn1, min,ercol0:integer;
 midpixb,midpixg,midpixr,erazbr:integer;
 limitmc,evenmc,brightgrey:boolean;
 linemax,linemaxcount,reg_max:integer;
 divs:array[0..31]of real;
 reg_divsi,reg_divsmax:real;
 mins,minups,mini1s,mini2s,mini3s,mini4s,mini1u,mini2u,mini3u,mini4u:array[0..31]of integer;
begin
 erazbr:=ord(cbMCFilter.Checked)*8;
 limitmc:=cbLimitMC.Checked;
 evenmc:=cbEvenMC.Checked;
 brightgrey:=cbBrightGrey.Checked;
 projon:=cbProjecting.Checked;
 for c:=0 to 31 do aa[c]:=7+64*ord(bronly);

 for j:=0 to 191 do begin
  for c:=0 to 31 do begin c8:=c shl 3;
   //COUNT MIN: FROM previous LINE
   i2:=aa[c]and 7+(aa[c]and 64)shr 3; i1:=aa[c]shr 3;
   mini1:=i1;mini2:=i2;
   atb[0]:=brb[i1]shl 1;atg[0]:=brg[i1]shl 1;atr[0]:=brr[i1]shl 1;
   atb[1]:=brb[i2]shl 1;atg[1]:=brg[i2]shl 1;atr[1]:=brr[i2]shl 1;
   atb[2]:=brb[i1]+brb[i2];atg[2]:=brg[i1]+brg[i2];atr[2]:=brr[i1]+brr[i2];
   min:=0;
   for i:=c8 to c8+7 do begin
    cb:=bx[j,i];cg:=gx[j,i];cr:=rx[j,i];
    inc(min,mi5i(
      {kb*}sqr(atb[0]-cb)+{kg*}sqr(atg[0]-cg)+sqr(atr[0]-cr),
      {kb*}sqr(atb[1]-cb)+{kg*}sqr(atg[1]-cg)+sqr(atr[1]-cr),
      {kb*}sqr(atb[2]-cb)+{kg*}sqr(atg[2]-cg)+sqr(atr[2]-cr),
      {kb*}sqr((atb[0]+atb[2])shr 1-cb)+{kg*}sqr((atg[0]+atg[2])shr 1-cg)+sqr((atr[0]+atr[2])shr 1-cr),
      {kb*}sqr((atb[1]+atb[2])shr 1-cb)+{kg*}sqr((atg[1]+atg[2])shr 1-cg)+sqr((atr[1]+atr[2])shr 1-cr)));
   end; //i
   minups[c]:=min;mini1u[c]:=mini1;mini2u[c]:=mini2;
   //
   midpixb:=0; midpixg:=0; midpixr:=0;
   for i:=c8 to c8+7 do begin
    cb:=bx[j,i];cg:=gx[j,i];cr:=rx[j,i];
    inc(midpixb,cb);
    inc(midpixg,cg);
    inc(midpixr,cr);
   end;
   midpixb:=midpixb div 8;
   midpixg:=midpixg div 8;
   midpixr:=midpixr div 8;
   //
   if j and 7<>0 then min:=trunc(min*topprior) else min:=1000000000; //top color to be most freqly
   //
   if evenmc and ((j and 1)<>0)
   then begin
     bri1:=ord(brightgrey);
     i1:=bri1 shl 3;
     i2:=(bri1 shl 3)+7;
     atb[0]:=brb[i1]shl 1;atg[0]:=brg[i1]shl 1;atr[0]:=brr[i1]shl 1;
     atb[1]:=brb[i2]shl 1;atg[1]:=brg[i2]shl 1;atr[1]:=brr[i2]shl 1;
     atb[2]:=brb[i1]+brb[i2];atg[2]:=brg[i1]+brg[i2];atr[2]:=brr[i1]+brr[i2];
     ercol0:=0;
     for i:=c8 to c8+7 do begin
       cb:=bx[j,i];cg:=gx[j,i];cr:=rx[j,i];
       inc(ercol0,mi5i(
         {kb*}sqr(atb[0]-cb)+{kg*}sqr(atg[0]-cg)+sqr(atr[0]-cr),
         {kb*}sqr(atb[1]-cb)+{kg*}sqr(atg[1]-cg)+sqr(atr[1]-cr),
         {kb*}sqr(atb[2]-cb)+{kg*}sqr(atg[2]-cg)+sqr(atr[2]-cr),
         {kb*}sqr((atb[0]+atb[2])shr 1-cb)+{kg*}sqr((atg[0]+atg[2])shr 1-cg)+sqr((atr[0]+atr[2])shr 1-cr),
         {kb*}sqr((atb[1]+atb[2])shr 1-cb)+{kg*}sqr((atg[1]+atg[2])shr 1-cg)+sqr((atr[1]+atr[2])shr 1-cr)));
     end; //i
     min:=ercol0;mini1:=i1;mini2:=i2;
   end
   else begin
     for bri1:=ord(bronly){0} to 1 do
     for i1:=bri1 shl 3 to bri1 shl 3+6 do for i2:=i1+1 to bri1 shl 3+7 do begin
      atb[0]:=brb[i1]shl 1;atg[0]:=brg[i1]shl 1;atr[0]:=brr[i1]shl 1;
      atb[1]:=brb[i2]shl 1;atg[1]:=brg[i2]shl 1;atr[1]:=brr[i2]shl 1;
      atb[2]:=brb[i1]+brb[i2];atg[2]:=brg[i1]+brg[i2];atr[2]:=brr[i1]+brr[i2];
      if erazbr*(sqr(atb[2]-midpixb)+sqr(atg[2]-midpixg)+sqr(atr[2]-midpixr))<min then begin
        ercol0:=0;
        for i:=c8 to c8+7 do begin
         cb:=bx[j,i];cg:=gx[j,i];cr:=rx[j,i];
         inc(ercol0,mi5i(
           {kb*}sqr(atb[0]-cb)+{kg*}sqr(atg[0]-cg)+sqr(atr[0]-cr),
           {kb*}sqr(atb[1]-cb)+{kg*}sqr(atg[1]-cg)+sqr(atr[1]-cr),
           {kb*}sqr(atb[2]-cb)+{kg*}sqr(atg[2]-cg)+sqr(atr[2]-cr),
           {kb*}sqr((atb[0]+atb[2])shr 1-cb)+{kg*}sqr((atg[0]+atg[2])shr 1-cg)+sqr((atr[0]+atr[2])shr 1-cr),
           {kb*}sqr((atb[1]+atb[2])shr 1-cb)+{kg*}sqr((atg[1]+atg[2])shr 1-cg)+sqr((atr[1]+atr[2])shr 1-cr)));
         if ercol0>min then break;
        end; //i
        if ercol0<min then begin min:=ercol0;mini1:=i1;mini2:=i2;end;
      end;
     end; //i2i1bri1
   end; //if evenmc
   mins[c]:=min;mini1s[c]:=mini1;mini2s[c]:=mini2;
  end; //c
  //
  //!!!ограничиваем число мультиколорных знакомест!!!
  //оставляем те, у которых верхний цвет хуже всего подходит (minups[c]/mins[c] больше)
  if (limitmc) and not (evenmc and ((j and 1)<>0)){and(j and 7<>0){ДАЁТ ПОЛОСКИ}
  then linemax:=8
  else linemax:=16;
  for i:=0 to 15 do divs[i]:=(minups[i+i]+minups[i+i+1]+1e3)/(mins[i+i]+mins[i+i+1]+1e3);
  //ищем и обрабатываем linemax максимальных divs
  for linemaxcount:=0 to 15 do
  begin
   reg_max:=0;
   reg_divsmax:=divs[linemaxcount];
   for i:=0 to 15 do
   begin
    reg_divsi:=divs[i];
    if reg_divsi>=reg_divsmax
    then begin reg_max:=i;reg_divsmax:=reg_divsi end;
   end;
   divs[reg_max]:=-1e38;

   for c:=reg_max*2 to reg_max*2+1 do begin
    c8:=c shl 3;
    if linemaxcount{0..15}<linemax{8 или 16}
    then begin mini1:=mini1s[c];mini2:=mini2s[c];end
    else begin mini1:=mini1u[c];mini2:=mini2u[c];end;
    aa[c]:=mini2 and 7+mini1 shl 3;
    atb[0]:=brb[mini1]shl 1;atg[0]:=brg[mini1]shl 1;atr[0]:=brr[mini1]shl 1;
    atb[1]:=brb[mini2]shl 1;atg[1]:=brg[mini2]shl 1;atr[1]:=brr[mini2]shl 1;
    if projon then begin
      //prefiltering ('05)
      oa:=sqr(atb[1]-atb[0])+sqr(atg[1]-atg[0])+sqr(atr[1]-atr[0]);
     if oa=0 then oa:=1;
      for i:=c8 to c8+7 do begin
        cb:=bx[j,i];cg:=gx[j,i];cr:=rx[j,i];
        otn1:=128+(128*(sqr(atb[0]-cb)+sqr(atg[0]-cg)+sqr(atr[0]-cr){OM}-sqr(atb[1]-cb)-sqr(atg[1]-cg)-sqr(atr[1]-cr){AM}))div oa;
        if(otn1<0)then otn1:=0;if(otn1>255)then otn1:=255;
        cb:=atb[0]+(otn1*(atb[1]-atb[0]))div 256;
        cg:=atg[0]+(otn1*(atg[1]-atg[0]))div 256;
        cr:=atr[0]+(otn1*(atr[1]-atr[0]))div 256;
        bx[j,i]:=cb;gx[j,i]:=cg;rx[j,i]:=cr;
        //pic8.Canvas.Pixels[i,j]:=(cb shl 16)+(cg shl 8)+cr;
      end; //end of prefiltering
    end; //projon
    for i:=c8 to c8+7 do begin
     cb:=bx[j,i];cg:=gx[j,i];cr:=rx[j,i];
     if cb>n255 then cb:=255;if cg>n255 then cg:=255;if cr>n255 then cr:=255;
     if cb<n0 then cb:=0;if cg<n0 then cg:=0;if cr<n0 then cr:=0;
     mini1:=m2i({kb*}sqr(atb[0]-cb)+{kg*}sqr(atg[0]-cg)+sqr(atr[0]-cr),
                {kb*}sqr(atb[1]-cb)+{kg*}sqr(atg[1]-cg)+sqr(atr[1]-cr));
     sa[c]:=sa[c]shl 1+mini1; //здесь range error, т.к. sa[c] не инициализировано нулем
     pic8.Canvas.Pixels[i,j]:=(atb[mini1] shl 16)+(atg[mini1] shl 8)+atr[mini1];
     cb:=cb-atb[mini1];cg:=cg-atg[mini1];cr:=cr-atr[mini1];
     bx[j,i+1]:=bx[j,i+1]+cb div 2;gx[j,i+1]:=gx[j,i+1]+cg div 2;rx[j,i+1]:=rx[j,i+1]+cr div 2;
     bx[j+1,i]:=bx[j+1,i]+cb div 4;gx[j+1,i]:=gx[j+1,i]+cg div 4;rx[j+1,i]:=rx[j+1,i]+cr div 4;

{     bx[j+1,i+1]:=bx[j+1,i+1]+cb div 8;gx[j+1,i+1]:=gx[j+1,i+1]+cg div 8;rx[j+1,i+1]:=rx[j+1,i+1]+cr div 8;
     bx[j+1,i-1]:=bx[j+1,i-1]+cb div 8;gx[j+1,i-1]:=gx[j+1,i-1]+cg div 8;rx[j+1,i-1]:=rx[j+1,i-1]+cr div 8;{}
     for i1:=c8 to c8+7 do begin
      bx[j+1,i1]:=bx[j+1,i1]+cb div 32;gx[j+1,i1]:=gx[j+1,i1]+cg div 32;rx[j+1,i1]:=rx[j+1,i1]+cr div 32;
     end;{}
    end; //i
   end; //c
  end; //linemaxcount
  scr2[j]:=aa; scr1[j]:=sa;
 end; //j
end;

function gammacorr(inlevel:real):integer; //0..255
var res:integer;
begin
//a^b = exp(b*ln (a))
  if (inlevel>0.5)
  then res:=trunc((exp(0.5*ln(inlevel/256)))*256+0.5)
  else res:=0;
  if res>255 then res:=255;
  gammacorr:=res;
end;

function nogammacorr(inlevel:real):integer; //0..255
var res:integer;
begin
//a^b = exp(b*ln (a))
  if (inlevel>0.5)
  then res:=trunc((exp(1.*ln(inlevel/256)))*256+0.5)
  else res:=0;
  //if res>255 then res:=255;
  nogammacorr:=res;
end;


//____________________________ R-Mode _______________________________
procedure TForm1.convRMode;
var
 i,j:byte{integer{};
 cx,cy,cx8,cy8:byte;
 pal,paln:byte;
 palerr:array[0..RPALS-1] of real;
 whiteerror:array[0..255] of integer;
 wmy,wyc,wcm,wmr,wry,wyg,wgc,wcb,wbm,cmy,mry,ryg:boolean;
 errwmy,errwyc,errwcm,errwmr,errwry,errwyg,errwgc,errwcb,errwbm,errcmy,errmry,errryg:real;
 k1x,k2x,k3x:array[0..191,0..255] of real;
 minerr:real;
 palatr:array[0..23,0..31] of byte;
 a1,a2,a3,a4:byte; //атрибуты
 nak1,nak2,nak3:byte; //номера атрибутов для коэффициентов 1..3
 c1,c2,c3,c4:integer; //c1,c2,c3,c4 - слои экрана (0..255)
 curc2,curc4,curc:integer;
 c1scr,c2scr,c3scr,c4scr:integer; //c1scr,c2scr,c3scr,c4scr - слои экрана (0/128)
 cb,cg,cr,cr_,cg_,cb_:integer; //cr,cg,cb - как это выглядит на экране (0..255)
 mini1,mini2,mini3,mini4:byte;
 atb0,atb1,atb2,atb3,atb4,
 atg0,atg1,atg2,atg3,atg4,
 atr0,atr1,atr2,atr3,atr4:byte;
 bb,bg,br:integer;
 noise:boolean;
const
 xyzmul=1.5;//2.13;//2
 dithval=128;//144;//128
begin
 noise:=cbRModeNoise.Checked; //включает костыли для цветопереходов
 for i:=0 to 255 do whiteerror[i] := 0;

 for cy:=0 to 23 do begin cy8:=cy shl 3;
  for cx:=0 to 31 do begin cx8:=cx shl 3;

// ищем палитру - надо либо MCYW, либо одну из 6 окрашенных
// минимизацией суммарной ошибки
    for pal:=0 to RPALS-1 do palerr[pal]:=0.0;
// для всех пикселей знакоместа
    for j:=cy8 to cy8+7 do begin
      for i:=cx8 to cx8+7 do begin

//rx[j,i]:=255*2;
//gx[j,i]:=150*2;
//bx[j,i]:=106*2;
  x:=rx[j,i]*xyzmul/255;
  y:=gx[j,i]*xyzmul/255;
  z:=bx[j,i]*xyzmul/255;
// x,y,z уже присвоены
  wmy:=checkcoord(0,0,0,errwmy, 1,1,1, 1,0,1, 1,1,0); //W,M,Y
  wyc:=checkcoord(0,0,0,errwyc, 1,1,1, 1,1,0, 0,1,1); //W,Y,C
  wcm:=checkcoord(0,0,0,errwcm, 1,1,1, 0,1,1, 1,0,1); //W,C,M
  //x:=x-1;
  //y:=y-1;
  //z:=z-1;
  cmy:=checkcoord(-1,-1,-1,errcmy, 0,1,1, 1,0,1, 1,1,0); //[W,]C,M,Y
  mry:=checkcoord(-1,-1,-1,errmry, 1,0,1, 1,0,0, 1,1,0); //[W,]M,R,Y
  ryg:=checkcoord(-1,-1,-1,errryg, 1,0,0, 1,1,0, 0,1,0); //[W,]R,Y,G //вырожденный базис!
   //ryg:=false; errryg:=1e9;
  //if not mry then errmry:=1.;
  //x:=x+1;
  //y:=y+1;
  //z:=z+1;
  if not(wmy or wyc or wcm or cmy) then palerr[0]:=palerr[0]+min2(min2(errwmy,errwyc),min2(errwcm,errcmy)); //MCYW
  wmr:=checkcoord(0,0,0,errwmr, 1,1,1, 1,0,1, 1,0,0); //W,M,R
  wry:=checkcoord(0,0,0,errwry, 1,1,1, 1,0,0, 1,1,0); //W,R,Y
  wyg:=checkcoord(0,0,0,errwyg, 1,1,1, 1,1,0, 0,1,0); //W,Y,G
  wgc:=checkcoord(0,0,0,errwgc, 1,1,1, 0,1,0, 0,1,1); //W,G,C
  wcb:=checkcoord(0,0,0,errwcb, 1,1,1, 0,1,1, 0,0,1); //W,C,B
  wbm:=checkcoord(0,0,0,errwbm, 1,1,1, 0,0,1, 1,0,1); //W,B,M
  if not(wmr or wry or mry) then palerr[1]:=palerr[1]+min3(errwmr,errwry,errmry); //MRYW
  if not(wry or wyg or ryg) then palerr[2]:=palerr[2]+min3(errwry,errwyg,errryg); //GRYW
  if not(wyg or wgc) then palerr[3]:=palerr[3]+min2(errwyg,errwgc); //GCYW
  if not(wgc or wcb) then palerr[4]:=palerr[4]+min2(errwgc,errwcb); //GCBW
  if not(wcb or wbm) then palerr[5]:=palerr[5]+min2(errwcb,errwbm); //MCBW
  if not(wbm or wmr) then palerr[6]:=palerr[6]+min2(errwbm,errwmr); //MRBW

        end; //i
      end; //j

// выбираем ту палитру, где суммарная ошибка меньше всего
    paln:=0; minerr:=palerr[paln];
   for pal:=0 to RPALS-1 do
      if palerr[pal]<minerr then begin paln:=pal; minerr:=palerr[paln]; end;
{}
//paln:=0; //MCYW
//paln:=1; //MRYW
    palatr[cy,cx]:=paln;

// ищем координаты в заданной палитре
// для всех пикселей знакоместа
    for j:=cy8 to cy8+7 do begin
      for i:=cx8 to cx8+7 do begin
  x:=rx[j,i]*xyzmul/255;
  y:=gx[j,i]*xyzmul/255;
  z:=bx[j,i]*xyzmul/255;
// x,y,z уже присвоены
  a4:=7; //4-й атрибут всегда W
  nak1:=4; //W всегда в 4-м атрибуте
          c1x[j,i]:=0;
          c2x[j,i]:=0;
          c3x[j,i]:=0;
          c4x[j,i]:=0;
// если MCYW, то точка может быть в треугольниках: WMY, WYC, WCM
  if (paln=0)
  then begin
    a1:=3; a2:=5; a3:=6;{чтобы было только по 2 варианта цветов в каждой строке}
    //a1:=5; a2:=3; a3:=6; //надо подменить nak... ниже
    wmy:=checkcoord(0,0,0,errwmy, 1,1,1, 1,0,1, 1,1,0); //W,M,Y
           //if (k1real>0.8)or(k2real>0.8)or(k3real>0.8) then errwmy:=1;
    wyc:=checkcoord(0,0,0,errwyc, 1,1,1, 1,1,0, 0,1,1); //W,Y,C
           //if (k1real>0.8)or(k2real>0.8)or(k3real>0.8) then errwyc:=1;
    wcm:=checkcoord(0,0,0,errwcm, 1,1,1, 0,1,1, 1,0,1); //W,C,M
           //if (k1real>0.8)or(k2real>0.8)or(k3real>0.8) then errwcm:=1;
    //x:=x-1;
    //y:=y-1;
    //z:=z-1;
    cmy:=checkcoord(-1.,-1.,-1.,errcmy, 0,1,1, 1,0,1, 1,1,0); //[W,]C,M,Y
    //cmy:=checkcoord(-0.5,-0.5,-0.5,errcmy, 0,1,1, 1,0,1, 1,1,0); //[W,]C,M,Y
    //x:=x+1;
    //y:=y+1;
    //z:=z+1;
//почему на чисто красном wmy (розовый) имеет ошибку больше, чем wyc (серый)?
    if cmy and ((errcmy<errwmy) and (errcmy<errwyc) and (errcmy<errwcm)){} then begin
        c4x[j,i]:=255;
        //c4x[j,i]:=128;
        {if (k1real>0.5) then c4x[j,i]:=c4x[j,i] + tobyte(k1real-0.5);
        if (k2real>0.5) then c4x[j,i]:=c4x[j,i] + tobyte(k2real-0.5);
        if (k3real>0.5) then c4x[j,i]:=c4x[j,i] + tobyte(k3real-0.5);{}
             {k1real:=0;
             k2real:=0;
             k3real:=0;{}
        nak1:=2{1}; nak2:=1{2}; nak3:=3;
        //nak1:=1; nak2:=2; nak3:=3;
    end
    else
    if {true or} (errwmy<errwyc) then begin
      if {false and} (errwcm<errwmy) then begin
        wcm:=checkcoord(0,0,0,errwcm, 1,1,1, 0,1,1, 1,0,1); //W,C,M
        nak2:=2{1}; nak3:=1{2};
        //nak2:=1; nak3:=2;
      end
      else begin
{}        wmy:=checkcoord(0,0,0,errwmy, 1,1,1, 1,0,1, 1,1,0); //W,M,Y
        {if (k1real>0.5) then begin
          //k2real := k2real - (k1real-0.5);
          //k3real := k3real - (k1real-0.5);
          c4x[j,i]:=c4x[j,i] + tobyte(k1real-0.5)*2;
        end;{}
        if noise and (k2real>0.4) then begin //M //костыль для телесного цветоперехода
          k1real := k1real + (k2real-0.4); //W
          k3real := k3real + (k2real-0.4); //Y
          c2x[j,i]:=c2x[j,i] + tobyte((k2real-0.4)); //C
          k2real := 0.4; //M
          if k3real > 0.5 then k3real := 0.5;
             {c4x[j,i]:=0;//255;
             k1real:=0;
             k2real:=0;
             k3real:=0;{}
        end;
        {if (k3real>0.5) then begin
          //k1real := k1real - (k3real-0.5);
          //k2real := k2real - (k3real-0.5);
          c4x[j,i]:=c4x[j,i] + tobyte(k3real-0.5)*2;
        end;{}
           {if (k1real>0.9)or(k2real>0.9)or(k3real>0.9) then begin
             c4x[j,i]:=0;//255;
             k1real:=0;
             k2real:=0;
             k3real:=0;
           end;{}
        nak2:=1{2}; nak3:=3;
        //nak2:=2; nak3:=3;
      end
    end
    else begin
      if (errwcm<errwyc) then begin
        wcm:=checkcoord(0,0,0,errwcm, 1,1,1, 0,1,1, 1,0,1); //W,C,M
        nak2:=2{1}; nak3:=1{2};
        //nak2:=1; nak3:=2;
      end
      else begin
        wyc:=checkcoord(0,0,0,errwyc, 1,1,1, 1,1,0, 0,1,1); //W,Y,C
        nak2:=3; nak3:=2{1};
        //nak2:=3; nak3:=1;
      end
    end;
{}
  end //MCYW
  else begin
// если одна из окрашенных палитр, то точка может быть в двух треугольниках
    case paln of
      1: begin //MRYW
           a1:=3; a2:=2; a3:=6;
           wmr:=checkcoord(0,0,0,errwmr, 1,1,1, 1,0,1, 1,0,0); //W,M,R
           //if (k1real>1)or(k2real>1)or(k3real>1) then errwmr:=1;
           wry:=checkcoord(0,0,0,errwry, 1,1,1, 1,0,0, 1,1,0); //W,R,Y
           //if (k1real>1)or(k2real>1)or(k3real>1) then errwry:=1;
    //x:=x-1;
    //y:=y-1;
    //z:=z-1;
    mry:=checkcoord(-1,-1,-1,errmry, 1,0,1, 1,0,0, 1,1,0); //[W,]M,R,Y
    //x:=x+1;
    //y:=y+1;
    //z:=z+1;
    if {mry{}((errmry<errwmr) and (errmry<errwry)){} then begin
        c4x[j,i]:=255;
        nak1:=1; nak2:=2; nak3:=3;
    end
    else
           if errwmr<errwry
           then begin
             wmr:=checkcoord(0,0,0,errwmr, 1,1,1, 1,0,1, 1,0,0); //W,M,R
             nak2:=1; nak3:=2;
           end
           else begin
             wry:=checkcoord(0,0,0,errwry, 1,1,1, 1,0,0, 1,1,0); //W,R,Y
              {if (k1real>0.5) then begin
                //k2real := k2real - (k1real-0.5);
                //k3real := k3real - (k1real-0.5);
                c4x[j,i]:=c4x[j,i] + tobyte(k1real-0.5)*2;
              end;
              if (k2real>0.5) then begin
                //k1real := k1real - (k2real-0.5);
                //k3real := k3real - (k2real-0.5);
                c4x[j,i]:=c4x[j,i] + tobyte(k2real-0.5)*2;
              end;
              if (k3real>0.5) then begin
                //k1real := k1real - (k3real-0.5);
                //k2real := k2real - (k3real-0.5);
                c4x[j,i]:=c4x[j,i] + tobyte(k3real-0.5)*2;
              end;{}
             nak2:=2; nak3:=3;
           end;
         end;
      2: begin //GRYW
           a1:=4; a2:=2; a3:=6;
           wry:=checkcoord(0,0,0,errwry, 1,1,1, 1,0,0, 1,1,0); //W,R,Y
           wyg:=checkcoord(0,0,0,errwyg, 1,1,1, 1,1,0, 0,1,0); //W,Y,G
    //x:=x-1; //почему эта группа не была закомментирована до 2020?
    //y:=y-1;
    //z:=z-1;
    ryg:=checkcoord(-1,-1,-1,errryg, 1,0,0, 1,1,0, 0,1,0); //[W,]R,Y,G
    //x:=x+1;
    //y:=y+1;
    //z:=z+1;
    if {ryg}((errryg<errwry) and (errryg<errwyg)) then begin
        c4x[j,i]:=255;
        nak1:=2; nak2:=3; nak3:=1;
    end
    else
           if errwry<errwyg
           then begin
             wry:=checkcoord(0,0,0,errwry, 1,1,1, 1,0,0, 1,1,0); //W,R,Y
              {if (k1real>0.5) then begin
                //k2real := k2real - (k1real-0.5);
                //k3real := k3real - (k1real-0.5);
                c4x[j,i]:=c4x[j,i] + tobyte(k1real-0.5)*2;
              end;{}
              if noise and (k2real>0.5) then begin
                k1real := k1real + (k2real-0.5);
                //k3real := k3real - (k2real-0.5);
                //c4x[j,i]:=c4x[j,i] + tobyte(k2real-0.5)*2;
              end;
              if noise and (k3real>0.5) then begin
                k1real := k1real + (k3real-0.5);
                //k2real := k2real - (k3real-0.5);
                //c4x[j,i]:=c4x[j,i] + tobyte(k3real-0.5)*2;
              end;
             nak2:=2; nak3:=3;
           end
           else begin
             wyg:=checkcoord(0,0,0,errwyg, 1,1,1, 1,1,0, 0,1,0); //W,Y,G
             nak2:=3; nak3:=1;
           end;
         end;
      3: begin //GCYW
           a1:=4; a2:=5; a3:=6;
           wyg:=checkcoord(0,0,0,errwyg, 1,1,1, 1,1,0, 0,1,0); //W,Y,G
           wgc:=checkcoord(0,0,0,errwgc, 1,1,1, 0,1,0, 0,1,1); //W,G,C
           if errwyg<errwgc
           then begin
             wyg:=checkcoord(0,0,0,errwyg, 1,1,1, 1,1,0, 0,1,0); //W,Y,G
             nak2:=3; nak3:=1;
           end
           else begin
             wgc:=checkcoord(0,0,0,errwgc, 1,1,1, 0,1,0, 0,1,1); //W,G,C
             nak2:=1; nak3:=2;
           end;
         end;
      4: begin //GCBW
           a1:=4; a2:=5; a3:=1;
           wgc:=checkcoord(0,0,0,errwgc, 1,1,1, 0,1,0, 0,1,1); //W,G,C
           wcb:=checkcoord(0,0,0,errwcb, 1,1,1, 0,1,1, 0,0,1); //W,C,B
           if errwgc<errwcb
           then begin
             wgc:=checkcoord(0,0,0,errwgc, 1,1,1, 0,1,0, 0,1,1); //W,G,C
             nak2:=1; nak3:=2;
           end
           else begin
             wcb:=checkcoord(0,0,0,errwcb, 1,1,1, 0,1,1, 0,0,1); //W,C,B
             nak2:=2; nak3:=3;
           end;
         end;
      5: begin //MCBW
           a1:=3; a2:=5; a3:=1;
           wcb:=checkcoord(0,0,0,errwcb, 1,1,1, 0,1,1, 0,0,1); //W,C,B
           wbm:=checkcoord(0,0,0,errwbm, 1,1,1, 0,0,1, 1,0,1); //W,B,M
           if errwcb<errwbm
           then begin
             wcb:=checkcoord(0,0,0,errwcb, 1,1,1, 0,1,1, 0,0,1); //W,C,B
             nak2:=2; nak3:=3;
           end
           else begin
             wbm:=checkcoord(0,0,0,errwbm, 1,1,1, 0,0,1, 1,0,1); //W,B,M
             nak2:=3; nak3:=1;
           end;
         end;
      6: begin //MRBW
           a1:=3; a2:=2; a3:=1;
           wbm:=checkcoord(0,0,0,errwbm, 1,1,1, 0,0,1, 1,0,1); //W,B,M
           wmr:=checkcoord(0,0,0,errwmr, 1,1,1, 1,0,1, 1,0,0); //W,M,R
           if errwbm<errwmr
           then begin
             wbm:=checkcoord(0,0,0,errwbm, 1,1,1, 0,0,1, 1,0,1); //W,B,M
             nak2:=3; nak3:=1;
           end
           else begin
             wmr:=checkcoord(0,0,0,errwmr, 1,1,1, 1,0,1, 1,0,0); //W,M,R
             nak2:=1; nak3:=2;
           end;
         end;
    end //case
  end; //paln<>0

  attr1[cy,cx]:=a1+64;
  attr2[cy,cx]:=a2+64;
  attr3[cy,cx]:=a3+64;
  attr4[cy,cx]:=a4+64; //W
  //k1x[j,i]:=k1real;
  //k2x[j,i]:=k2real;
  //k3x[j,i]:=k3real;
  //rx[j,i]:=tobyte(xreal);
  //gx[j,i]:=tobyte(yreal);
  //bx[j,i]:=tobyte(zreal);
  //pic8.Canvas.Pixels[i,j]:=(bx[j,i] shl 16)+(gx[j,i] shl 8)+rx[j,i];

          //c4x[j,i]:=tobyte(k1real); //4-й слой всегда W, всегда k1
          case nak1 of
            1:begin
               c1x[j,i]:=tobyte(k1real);
              end;
            2:begin
               c2x[j,i]:=tobyte(k1real);
              end;
            3:begin
               c3x[j,i]:=tobyte(k1real);
              end;
            4:begin
               c4x[j,i]:=tobyte(k1real);
              end;
          end; //case
          case nak2 of
            1:begin
               c1x[j,i]:=tobyte(k2real);
              end;
            2:begin
               c2x[j,i]:=tobyte(k2real);
              end;
            3:begin
               c3x[j,i]:=tobyte(k2real);
              end;
          end; //case
          case nak3 of
            1:begin
               c1x[j,i]:=tobyte(k3real);
              end;
            2:begin
               c2x[j,i]:=tobyte(k3real);
              end;
            3:begin
               c3x[j,i]:=tobyte(k3real);
              end;
          end; //case
        if noise then begin //нельзя в дизеринге, это чисто отладочное - смотреть модель
          if c1x[j,i] > 128 then c1x[j,i] := 128;
          if c2x[j,i] > 128 then c2x[j,i] := 128;
          if c3x[j,i] > 128 then c3x[j,i] := 128;
        end;

        c1:=c1x[j,i];c2:=c2x[j,i];c3:=c3x[j,i];c4:=c4x[j,i];
        cr:=trunc(((c2)/255)*rpaltab[a2,0] + ((c4)/255)*rpaltab[a4,0] + ((c3)/255)*rpaltab[a3,0] + ((c1)/255)*rpaltab[a1,0])div 2;
        cg:=trunc(((c2)/255)*rpaltab[a2,1] + ((c4)/255)*rpaltab[a4,1] + ((c3)/255)*rpaltab[a3,1] + ((c1)/255)*rpaltab[a1,1])div 2;
        cb:=trunc(((c2)/255)*rpaltab[a2,2] + ((c4)/255)*rpaltab[a4,2] + ((c3)/255)*rpaltab[a3,2] + ((c1)/255)*rpaltab[a1,2])div 2;
        rx[j,i]:=cr; gx[j,i]:=cg; bx[j,i]:=cb;
        if cb>255 then cb:=255;if cg>255 then cg:=255;if cr>255 then cr:=255;
        if cb<0 then cb:=0;if cg<0 then cg:=0;if cr<0 then cr:=0;
        pictotmp.Canvas.Pixels[i,j]:=(cb shl 16)+(cg shl 8)+cr;

        mini1:=0;mini3:=0;
        if odd(j)
        then begin mini2:=a1;mini4:=a2;end
        else begin mini2:=a3;mini4:=a4;end; //B/Y, W
        //else begin mini2:=a4;mini4:=a3;end;
        if odd(j)
        then begin curc2:=c1;curc4:=c2;end
        else begin curc2:=c3;curc4:=c4;end;
        //else begin curc2:=c4;curc4:=c3;end;

        //if (curc2 >= 128) then curc4 := curc4 + (curc2-128) div 2;
        //if (curc4 >= 128) then curc2 := curc2 + (curc4-128) div 2;

        pictotmp.Canvas.Pixels[i,j]:=(gammacorr((curc2*brb[mini2] + curc4*brb[mini4])div 64) shl 16)+
                                     (gammacorr((curc2*brg[mini2] + curc4*brg[mini4])div 64) shl 8)+
                                      gammacorr((curc2*brr[mini2] + curc4*brr[mini4])div 64);
{        pictotmpgrey.Canvas.Pixels[i,j]:=(gammacorr((curc2*brb[mini2])div 32) shl 16)+
                                         (gammacorr((curc2*brg[mini2])div 32) shl 8)+
                                          gammacorr((curc2*brr[mini2])div 32);
        pictotmpgrey2.Canvas.Pixels[i,j]:=(gammacorr((curc4*brb[mini4])div 32) shl 16)+
                                          (gammacorr((curc4*brg[mini4])div 32) shl 8)+
                                           gammacorr((curc4*brr[mini4])div 32);{}

        curc2:={nogammacorr{}((curc2*b75)div 32);
        curc4:={nogammacorr{}((curc4*b75)div 32);
        if (odd(j)) then begin //non-white line
          curc2 := curc2 + whiteerror[i] div 2;
          curc4 := curc4 + whiteerror[i] div 2;
        end else begin //white line - можно размазать
          if (curc4 >= 256) then begin
            whiteerror[i] := (curc4-256) div 1;
            curc2 := curc2 + whiteerror[i] div 2;
          end else whiteerror[i] := 0;
        end;
        //if (curc2 >= 256) then curc4 := curc4 + (curc2-256) div 1;
        //if (curc4 >= 256) then curc2 := curc2 + (curc4-256) div 1;
        if (curc2 >= 256) then curc2 := 255;
        if (curc4 >= 256) then curc4 := 255;
        pictotmpgrey.Canvas.Pixels[i,j]:=(curc2 * $010101);
        pictotmpgrey2.Canvas.Pixels[i,j]:=(curc4 * $010101);{}
        end; //i
      end; //j
    end; //cx
  end; //cy

 for cy:=0 to 23 do begin cy8:=cy shl 3;
  for cx:=0 to 31 do begin cx8:=cx shl 3;
//dithering
  a1:=attr1[cy,cx] and 7;
  a2:=attr2[cy,cx] and 7;
  a3:=attr3[cy,cx] and 7;
  a4:=attr4[cy,cx] and 7;
//   if cx<12 then
// для всех пикселей знакоместа
    for j:=cy8 to cy8+7 do begin

    mini1:=0;mini3:=0;
    if odd(j)
    then begin mini2:=a1;mini4:=a2;end
    else begin mini2:=a3;mini4:=a4;end;
    {pp}atb0:=brb[mini1]+brb[mini3];atg0:=brg[mini1]+brg[mini3];atr0:=brr[mini1]+brr[mini3];
    {ip}atb1:=brb[mini2]+brb[mini3];atg1:=brg[mini2]+brg[mini3];atr1:=brr[mini2]+brr[mini3];
    {pi}atb2:=brb[mini1]+brb[mini4];atg2:=brg[mini1]+brg[mini4];atr2:=brr[mini1]+brr[mini4];
    {ii}atb3:=brb[mini2]+brb[mini4];atg3:=brg[mini2]+brg[mini4];atr3:=brr[mini2]+brr[mini4];
    {pp}atb[0]:=atb0*2;atg[0]:=atg0*2;atr[0]:=atr0*2;
    {ip}atb[1]:=atb1*2;atg[1]:=atg1*2;atr[1]:=atr1*2;
    {pi}atb[2]:=atb2*2;atg[2]:=atg2*2;atr[2]:=atr2*2;
    {ii}atb[3]:=atb3*2;atg[3]:=atg3*2;atr[3]:=atr3*2;

      for i:=cx8 to cx8+7 do begin
//c1,c2,c3,c4 - слои экрана (0..255)
//c1scr,c2scr,c3scr,c4scr - слои экрана (0/128)
//cr,cg,cb - как это выглядит на экране (0..255)
//a1:=3; a2:=5; a3:=6; a4:=7;
//дизеринг из mcx:
       cb:=bx[j,i];cg:=gx[j,i];cr:=rx[j,i];
       if cb>n255 then cb:=255;if cg>n255 then cg:=255;if cr>n255 then cr:=255;
       if cb<n0 then cb:=0;if cg<n0 then cg:=0;if cr<n0 then cr:=0;
       mini1:=mni(
         {kb*}sqr(atb0-cb)+{kg*}sqr(atg0-cg)+sqr(atr0-cr),
         {kb*}sqr(atb1-cb)+{kg*}sqr(atg1-cg)+sqr(atr1-cr),
         {kb*}sqr(atb2-cb)+{kg*}sqr(atg2-cg)+sqr(atr2-cr),
         {kb*}sqr(atb3-cb)+{kg*}sqr(atg3-cg)+sqr(atr3-cr));
       scr1[j,cx]:=scr1[j,cx]shl 1+mini1 and 1; scr2[j,cx]:=scr2[j,cx]shl 1+mini1 shr 1; //здесь range error, т.к. sa[c],sb[c] не инициализированы нулем
       bb:=atb[mini1];bg:=atg[mini1];br:=atr[mini1];
       cb:=cb-bb;cg:=cg-bg;cr:=cr-br;
       bx[j,i+1]:=bx[j,i+1]+cb div 2;gx[j,i+1]:=gx[j,i+1]+cg div 2;rx[j,i+1]:=rx[j,i+1]+cr div 2;
       bx[j+1,i]:=bx[j+1,i]+cb div 4;gx[j+1,i]:=gx[j+1,i]+cg div 4;rx[j+1,i]:=rx[j+1,i]+cr div 4;
       bx[j+1,i-1]:=bx[j+1,i-1]+cb div 8;gx[j+1,i-1]:=gx[j+1,i-1]+cg div 8;rx[j+1,i-1]:=rx[j+1,i-1]+cr div 8;
       bx[j+1,i+1]:=bx[j+1,i+1]+cb div 8;gx[j+1,i+1]:=gx[j+1,i+1]+cg div 8;rx[j+1,i+1]:=rx[j+1,i+1]+cr div 8;
       pic8.Canvas.Pixels[i,j]:=(bb shl 16)+(bg shl 8)+br;

//тупой дизеринг:
        c1:=c1x[j,i];c2:=c2x[j,i];c3:=c3x[j,i];c4:=c4x[j,i];
{        if c1<0 then c1:=0;
        if c2<0 then c2:=0;
        if c3<0 then c3:=0;
        if c4<0 then c4:=0;{}
{        if c1>255 then c1:=255;
        if c2>255 then c2:=255;
        if c3>255 then c3:=255;
        if c4>255 then c4:=255;
{}        c1scr:=ord(c1>=dithval{128});
        c2scr:=ord(c2>=dithval{128});
        c3scr:=ord(c3>=dithval{128});
        c4scr:=ord(c4>=dithval{128});
        if odd(j)
        then begin
          cr_:=((c1scr shr 0)*rpaltab[a1,0] + (c4scr shr 0)*rpaltab[a4,0])div 2;
          cg_:=((c1scr shr 0)*rpaltab[a1,1] + (c4scr shr 0)*rpaltab[a4,1])div 2;
          cb_:=((c1scr shr 0)*rpaltab[a1,2] + (c4scr shr 0)*rpaltab[a4,2])div 2;{}
{          cr_:=trunc(((c2)/255)*rpaltab[a2,0] + ((c4)/255)*rpaltab[a4,0])div 2;
          cg_:=trunc(((c2)/255)*rpaltab[a2,1] + ((c4)/255)*rpaltab[a4,1])div 2;
          cb_:=trunc(((c2)/255)*rpaltab[a2,2] + ((c4)/255)*rpaltab[a4,2])div 2;{}
        end
        else begin
          cr_:=((c3scr shr 0)*rpaltab[a3,0] + (c2scr shr 0)*rpaltab[a2,0])div 2;
          cg_:=((c3scr shr 0)*rpaltab[a3,1] + (c2scr shr 0)*rpaltab[a2,1])div 2;
          cb_:=((c3scr shr 0)*rpaltab[a3,2] + (c2scr shr 0)*rpaltab[a2,2])div 2;{}
{          cr_:=trunc(((c3)/255)*rpaltab[a3,0] + ((c1)/255)*rpaltab[a1,0])div 2;
          cg_:=trunc(((c3)/255)*rpaltab[a3,1] + ((c1)/255)*rpaltab[a1,1])div 2;
          cb_:=trunc(((c3)/255)*rpaltab[a3,2] + ((c1)/255)*rpaltab[a1,2])div 2;{}
        end;
        c1:=c1-c1scr*trunc(dithval*1.0){128{};
        c4:=c4-c4scr*trunc(dithval*1.0){128{};
        c2:=c2-c2scr*trunc(dithval*1.0){128{};
        c3:=c3-c3scr*trunc(dithval*1.0){128{};
        if cb_>255 then cb_:=255;if cg_>255 then cg_:=255;if cr_>255 then cr_:=255;
        if cb_<0 then cb_:=0;if cg_<0 then cg_:=0;if cr_<0 then cr_:=0;
//        pic8.Canvas.Pixels[i,j]:=(cb_ shl 16)+(cg_ shl 8)+cr_;
//будет глюк при переходе на знакоместо с другим окрасом. поскольку цвета в каждом атрибуте инвертируются, использовать отрицательные значения цвета?
//кроме того, текущий вариант дизеринга не умеет распределять цвет между двумя строчками
        c1x[j  ,i+1]:=c1x[j  ,i+1]+(c1*3)div 8; c4x[j  ,i+1]:=c4x[j  ,i+1]+(c4*3)div 8;
        c1x[j+1,i  ]:=c1x[j+2,i  ]+(c1*3)div 8; c4x[j+1,i  ]:=c4x[j+2,i  ]+(c4*3)div 8;
        c1x[j+1,i-1]:=c1x[j+2,i-1]+ c1   div 8; c4x[j+1,i-1]:=c4x[j+2,i-1]+ c4   div 8;
        c1x[j+1,i+1]:=c1x[j+2,i+1]+ c1   div 8; c4x[j+1,i+1]:=c4x[j+2,i+1]+ c4   div 8;
        c2x[j  ,i+1]:=c2x[j  ,i+1]+(c2*3)div 8; c3x[j  ,i+1]:=c3x[j  ,i+1]+(c3*3)div 8;
        c2x[j+1,i  ]:=c2x[j+2,i  ]+(c2*3)div 8; c3x[j+1,i  ]:=c3x[j+2,i  ]+(c3*3)div 8;
        c2x[j+1,i-1]:=c2x[j+2,i-1]+ c2   div 8; c3x[j+1,i-1]:=c3x[j+2,i-1]+ c3   div 8;
        c2x[j+1,i+1]:=c2x[j+2,i+1]+ c2   div 8; c3x[j+1,i+1]:=c3x[j+2,i+1]+ c3   div 8;
{}
        end; //i
      end; //j

    end; //cx
  end; //cy
end;








//__%%%%_______%%%%%______ R48-Mode _______%%%__________%%%%%%_______
procedure TForm1.convR48Mode;
var
 i,j:byte{integer{};
 di:integer;
 cx,cy,cx8,cy8:byte;
 pal,paln:byte;
 palerr:array[0..R48PALS-1] of real;
 RGB, RGY, RMB, RMY, CGB, CGY, CMB, CMY:boolean;
 errRGB,errRGY,errRMB,errRMY,errCGB,errCGY,errCMB,errCMY:real;
 k1x,k2x,k3x:array[0..191,0..255] of real;
 minerr:real;
 palatr:array[0..199,0..31] of byte;
 a1,a2,a3,a4:byte; //атрибуты
 nak1,nak2,nak3:byte; //номера атрибутов для коэффициентов 1..3
 c1,c2,c3,c4:integer; //c1,c2,c3,c4 - слои экрана (0..255)
 c1scr,c2scr,c3scr,c4scr:integer; //c1scr,c2scr,c3scr,c4scr - слои экрана (0/128)
 cb,cg,cr,cr_,cg_,cb_:integer; //cr,cg,cb - как это выглядит на экране (0..255)
 mini1,mini2,mini3,mini4:byte;
 atb0,atb1,atb2,atb3,atb4,
 atg0,atg1,atg2,atg3,atg4,
 atr0,atr1,atr2,atr3,atr4:byte;
 bb,bg,br:integer;
 rerr,gerr,berr:array[-4..255+4] of integer;
 rerr2,gerr2,berr2:array[-4..255+4] of integer;
 Col1,Col2:integer;
 errC1,errC2:integer;
const
 xyzmul=1.5;//2.13;//2
 dithval=128;//144;//128
 amul2=4;
 MAXER=256;
 MAXERVER=256;
 errdiv8=32;
 kg=1;
begin
  for i:=0 to 255 do begin
    rerr[i]:=0; gerr[i]:=0; berr[i]:=0;
    rerr2[i]:=0; gerr2[i]:=0; berr2[i]:=0;
  end;

 for cy:=0 to 191{23} do begin cy8:=cy shl 3;
  for cx:=0 to 31 do begin cx8:=cx shl 3;

    {for j:=cy8 to cy8+7 do}j:=cy; begin
      for i:=cx8 to cx8+7 do begin
        rx[j,i]:= rx[j,i] + rerr[i]; gx[j,i]:=gx[j,i] + gerr[i]; bx[j,i]:=bx[j,i] + berr[i];
      end; //i
    end; //j


    case cy mod 3 of
      0: begin Col1:=2;end;
      1: begin Col1:=4;end;
      2: begin Col1:=1;end;
    end; //case j mod 3
    Col2:=7-Col1;
    {pp}atb0:=0;atg0:=0;atr0:=0;
    {ii}atb1:=brb[Col1]*amul2;atg1:=brg[Col1]*amul2;atr1:=brr[Col1]*amul2;
    {ii}atb2:=brb[Col2]*amul2;atg2:=brg[Col2]*amul2;atr2:=brr[Col2]*amul2;
    palerr[0]:=0;
    palerr[1]:=0;
    {for j:=cy8 to cy8+7 do}j:=cy; begin
      for i:=cx8 to cx8+7 do begin
        cb:=bx[j,i];cg:=gx[j,i];cr:=rx[j,i];
        errC1:=min3i(sqr(atb0-cb)+kg*sqr(atg0-cg)+sqr(atr0-cr),
                     sqr(atb1 div 2-cb)+kg*sqr(atg1 div 2-cg)+sqr(atr1 div 2-cr),
                     sqr(atb1-cb)+kg*sqr(atg1-cg)+sqr(atr1-cr));
        errC2:=min3i(sqr(atb0-cb)+kg*sqr(atg0-cg)+sqr(atr0-cr),
                     sqr(atb2 div 2-cb)+kg*sqr(atg2 div 2-cg)+sqr(atr2 div 2-cr),
                     sqr(atb2-cb)+kg*sqr(atg2-cg)+sqr(atr2-cr));
        palerr[0]:=palerr[0]+errC1;
        palerr[1]:=palerr[1]+errC2;
      end; //i
    end; //j
    if palerr[0]<palerr[1]
    then begin
      a1:=Col1;
    end
    else begin
      a1:=Col2;
    end;

{    errRGB := 0.0;
    errRGY := 0.0;
    errRMB := 0.0;
    errRMY := 0.0;
    errCGB := 0.0;
    errCGY := 0.0;
    errCMB := 0.0;
    errCMY := 0.0;}
(*
// ищем палитру
// минимизацией суммарной ошибки
    for pal:=0 to R48PALS-1 do palerr[pal]:=0.0;
// для всех пикселей знакоместа
    {for j:=cy8 to cy8+7 do}j:=cy; begin
      for i:=cx8 to cx8+7 do begin
      //rx[j,i]:=255*2;
      //gx[j,i]:=150*2;
      //bx[j,i]:=106*2;
        x:=rx[j,i]*xyzmul/255;
        y:=gx[j,i]*xyzmul/255;
        z:=bx[j,i]*xyzmul/255;
      // x,y,z уже присвоены
        RGB:=checkcoord(0,0,0,errRGB, 1,0,0, 0,1,0, 0,0,1);
        RGY:=checkcoord(0,0,0,errRGY, 1,0,0, 0,1,0, 1,1,0); //вырожденный базис!
        RMB:=checkcoord(0,0,0,errRMB, 1,0,0, 1,0,1, 0,0,1); //вырожденный базис!
        RMY:=checkcoord(0,0,0,errRMY, 1,0,0, 1,0,1, 1,1,0); //вырожденный базис!
        CGB:=checkcoord(0,0,0,errCGB, 0,1,1, 0,1,0, 0,0,1); //вырожденный базис!
        CGY:=checkcoord(0,0,0,errCGY, 0,1,1, 0,1,0, 1,1,0); //вырожденный базис!
        CMB:=checkcoord(0,0,0,errCMB, 0,1,1, 1,0,1, 0,0,1); //вырожденный базис!
        CMY:=checkcoord(0,0,0,errCMY, 0,1,1, 1,0,1, 1,1,0);
        palerr[0]:=palerr[0]+errRGB;
        palerr[1]:=palerr[1]+errRGY;
        palerr[2]:=palerr[2]+errRMB;
        palerr[3]:=palerr[3]+errRMY;
        palerr[4]:=palerr[4]+errCGB;
        palerr[5]:=palerr[5]+errCGY;
        palerr[6]:=palerr[6]+errCMB;
        palerr[7]:=palerr[7]+errCMY;
      end; //i
    end; //j
// выбираем ту палитру, где суммарная ошибка меньше всего
    paln:=0; minerr:=palerr[paln];
    for pal:=0 to R48PALS-1 do
      if palerr[pal]<minerr then begin paln:=pal; minerr:=palerr[paln]; end;
    palatr[cy,cx]:=paln;
*)
{
  for i:=0 to 255 do begin
    rerr[i]:=0; gerr[i]:=0; berr[i]:=0;
    rerr2[i]:=0; gerr2[i]:=0; berr2[i]:=0;
  end;
}
// ищем координаты в заданной палитре
// для всех пикселей знакоместа
    {for j:=cy8 to cy8+7 do}j:=cy; begin
      for i:=cx8 to cx8+7 do begin
        cb:=bx[j,i];cg:=gx[j,i];cr:=rx[j,i];
        attr1[cy,cx]:=a1+64;
(*        x:=rx[j,i]*xyzmul/255;
        y:=gx[j,i]*xyzmul/255;
        z:=bx[j,i]*xyzmul/255;
      // x,y,z уже присвоены
        case paln of
          0: begin a1:=2; a2:=4; a3:=1; RGB:=checkcoord(0,0,0,errRGB, 1,0,0, 0,1,0, 0,0,1); end; //RGB
          1: begin a1:=2; a2:=4; a3:=6; RGY:=checkcoord(0,0,0,errRGY, 1,0,0, 0,1,0, 1,1,0); end; //RGY
          2: begin a1:=2; a2:=3; a3:=1; RMB:=checkcoord(0,0,0,errRMB, 1,0,0, 1,0,1, 0,0,1); end; //RMB
          3: begin a1:=2; a2:=3; a3:=6; RMY:=checkcoord(0,0,0,errRMY, 1,0,0, 1,0,1, 1,1,0); end; //RMY
          4: begin a1:=5; a2:=4; a3:=1; CGB:=checkcoord(0,0,0,errCGB, 0,1,1, 0,1,0, 0,0,1); end; //CGB
          5: begin a1:=5; a2:=4; a3:=6; CGY:=checkcoord(0,0,0,errCGY, 0,1,1, 0,1,0, 1,1,0); end; //CGY
          6: begin a1:=5; a2:=3; a3:=1; CMB:=checkcoord(0,0,0,errCMB, 0,1,1, 1,0,1, 0,0,1); end; //CMB
          7: begin a1:=5; a2:=3; a3:=6; CMY:=checkcoord(0,0,0,errCMY, 0,1,1, 1,0,1, 1,1,0); end; //CMY
        end; //case paln
        attr1[cy,cx]:=a1+64;
        attr2[cy,cx]:=a2+64;
        attr3[cy,cx]:=a3+64;
        c1x[j,i]:=tobyte(k1real);
        c2x[j,i]:=tobyte(k2real);
        c3x[j,i]:=tobyte(k3real);
        c1:=c1x[j,i];c2:=c2x[j,i];c3:=c3x[j,i];
        cr:=trunc(((c2)/255)*rpaltab[a2,0] + ((c3)/255)*rpaltab[a3,0] + ((c1)/255)*rpaltab[a1,0])div 2;
        cg:=trunc(((c2)/255)*rpaltab[a2,1] + ((c3)/255)*rpaltab[a3,1] + ((c1)/255)*rpaltab[a1,1])div 2;
        cb:=trunc(((c2)/255)*rpaltab[a2,2] + ((c3)/255)*rpaltab[a3,2] + ((c1)/255)*rpaltab[a1,2])div 2;
*)
         //if cb>255 then cb:=255;if cg>255 then cg:=255;if cr>255 then cr:=255;
         //if cb<0 then cb:=0;if cg<0 then cg:=0;if cr<0 then cr:=0;
        rx[j,i]:=cr; gx[j,i]:=cg; bx[j,i]:=cb;
         if bx[j,i]>bmpn255 then bx[j,i]:=255;if gx[j,i]>bmpn255 then gx[j,i]:=255;if rx[j,i]>bmpn255 then rx[j,i]:=255;
         if bx[j,i]<0 then bx[j,i]:=0;if gx[j,i]<0 then gx[j,i]:=0;if rx[j,i]<0 then rx[j,i]:=0;
        //pictotmp.Canvas.Pixels[i,j]:=(cb shl 16)+(cg shl 8)+cr;
        pictotmp.Canvas.Pixels[i,j]:=(bx[j,i] shl 16)+(gx[j,i] shl 8)+rx[j,i];
      end; //i
    end; //j
  end; //cx
// end; //cy

  for i:=0 to 255 do begin
    //rerr[i]:=0; gerr[i]:=0; berr[i]:=0;
    rerr[i]:=rerr2[i]; gerr[i]:=rerr2[i]; berr[i]:=rerr2[i];
    rerr2[i]:=0; gerr2[i]:=0; berr2[i]:=0;
  end;

//палитры найдены, делаем dithering:
// for cy:=0 to 191{23} do begin cy8:=cy shl 3;
  for cx:=0 to 31 do begin cx8:=cx shl 3;
//dithering
    a1:=attr1[cy,cx] and 7;
    a2:=attr2[cy,cx] and 7;
    a3:=attr3[cy,cx] and 7;
//   if cx<12 then
// для всех пикселей знакоместа
   {for j:=cy8 to cy8+7 do}j:=cy; begin

    case j mod 3 of
      0: begin mini2:=a1;end;
      1: begin mini2:=a2;end;
      2: begin mini2:=a3;end;
    end; //case j mod 3

    mini2:=a1;

    {pp}atb0:=0;atg0:=0;atr0:=0;
    {pp}atb[0]:=0;atg[0]:=0;atr[0]:=0;
    {ii}atb1:=brb[mini2]*amul2;atg1:=brg[mini2]*amul2;atr1:=brr[mini2]*amul2;
    {ii}atb[1]:=atb1;atg[1]:=atg1;atr[1]:=atr1;

      for i:=cx8 to cx8+7 do begin
//c1,c2,c3,c4 - слои экрана (0..255)
//c1scr,c2scr,c3scr,c4scr - слои экрана (0/128)
//cr,cg,cb - как это выглядит на экране (0..255)

//дизеринг из mcx:
       cb:=bx[j,i];cg:=gx[j,i];cr:=rx[j,i];
       //cb:=0;cg:=128;cr:=64;
       if cb>n255 then cb:=255;if cg>n255 then cg:=255;if cr>n255 then cr:=255;
       if cb<n0 then cb:=0;if cg<n0 then cg:=0;if cr<n0 then cr:=0;
        //pictotmp.Canvas.Pixels[i,j]:=(cb shl 16)+(cg shl 8)+cr;
       mini1:=m2i(
         {kb*}sqr(atb0-cb)+{kg*}sqr(atg0-cg)+sqr(atr0-cr),
         {kb*}sqr(atb1-cb)+{kg*}sqr(atg1-cg)+sqr(atr1-cr));
       scr1[j,cx]:=scr1[j,cx]shl 1+mini1 and 1;
       bb:=atb[mini1];bg:=atg[mini1];br:=atr[mini1];
       cb:=(cb-bb);cg:=(cg-bg);cr:=(cr-br); //ошибки (могут быть отрицательные)

       if cb>MAXERVER then cb:=MAXERVER;if cg>MAXERVER then cg:=MAXERVER;if cr>MAXERVER then cr:=MAXERVER;
       if cb<-MAXERVER then cb:=-MAXERVER;if cg<-MAXERVER then cg:=-MAXERVER;if cr<-MAXERVER then cr:=-MAXERVER;

       for di:=-3 to +4 do begin
         berr[i+di]:=berr[i+di]+cb div errdiv8;gerr[i+di]:=gerr[i+di]+cg div errdiv8;rerr[i+di]:=rerr[i+di]+cr div errdiv8;
         berr2[i+di]:=berr2[i+di]+cb div errdiv8;gerr2[i+di]:=gerr2[i+di]+cg div errdiv8;rerr2[i+di]:=rerr2[i+di]+cr div errdiv8;
       end;

       if cb>MAXER then cb:=MAXER;if cg>MAXER then cg:=MAXER;if cr>MAXER then cr:=MAXER;
       if cb<-MAXER then cb:=-MAXER;if cg<-MAXER then cg:=-MAXER;if cr<-MAXER then cr:=-MAXER;

       //распространять вправо только ошибку, которую можно исправить в этих атрибутах? не увидим разницы, т.к. ошибка не переходит на следующее знакоместо

       if (i<>cx8+7) then begin
         bx[j,i+1]:=bx[j,i+1]+cb div 2;gx[j,i+1]:=gx[j,i+1]+cg div 2;rx[j,i+1]:=rx[j,i+1]+cr div 2;
       end;
       //bx[j+1,i]:=bx[j+1,i]+cb div 4;gx[j+1,i]:=gx[j+1,i]+cg div 4;rx[j+1,i]:=rx[j+1,i]+cr div 4;
       //bx[j+1,i-1]:=bx[j+1,i-1]+cb div 8;gx[j+1,i-1]:=gx[j+1,i-1]+cg div 8;rx[j+1,i-1]:=rx[j+1,i-1]+cr div 8;
       //bx[j+1,i+1]:=bx[j+1,i+1]+cb div 8;gx[j+1,i+1]:=gx[j+1,i+1]+cg div 8;rx[j+1,i+1]:=rx[j+1,i+1]+cr div 8;
{       berr[i]:=berr[i]+cb div 4;gerr[i]:=gerr[i]+cg div 4;rerr[i]:=rerr[i]+cr div 4;
       berr[i-1]:=berr[i-1]+cb div 8;gerr[i-1]:=gerr[i-1]+cg div 8;rerr[i-1]:=rerr[i-1]+cr div 8;
       berr[i+1]:=berr[i+1]+cb div 8;gerr[i+1]:=gerr[i+1]+cg div 8;rerr[i+1]:=rerr[i+1]+cr div 8;}
        //if bx[j,i+1]>bmpn255 then bx[j,i+1]:=255;if gx[j,i+1]>bmpn255 then gx[j,i+1]:=255;if rx[j,i+1]>bmpn255 then rx[j,i+1]:=255;
        //if bx[j+1,i]>bmpn255 then bx[j+1,i]:=255;if gx[j+1,i]>bmpn255 then gx[j+1,i]:=255;if rx[j+1,i]>bmpn255 then rx[j+1,i]:=255;
        //if bx[j+1,i-1]>bmpn255 then bx[j+1,i-1]:=255;if gx[j+1,i-1]>bmpn255 then gx[j+1,i-1]:=255;if rx[j+1,i-1]>bmpn255 then rx[j+1,i-1]:=255;
        //if bx[j+1,i+1]>bmpn255 then bx[j+1,i+1]:=255;if gx[j+1,i+1]>bmpn255 then gx[j+1,i+1]:=255;if rx[j+1,i+1]>bmpn255 then rx[j+1,i+1]:=255;
       //if bb>n255 then bb:=255;if bg>n255 then bg:=255;if br>n255 then br:=255;
       pic8.Canvas.Pixels[i,j]:=(bb shl 16)+(bg shl 8)+br;

      end; //i
    end; //j

  end; //cx
 end; //cy
end;




//$$$$$$$!!!!!!!!!!!!!!!!! BriGhTNeSs ChaNGe !!!!!!!!!!!!!!!!%$%$%$%$
//$$$$$$$!!!!!!!!!!!!!!!!! BriGhTNeSs ChaNGe !!!!!!!!!!!!!!!!%$%$%$%$
procedure TForm1.edBrightnessChange(Sender: TObject);
var
 rdx,rdy:real;
 code,i,j,y:integer;
 bb,bg,br:integer;
 cont,bri,light:real;
 s:string;
 png:tPNG;
 tga:tTGA;
 pix:TColor;
 rect1:TRect;
 fin:file of byte;
begin
 bronly:=cbBrightOnly.Checked;
 if cbChunk5.Checked then kletkamask:=1 else kletkamask:=7;
 val(edbrightness.Text,rdx,code);
 if code=0 then brightness:=rdx;
 val(edcolor.Text,rdx,code);
 if code=0 then colority:=rdx;
 val(edcontrast.Text,rdx,code);
 if code=0 then contrast:=rdx;
 val(edprior.Text,rdx,code);
 if code=0 then topprior:=rdx;
 val(edkcolerr.Text,rdx,code);
 if code=0 then kcolerr:=rdx;

 if (Pos('.act', LowerCase(palname))>0)
 then
  begin
  AssignFile(fin,palname);
  Reset(fin);
  for i:=0 to 15 do begin
        BlockRead(fin,br,1);
        BlockRead(fin,bg,1);
        BlockRead(fin,bb,1);
        brr[i]:=br div 2;
        brg[i]:=bg div 2;
        brb[i]:=bb div 2;
  end;
  CloseFile(fin);
 end{};

if oldfname<>fname then begin
 pic:=tbitmap.create;
 pic.PixelFormat:=pf24bit;
 s:=fname;
 oldfname:=fname;
 memo1.lines.add(s);
// try
if Pos('.png', LowerCase(S)) > 0
 then
  begin
  png:=tPNG.Create;
  png.LoadFromFile(s);
  pic.Assign(png);
  png.Free;
 end{}
 else if Pos('.tga', LowerCase(S)) > 0
 then
  begin
  tga:=tTGA.Create;
  tga.LoadFromFile(s);
  pic.Assign(tga);
  tga.Free;
 end{}
 else if (Pos('.jpg', LowerCase(S))>0)
       or(Pos('.gif', LowerCase(S))>0)
       or(Pos('.bmp', LowerCase(S))>0)
//       or(Pos('.ico', LowerCase(S))>0)
 then
  begin
  image1.Picture.LoadFromFile(s);
  pic.Height:=image1.Height;
  pic.Width:=image1.Width;
  pic.assign(image1.picture.graphic);
 end{};
 image1.Height:=pic.Height;
 image1.Width:=pic.Width;
 image1.picture.assign(pic);
 memo1.lines.Add(inttostr(pic.width)+'x'+inttostr(pic.height));
 width:=pic.width;height:=pic.height;xmin:=0;ymin:=0;
 edWidth.Text:=floattostr(width);
 edHeight.Text:=floattostr(height);
 edXmin.Text:=floattostr(xmin);
 edYmin.Text:=floattostr(ymin);
end;
 pic256:=tbitmap.create;
 pic256.PixelFormat:=pf24bit;
 pic256.Height:=192;pic256.Width:=256;
{ pic256.Canvas.Brush.Color:=$444400;
 rect1.Left:=0;
 rect1.Right:=pic256.Width-1;
 rect1.Top:=0;
 rect1.Bottom:=pic256.Height-1;
 pic256.Canvas.FillRect(rect1);}
 rdx:={pic.}Width/pic256.Width;
 rdy:={pic.}Height/pic256.Height;
 cont:=contrast;
 bri:=(brightness*256)-128*(contrast-1);
//ff0000's -blue
//ff00's -green
//ff's -red
 for j:=0 to pic256.Height-1 do begin
 y:=trunc(j*rdy+ymin);
 for i:=0 to pic256.Width-1 do
  begin
   pix:=pic.Canvas.Pixels[trunc(i*rdx+xmin),y];
   bb:=trunc((pix shr 16)*cont+bri);
   bg:=trunc(((pix shr 8)and 255)*cont+bri);
   br:=trunc((pix and 255)*cont+bri);
  light:=0.15*bb+0.3*br+0.55*bg;
  bb:=trunc((bb-light)*colority+light);
  bg:=trunc((bg-light)*colority+light);
  br:=trunc((br-light)*colority+light);
   if bb>255 then bb:=255;if bb<0 then bb:=0;
   if bg>255 then bg:=255;if bg<0 then bg:=0;
   if br>255 then br:=255;if br<0 then br:=0;
   pic256.Canvas.Pixels[i,j]:=(bb shl 16)+(bg shl 8)+br;
   bx[j,i]:=bb;gx[j,i]:=bg;rx[j,i]:=br;
  end;
 end;
 imFrom.Height:=pic256.Height;imFrom.Width:=pic256.Width;
 imFrom.picture.Assign(pic256);
end;

/////////////////////////////////////////////////////////////////////////
///////////                    КЛИКЕРЫ                       ////////////
/////////////////////////////////////////////////////////////////////////
procedure TForm1.btConvMCXClick(Sender: TObject);
begin
 edBrightnessChange(Sender);
 btSaveDraw.Enabled:=false;
 editable:=false;
 assignfile(fsa,mainname+'.mcx');rewrite(fsa,1);
 time1:=time;
 bxmaster:=bx;gxmaster:=gx;rxmaster:=rx;
  convMCX;
 s:=floattostr((time-time1)*86400)+' sec';memo1.Lines.Add(s);
 imTo.picture.Assign(pic8);
 blockwrite(fsa,scr1,6144+6144);blockwrite(fsa,scr2,6144+6144);
 closefile(fsa);
end;

procedure TForm1.btConvGigaClick(Sender: TObject);
const
 chrshead:array[0..6]of char=('c','h','r','$',#32,#24,#12);
var b:byte;
 i,j,m,st,row,c,adr,basescr:integer;
//ecoimg:
//по столбцам: пара0[0 и 1],пара1[0 и 1],пара0[2 и 3] и т.д.
//пары кодируются из четверок яркостей 0..4 по code256.dat
//потом все атрибуты по столбцам: экр0,экр1,экр0 и т.д.
begin
 edBrightnessChange(Sender);
 btSaveDraw.Enabled:=false;
 editable:=true;editimg:=true;
 time1:=time;
 bxmaster:=bx;gxmaster:=gx;rxmaster:=rx;
  convGiga;
 s:=floattostr((time-time1)*86400)+' sec';memo1.Lines.Add(s);
if cbEcoImg.Checked then begin
///////////////////ecoimg//////////////////
 assignfile(fsa,mainname+'.emg');rewrite(fsa,1);
 adr:=0;
 for st:=0 to 31 do begin
  for row:=0 to 95 do begin
   basescr:=nomerln(row shl 1);
   j:=0;m:=128;
   for i:=0 to 3 do begin
    j:=j*5;
    if (scr1[basescr,st]and m)<>0 then inc(j);
    if (scr1[basescr+8,st]and m)<>0 then inc(j);
    m:=m shr 1;
    if (scr1[basescr,st]and m)<>0 then inc(j);
    if (scr1[basescr+8,st]and m)<>0 then inc(j);
    m:=m shr 1;
   end;
   emg[adr]:=code256[j];inc(adr);
   j:=0;m:=128;
   for i:=0 to 3 do begin
    j:=j*5;
    if (scr2[basescr,st]and m)<>0 then inc(j);
    if (scr2[basescr+8,st]and m)<>0 then inc(j);
    m:=m shr 1;
    if (scr2[basescr,st]and m)<>0 then inc(j);
    if (scr2[basescr+8,st]and m)<>0 then inc(j);
    m:=m shr 1;
   end;
   emg[adr]:=code256[j];inc(adr);
  end;
 end;
 for st:=0 to 31 do begin
  for row:=0 to 23 do begin
   basescr:=192+row;
   emg[adr]:=scr1[basescr,st];inc(adr);
   emg[adr]:=scr2[basescr,st];inc(adr);
  end;
 end;
 blockwrite(fsa,emg,6144+768+768);
 closefile(fsa);
// editable:=false;
end
else begin
////////////////normal img//////////////////
 if(cbCHRS.Checked)then
 begin
  assignfile(fsa,mainname+'.ch$');rewrite(fsa,1);
  blockwrite(fsa,chrshead,7);
  for row:=0 to 23 do
   for c:=0 to 31 do
   begin
    for j:=0 to 7 do
    begin
     b:=scr1[j shl 3+row and 7+(row and $18)shl 3,c];
     blockwrite(fsa,b,1);
    end;
    b:=scr1[row+192,c];
    blockwrite(fsa,b,1);
    for j:=0 to 7 do
    begin
     b:=scr2[j shl 3+row and 7+(row and $18)shl 3,c];
     blockwrite(fsa,b,1);
    end;
    b:=scr2[row+192,c];
    blockwrite(fsa,b,1);
   end;
 end
 else
 begin
  assignfile(fsa,mainname+'.img');rewrite(fsa,1);
  blockwrite(fsa,scr1,6912);blockwrite(fsa,scr2,6912);
 end;
 closefile(fsa);
end;
 scr1master:=scr1;scr2master:=scr2;
 imTo.picture.Assign(pic8);
end;

procedure TForm1.btConv6912Click(Sender: TObject);
const
 chrshead:array[0..6]of char=('c','h','r','$',#32,#24,#09);
var b:byte;row,c,j:integer;
begin
 edBrightnessChange(Sender);
 btSaveDraw.Enabled:=false;
 editable:=true;editimg:=false;
 time1:=time;
 bxmaster:=bx;gxmaster:=gx;rxmaster:=rx;
  conv6912;
 s:=floattostr((time-time1)*86400)+' sec';memo1.Lines.Add(s);
 imTo.picture.Assign(pic8);
 if(cbCHRS.Checked)then
 begin
  assignfile(fsa,mainname+'.ch$');rewrite(fsa,1);
  blockwrite(fsa,chrshead,7);
  for row:=0 to 23 do
   for c:=0 to 31 do
   begin
    for j:=0 to 7 do
    begin
     b:=scr1[j shl 3+row and 7+(row and $18)shl 3,c];
     blockwrite(fsa,b,1);
    end;
    b:=scr1[row+192,c];
    blockwrite(fsa,b,1);
   end;
 end
 else
 begin
  assignfile(fsa,mainname+'.scr');rewrite(fsa,1);
  blockwrite(fsa,scr1,6912);
 end;
 ditlev2:=ditlev1;scr2:=scr1;
 scr1master:=scr1;scr2master:=scr2;
 closefile(fsa);
end;

//8col /////////////////
procedure TForm1.btConv8colClick(Sender: TObject);
begin
 edBrightnessChange(Sender);
 btSaveDraw.Enabled:=false;
 editable:=false;editimg:=false;
 assignfile(fsa,mainname+'.3');rewrite(fsa,1);
 time1:=time;
  conv8col;
 imTo.picture.Assign(pic8);
 blockwrite(fsa,scr1,6144+6144);
 blockwrite(fsa,scr2,6144);
 s:=floattostr((time-time1)*86400)+' sec';memo1.Lines.Add(s);
 closefile(fsa);
end;

procedure TForm1.btConvMCClick(Sender: TObject);
begin
 edBrightnessChange(Sender);
 btSaveDraw.Enabled:=false;
 editable:=false;
 assignfile(fsa,mainname+'.mc');rewrite(fsa,1);
 time1:=time;
 bxmaster:=bx;gxmaster:=gx;rxmaster:=rx;
  convMC;
 s:=floattostr((time-time1)*86400)+' sec';memo1.Lines.Add(s);
 imTo.picture.Assign(pic8);
 blockwrite(fsa,scr1,6144);blockwrite(fsa,scr2,6144);
 closefile(fsa);
end;

procedure TForm1.btConvRModeClick(Sender: TObject);
begin
 edBrightnessChange(Sender);
 btSaveDraw.Enabled:=false;
 editable:=false;
 assignfile(fsa,mainname+'.rm');rewrite(fsa,1);
 time1:=time;
 bxmaster:=bx;gxmaster:=gx;rxmaster:=rx;
  convRMode;
 s:=floattostr((time-time1)*86400)+' sec';memo1.Lines.Add(s);
 imTo.picture.Assign(pic8);
 imToTmp.picture.Assign(pictotmp);
 imToTmpGrey.picture.Assign(pictotmpgrey);
 imToTmpGrey2.picture.Assign(pictotmpgrey2);
 imToTmpGrey.picture.SaveToFile('layer1.bmp');
 imToTmpGrey2.picture.SaveToFile('layer2.bmp');
 blockwrite(fsa,scr1,6144);blockwrite(fsa,scr2,6144);
 blockwrite(fsa,attr1,768);blockwrite(fsa,attr2,768);
 blockwrite(fsa,attr3,768);blockwrite(fsa,attr4,768);
 closefile(fsa);
end;

procedure TForm1.btConvR48ModeClick(Sender: TObject);
begin
 edBrightnessChange(Sender);
 btSaveDraw.Enabled:=false;
 editable:=false;
 assignfile(fsa,mainname+'.r48');rewrite(fsa,1);
 time1:=time;
 bxmaster:=bx;gxmaster:=gx;rxmaster:=rx;
  convR48Mode;
 s:=floattostr((time-time1)*86400)+' sec';memo1.Lines.Add(s);
 imTo.picture.Assign(pic8);
 imToTmp.picture.Assign(pictotmp);
 blockwrite(fsa,scr1,6144);
 blockwrite(fsa,attr1,6144);
{ blockwrite(fsa,attr1,768);blockwrite(fsa,attr2,768);
 blockwrite(fsa,attr3,768);}
 closefile(fsa);
end;

///////////                  ЕЩЕ КЛИКЕРЫ                  ////////////
procedure TForm1.btOpenClick(Sender: TObject);
var
 i:integer;
 c:char;
begin
//все из-за mainname
 btSaveDraw.Enabled:=false;
 editable:=false;
//
 opendialog1.InitialDir:=getcurrentdir;
 if OpenDialog1.Execute then begin
  fname:=OpenDialog1.FileName;
  setcurrentdir(OpenDialog1.FileName);
  mainname:=fname;
  for i:=length(mainname)downto 1 do begin
   c:=mainname[i];
   Delete(mainname,i,1);
   if c='.'then break;
  end;
 end;
 edbrightness.OnChange(sender);

 end;

procedure TForm1.Button1Click(Sender: TObject);
begin
 imFrom.Visible:=not(imFrom.Visible);
 imTo.Visible:=not(imTo.Visible);
 Image1.Visible:=not(Image1.Visible);
end;

procedure TForm1.ImLoadClick(Sender: TObject);
var
 s,fname2:string;
 st,row,i,j,c,i1,i2,i3,i4,adr,basescr:integer;
 bb,bg,br,b:byte;
begin
 btSaveDraw.Enabled:=false;
 editable:=false;
 zxOpenDialog.InitialDir:=getcurrentdir;
 if zxOpenDialog.Execute then begin
  fname2:=zxOpenDialog.FileName;
  setcurrentdir(zxOpenDialog.FileName);
  assignfile(faa,fname2);
  reset(faa,1);//todo length?
  s:=fname2;
  while pos('.',s)>0 do delete(s,1,pos('.',s));
  if (s='scr')or(s='SCR') then begin
   blockread(faa,scr1,6912);
   for row:=0 to 23 do begin
    aa:=scr1[192+row];
    for j:=row shl 3 to row shl 3+7 do begin
     sa:=scr1[(j and 7)shl 3+row and 7+(row and $18)shl 3];
     for c:=0 to 31 do begin
      i1:=aa[c]and 7+(aa[c]and 64)shr 3; i2:=aa[c]shr 3;
      atb[0]:=brb[i1]+brb[i1];atg[0]:=brg[i1]+brg[i1];atr[0]:=brr[i1]+brr[i1];
      atb[1]:=brb[i2]+brb[i2];atg[1]:=brg[i2]+brg[i2];atr[1]:=brr[i2]+brr[i2];
      for i:=c shl 3 to c shl 3+7 do begin
       if(sa[c]and 128=0)
       then begin bb:=atb[1];bg:=atg[1];br:=atr[1] end
       else begin bb:=atb[0];bg:=atg[0];br:=atr[0] end;
       sa[c]:=sa[c]shl 1;
       pic8.Canvas.Pixels[i,j]:=(bb shl 16)+(bg shl 8)+br;
      end; //i
     end; //c
    end; //j
   end; //row
  end //scr
  else if (s='mcx')or(s='MCX') then begin
   blockread(faa,scr1,6144*2); blockread(faa,scr2,6144*2);
   for j:=0 to 191 do begin
    aa:=scr1[192+j]; ab:=scr2[192+j]; sa:=scr1[j]; sb:=scr2[j];
    for c:=0 to 31 do begin
     i1:=aa[c]and 7+(aa[c]and 64)shr 3; i2:=aa[c]shr 3;
     i3:=ab[c]and 7+(ab[c]and 64)shr 3; i4:=ab[c]shr 3;
     atb[0]:=brb[i1]+brb[i3];atg[0]:=brg[i1]+brg[i3];atr[0]:=brr[i1]+brr[i3];
     atb[1]:=brb[i2]+brb[i3];atg[1]:=brg[i2]+brg[i3];atr[1]:=brr[i2]+brr[i3];
     atb[2]:=brb[i1]+brb[i4];atg[2]:=brg[i1]+brg[i4];atr[2]:=brr[i1]+brr[i4];
     atb[3]:=brb[i2]+brb[i4];atg[3]:=brg[i2]+brg[i4];atr[3]:=brr[i2]+brr[i4];
     for i:=c shl 3 to c shl 3+7 do begin
      b:=3-((sa[c]and 128)shr 7+(sb[c]and 128)shr 6);
      bb:=atb[b];bg:=atg[b];br:=atr[b];
      sa[c]:=sa[c]shl 1; sb[c]:=sb[c]shl 1;
      pic8.Canvas.Pixels[i,j]:=(bb shl 16)+(bg shl 8)+br;
     end; //i
    end; //c
   end; //j
  end //mcx
  else if (s='mc')or(s='MC') then begin
   blockread(faa,scr1,6912*2);
   for j:=0 to 191 do begin
    aa:=scr1[192+j]; sa:=scr1[j];
    for c:=0 to 31 do begin
     i1:=aa[c]and 7+(aa[c]and 64)shr 3; i2:=aa[c]shr 3;
     atb[0]:=brb[i1]+brb[i1];atg[0]:=brg[i1]+brg[i1];atr[0]:=brr[i1]+brr[i1];
     atb[1]:=brb[i2]+brb[i2];atg[1]:=brg[i2]+brg[i2];atr[1]:=brr[i2]+brr[i2];
     for i:=c shl 3 to c shl 3+7 do begin
      if(sa[c] and 128=0)
      then begin bb:=atb[1];bg:=atg[1];br:=atr[1] end
      else begin bb:=atb[0];bg:=atg[0];br:=atr[0] end;
      sa[c]:=sa[c]shl 1;
      pic8.Canvas.Pixels[i,j]:=(bb shl 16)+(bg shl 8)+br;
     end; //i
    end; //c
   end; //j
  end //mc
  else if (s='img')or(s='IMG') then begin
   blockread(faa,scr1,6912); blockread(faa,scr2,6912);
   for row:=0 to 23 do begin
    aa:=scr1[192+row]; ab:=scr2[192+row];
    for j:=row shl 3 to row shl 3+7 do begin
     sa:=scr1[(j and 7)shl 3+row and 7+(row and $18)shl 3];
     sb:=scr2[(j and 7)shl 3+row and 7+(row and $18)shl 3];
     for c:=0 to 31 do begin
      i1:=aa[c]and 7+(aa[c]and 64)shr 3; i2:=aa[c]shr 3;
      i3:=ab[c]and 7+(ab[c]and 64)shr 3; i4:=ab[c]shr 3;
      atb[0]:=brb[i1]+brb[i3];atg[0]:=brg[i1]+brg[i3];atr[0]:=brr[i1]+brr[i3];
      atb[1]:=brb[i2]+brb[i3];atg[1]:=brg[i2]+brg[i3];atr[1]:=brr[i2]+brr[i3];
      atb[2]:=brb[i1]+brb[i4];atg[2]:=brg[i1]+brg[i4];atr[2]:=brr[i1]+brr[i4];
      atb[3]:=brb[i2]+brb[i4];atg[3]:=brg[i2]+brg[i4];atr[3]:=brr[i2]+brr[i4];
      for i:=c shl 3 to c shl 3+7 do begin
       b:=3-((sa[c]and 128)shr 7+(sb[c]and 128)shr 6);
       bb:=atb[b];bg:=atg[b];br:=atr[b];
       sa[c]:=sa[c]shl 1;sb[c]:=sb[c]shl 1;
       pic8.Canvas.Pixels[i,j]:=(bb shl 16)+(bg shl 8)+br;
      end; //i
     end; //c
    end; //j
   end; //row
  end //img
  else if (s='emg')or(s='EMG') then begin
   blockread(faa,emg,6144+768+768);
 adr:=0;
 for st:=0 to 31 do begin
  for row:=0 to 95 do begin
   basescr:=nomerln(row shl 1);
   scr1[basescr,st]:=deco256[emg[adr]];
   scr1[basescr+8,st]:=deco256[256+emg[adr]];inc(adr);
   scr2[basescr,st]:=deco256[emg[adr]];
   scr2[basescr+8,st]:=deco256[256+emg[adr]];inc(adr);
  end;
 end;
 for st:=0 to 31 do begin
  for row:=0 to 23 do begin
   basescr:=192+row;
   scr1[basescr,st]:=emg[adr];inc(adr);
   scr2[basescr,st]:=emg[adr];inc(adr);
  end;
 end;

   for row:=0 to 23 do begin
    aa:=scr1[192+row]; ab:=scr2[192+row];
    for j:=row shl 3 to row shl 3+7 do begin
     sa:=scr1[(j and 7)shl 3+row and 7+(row and $18)shl 3];
     sb:=scr2[(j and 7)shl 3+row and 7+(row and $18)shl 3];
     for c:=0 to 31 do begin
      i1:=aa[c]and 7+(aa[c]and 64)shr 3; i2:=aa[c]shr 3;
      i3:=ab[c]and 7+(ab[c]and 64)shr 3; i4:=ab[c]shr 3;
      atb[0]:=brb[i1]+brb[i3];atg[0]:=brg[i1]+brg[i3];atr[0]:=brr[i1]+brr[i3];
      atb[1]:=brb[i2]+brb[i3];atg[1]:=brg[i2]+brg[i3];atr[1]:=brr[i2]+brr[i3];
      atb[2]:=brb[i1]+brb[i4];atg[2]:=brg[i1]+brg[i4];atr[2]:=brr[i1]+brr[i4];
      atb[3]:=brb[i2]+brb[i4];atg[3]:=brg[i2]+brg[i4];atr[3]:=brr[i2]+brr[i4];
      for i:=c shl 3 to c shl 3+7 do begin
       b:=3-((sa[c]and 128)shr 7+(sb[c]and 128)shr 6);
       bb:=atb[b];bg:=atg[b];br:=atr[b];
       sa[c]:=sa[c]shl 1;sb[c]:=sb[c]shl 1;
       pic8.Canvas.Pixels[i,j]:=(bb shl 16)+(bg shl 8)+br;
      end; //i
     end; //c
    end; //j
   end; //row
  end; //img
  imTo.picture.Assign(pic8);
  closefile(faa);
 end; //if file opened ok
end;

//ппппппппппппппппппппппп   РИСОВАНИЕ   ппппппппппппппппппппппппппп
procedure TForm1.imToMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
 if editable then drawchr(button,x,y);
end;

procedure TForm1.drawchr(Button: TMouseButton; X, Y: Integer);
var
 i,j:integer;
 bb,bg,br,rad:integer;
 kletka,bitik,row,i7,i8,scrln:byte;
 mini1,mini2,mini3,mini4,atr1,atr2:byte;
begin
 btSaveDraw.Enabled:=true;
 rad:=udRadius.Position;
 for i:=x-rad to x+rad do begin
  i7:=i and 7; i8:=i shr 3;
  bitik:=128 shr i7;
  for j:=y-rad to y+rad do
  if(i>=0)and(j>=0)and(i<256)and(j<192)then begin
   scrln:=nomerln(j);
   if button=mbLeft then begin//chunk draw
    row:=j shr 3;
    atr1:=scr1[192+row,i8];
    mini1:=atr1 and 7+(atr1 and 64)shr 3; mini2:=(atr1 and $78)shr 3;
    atr2:=scr2[192+row,i8];
    mini3:=atr2 and 7+(atr2 and 64)shr 3; mini4:=(atr2 and $78)shr 3;
{pp}amb[0,0]:=brb[mini2]+brb[mini4];amg[0,0]:=brg[mini2]+brg[mini4];amr[0,0]:=brr[mini2]+brr[mini4];
{ip}amb[0,1]:=brb[mini1]+brb[mini4];amg[0,1]:=brg[mini1]+brg[mini4];amr[0,1]:=brr[mini1]+brr[mini4];
{pi}amb[0,2]:=brb[mini2]+brb[mini3];amg[0,2]:=brg[mini2]+brg[mini3];amr[0,2]:=brr[mini2]+brr[mini3];
{ii}amb[0,3]:=brb[mini1]+brb[mini3];amg[0,3]:=brg[mini1]+brg[mini3];amr[0,3]:=brr[mini1]+brr[mini3];
    kletka:=min2i(max2i(chtab[i and kletkamask,j and kletkamask],n0),n255);
    mini1:=ord(ditlev2[j,i]>kletka)shl 1{sb}+ord(ditlev1[j,i]>kletka);{sa}
    bb:=amb[0,mini1];bg:=amg[0,mini1];br:=amr[0,mini1];
    imTo.picture.Bitmap.Canvas.Pixels[i,j]:=(bb shl 16)+(bg shl 8)+br;
    scr1[scrln,i8]:=scr1[scrln,i8]and(255-bitik)+(byte(mini1 shl 7))shr i7;
    scr2[scrln,i8]:=scr2[scrln,i8]and(255-bitik)+((mini1 and 2)shl 6)shr i7;
   end
   else begin//dith draw
    imTo.picture.Bitmap.Canvas.Pixels[i,j]:=pic8.Canvas.Pixels[i,j];
    scr1[scrln,i8]:=scr1[scrln,i8]and(255-bitik)+scr1master[scrln,i8]and bitik;
    scr2[scrln,i8]:=scr2[scrln,i8]and(255-bitik)+scr2master[scrln,i8]and bitik;
   end;
  end; //j
 end; //i
end;

procedure TForm1.imToMouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
var atr1,atr2:byte;
begin
 if editable then begin
  if ssLeft in Shift then drawchr(mbLeft,x,y);
  if ssRight in Shift then drawchr(mbRight,x,y);
 end;
 if(x>=0)and(y>=0)and(x<256)and(y<192)then begin
// if editable and editimg then begin
  atr1:=scr1[192+y shr 3,x shr 3];
  lbIP1.Caption:='ink='+inttostr(atr1 and 7+(atr1 and 64)shr 3)+';pap='+inttostr(atr1 shr 3);
  atr2:=scr2[192+y shr 3,x shr 3];
  lbIP2.Caption:='ink='+inttostr(atr2 and 7+(atr2 and 64)shr 3)+';pap='+inttostr(atr2 shr 3);
 end
 else begin lbIP1.Caption:='';lbIP2.Caption:='' end;
end;

procedure TForm1.btSaveDrawClick(Sender: TObject);
begin
 btSaveDraw.Enabled:=false;
//mainname может по ошибке взяться из загруженного нового файла
 if editimg then
 assignfile(fsa,mainname+'.img')
 else assignfile(fsa,mainname+'.scr');
 rewrite(fsa,1);
 blockwrite(fsa,scr1,6912);
 if editimg then blockwrite(fsa,scr2,6912);
 closefile(fsa);
end;

procedure TForm1.edDithLevelChange(Sender: TObject);
var
 r:real;
 code:integer;
begin
 val(edDithLevel.Text,r,code);
 if code=0 then dithlevel:=r;
 if dithlevel>1 then dithlevel:=1;
 if dithlevel<0 then dithlevel:=0;
 n0:=trunc(128-dithlevel*128);
 n255:=trunc(127+dithlevel*128);
end;

procedure TForm1.edWidthChange(Sender: TObject);
var
 r:real;
 code:integer;
begin
 if not clicking then begin
 val(edWidth.Text,r,code);
 if code=0 then width:=r;
 if cbFix.Checked then begin
  height:=width*3/4;
  edHeight.Text:=floattostr(height);
 end;
 edBrightness.OnChange(sender);
 end;
end;

procedure TForm1.edHeightChange(Sender: TObject);
var
 r:real;
 code:integer;
begin
 if not clicking then begin
 val(edHeight.Text,r,code);
 if code=0 then height:=r;
 if cbFix.Checked then begin
  width:=height*4/3;
  edWidth.Text:=floattostr(width);
 end;
 edBrightness.OnChange(sender);
 end;
end;

procedure TForm1.edXminChange(Sender: TObject);
var
 r:real;
 code:integer;
begin
 if not clicking then begin
  val(edXmin.Text,r,code);
  if code=0 then xmin:=r;
  val(edYmin.Text,r,code);
  if code=0 then ymin:=r;
  edBrightness.OnChange(sender);
 end;
end;

procedure TForm1.Image1MouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
  lbIP1.Caption:='X='+inttostr(X)+';Y='+inttostr(Y);
end;

procedure TForm1.Image1MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
 clicking:=true;
 if button=mbLeft then begin
  xmin:=x;ymin:=y;
  edXmin.Text:=floattostr(xmin);
  edYmin.Text:=floattostr(ymin);
  edBrightness.OnChange(sender);
 end
 else begin
  width:=x-xmin;height:=y-ymin;
  edWidth.Text:=floattostr(width);
  edHeight.Text:=floattostr(height);
  edBrightness.OnChange(sender);
 end;
 clicking:=false;
end;

procedure TForm1.Button2Click(Sender: TObject);
var
 i:integer;
 c:char;
begin
//все из-за mainname
 btSaveDraw.Enabled:=false;
 editable:=false;
//
 opendialog2.InitialDir:=getcurrentdir;
 if OpenDialog2.Execute then begin
  palname:=OpenDialog2.FileName;
  setcurrentdir(OpenDialog2.FileName);
  mainpalname:=palname;
  for i:=length(mainpalname)downto 1 do begin
   c:=mainpalname[i];
   Delete(mainpalname,i,1);
   if c='.'then break;
  end;
 end;
 edbrightness.OnChange(sender);

end;

end.
