[Resolvido] - Função delphi equivalente no Lazarus

[neodarkman]

Qual a função no Lazarus equivalente a função PalleteRGB(R,G,B) do Delphi?
Estou tentando adaptar um código(delphi) para converter uma imagem colorida em tons de cinza e esse código usa essa função.

[typo]

Em que unidade do Delphi está declarada esta função?

[neodarkman]

Aí é que está.... onde peguei a função não diz...
Mas se eu substituo o PaletteRGB(R,G,B) por RGB(R,G,B) funciona... mas leva muiiiiiiiiiito tempo para converter a imagem colorida para tons de cinza... chegou a levar umas 6 horas processando...

[typo]

No Lazarus use o Localizar Declaração no menu do botão direito do mouse.

[typo]

Provavelmente essa função não é do Delphi.

[neodarkman]

Olha a procedure:

Code: [Select]

procedure ColorToGrayScale(ABmp: TBitmap);
//
// Transforma um bitmap colorido em tons de cinza
//
// Use-o assim:
//
// var x: TBitmap;
// begin
//
//   x := TBitmap.create;
//   x.LoadFromFile('c:\MVC-267S.bmp');
//   ColorToGrayScale(x);
//   image1.Picture.Assign(x);
// end;
//
//
var
  c: TCursor;
  x, y: Integer;
  R, G, B: Byte;
  ColorRGB: LongInt;
  HCLR: Byte;
begin
  c := Screen.Cursor;
  Screen.Cursor := crHourGlass;
  for y := 0 to (ABmp.Height - 1) do
    for x := 0 to (ABmp.Width - 1) do begin
      ColorRGB := ColorToRGB(ABmp.Canvas.Pixels[x, y]);
      // obtém as cores da paleta
      R := GetRValue(ColorRGB);
      G := GetGValue(ColorRGB);
      B := GetBValue(ColorRGB);
      // obtém o maior valor da paleta
      HCLR := 0;
      if R > HCLR then HCLR := R;
      if G > HCLR then HCLR := G;
      if B > HCLR then HCLR := B;
      // converte para tons de cinza
      R := HCLR;
      G := HCLR;
      B := HCLR;
      // aplica a nova cor ao pixel
      ABmp.Canvas.Pixels[x, y] := PaletteRGB(R, G, B);
    end;
  Screen.Cursor := c;
end;

Peguei essa função num site de dicas Delphi.

[typo]

Provavelmente no mesmo site você vai encontrar essa função.

[neodarkman]

Provavelmente no mesmo site você vai encontrar essa função.

Pior que não.
Lá trata como se PaletteRGB(R,G,B) fosse uma função nativa do delphi..

[neodarkman]

Descobri: PaletteRGB(r, g, b: Byte) pertence a unit Windows do Delphi....

[typo]

Você pode fazer uma Feature Request no BugTracker.

[JorgeAldo]

se a maquina alvo for multiprocessador voce pode usar o meu pascalactormodel para dividir a tarefa entre multiplos nucleos e ganhar velocidade com isso.  6 nucleos fariam o mesmo trabalho em 1 hora

[neodarkman]

Olá um colega de outro fórum, mas também é usuário daqui, me passou esse código:


uRasterImageHelper.pas

Code: [Select]

unit uRasterImageHelper;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, Graphics, GraphType, LCLType;

type

  { TRasterImageHeper }

  TRasterImageHeper = class helper for TRasterImage
  public
    function GetRawPtr(): PRawImage;
    procedure ToGrayScale();
  end;

procedure ToGrayScale(aImg : TRasterImage); //pq o helper ta bugado

implementation

procedure ToGrayScale(aImg : TRasterImage);
begin
  aImg.ToGrayScale();
end;

function RGBToGray(R, G, B : Byte) : Byte;
var
  i : Integer;
begin
  i := Round(0.2989 * R + 0.5870 * G + 0.1140 * B);
  if i > 255 then
    Result := 255
  else
    Result := i;
end;

{ TRasterImageHeper }

function TRasterImageHeper.GetRawPtr : PRawImage;
begin
  Result :=  GetRawImagePtr;
end;

procedure TRasterImageHeper.ToGrayScale;
var
  x, y    : Integer;
  pRawPtr : PRawImage;
  Bpp     : Integer;
  pRow, pPixel : PByte;
  pix     : PRGBAQuad absolute pPixel;
begin
  Self.BeginUpdate(False);
  try
    pRawPtr := Self.GetRawPtr();
    Bpp     := pRawPtr^.Description.BitsPerPixel div 8;
    pRow    := pRawPtr^.Data;

    for y := 0 to  Height - 1 do
    begin
      pPixel  := pRow;
      for x := 0 to Width - 1 do
      begin
        //if pix^.Alpha <> 0 then
        begin
          pix^.Red   := RGBToGray(pix^.Red, pix^.Green, pix^.Blue);
          pix^.Green := pix^.Red;
          pix^.Blue  := pix^.Red;
        end;

        Inc(pPixel, Bpp);
      end;

      Inc(pRow, pRawPtr^.Description.BytesPerLine);
    end;
  finally
    Self.EndUpdate(False);
  end;
end;

end.

Muito mais rápido e que resolveu o meu problema.
Muito Obrigado Gilson Nunes Rodrigues