AGB  ·  Datenschutz  ·  Impressum  







Anmelden
Nützliche Links
Registrieren
Zurück Delphi-PRAXiS Sprachen und Entwicklungsumgebungen Object-Pascal / Delphi-Language Delphi Aus einem TBitMap eine "ImageMap" erstellen
Thema durchsuchen
Ansicht
Themen-Optionen

Aus einem TBitMap eine "ImageMap" erstellen

Offene Frage von "endeffects"
Ein Thema von endeffects · begonnen am 25. Mai 2005 · letzter Beitrag vom 25. Mai 2005
Antwort Antwort
endeffects

Registriert seit: 27. Jun 2004
450 Beiträge
 
#1

Aus einem TBitMap eine "ImageMap" erstellen

  Alt 25. Mai 2005, 13:09
Hallo,

ich versuche noch immer aus einem TBitmap eine Karte
zu erstellen um so benachbarte Pixel einer Farbe
auf einem anderen BitMap auszugeben.
Das Bild ist lediglich schwarz/weiß.

Um das Ganze zu veranschaulichen hat mir Jemand
vor einer Weile folgendes Konsolen Programm geschickt:

Delphi-Quellcode:
program Project1;

{$APPTYPE CONSOLE}

uses
  SysUtils;

const
  N = 5;
type
  TCoordinate = 1..N;
  TColour = '0'..'1';
  TImage = array [TCoordinate, TCoordinate] of TColour;

procedure Dump(const Image: TImage; const XX, YY: TCoordinate);
var X, Y: TCoordinate;
begin
  for X:=Low(X) to High(X)
  do begin
    for Y:=Low(Y) to High(Y)
    do begin
      if (X=XX) and (Y=YY)
      then Write('*')
      else Write(Image[X, Y]);
    end;
    WriteLn;
  end;
  WriteLn;
end;

procedure Fill
 (var Image: TImage;
  const X, Y: TCoordinate;
  const Colour: TColour);
var
  OldColour: TColour;
begin
  OldColour:=Image[X, Y];
  Image[X, Y]:=Colour;

  Dump(Image, X, Y);

  { Look left }
  if (Low(X)<X) and (Image[Pred(X), Y]=OldColour)
  then Fill(Image, Pred(X), Y, Colour);

  { Look right }
  if (X<High(X)) and (Image[Succ(X), Y]=OldColour)
  then Fill(Image, Succ(X), Y, Colour);

  { Look up }
  if (Low(Y)<Y) and (Image[X, Pred(Y)]=OldColour)
  then Fill(Image, X, Pred(Y), Colour);

  { Look down }
  if (Y<High(Y)) and (Image[X, Succ(Y)]=OldColour)
  then Fill(Image, X, Succ(Y), Colour);
end;

const
  Image : TImage
        = (('1', '1', '1', '0', '0'),
           ('1', '0', '0', '0', '1'),
           ('1', '0', '1', '1', '0'),
           ('0', '0', '1', '0', '0'),
           ('0', '1', '1', '0', '1')
          );
var
  NewImage: TImage;
begin
  NewImage:=Image;
  Fill(NewImage, (Pred(N+2)) div 2, (Pred(N+2)) div 2, '0');
end.
Das Alles möchte ich nun auf richtige Bitmaps projezieren.
Bisher sieht mein Versuch wie folgt aus, leider endet dieser
in einem Stack-Overflow in der Methode Fill();.
Hat Jemand vielleicht eine ruhige Minute und könnte sich das anschauen?

Delphi-Quellcode:
unit Unit1;

interface

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

type
  TCoordinate = 1..300;
  TForm1 = class(TForm)
    Image1: TImage;
    Image2: TImage;
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
  private
    { Private-Deklarationen }
    CacheBitmap: TBitmap;
    MyImageMap: array [TCoordinate, TCoordinate] of integer;
    procedure Fill(X, Y: TCoordinate; Colour: integer);
    procedure BuildImageMap;
  public
    { Public-Deklarationen }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.BuildImageMap;
var
  TempBitmap: TBitmap;
  x, y: Integer;
  P: PRGBQuad; // definiert in Windows.pas
