Hallo,

ich habe eine x-beliebige Fläche (auf dem Desktop). z.B. 200x50.

Ich habe eine Prozedur, mir der ich die Farbe auf dem Deksopt ermitteln kann (x,y).

Ich möchte nun ermitteln, welche Farbe in einer Fläche (s. oben) am häufigsten vor kommt.

Ich habe es nun so gemacht, dass mein Programm die Farbe von jedem Pixel in der Fläche in einen String umwandelt und diesen in eine Liste einträgt. Danach gucke ich, welcher String am häufigsten in der Liste steht.

Das Problem ist nur, dass er sich tot rechnet. Ist ja auch kein Wunder. Allein bei der Fläche von 200x50 sind in der Stringlist 10.000 Einträge drin.

Gibt es eine schnellere Methode, welche nur wenige Sekunden dauert?

Gruß
Sascha

Es gibt auch Methoden die einige Teile EINER Sekunde brauchen.
Es ist mir schwer das zu erklären, aber ich werde versuchen, ein Beispiel zu machen, und dann melde ich mich wieder.

Ich hab das wie folgt gelösst:

zusammenfalten · markieren

Delphi-Quellcode:

var
  Form1: TForm1;
  Farbarray : array[0..$FFFFFF] of integer;

implementation

{$R *.dfm}

function tform1.zaehlefarben(worin : Timage) : tcolor;
var
  i,i2 : integer;
begin
  for i := 0 to high(farbarray) do farbarray[i] := 0; //alles auf 0 setzen
  for i := 0 to worin.height do for i2 := 0 to worin.width do inc(Farbarray[worin.Canvas.Pixels[i,i2]]); //pixel f. pixel durchgehen und wert im array incrementieren
  result := farbarray[0]; //initialisieren
  for i := 0 to high(farbarray)-1 do if Farbarray[i] < Farbarray[i+1] then result := i+1; //welche zahl ist am grössten?
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  showmessage(ColorToString(zaehlefarben(image1)));
end;

end.

Ein kleines Problem hat die Sache aber, was wenn 2 Farben zufällig gleichoft vorkommen?

Danke, ich werde es mal ausprobieren.

Wenn 2 oder mehrere Farben gleich oft vorkommen ist es nicht so schlimm, da es für meine Zwecke reichen müsste.

Gruß
Sascha

zusammenfalten · markieren

Delphi-Quellcode:

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtDlgs, StdCtrls, ExtCtrls;

type
  PbinNode = ^TbinNode;

  TbinNode = packed record
    Color: TColor;
    Number:integer;
    left_child : PbinNode;
    right_child : PbinNode;
    parent : PbinNode;
  end;

  TForm1 = class(TForm)
    Button1: TButton;
    OpenPictureDialog1: TOpenPictureDialog;
    Button2: TButton;
    Image1: TImage;
    procedure Button1Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure Button2Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
    pic : tbitmap;
  end;

var
  Form1: TForm1;
  loaded_ : boolean = false;

  count : integer = 0;// how many diff. colors

  WordList : TStringList; // must be cleared before use of TreePrint procedure
                                // it is automatic created and destroyed..

  max_occurance: integer=0; // the most repeated color in the list - how many times

  Tree : Pbinnode = nil; // our binary tree

  THECOLOR : TColor; // <<<<------ our most repeated color

function FindNode( p : Pbinnode; _color_ : tcolor; var Node:pbinnode ):boolean;
function AddNode( p : Pbinnode; _color_ : tcolor; parent_ : Pbinnode = nil):PbinNode;
procedure TreePrint( p : PbinNode);

implementation

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);
begin
 if OpenPictureDialog1.Execute then
 begin
  if OpenPictureDialog1.FileName<>'' then
   image1.Picture.LoadFromFile(OpenPictureDialog1.FileName);
    loaded_ := true;
    Repaint;
 end;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
 pic := TBitmap.Create;
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
 pic.Free();
end;

procedure TForm1.Button2Click(Sender: TObject);
 var x,y : integer;
