AGB  ·  Datenschutz  ·  Impressum  







Anmelden
Nützliche Links
Registrieren
Zurück Delphi-PRAXiS Code-Bibliothek Library: Grafik / Sound / Multimedia Delphi Scanning Boundary alias TurboFloh ;)

Scanning Boundary alias TurboFloh ;)

Ein Thema von FastJack2 · begonnen am 14. Dez 2004
Antwort Antwort
Benutzerbild von FastJack2
FastJack2

Registriert seit: 22. Mär 2004
Ort: Lübeck
54 Beiträge
 
Delphi 7 Enterprise
 
#1

Scanning Boundary alias TurboFloh ;)

  Alt 14. Dez 2004, 14:58
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
wo unrecht zu recht wird, wird widerstand zur pflicht ! (c) '98 - WoF board
  Mit Zitat antworten Zitat
Themen-Optionen Thema durchsuchen
Thema durchsuchen:

Erweiterte Suche
Ansicht

Forumregeln

Es ist dir nicht erlaubt, neue Themen zu verfassen.
Es ist dir nicht erlaubt, auf Beiträge zu antworten.
Es ist dir nicht erlaubt, Anhänge hochzuladen.
Es ist dir nicht erlaubt, deine Beiträge zu bearbeiten.

BB-Code ist an.
Smileys sind an.
[IMG] Code ist an.
HTML-Code ist aus.
Trackbacks are an
Pingbacks are an
Refbacks are aus

Gehe zu:

Impressum · AGB · Datenschutz · Nach oben
Alle Zeitangaben in WEZ +1. Es ist jetzt 10:53 Uhr.
Powered by vBulletin® Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
LinkBacks Enabled by vBSEO © 2011, Crawlability, Inc.
Delphi-PRAXiS (c) 2002 - 2023 by Daniel R. Wolf, 2024 by Thomas Breitkreuz