begin
  TempBitmap:= TBitMap.create;
  //MyImageMap:= MyImageMap;
  try
    TempBitmap.Assign(Image1.Picture);
    TempBitmap.PixelFormat:= pf32bit;

    for y:= 0 to TempBitmap.Height-1 do
    begin
      P:= TempBitmap.ScanLine[y];
      for x:= 0 to TempBitmap.Width-1 do
      begin
        if (P^.rgbRed = 0) and (P^.rgbGreen = 0) and (P^.rgbBlue = 0) then
          MyImageMap[X, Y]:= 1
        else
          MyImageMap[X, Y]:= 0;
      end;
    end;
  finally
    TempBitmap.Free;
  end;
end;

procedure TForm1.Fill(X, Y: TCoordinate; Colour: integer);
var OldColour: Integer;
begin
  OldColour:=MyImageMap[X, Y];
  MyImageMap[X, Y]:=Colour;

  //Dump(Image, X, Y);

  { Look left }
  if (Low(X)<X) and (MyImageMap[Pred(X), Y]=OldColour)
  then Fill(Pred(X), Y, Colour);

  { Look right }
  if (X<High(X)) and (MyImageMap[Succ(X), Y]=OldColour)
  then Fill(Succ(X), Y, Colour);

  { Look up }
  if (Low(Y)<Y) and (MyImageMap[X, Pred(Y)]=OldColour)
  then Fill(X, Pred(Y), Colour);

  { Look down }
  if (Y<High(Y)) and (MyImageMap[X, Succ(Y)]=OldColour)
  then Fill(X, Succ(Y), Colour);
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  BuildImageMap;
  Fill((Pred(300+2)) div 2, (Pred(300+2)) div 2, 0);
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  CacheBitmap:= TBitMap.create;
  CacheBitmap.PixelFormat:= pf32bit;
end;

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

end.
MfG
  Mit Zitat antworten Zitat
Benutzerbild von jim_raynor
jim_raynor

Registriert seit: 17. Okt 2004
Ort: Berlin
1.251 Beiträge
 
Delphi 5 Standard
 
#2

Re: Aus einem TBitMap eine "ImageMap" erstellen

  Alt 25. Mai 2005, 14:16
Dein X und Y sind vom Typ Integer. Bei Low(X) gibt er dann -2.xxx.xxx.xxx aus, wodurch die Rekursion recht lange läuft. Genauso gibt High(X) 2.xxx.xxx.xxx aus. Du musst also entweder die Prüfung ändern, oder den Datentypen.
Christian Reich
Schaut euch mein X-COM Remake X-Force: Fight For Destiny ( http://www.xforce-online.de ) an.
  Mit Zitat antworten Zitat
endeffects

Registriert seit: 27. Jun 2004
450 Beiträge
 
#3

Re: Aus einem TBitMap eine "ImageMap" erstellen

  Alt 25. Mai 2005, 14:27
ich hatte den typ schon nachträglich auf TCoordinate geändert,
leider tritt der stack overflow noch immer auf.

Delphi-Quellcode:
type
  TCoordinate = 1..300;
  TForm1 = class(TForm)

...
procedure TForm1.Fill(X, Y: TCoordinate; Colour: integer);
begin
...
ich versteh auch nicht so wirklich woran das nun liegen könnte,
in dem konsolen programm funktioniert es ja auch und grundsätzlich
hab ich es ja 1:1 übernommen

ps: ich hab den code oben noch einmal aktualisiert
  Mit Zitat antworten Zitat
marabu

Registriert seit: 6. Apr 2005
10.109 Beiträge
 
#4

Re: Aus einem TBitMap eine "ImageMap" erstellen

  Alt 25. Mai 2005, 19:22
Zitat von endeffects:
Bisher sieht mein Versuch wie folgt aus, leider endet dieser
in einem Stack-Overflow in der Methode Fill();.
Hat Jemand vielleicht eine ruhige Minute und könnte sich das anschauen?
Der Ansatz über die Rekursion erfordert bei 300 x 300 Pixeln deutlich mehr Stackspeicher als die standardmäßigen 16KByte. Du solltest in den Linker-Optionen deines Projektes etwas spendabler sein. Irgendwann ist allerdings immer Schluss. Dann brauchst du einen intelligenteren Ansatz - ohne Rekursion.

Grüße vom marabu
  Mit Zitat antworten Zitat
Antwort Antwort


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 16:15 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