_Мика_ писал(а):Как картинку проеобпрозовать в 8 bit т.е. 256 цветов
function FindColor(const c: integer):integer;
var
r: integer;
g: integer;
b: integer;
n: integer;
num: integer;
test: integer;
begin
r:= getRValue(c);
g:= getGValue(c);
b:= getBValue(c);
test:= 1000;
for n:= 0 to 255 do begin
if (abs(getRValue(ColourPalette[n]) - r) + abs(getGValue(ColourPalette[n]) - g) + abs(getBValue(ColourPalette[n]) - b)) < test then begin
test:= abs(getRValue(ColourPalette[n]) - r) + abs(getGValue(ColourPalette[n]) - g) + abs(getBValue(ColourPalette[n]) - b);
num:=n;
end;
end;
result:=ColourPalette[num];
end;
procedure TfrmMain.btnUsePaletteClick(Sender: TObject);
var
x: integer;
y: integer;
pic1: TBitmap;
pic2: TBitmap;
begin
try
pic1:= tbitmap.Create;
pic2:= tbitmap.Create;
finally
pic1.LoadFromFile('in.bmp');
pic2.LoadFromFile('in.bmp');
for y := 0 to pic1.Height do begin
for x := 0 to pic1.Width do begin
pic2.Canvas.Pixels[x,y]:=findcolor(pic1.Canvas.Pixels[x,y]);
end;
end;
picpic.Canvas.Draw(0,0,pic2);
end;
pic1.Free;
pic2.Free;
end;
Сейчас этот форум просматривают: нет зарегистрированных пользователей и гости: 3