delphi10 (Resolvido) Como saber se existe determinada cor ou uma variante da dessa cor em um .bmp

wagnercampanari · Março 11, 2021

Preciso que que o programa tire um print em determinada parte da tela e pegue um ponto especifico da tela, nesse ponto a maior parte da cor é branca, alguns pontos de preto a cinza e alguns pontos da tonalidade de verde, preciso que ele reconheça que existe alguma tonalidade de verde.

O problema é que pode ter muitos tons de verde e não sei uma forma eliminar os outros tons ou converter os tons de verde para um verde especifico, para eliminar as variações de verde, para que o programa consiga achar, no meio de tantas variações de verde.

uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.ExtCtrls, Vcl.StdCtrls;

type
TForm1 = class(TForm)
a: TMemo;
Image1: TImage;
Label2: TLabel;
Button2: TButton;
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
TCl = record
Count: Integer;
Color: TColor;
end;

var
Form1: TForm1;
b: TBitmap;
cs: Array of TCl;

implementation

{$R *.dfm}

var
Form1: TForm1;
b: TBitmap;
cs: Array of TCl;

implementation

{$R *.dfm}

procedure GetTela(bmp: TBitmap; X, Y: Integer);
var
BackgroundCanvas: TCanvas;
DC: hDC;
begin
DC := GetDC(0);
try
BackgroundCanvas := TCanvas.Create;
try
BackgroundCanvas.Lock;
try
BackgroundCanvas.Handle := DC;
bmp.Canvas.CopyRect(Rect(0, 0, bmp.Width, bmp.Height), BackgroundCanvas,
Rect(X, Y, bmp.Width + X, bmp.Height + Y));
finally
BackgroundCanvas.Unlock;
end;
finally
BackgroundCanvas.Free;
end;
finally
ReleaseDC(0, DC);
end;
end;

function ColorIndex(const Cl: TColor): Integer;
var
l: Integer;
begin
Result := -1;
for l := 0 to Length(cs) - 1 do
if cs[l].Color = Cl then
begin
Result := l;
Break;
end;
end;

function ColorPixel(P: TPoint): TColor;
var
DC: HDC;
begin
DC:= GetDC(0);
Result:= GetPixel(DC,P.X,P.Y);
ReleaseDC(0,DC);
end;

procedure TForm1.Button1Click(Sender: TObject);
var
x, y, i, n: Integer;
c :Cardinal;
begin
Image1.Picture.Bitmap.Width := 30;
Image1.Picture.Bitmap.Height := 15;
GetTela(Image1.Picture.Bitmap, 1008, 850);
Image1.Picture.SavetoFile('C:\Pixels\Win32\Debug\Comprar.bmp'); //1086,794
a.Clear;

b := TBitmap.Create;
SetLength(cs, 0);
try
b.LoadFromFile('C:\Pixels\Win32\Debug\Comprar.bmp');
with b, Canvas do
begin
n := -1;
for y := 0 to b.Height - 1 do
for x := 0 to b.Width - 1 do
begin
c := Pixels[x, y];
i := ColorIndex(c);
if i = -1 then
begin
n := Length(cs);
SetLength(cs, n + 1);
with cs[n] do
begin
Inc(Count);
Color := c;
end;
end
else
Inc(cs[i].Count);
end;
//if n = 0 then
// a.Lines.Add('Foi encontrado:')
//else
// a.Lines.Add('Foram encontrados:');
// a.Lines.Add('');
y := 0;
n := cs[0].Count;
for x := 0 to Length(cs) - 1 do
with cs[x] do
begin
a.Lines.Add(ColorToString(Color));
if Count > n then
begin
y := x;
n := Count;
end;
end;
// a.Lines.Add('');
// a.Lines.Add('Cor predominante: ' + ColorToString(cs[y].Color));

if pos('$0096D438', UpperCase(a.text))>0
then Label2.Caption:='Comprar' else Label2.Caption:='Aguarde';

if Label2.Caption='Aguarde' then
if pos('$00D7EDB5', UpperCase(a.text))>0
then Label2.Caption:='Comprar' else Label2.Caption:='Aguarde';

if Label2.Caption='Aguarde' then
if pos('$00B4DE72', UpperCase(a.text))>0
then Label2.Caption:='Comprar' else Label2.Caption:='Aguarde';

if Label2.Caption='Aguarde' then
if pos('$00A1D74D', UpperCase(a.text))>0
then Label2.Caption:='Comprar' else Label2.Caption:='Aguarde';

if Label2.Caption='Aguarde' then
if pos('$00D4EBAF', UpperCase(a.text))>0
then Label2.Caption:='Comprar' else Label2.Caption:='Aguarde';

if Label2.Caption='Aguarde' then
if pos('$00EDF5E0', UpperCase(a.text))>0
then Label2.Caption:='Comprar' else Label2.Caption:='Aguarde';

