DBR Delphi-Ecke

// Wenn man bei einem Bitmap mit 8 Bit Farbtiefe die Farbe eines Punktes
// auslesen will, hat man mehrere Möglichkeiten. Über die Eigenschaft
// Canvas.Pixels[x,y] geht das verhältnismäßig langsam. Die Funktion
// GetPixel(HDC,x,y) ist auch nur unwesentlich schneller. Ein Stück weit
// flinker funktioniert das mit der Eigenschaft ScanLine[Row]. Sie finden
// hier zwei Varianten dafür. Wenn Sie nur eine der beiden in Ihrem Programm
// einsetzen, entfällt natürlich "overload".

// Getestet mit D4 unter WinME

// Variante 1 
function GetPix(Bild: TBitmap; x, y: integer): TColor; overload; 
var 
  pe: tagPALETTEENTRY; 
begin 
  GetPaletteEntries(Bild.Palette, PByteArray(Bild.Scanline[y])[x], 1, pe); 
  result := rgb(pe.peRed, pe.peGreen, pe.peBlue); 
end; 
 
// Variante 2 
function GetPix(Pl: HPalette; x: uint): TColor; overload; 
var 
  pe: tagPALETTEENTRY; 
begin 
  GetPaletteEntries(pl, x, 1, pe); 
  result := rgb(pe.peRed, pe.peGreen, pe.peBlue); 
end; 
 
// --- Beispielaufrufe --- 
 
var 
  is8bit: boolean; 
 
procedure TForm1.FormCreate(Sender: TObject); 
begin 
  Image1.Picture.bitmap.loadfromfile('d:\bilder\corel001-8.bmp'); 
  is8bit := Image1.Picture.bitmap.pixelformat = pf8bit; 
end; 
 
// Variante 1 
procedure TForm1.Image1MouseDown(Sender: TObject; Button: TMouseButton; 
  Shift: TShiftState; X, Y: Integer); 
begin 
  if is8bit then // <-- Zeile nur bei Bedarf 
    Label1.Caption := ColorToString(GetPix(Image1.Picture.bitmap, x, y)); 
end; 
 
// oder falls man sowieso irgendwie mit "Scanline" arbeitet, 
// dann Variante 2 
procedure TForm1.Button7Click(Sender: TObject); 
var 
  x, y: integer; 
  p: PBytearray; 
begin 
  if is8bit then begin 
    y := 10; // z.B. 
    x := 5; // z.B. 
    p := Image1.Picture.bitmap.scanline[y]; 
    Panel1.color := GetPix(Image1.Picture.bitmap.palette, p[x]); 
  end; 
end;