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
 
endeffects

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

Aus einem TBitMap eine "ImageMap" erstellen

  Alt 25. Mai 2005, 12: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
 


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 03:42 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