if Label2.Caption='Aguarde' then
if pos('$00B7E078', UpperCase(a.text))>0
then Label2.Caption:='Comprar' else Label2.Caption:='Aguarde';

if Label2.Caption='Aguarde' then
if pos('$00DFEEC7', UpperCase(a.text))>0
then Label2.Caption:='Comprar' else Label2.Caption:='Aguarde';

if Label2.Caption='Aguarde' then
if pos('$00DAEDBC', UpperCase(a.text))>0
then Label2.Caption:='Comprar' else Label2.Caption:='Aguarde';

if Label2.Caption='Aguarde' then
if pos('$00D5EBB1', UpperCase(a.text))>0
then Label2.Caption:='Comprar' else Label2.Caption:='Aguarde';

if Label2.Caption='Aguarde' then
if pos('$00BFE387', UpperCase(a.text))>0
then Label2.Caption:='Comprar' else Label2.Caption:='Aguarde';

if Label2.Caption='Aguarde' then
if pos('$00A7D959', UpperCase(a.text))>0
then Label2.Caption:='Comprar' else Label2.Caption:='Aguarde';

if Label2.Caption='Aguarde' then
if pos('$00ECF4DE', UpperCase(a.text))>0
then Label2.Caption:='Comprar' else Label2.Caption:='Aguarde';

if Label2.Caption='Aguarde' then
if pos('$00DEEFC4', UpperCase(a.text))>0
then Label2.Caption:='Comprar' else Label2.Caption:='Aguarde';

if Label2.Caption='Aguarde' then
if pos('$00CAE79C', UpperCase(a.text))>0
then Label2.Caption:='Comprar' else Label2.Caption:='Aguarde';

if Label2.Caption='Aguarde' then
if pos('$00E9F4D9', UpperCase(a.text))>0
then Label2.Caption:='Comprar' else Label2.Caption:='Aguarde';

if Label2.Caption='Aguarde' then
if pos('$00ADDC65', UpperCase(a.text))>0
then Label2.Caption:='Comprar' else Label2.Caption:='Aguarde';

if Label2.Caption='Aguarde' then
if pos('$00E9F4D9', UpperCase(a.text))>0
then Label2.Caption:='Comprar' else Label2.Caption:='Aguarde';

if Label2.Caption='Aguarde' then
if pos('$00EBF4DC', UpperCase(a.text))>0
then Label2.Caption:='Comprar' else Label2.Caption:='Aguarde';
end;
finally
FreeAndNil(b);
end;
end;

**Jhonas** · Março 13, 2021

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, OleCtnrs, OleCtrls, ExtCtrls, SHDocVw;

type
  TForm1 = class(TForm)
    Button1: TButton;
    wb: TWebBrowser;
    Image1: TImage;
    SaveDialog1: TSaveDialog;
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

uses activex, jpeg;

procedure TForm1.Button1Click(Sender: TObject);
var
  viewObject : IViewObject;
  r : TRect;
  bitmapdst, bitmap : TBitmap;
  RectOrigem, RectDestino: TRect;
  BitmapFont, BitmapDest, MyBMPImage: TBitmap;
begin
  if wb.Document <> nil then
  begin
    wb.Document.QueryInterface(IViewObject, viewObject);
    if Assigned(viewObject) then
    try
      bitmap    := TBitmap.Create;
      bitmapdst := TBitmap.Create;
      try

        bitmap.Height := wb.Height; // 288; // 322wb.Height;
        bitmap.Width  := wb.Width; // 322; // wb.Width;

        r  := Rect(0, 0, bitmap.width-1, bitmap.height-1);

        viewObject.Draw(DVASPECT_CONTENT, 1, nil, nil, Application.Handle, bitmap.Canvas.Handle, @r, nil, nil, 0);

        RectOrigem  := Rect(101, 101, 452, 388);
        RectDestino := Rect(0, 0, 351, 287);

        Bitmapdst.Width  := 352;
        Bitmapdst.Height := 288;
        Bitmapdst.Canvas.CopyRect(RectDestino, Bitmap.Canvas, RectOrigem);

        with TJPEGImage.Create do
        try
          Assign(bitmapdst);
          SaveToFile(SaveDialog1.FileName);
        finally
          Free;
        end;
      finally
        bitmapdst.Free;
        bitmap.Free;
      end;
    finally
      viewObject._Release;
    end;
  end;
end;


end.

OBS: No exemplo acima, voce recorta um pedaço da imagem bmp e salva como jpeg. ( isso diminui o tamanho da figura )

aqui voce pode alterar o programa para usar o mouse para pegar as coordenadas ( X,Y) que voce quiser da imagem

Depois voce carrega a nova imagem e usa o código abaixo para armazenar num array ( ArrayPuntos ou pode usar outro nome ) todos os pixels da nova figura, que foi selecionado pelo mouse.

Obs: a imagem recortada vem de uma URL ( WebBrowser ) mas voce pode usar uma imagem bmp ( basta modificar o código )

