Delphi-PRAXiS
Seite 2 von 2     12   

Delphi-PRAXiS (https://www.delphipraxis.net/forum.php)
-   Multimedia (https://www.delphipraxis.net/16-multimedia/)
-   -   Delphi 2-Farben Bmp einlesen und im Array speichern (https://www.delphipraxis.net/141094-2-farben-bmp-einlesen-und-im-array-speichern.html)

Namenloser 5. Okt 2009 09:58

Re: 2-Farben Bmp einlesen und im Array speichern
 
Hier mal eine Klasse von mir, die den Zugriff auf ein 2D-Boolean-Array kapselt (hab sie eben auf die Schnelle noch angepasst, hoffe, dass keine Fehler drin sind). Vielleicht kannst du ja was damit anfangen:
Delphi-Quellcode:
type
  TBoolMap = class
  private
    FData: packed array of Boolean;
    FWidth, FHeight: integer;
    procedure SetHeight(const Value: integer);
    procedure SetWidth(const Value: integer);
    function GetPixelPtr(X,Y: integer): PBoolean;
    function GetPixel(X,Y: integer): Boolean;
  public
    property Width: integer read FWidth write SetWidth;
    property Height: integer read FHeight write SetHeight;
    procedure LoadFromBitmap(BMP: TBitmap32);
    procedure SetSize(AWidth, AHeight: integer);
    property PixelPtr[X,Y: integer]: PBoolean read GetPixelPtr;
    property Pixel[X,Y: integer]: Boolean read GetPixel;
  end;

implementation

{ TBoolMap }
procedure TBoolMap.LoadFromBitmap(BMP: TBitmap);
var
  SourcePtr: PColor;
  StopPtr: PColor;
  TargetPtr: PBoolean;
begin
  SetSize(BMP.Width,BMP.Height);
  BMP.PixelFormat := pf32Bit;
  TargetPtr := PixelPtr(0,0);
  SourcePtr := BMP.Scanline[0];
  StopPtr := BMP.Scanline[BMP.Height-1];
  inc(StopPtr, Bmp.Width-1);
  While integer(SourcePtr) <= integer(StopPtr) do
  begin
    TargetPtr^ := (SourcePtr^ and $00FFFFFF) = $00000000;
    inc(TargetPtr);
    inc(SourcePtr);
  end;
end;

function TBoolMap.GetPixelPtr(X, Y: integer): PBoolean;
begin
  Result := @FData[Y * Width + X];
end;

function TBoolMap.GetPixel(X, Y: integer): Boolean;
begin
  Result := GetPixelPtr(X,Y)^;
end;

procedure TBoolMap.SetHeight(const Value: integer);
begin
  FHeight := Value;
  SetLength(FData, FWidth*FHeight);
end;

procedure TBoolMap.SetSize(AWidth, AHeight: integer);
begin
  FWidth := AWidth;
  FHeight := AHeight;
  SetLength(FData, FWidth*FHeight);
end;

procedure TBoolMap.SetWidth(const Value: integer);
begin
  FWidth := Value;
  SetLength(FData, FWidth*FHeight);
end;


Alle Zeitangaben in WEZ +1. Es ist jetzt 09:47 Uhr.
Seite 2 von 2     12   

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