Ir para conteúdo
Fórum Script Brasil
  • 0

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


wagnercampanari

Pergunta

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;

comprar.png

comprar2.png

Link para o comentário
Compartilhar em outros sites

2 respostass a esta questão

Posts Recomendados

  • 0
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

 

 

 

 

 

Link para o comentário
Compartilhar em outros sites

  • 0
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.  

Link para o comentário
Compartilhar em outros sites

Participe da discussão

Você pode postar agora e se registrar depois. Se você já tem uma conta, acesse agora para postar com sua conta.

Visitante
Responder esta pergunta...

×   Você colou conteúdo com formatação.   Remover formatação

  Apenas 75 emoticons são permitidos.

×   Seu link foi incorporado automaticamente.   Exibir como um link em vez disso

×   Seu conteúdo anterior foi restaurado.   Limpar Editor

×   Você não pode colar imagens diretamente. Carregar ou inserir imagens do URL.



  • Estatísticas dos Fóruns

    • Tópicos
      152k
    • Posts
      651,8k
×
×
  • Criar Novo...