Neregistrovaný Přihlásit Registrovat

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;
Jsou zobrazeny jen nové odpovědi. Zobrazit všechny
Předmět Autor Datum
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
Nejak takto ?: var DC: HDC; Canvas: TCanvas; begin Canvas:=TCanvas.Create; try DC:=GetWindowDC(GetD… poslední
pme 23.09.2011 12:04
 pme

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.

Napada. Postup, ktery jsem popsal.
Proc pro kazde cteni pixelu alokujes a dealokujes handle na obrazovku? Proc to neudelas jednou na zacatku, pak si cti, co potrebujes, je jedno jestli v cyklu nebo v timmeru a az na konci DC dealokuj.
Pak nebudes mit zadne zdrzeni ani zadne vytizeni procesoru.

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;

Nejak takto ?:

var DC: HDC;
    Canvas: TCanvas;
begin
  Canvas:=TCanvas.Create;
  try
    DC:=GetWindowDC(GetDesktopWindow);
    try
      Canvas.Handle:=DC;
      //
      // teraz si skúmaj čo chceš...



    finally
      Canvas.Handle:=0;
      ReleaseDC(0,DC):
    end;
  finally
    Canvas.Free;
  end;
end;

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