Přidat otázku mezi oblíbenéZasílat nové odpovědi e-mailemVyřešeno Delphi-ziskani barvy pixelu

Dobrý den,
našel jsem na internetu program na ziskavani barvy pixelu. Snima celou obrazovku, coz je vypocetne narocne. Prosím o radu, jak přepsat program, aby snímal obraz pouze z části obrazovky. Děkuji, Lojzan

//Ziskani pixelu pro urceni barvy
function DesktopColor(const x,y: integer): TColor;
var
  c:TCanvas;
begin
  c:=TCanvas.create;
  c.handle:=GetWindowDC(GetDesktopWindow);  //predpokladam, ze nekde zde
  result:=getpixel(c.handle,x,y);
  c.free;
end; 

//Konverze barvy do HEX kodu
function ColorToHTMLHex(Color: TColor): String;
begin
  Result := IntToHex(ColorToRGB(Color), 6);
  Result := Copy(Result, 5, 2) + Copy(Result, 3, 2) + Copy(Result, 1, 2);
end;
Předmět Autor Datum
Například z oblasti x=100..200 y=100..200
Lojzan 20.09.2011 19:56
Lojzan
Popřípadě zvolit méně náročný postup: Tachometr ve flashi->Červená rafička (Barva FF0000). Potřebuji…
Lojzan 20.09.2011 20:41
Lojzan
No ale vždyť to nebere celou obrazovku. Získává na ní pouze handle a až pak získává barvu pixelu.
Wikan 20.09.2011 21:02
Wikan
Ta fukcia ziskava farbu len jedneho pixelu, na pozicii x,y. Ked chces ziskavat nejaky rozsah a opak…
MM.. 20.09.2011 21:20
MM..
"takmer okamzite" Kontrolu změny barvy mám v Timeru. Pri tak malem rozliseni toho flash tachometru m…
Lojzan 20.09.2011 21:35
Lojzan
S tím resultem potřebuji pomoci. Prosím o názornou ukázku. (Zkrácená verze) unit Unit1; interface u…
Lojzan 20.09.2011 21:43
Lojzan
Najprv studuj, az potom programuj.
MM.. 20.09.2011 21:49
MM..
No a preco si myslis ze to snima celu obrazovku? Jaky mas problem? Ja ti to asi len prelozim do nor…
MM.. 20.09.2011 21:45
MM..
Máš skutečně pevné nervy. Děkuji a přeji Ti, ať ve svém životě potkáš co nejméně lidí, kteří prvně ř…
Lojzan 20.09.2011 21:56
Lojzan
ja sa neznervoznujem, len ti radim ten spravny postup, t.j. najprv si nastudovat cykly :) ked nebud…
MM.. 20.09.2011 21:59
MM..
resp. na to ani netreba mat cas, s cyklom a jednym volanim GetWindowDC to bude vypadat napr. takto:…
MM.. 20.09.2011 22:06
MM..
Jenže x-ová souřadnice není stále 613.
Wikan 20.09.2011 22:10
Wikan
... jaj ty tam menis aj x, neni furt 613, tak potom //Konverze barvy do HEX kodu function ColorToHT…
MM.. 20.09.2011 22:11
MM..
Pořád stejný problém. Po spuštění Timeru se sníží FrameRate flash aplikace přibližně na 0,1FPS. (Poč…
Lojzan 20.09.2011 22:34
Lojzan
55 IFů 50x/s si žádá svoji daň
Lojzan 20.09.2011 22:35
Lojzan
To neni o ifoch, if-ov zvladne tvoj cpu asi tak miliardu za sekundu. Ked mas popri tom spustenu hru…
MM.. 20.09.2011 23:19
MM..
A jak presne si nastavil ten timer? daj sem ten riadok kde ho nastavujes
MM.. 20.09.2011 23:25
MM..
55 if-ov 50-krát za sekundu si CPU ani nevšimne. Horšie je to s tými zbytočnými volaniami ColorToHT…
los 20.09.2011 23:31
los
to je pravda ale 55 pixelov je extremne male mnozstvo, ci by bol BitBlt na nejaky rozsah 4x55 alebo…
MM.. 21.09.2011 01:06
MM..
55 pixlov je na volanie GetPixel veľa - BitBlt by som použil už asi pri piatich a pri desiatich urči…
los 21.09.2011 21:40
los
hej to je pravda nech skusi aj BitBlt (lebo Win nema obsah obrazovky v RAM tak to musi liezt cez vse…
MM.. 21.09.2011 21:56
MM..
Pouzitelne? {************************************************* ****************************** * Cop…
Lojzan 22.09.2011 06:30
Lojzan
Este mozes radsej pouzit GetDC(0) namiesto toho GetWindowsDC to je na cely screen zbytocne. Napr. ni…
MM.. 20.09.2011 23:37
MM..
A je nějaký důvod, abys to zjištění pixelu dělal tak, jak to děláš? Děláš to naprosto neefektivně. P…
Jan Fiala 21.09.2011 16:15
Jan Fiala
Je to vcelku jednoduché. Flash aplikace: http://mirror1.upwap.ru/d/1734081/a2f442f625a7e694 12511600…
Lojzan 21.09.2011 19:22
Lojzan
Napada. Postup, ktery jsem popsal. Proc pro kazde cteni pixelu alokujes a dealokujes handle na obraz…
Jan Fiala 22.09.2011 06:40
Jan Fiala
Prepsal jsem to: 1. Na zacatku Handle 2. Pomoci Case=Proveruji se jenom dve podminky. Presto je ryc…
Lojzan 22.09.2011 17:43
Lojzan
Nikde v tom tvem kodu nevidim na konci ReleaseDC. Znamena to, ze za chvili to padne na nedostatek pr…
Jan Fiala 23.09.2011 11:13
Jan Fiala
Nejak takto ?: var DC: HDC; Canvas: TCanvas; begin Canvas:=TCanvas.Create; try DC:=GetWindowDC(GetD… poslední
pme 23.09.2011 12:04
pme
Verdikt: Používám Windows 7. Nastavil jsem hloubku barev systému na 16bitů a přepl motiv z Windows 7…
Lojzan 22.09.2011 20:58
Lojzan
Ešte môžeš zrušiť tú spomaľovaciu funkciu ColorToHTMLHex a bude to dokonalé. Označujem ako vyriešené…
los 22.09.2011 21:04
los

Popřípadě zvolit méně náročný postup: Tachometr ve flashi->Červená rafička (Barva FF0000). Potřebuji v reálném čase zjišťovat pohyb rafičky a z toho odvozovat rychlost. Tento tachometr má velikost pouze 27x30 pixelů a proto je zbytečné brát celou obrazovku.

Ta fukcia ziskava farbu len jedneho pixelu, na pozicii x,y.

Ked chces ziskavat nejaky rozsah a opakovane volanie celej tej funkcie je moc pomale kvoli ziskavaniu contextu, tak si daj do cyklu len riadok result:=getpixel(c.handle,x,y);, a ukladaj si vysledky do nejakeho pola. Takym sposobom sa GetWindowsDC bude volat len raz, pre cely rozsah.

P.S> ale nemalo by to byt pomale on ten GetWindowDC by mal prebehnut takmer okamzite.

"takmer okamzite"
Kontrolu změny barvy mám v Timeru. Pri tak malem rozliseni toho flash tachometru mam Timer.interval nastaven na 20. Timer testuje 55 ruznych bodu jestli se nezmenily=> Timer probehne 50x/s a provede 55x (ColorToHTMLHex(DesktopColor(x,y)))
=> 50*55=kazdou vterinu 2750x ... opravdu jsem zacatecnik=jak je moznost tak vse hazim do Timeru a o optimalizaci nic nevim :-D

S tím resultem potřebuji pomoci. Prosím o názornou ukázku. (Zkrácená verze)

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Tlhelp32, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, OleCtrls, SHDocVw, shellapi, ExtCtrls;

type
  TForm1 = class(TForm)

    Timer1: TTimer;
    procedure Timer1Timer(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

//Konverze barvy do HEX kodu
function ColorToHTMLHex(Color: TColor): String;
begin
  Result := IntToHex(ColorToRGB(Color), 6);
  Result := Copy(Result, 5, 2) + Copy(Result, 3, 2) + Copy(Result, 1, 2);
end;

//Ziskani pixelu pro urceni barvy
function DesktopColor(const x,y: integer): TColor;
var
  c:TCanvas;
begin
  c:=TCanvas.create;
  c.handle:=GetWindowDC(GetDesktopWindow);
  result:=getpixel(c.handle,x,y);
  c.free;
end;

//timer
procedure TForm1.Timer1Timer(Sender: TObject);
var
  n:integer;
begin
if (ColorToHTMLHex(DesktopColor(	613	,	442	)))='FF0000' then n:=	1	;
if (ColorToHTMLHex(DesktopColor(	613	,	441	)))='FF0000' then n:=	2	;
if (ColorToHTMLHex(DesktopColor(	612	,	440	)))='FF0000' then n:=	3	;
if (ColorToHTMLHex(DesktopColor(	612	,	439	)))='FF0000' then n:=	4	;
if (ColorToHTMLHex(DesktopColor(	611	,	438	)))='FF0000' then n:=	5	;
if (ColorToHTMLHex(DesktopColor(	611	,	437	)))='FF0000' then n:=	6	;
if (ColorToHTMLHex(DesktopColor(	611	,	436	)))='FF0000' then n:=	7	;
if (ColorToHTMLHex(DesktopColor(	611	,	435	)))='FF0000' then n:=	8	;
if (ColorToHTMLHex(DesktopColor(	611	,	434	)))='FF0000' then n:=	9	;
if (ColorToHTMLHex(DesktopColor(	611	,	433	)))='FF0000' then n:=	10	;
if (ColorToHTMLHex(DesktopColor(	611	,	432	)))='FF0000' then n:=	11	;
if (ColorToHTMLHex(DesktopColor(	611	,	431	)))='FF0000' then n:=	12	;
if (ColorToHTMLHex(DesktopColor(	612	,	430	)))='FF0000' then n:=	13	;
if (ColorToHTMLHex(DesktopColor(	612	,	429	)))='FF0000' then n:=	14	;
if (ColorToHTMLHex(DesktopColor(	613	,	428	)))='FF0000' then n:=	15	;
if (ColorToHTMLHex(DesktopColor(	613	,	427	)))='FF0000' then n:=	16	;
if (ColorToHTMLHex(DesktopColor(	614	,	426	)))='FF0000' then n:=	17	;
if (ColorToHTMLHex(DesktopColor(	615	,	425	)))='FF0000' then n:=	18	;
if (ColorToHTMLHex(DesktopColor(	616	,	424	)))='FF0000' then n:=	19	;
if (ColorToHTMLHex(DesktopColor(	617	,	423	)))='FF0000' then n:=	20	;
end;

end.

No a preco si myslis ze to snima celu obrazovku? Jaky mas problem?

Ja ti to asi len prelozim do normalnej reci, a potom si to urob jak chces:
c:=TCanvas.create;
- vytvori to objekt triedy TCanvas (to je len zbytocna specialita delphi)

c.handle:=GetWindowDC(GetDesktopWindow);
- tymto poziadas Windows nech ti da neco, pomocou coho mozes liezt na zariadenie "plocha Windows" (to vrati funkcia GetDesktopWindow). To neco co z toho celeho ziskas sa vola Device Context (preto sa fcia vola GetWindowDC), ziskas na neho ukazatel a ulozis si ho do c.handle

result:=getpixel(c.handle,x,y);
- Windows poziadas nech ti da z toho zariadenia s ukazatelom c.handle jeden pixel na pozicii x,y. Tuto funkciu mozes opakovat kolkokrat chces, aj miliardukrat s roznymi parametrami x,y, ale so stejnym uz ziskanym c.handle (context plochy)

c.free;
- uvolni pamat zabratu tym objektom c (triedy TCanvas). Tym sa samozrejme strati aj c.handle, odteraz nemas uz ziadne c.handle a nabuduce musis zopakovat cely proces od zaciatku.

resp. na to ani netreba mat cas, s cyklom a jednym volanim GetWindowDC to bude vypadat napr. takto:

//Konverze barvy do HEX kodu
function ColorToHTMLHex(Color: TColor): String;
begin
Result := IntToHex(ColorToRGB(Color), 6);
Result := Copy(Result, 5, 2) + Copy(Result, 3, 2) + Copy(Result, 1, 2);
end;

//timer
procedure TForm1.Timer1Timer(Sender: TObject);
var
c:TCanvas;
n:integer;
y:integer;
begin
c:=TCanvas.create;
c.handle:=GetWindowDC(GetDesktopWindow);
for y:=442 downto 423 do
  if (ColorToHTMLHex(getpixel(c.handle, 613, y)))='FF0000' then n:= 443-y;
c.free;
end;

... jaj ty tam menis aj x, neni furt 613, tak potom

//Konverze barvy do HEX kodu
function ColorToHTMLHex(Color: TColor): String;
begin
Result := IntToHex(ColorToRGB(Color), 6);
Result := Copy(Result, 5, 2) + Copy(Result, 3, 2) + Copy(Result, 1, 2);
end;

//timer
procedure TForm1.Timer1Timer(Sender: TObject);
var
c:TCanvas;
n:integer;
begin
c:=TCanvas.create;
c.handle:=GetWindowDC(GetDesktopWindow);
if (ColorToHTMLHex(getpixel(c.handle, 613 , 442 )))='FF0000' then n:= 1 ;
if (ColorToHTMLHex(getpixel(c.handle, 613 , 441 )))='FF0000' then n:= 2 ;
if (ColorToHTMLHex(getpixel(c.handle, 612 , 440 )))='FF0000' then n:= 3 ;
if (ColorToHTMLHex(getpixel(c.handle, 612 , 439 )))='FF0000' then n:= 4 ;
if (ColorToHTMLHex(getpixel(c.handle, 611 , 438 )))='FF0000' then n:= 5 ;
if (ColorToHTMLHex(getpixel(c.handle, 611 , 437 )))='FF0000' then n:= 6 ;
if (ColorToHTMLHex(getpixel(c.handle, 611 , 436 )))='FF0000' then n:= 7 ;
if (ColorToHTMLHex(getpixel(c.handle, 611 , 435 )))='FF0000' then n:= 8 ;
if (ColorToHTMLHex(getpixel(c.handle, 611 , 434 )))='FF0000' then n:= 9 ;
if (ColorToHTMLHex(getpixel(c.handle, 611 , 433 )))='FF0000' then n:= 10 ;
if (ColorToHTMLHex(getpixel(c.handle, 611 , 432 )))='FF0000' then n:= 11 ;
if (ColorToHTMLHex(getpixel(c.handle, 611 , 431 )))='FF0000' then n:= 12 ;
if (ColorToHTMLHex(getpixel(c.handle, 612 , 430 )))='FF0000' then n:= 13 ;
if (ColorToHTMLHex(getpixel(c.handle, 612 , 429 )))='FF0000' then n:= 14 ;
if (ColorToHTMLHex(getpixel(c.handle, 613 , 428 )))='FF0000' then n:= 15 ;
if (ColorToHTMLHex(getpixel(c.handle, 613 , 427 )))='FF0000' then n:= 16 ;
if (ColorToHTMLHex(getpixel(c.handle, 614 , 426 )))='FF0000' then n:= 17 ;
if (ColorToHTMLHex(getpixel(c.handle, 615 , 425 )))='FF0000' then n:= 18 ;
if (ColorToHTMLHex(getpixel(c.handle, 616 , 424 )))='FF0000' then n:= 19 ;
if (ColorToHTMLHex(getpixel(c.handle, 617 , 423 )))='FF0000' then n:= 20 ;
c.free;
end;

slusnejsie by to bolo s cyklom a s polom suradnic, ale to sa mi uz teraz nechce robit :)

To neni o ifoch, if-ov zvladne tvoj cpu asi tak miliardu za sekundu.
Ked mas popri tom spustenu hru na celu obrazovku tak je mozne ze to neustale prepina obrazovku medzi hrou a plochou, asi nemozes sahat na plochu ked bezi hra v overlay, apod. Nechapem o co sa snazis a preco to robis takto sialene (skenovat pixely plochy kvoli zisteniu vytazenia CPU je nezmysel. Najdi si googlom nejake WinAPI fcie na to co potrebujes a nescanuj pixely plochy)

P.S> mozes si to zredukovat na

//timer
procedure TForm1.Timer1Timer(Sender: TObject);
var
c:TCanvas;
n:integer;
begin
c:=TCanvas.create;
c.handle:=GetWindowDC(GetDesktopWindow);
if (ColorToHTMLHex(getpixel(c.handle, 613 , 442 )))='FF0000' then n:= 1 ;
c.free;
end;

a uvidis ci je problem v tom samotnom sahani na plochu. Moj tip je ako som uz pisal nesahaj na plochu ked bezi hra, praca s plochou tymito metodami je vo Win vseobecne velmi pomala. Pouzivaj WinAPI fcie ktore su priamo urcene na to co chces zistit (neviem co vlastne chces tym programom dosiahnut)

55 if-ov 50-krát za sekundu si CPU ani nevšimne.

Horšie je to s tými zbytočnými volaniami ColorToHTMLHex - každý riadok by bol efektívnejši, keby bol zapísaný nejako takto (v Delphi nerobím, môžu tam byť chyby):

if getpixel(c.handle, 613, 442) = $FF0000 then n := 1;

Ďalšia vec je, že by si mal používať aj else, pretože takto porovnávaš niektoré pixle úplne zbytočne, čím strácaš rýchlosť.

Úplne najväčším zdržaním je volanie metódy getpixel. Normálne sa to robí tak, že si skopíruješ časť obrazovky do pamäte a zisťovanie farieb pixlov robíš v pamäti. Na to existuje v GDI metóda BitBlt, takže skús pogoogliť, či sa dá BitBlt volať nejako z Delphi.

to je pravda ale 55 pixelov je extremne male mnozstvo, ci by bol BitBlt na nejaky rozsah 4x55 alebo kolko tam potrebuje rychlejsi pochybujem. Ale tazko povedat jak to vo WinAPI microsofti "machri" dopackali, musi sa s tym pohrat. Teoreticky je GetPixel zalezitost max. 4-5 instrukcii (tych zvladne aj jedno jadro CPU zo 10 miliard za sekundu, ano kludne aj viac jak ma GHz ptz kazde jadro dnesnych CPU ma 3 paralelne ALU a adresne jednotky atd). Proste CPU toho zvladne 10 miliard, a akonahle je medzi tym nejaky MS medzikus, tak tych 10 miliard treba vydelit aspon cislom 100000 :D Ok uz som radsej ticho :)

55 pixlov je na volanie GetPixel veľa - BitBlt by som použil už asi pri piatich a pri desiatich určite. Najlepšie by bolo vyskúšať oba prístupy, pretože neviem povedať na sto percent, že to bude rýchlejšie, ale očakával by som podstatné zrýchlenie oproti používaniu GetPixel. Tá rýchlosť najviac závisí od grafickej karty a teda jej ovládača, a to packajú iní machri než z Microsoftu.

hej to je pravda nech skusi aj BitBlt (lebo Win nema obsah obrazovky v RAM tak to musi liezt cez vsetky vrstvy. To ma tiez furt vytacalo ze aplikacia musela vykreslovat obsah celeho okna nanovo len preto ze si uzivatel uprdol pri drzani mysi :D). Ale stejne sa clovek nestaci divit ze co tam ten Windows robi tak dlho na niekolko GHz CPU, ked napr. 100MB zdrojakov BIOSu prekladanych 10minut zbehne (POST) na stejnom CPU za 5 sekund a to sa CPU 90% casu flaka lebo caka na nejaky HW, tak to asi ta MS GetPixel funkcia musi mat 1MB v zdrojakoch alebo co :D No divim sa uz 20rokov, viem ze je to pomale ale uz sa nepamatam do akej miery je ktora konkretne funkcia pomala. Nech sa s tym pohra sam.

Pouzitelne?

{************************************************* ******************************
 *    Copy a Source BiMap into a TargetBitMap
 *    The TargetBitBap should a have a Frame of  X - Y   Pixels Size
 ************************************************** ****************************}
 
procedure  CreateBitmapFrame(SourceBMP,  TargetBMP :  TBitMap; FrameX, FrameY : Integer; FrameColor : TColor);
begin
 
     SourceBMP.SaveToFile('c:\t1.bmp');
 
     TargetBMP.Height := SourceBMP.Height + 2 * FrameY;
 
     TargetBMP.Width := SourceBMP.Width + 2 * FrameX;
 
 
   {************************************************* ***********************
   BOOL BitBlt(
      HDC hdcDest, // handle to destination DC
      int nXDest,  // x-coord of destination upper-left corner
      int nYDest,  // y-coord of destination upper-left corner
      int nWidth,  // width of destination rectangle
      int nHeight, // height of destination rectangle
      HDC hdcSrc,  // handle to source DC
      int nXSrc,   // x-coordinate of source upper-left corner
      int nYSrc,   // y-coordinate of source upper-left corner
      DWORD dwRop  // raster operation code
    );
    ************************************************** **********************}
 
 
     BitBlt(TargetBMP.Handle, FrameX, FrameY, SourceBMP.Width, SourceBMP.Height, SourceBMP.Handle, 0,  0, SRCCOPY);
 
 
     TargetBMP.SaveToFile('c:\t2.bmp');
end;

Este mozes radsej pouzit GetDC(0) namiesto toho GetWindowsDC to je na cely screen zbytocne. Napr. nieco take (neskusal som to v delphi ptz nerobim v delphi, toto su priamo WinAPI funkcie ktore sami o sebe musia fungovat vsade, http://msdn.microsoft.com/en-us/library/aa921543.a spx , http://msdn.microsoft.com/en-us/library/aa928105.a spx)

var
  dc: HDC;
  n: integer;
begin
  dc := GetDc(0);
  if(GetPixel(dc, 423, 300) = $FF0000) n:=1;
  ...
  ReleaseDc(0, dc);
end;

P.S> je to aj omnoho optimalnejsie ptz nemusis konvertovat nic na stringy ale porovnavas priamo hex hodnotu.

A je nějaký důvod, abys to zjištění pixelu dělal tak, jak to děláš?
Děláš to naprosto neefektivně. Požádáš si o ukazatel na Canvas, pak si přečteš jeden pixel, celé to uvolníš a abys načetl další pixel, tak celý proces takto opakuješ.

Představ si, že chceš smontovat poličku se 4 šroubky. Určitě to nebudeš dělat tak, že si zajdeš do dílny pro nářadí, připravíš si jednu díru a nářadí zase uklidíš do dílny. Pro další díry budeš tento neefektivní postup opakovat.

Princip, jakým to předělej:
na začátku provedeš žádost o DC a přiřadím canvas
pak budeš načítat pixely
na konci uvolníš DC

Nebude docházet je zdržování při lokaci a dealokaci handle na canvas obrazovky.

Prepsal jsem to:
1. Na zacatku Handle
2. Pomoci Case=Proveruji se jenom dve podminky.

Presto je rychlost prekreslovani asi 14FPS.

procedure TForm1.Timer3Timer(Sender: TObject);
var
  c:TCanvas;
begin
  c:=TCanvas.create;
  c.handle:=GetWindowDC(GetDesktopWindow);
  case n of
    0	: begin
        if (ColorToHTMLHex(getpixel(c.handle,	613	,	441	)))='FF0000' then n:=	2	;
    end;
    2	: begin
        if (ColorToHTMLHex(getpixel(c.handle,	613	,	442	)))='FF0000' then n:=	0	;
        if (ColorToHTMLHex(getpixel(c.handle,	612	,	440	)))='FF0000' then n:=	4	;
    end;
    4	: begin
        if (ColorToHTMLHex(getpixel(c.handle,	613	,	441	)))='FF0000' then n:=	2	;
        if (ColorToHTMLHex(getpixel(c.handle,612	,	439	)))='FF0000' then n:=	6	;
    end;
    6	: begin
        if (ColorToHTMLHex(getpixel(c.handle,	612	,	440	)))='FF0000' then n:=	4	;
        if (ColorToHTMLHex(getpixel(c.handle,611	,	438	)))='FF0000' then n:=	7	;
    end;
    7	: begin
        if (ColorToHTMLHex(getpixel(c.handle,	612	,	439	)))='FF0000' then n:=	6	;
        if (ColorToHTMLHex(getpixel(c.handle,611	,	437	)))='FF0000' then n:=	9	;
    end;
    9	: begin
        if (ColorToHTMLHex(getpixel(c.handle,	611	,	438	)))='FF0000' then n:=	7	;
        if (ColorToHTMLHex(getpixel(c.handle,611	,	436	)))='FF0000' then n:=	11	;
    end;
    11	: begin
          if (ColorToHTMLHex(getpixel(c.handle,	611	,	437	)))='FF0000' then n:=	9	;
          if (ColorToHTMLHex(getpixel(c.handle,	611	,	435	)))='FF0000' then n:=	13	;
    end;
    13	: begin
          if (ColorToHTMLHex(getpixel(c.handle ,	611	,	436	)))='FF0000' then n:=	11	;
          if (ColorToHTMLHex(getpixel(c.handle,	611	,	434	)))='FF0000' then n:=	15	;
    end;
    15	: begin
          if (ColorToHTMLHex(getpixel(c.handle,	611	,	435	)))='FF0000' then n:=	13	;
          if (ColorToHTMLHex(getpixel(c.handle,	611	,	433	)))='FF0000' then n:=	17	;
    end;
    17	: begin
          if (ColorToHTMLHex(getpixel(c.handle,	611	,	434	)))='FF0000' then n:=	15	;
          if (ColorToHTMLHex(getpixel(c.handle,611	,	432	)))='FF0000' then n:=	19	;
    end;
    19	: begin
          if (ColorToHTMLHex(getpixel(c.handle,	611	,	433	)))='FF0000' then n:=	17	;
          if (ColorToHTMLHex(getpixel(c.handle,611	,	431	)))='FF0000' then n:=	20	;
    end;
    20	: begin
          if (ColorToHTMLHex(getpixel(c.handle,	611	,	432	)))='FF0000' then n:=	19	;
          if (ColorToHTMLHex(getpixel(c.handle,612	,	430	)))='FF0000' then n:=	22	;
    end;
    22	: begin
          if (ColorToHTMLHex(getpixel(c.handle,	611	,	431	)))='FF0000' then n:=	20	;
          if (ColorToHTMLHex(getpixel(c.handle,612	,	429	)))='FF0000' then n:=	24	;
.
.
.
.
.
.
.

    end;
    98	: begin
          if (ColorToHTMLHex(getpixel(c.handle,	639	,	439	)))='FF0000' then n:=	96	;
          if (ColorToHTMLHex(getpixel(c.handle,638	,	441	)))='FF0000' then n:=	100	;
    end;
    100	: begin
          if (ColorToHTMLHex(getpixel(c.handle,	639	,	440	)))='FF0000' then n:=	98	;
    end;
  end;
  c.free;
  label12.caption:=inttostr(n);

end;

Nikde v tom tvem kodu nevidim na konci ReleaseDC. Znamena to, ze za chvili to padne na nedostatek prostredku.
S tim presunem alokovani a uvolneni jsem to myslel tak, ze to das na zacatek testu, pak nechas jet ten tvuj timer, budes nacitat pixely a az na uplnem konci pak uvolnis DC.

Tim, co jsi provedl sis vubec nepomohl, protoze delas uplne to same, co predtim.
Navic, kde mas definovane "n", aby case vedel, kam ma jit?

Zkus se trosku zamyslet nad tim, co vlastne chces delat a co dela kod, ktery napises.

Verdikt:
Používám Windows 7. Nastavil jsem hloubku barev systému na 16bitů a přepl motiv z Windows 7 na Základní=odstranění všech těch průhlednopstí. Nyní není problém ani 5500/s brát canvas obrazovky, hledat bod a určovat jeho barvu.

Pokud budete programovat v systémech Windows Vista a vyšších, vypněte si Motiv (přepnout na Základní=styl Windwos98).

Zpět do poradny Odpovědět na původní otázku Nahoru