Wie oft kommt eine Farbe in einer Fläche vor

[sniper_w]

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.