Jump to content
Fórum Script Brasil
  • 0

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


Question

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 to post
Share on other sites

2 answers to this question

Recommended Posts

  • 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 to post
Share on other 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 to post
Share on other sites

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.

Guest
Answer this question...

×   Pasted as rich text.   Paste as plain text instead

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.



  • Forum Statistics

    • Total Topics
      149150
    • Total Posts
      645417
×
×
  • Create New...