Scanning Boundary alias TurboFloh ;)

[FastJack2]

Hy all ;)

Hab grade mit nem Kollegen eine nette Unit zum Boundary-Scanning fertiggestellt.
brauchten das, um auf ner Weltkarte die koordinaten der einzelnen Länder für ne Internetseite herauszubekommen und hatten keine Lust das per Hand zu machen ;)
Die Funktion scanningBoundary läuft von den angegeben Koordinaten erstmal grade nach oben bis zur ersten anderen Farbe auf dem Canvas und dann entlang der Kante, bis es wieder an der Ausgansposition angekommen ist. (aktuelle Position wird durch ein geXORtes Pixel dargestellt)

Jedes mal wenn sich die Richtung ändert(order bei jedem Pixel falls vecFuncEveryPixel = true), wird die Prozedur "pVecFunc" aufgerufen, die zur Ausgabe der Points genutzt werden kann.

und nun genug gelabert... hier der Code... viel spass damit:

Delphi-Quellcode:

//////////////////////////////////////////////
//                                          //
//  TurboFloh (c) 2004 - FastJack2 & Roger  //
//  [url]http://fastjack2.homeip.net:88/[/url]         //
//                                          //
//////////////////////////////////////////////
//                                          //
//  fast boundary scanning method           //
//                                          //
//  code is totally free to use,            //
//  but this comment may not be removed     //
//  and has to be included in every kind    //
//  of redistribution or copy               //
//                                          //
//  also there is no kind of warranty       //
//  use this code on your own risk          //
//                                          //
//////////////////////////////////////////////

unit TurboFloh;

interface

uses
  Types,
  graphics;

type
  PCHANGEVECTORFUNC = procedure(location: TPoint);


procedure scanningBoundary(var Cancel: boolean; intX,intY: integer; const Canvas: TCanvas; EnableDraw: boolean = true; pVecFunc: PCHANGEVECTORFUNC = nil; vecFuncEveryPixel: boolean = false);


implementation

uses
  forms;

const
  //verctor array
  va: array [0..7] of TPoint = (
    (x: 0; y:-1),
    (x: 1; y:-1),
    (x: 1; y: 0),
    (x: 1; y: 1),
    (x: 0; y: 1),
    (x:-1; y: 1),
    (x:-1; y: 0),
    (x:-1; y:-1)
  );

procedure scanningBoundary(var Cancel: boolean; intX,intY: integer; const Canvas: TCanvas; EnableDraw: boolean = true; pVecFunc: PCHANGEVECTORFUNC = nil; vecFuncEveryPixel: boolean = false);
var
  v: integer;                    //derzeitiger vektor
  curr: TPoint;                  //derzeitige position
  start: TPoint;                 //startposition
  mycol: TColor;                 //farbe auf dem sich der punkt bewegt
  goright: boolean;              //control-var für scanrichtung
  oldvector: integer;            //letzter vektor
  procedure retrieveNextVector;
  //findet den nächsten vektor
  begin
    if EnableDraw then
      application.ProcessMessages;
    while not Cancel do
    begin
      //richtungsvektor initialisieren (nächster punkt in gebiet?)
      goright := (Canvas.Pixels[curr.X + va[v].X,curr.Y + va[v].Y] <> mycol);
      //vektorenkreislauf
      if goright then
        v := v + 1
      else
        v := v - 1;
      v := (v+8) mod 8;
      //punkt in vektorrichtung auf zugehörigkeit prüfen
      if goright then
      begin
        if Canvas.Pixels[curr.X + va[v].X,curr.Y + va[v].Y] = mycol then
          break;
      end
      else
      begin
        if (Canvas.Pixels[curr.X + va[v].X,curr.Y + va[v].Y] <> mycol) then
        begin
          //vektor zurücksetzen auf letzten gültigen
          v := (v + 1) mod 8;
          break;
        end;
      end;
    end;
    //ggf vecFunc aufrufen
    if (oldvector <> v) or vecFuncEveryPixel then
    begin
      if @pVecFunc <> nil then pVecFunc(curr);
      oldvector := v;
    end;
  end;
begin
  //initialisierung
  Cancel := false;
  curr.x := intX;
  curr.y := intY;
  mycol := Canvas.Pixels[curr.x,curr.y];
  v := 0;
  oldvector := v;
  //zum nächsten rand nach oben wandern
  while Canvas.Pixels[curr.X + va[v].X,curr.Y + va[v].Y] = mycol do
  begin
    curr.X := curr.X + va[v].X;
    curr.Y := curr.Y + va[v].Y;
  end;
  //startpunkt merken (am rand)
  start.x := curr.x;
  start.y := curr.y;
  retrieveNextVector;
  //falls vektorabweichung, funktion aufrufen und alten vektor speichern
  //aktuellen punkt setzen
  curr.x := curr.x + va[v].x;
  curr.y := curr.y + va[v].y;
  //punkt ausgeben
  Canvas.Pixels[curr.X,curr.Y] := Canvas.Pixels[curr.X,curr.Y] xor clwhite;
  //hauptschleife
  repeat
    retrieveNextVector;
    //auf abbruch oder ende prüfen
    Cancel := (start.x = (curr.X + va[v].X)) and (start.y = (curr.Y + va[v].Y));
    //alten punkt löschen
    Canvas.Pixels[curr.X,curr.Y] := Canvas.Pixels[curr.X,curr.Y] xor clwhite;
    //neuen punkt setzen
    curr.x := curr.x + va[v].x;
    curr.y := curr.y + va[v].y;
    //neuen punkt ausgeben
    Canvas.Pixels[curr.X,curr.Y] := Canvas.Pixels[curr.X,curr.Y] xor clwhite;
  until Cancel;
  //letzten punkt löschen
  Canvas.Pixels[curr.X,curr.Y] := Canvas.Pixels[curr.X,curr.Y] xor clwhite;
end;

end.

greetz
-FastJack2