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… nový
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… nový
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… nový
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… nový
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é… nový
los 22.09.2011 21:04
 los

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;

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.

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;

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