o código da cor ficara armazenada no array ( ArrayPanel )

No código abaixo, a leirura sera de 100 pixels

Código:

------------------------------------------

var
i:Integer;
color:TColor;
begin
i:=0;
While i<100 do
begin
color:=GetPixel(GetWindowDC(GetDesktopWindow),ArrayPuntos[i].X,ArrayPuntos[i].Y);
ArrayPanel[i].Color:=color;
end;

------------------------------------------

Depois basta usar um comando For para testar a cor verde que voce quer com a que está armazenada no array ( ArrayPanel )

Modifique o código para o seu uso.

abraço

wagnercampanari · Abril 2, 2021

Em 13/03/2021 em 20:29, Jhonas disse:
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, OleCtnrs, OleCtrls, ExtCtrls, SHDocVw;

type
  TForm1 = class(TForm)
    Button1: TButton;
    wb: TWebBrowser;
    Image1: TImage;
    SaveDialog1: TSaveDialog;
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

uses activex, jpeg;

procedure TForm1.Button1Click(Sender: TObject);
var
  viewObject : IViewObject;
  r : TRect;
  bitmapdst, bitmap : TBitmap;
  RectOrigem, RectDestino: TRect;
  BitmapFont, BitmapDest, MyBMPImage: TBitmap;
begin
  if wb.Document <> nil then
  begin
    wb.Document.QueryInterface(IViewObject, viewObject);
    if Assigned(viewObject) then
    try
      bitmap    := TBitmap.Create;
      bitmapdst := TBitmap.Create;
      try

        bitmap.Height := wb.Height; // 288; // 322wb.Height;
        bitmap.Width  := wb.Width; // 322; // wb.Width;

        r  := Rect(0, 0, bitmap.width-1, bitmap.height-1);

        viewObject.Draw(DVASPECT_CONTENT, 1, nil, nil, Application.Handle, bitmap.Canvas.Handle, @r, nil, nil, 0);

        RectOrigem  := Rect(101, 101, 452, 388);
        RectDestino := Rect(0, 0, 351, 287);

        Bitmapdst.Width  := 352;
        Bitmapdst.Height := 288;
        Bitmapdst.Canvas.CopyRect(RectDestino, Bitmap.Canvas, RectOrigem);

        with TJPEGImage.Create do
        try
          Assign(bitmapdst);
          SaveToFile(SaveDialog1.FileName);
        finally
          Free;
        end;
      finally
        bitmapdst.Free;
        bitmap.Free;
      end;
    finally
      viewObject._Release;
    end;
  end;
end;


end.
OBS: No exemplo acima, voce recorta um pedaço da imagem bmp e salva como jpeg. ( isso diminui o tamanho da figura )

aqui voce pode alterar o programa para usar o mouse para pegar as coordenadas ( X,Y) que voce quiser da imagem

Depois voce carrega a nova imagem e usa o código abaixo para armazenar num array ( ArrayPuntos ou pode usar outro nome ) todos os pixels da nova figura, que foi selecionado pelo mouse.

Obs: a imagem recortada vem de uma URL ( WebBrowser ) mas voce pode usar uma imagem bmp ( basta modificar o código )

o código da cor ficara armazenada no array ( ArrayPanel )

No código abaixo, a leirura sera de 100 pixels

Código:

------------------------------------------

var
i:Integer;
color:TColor;
begin
i:=0;
While i<100 do
begin
color:=GetPixel(GetWindowDC(GetDesktopWindow),ArrayPuntos[i].X,ArrayPuntos[i].Y);
ArrayPanel[i].Color:=color;
end;

------------------------------------------

Depois basta usar um comando For para testar a cor verde que voce quer com a que está armazenada no array ( ArrayPanel )

Modifique o código para o seu uso.

abraço

Obrigado pela ajuda, consegui resolver o problema da seguinte forma: Como a área da imagem que eu recortava se mantinha em tons de branco e cinza, com o tempo aparecia alguns tons de verde, peguei a imagem com os tons de branco e cinza e listei o código de cores desses pixels, que considerei inutilizável, e coloquei um filtro em um memo para eliminar essas cores, que não eram relevantes.

Um timer ficava carregando a imagem e listando as corres no memo.

Ai puxei uma imagem com os tons de verde que podia aparecer na imagem e quando aparecia listado algum tom diferente do que foi filtrado eu saberia que era o verde e executaria as instruções do programa, pois a área que era recortado só podiam aparecer esses três tons de branco, cinza e verde.

Entrar

delphi10 (Resolvido) Como saber se existe determinada cor ou uma variante da dessa cor em um .bmp

Pergunta

wagnercampanari

Link para o comentário

Compartilhar em outros sites

2 respostass a esta questão

Posts Recomendados

Jhonas

Link para o comentário

Compartilhar em outros sites

wagnercampanari

Link para o comentário

Compartilhar em outros sites

Participe da discussão

Estatísticas dos Fóruns

Navegação

Atividades