begin//
  for x := 1to Image1.Picture.Width-1 do
        for y:=1 to Image1.Picture.Height-1 do
           Tree := AddNode(Tree,Image1.Picture.Bitmap.Canvas.Pixels[x,y]);
  Color := THECOLOR;
  Application.MessageBox(Pchar(ColorToString(THECOLOR)),'The Color')
end;

procedure TreePrint( p : PbinNode); // 0,1,2,3,4,5,6....
begin
  if (p <> nil) then
  begin
    TreePrint(p^.left_child);
    WordList.Add(ColorToString(p^.Color));
    TreePrint(p^.right_child);
  end;
end;

function FindNode( p : Pbinnode; _color_ : tcolor; var Node:pbinnode ):boolean; // recursive
begin
 if p = nil then
 begin // nothing found
  Result := False;
  Node := nil;
 end

        else
         // we found it
         if _color_ = p^.Color then
                begin
                 Node := p;
                 Result := true;
               end
        else
        // look on left
        if (_color_ < p^.Color) then Result := FindNode(p^.left_child, _color_, Node )

        else
        // look on right
        Result := FindNode(p^.right_child, _color_, Node);
end;

function AddNode( p : Pbinnode; _color_ : tcolor; parent_ : Pbinnode = nil):PbinNode;
begin
  if p = nil then
  begin
    New(p);
    p^.Color := _color_;
    p^.Number := 1;
    p^.left_child := nil;
    p^.right_child := nil;
    p^.parent := parent_;
    inc(count);
  end

  else
        if (_color_ = p^.Color) then
                 Inc(p^.Number)// nothing happens
  else
        if (_color_ < p^.Color) then
                 p^.left_child := AddNode(p^.left_child, _color_, p)
  else
         p^.right_child := AddNode(p^.right_child,_color_, p);

    // check for max occurance
    if max_occurance<p^.Number then
        begin
         max_occurance := p^.Number;
         THECOLOR := p^.Color;
        end;

  result := p;
end;

initialization

 WordList := TStringList.Create();
 WordList.Clear(); // there is no real need for this but never the less

finalization

 WordList.Free();

 FreeMem(Tree);

end.

Das Code ist SEHR SCHNELL, das kannst selber auspr.
Es wird manchmal "clBlack" als DIE Farbe gefunden, aber sonst ist es gut, es funct.

//EDIT

Es geht jetzt einwandfrei.Hmm... nur für das erstes Bild, sonst musst du das Program neu starten.

danke,

aber das Problem bei deinem Code, und auch dem von KLS ist, dass ich ein Image brauche. Ich habe aber kein Image zur Verfügung und wenn ich jedes Mal ein Screenshot von der Fläche machen müsste, wäre das zu speicheraufwendig.


EDIT:

Aber ich glaube, das ist die einzige und schnellste Möglichkeit. Danke

Zitat von Sascha L:

danke,

aber das Problem bei deinem Code, und auch dem von KLS ist, dass ich ein Image brauche. Ich habe aber kein Image zur Verfügung und wenn ich jedes Mal ein Screenshot von der Fläche machen müsste, wäre das zu speicheraufwendig.

Wie willst du die Farben zählen, wenn du keine Farben zum Zählen hast?
Ich glaube anders als mit einem Screenshot wirds wohl nicht gehen.

Ich habe eine Funktion, mit der ich die Farbe von einem Pixel auf dem Desktop ermitteln kann (habe ich auch im 1. Post erwähnt).

Die Funktion:

zusammenfalten · markieren

Delphi-Quellcode:

function DesktopColor(const X, Y: Integer): TColor;
var
  c: TCanvas;
begin
  c := TCanvas.Create;
  try
    c.Handle := GetWindowDC(GetDesktopWindow);
    Result := GetPixel(c.Handle, X, Y);
  finally
    c.Free;
  end;
end;

Du musst zum einen die Suchmethoden so umschreiben, dass sie kein bild mehr brachen, sondern nur das canvas, und dann kannst du deine Methode relativ easy umschreiben, dass sie nicht nur den Pixel gibt, sondern das komplette Canvas.

Sag bloß, du hast diese Funktion für jeden Pixel jedes mal aufgerufen ?
kein Wunder, wenn das dann so langsam geht ...

Danke noch mal, ich werde es nun mit einem Screenshot machen.