Pesquisar na Comunidade

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;

Alguém teria uma solução melhor ou poderia me ajudar a acabar esse código que estou tendo problema em modificar algumas das possibilidades sem que interfira nas outras possibilidades: Preciso que valores do edit1 sejam corrigidos para o edit2, serão valores numéricos. caso o valor seja: 45,12 ou 45.12 o sistema mantem o ponto ou a virgula dependendo como foi digitado. se os valores forem maiores exemplo: 1,125,12 ou 1.125.12 o sistema limpe as milhares '.' ou ',' e mantenha somente os centavos. 1125,12 ou 1125.12 dependendo de como foi digitado. as possibilidades do usuário digitar são: x , xxx, xx x . xxx . xx x, xxx . xx x . xxx , xx xx , xx xx . xx ou valores maiores na casa de milhões, mas se conseguir na casa dos 100.000,00 já esta bom. meu Código: var Form1: TForm1; count,count2,r:integer; implementation {$R *.dfm} procedure TForm1.Button1Click(Sender: TObject); var VLR:string; i:integer; begin vlr:=Edit1.Text; for i:=1 to Length(vlr) do if vlr[i]=',' then Count:=Count+1; Label1.Caption:=IntToStr(Count); if count >= 2 then begin for i:=1 to Length(vlr) do if vlr[i]=',' then break; ///Delete(vlr,i,1); Delete(vlr,i,1); Edit2.Text := vlr; //Count:=0; end; for i:=1 to Length(vlr) do if vlr[i]='.' then Count2:=Count2+1; Label1.Caption:=IntToStr(Count2); if (count = 1) and (count2 = 1) then begin for i:=1 to Length(vlr) do if vlr[i]='.' then break; ///Delete(vlr,i,1); Delete(vlr,i,1); Edit2.Text := vlr; end; count:=0; Count2:=0; for i:=1 to Length(vlr) do if vlr[i]=',' then Count:=Count+1; Label1.Caption:=IntToStr(Count); for i:=1 to Length(vlr) do if vlr[i]='.' then Count2:=Count2+1; Label1.Caption:=IntToStr(Count2); if (count = 1) or (count2 = 1) then begin Edit2.Text := vlr; count:=0; Count2:=0; end; end; procedure TForm1.FormCreate(Sender: TObject); begin Count:=0; count2:=0; r:=0; end; Não esta completo, quando eu tento para corrigir x,xxx.xx acaba interferindo em alguma outra correção.

Boa Tarde pessoal fiquei a semana inteira quebrando cabeça com uma aplicação e não consegui resolver, eu pago quem me ajudar sem problema... Pra explicar melhor fiz um video e postei no youtube... Realmente estou disposto a pagar por uma consultoria, pois isso é muito importante pra mim, meu whatssap é ( 034 88080777 ) ddd trinta e quatro, fone oito oito zero oito zero sete sete sete. OBs: em algumas maquinas funciona normal e em outras não, já formatei, já fiz de tudo...já testei em umas 10 maquinas, algumas funcionam e outras não, não descobrir o porque, todas que testei foi com windows 7 32 e 64 aleatoriamente, já testei a aplicação local também e acontece o mesmo. Fiz um video e coloquei no youtube pra explicar melhor a situação, segue o link abaixo. Desde já agradeço;linnk https://youtu.be/2lvW1g5-sOE