[player891]

Как можно сделать постеризацию изображения?нашел вот такой компоненет TOrImage,есть какие нибудь альтернативные пути?

[angvelem]

Этот компонент идёт с исходным кодом, "выдерни" нужную часть.

[player891]

там слишком сложный для меня код,не могу понять где постеризация

[player891]

ImageEn,G32/Graphics32/ImageVampire посоветовали также,что скажете про них?есть ли их исходные коды?может быть они попроще?

[angvelem]

Вот кусок из исходников:

Код:

 if (FPictureOriginal.Graphic <> nil) and (FPicture.Graphic <> nil) then
   if (FPictureOriginal.Graphic is TBitmap) and (FPicture.Graphic is TBitmap) then
 begin
...
    // for each row of pixels
    for I := 0 to BmpOriginal.Height - 1 do
    begin
      OrigRow := BmpOriginal.ScanLine[i];
      DestRow := FPicture.Bitmap.ScanLine[i];
      if FNoise <> nil then
        NoiseRow := FNoise.ScanLine[i]
      else
        NoiseRow := OrigRow;

      // for each pixel in row
      for j := 0 to BmpOriginal.Width - 1 do
      begin
        RO:=OrigRow[j].rgbtRed;
        GO:=OrigRow[j].rgbtGreen;
        BO:=OrigRow[j].rgbtBlue;

        //Calculate Posterize or Solorize
        if FPosterize<>0 then
        begin
          RO:=round(RO/FPosterize)*FPosterize;
          GO:=round(GO/FPosterize)*FPosterize;
          BO:=round(BO/FPosterize)*FPosterize;
        end
...

[player891]

подскажите в чем дело,вот рабочий код

Код:

procedure TForm1.Button8Click(Sender: TObject);
var i,j:integer;
begin
if (OpenPictureDialog1.Execute) and FileExists(OpenPictureDialog1.FileName) then
begin
bp:=TBitmap.Create;
if copy(form1.OpenPictureDialog1.FileName,length(form1.OpenPictureDialog1.FileName)-2,3)='bmp' then
bp.LoadFromFile(form1.OpenPictureDialog1.FileName)
else
begin
bpj:=TJPEGImage.Create;
bpj.LoadFromFile(form1.OpenPictureDialog1.FileName);
bp.Assign(bpj);
bpj.Free;
end;
end;
SetLength(pic,bp.Width,bp.Height);
for i:=0 to bp.Width-1 do
for j:=0 to bp.Height-1 do
pic[i,j]:=bp.Canvas.Pixels[i,j];

for i:=0 to bp.Width-1 do
for j:=0 to bp.Height-1 do begin
r:=getrvalue(pic[i,j]); g:=getgvalue(pic[i,j]); b:=getbvalue(pic[i,j]);
r:=round(r/(255/5))*round(255/5);
g:=round(g/(255/5))*round(255/5);
b:=round(b/(255/5))*round(255/5);
pic[i,j]:=(b*65536)+(g*256)+r
end;

for j:=0 to bp.Height-1 do
for i:=0 to bp.Width-1 do
bp.Canvas.Pixels[i,j]:=pic[i,j];
bp.SaveToFile(home+'itog.bmp');
bp.Free;

если ставлю в функцию значение 4 (самое нужное мне) не работает

если ставлю любое другое 3 5 6 7 8 9 10 всё работает)

Код:

r:=round(r/(255/4))*round(255/4);
g:=round(g/(255/4))*round(255/4);
b:=round(b/(255/4))*round(255/4);

[angvelem]

Особо разбираться лень, но в этом коде нужно добавить проверку:

Код:

  R := Round(R / (255 / 4)) * Round(255 / 4);
  G := Round(G / (255 / 4)) * Round(255 / 4);
  B := Round(B / (255 / 4)) * Round(255 / 4);

  if R < 0 then R := 0;
  if G < 0 then G := 0;
  if B < 0 then b := 0;
  if R > 255 then R := 255;
  if G > 255 then G := 255;
  if B > 255 then B := 255;