// Querverweis: eingefärbte Raster-Bitmaps erstellen
// oder auch:   Zeitungs-Raster nachempfinden
 

// Wenn man auf ein Desktop-Icon klickt, wird dieses mit einem Raster
// überblendet. Der Spaß funktioniert aber auch beim Zeichnen
// von einer Bitmap:
 

Original feines Raster grobes Raster


// Variante 1:
// Getestet mit D4 unter WinME

uses commctrl; 
 
procedure DrawBlendingBitmap(dc: HDC; b: TBitmap; x, y: integer; u: uint); 
var 
  m: TBitmap; 
  i: TImagelist; 
begin 
  m := TBitmap.create; 
  m.width := b.width; 
  m.height := b.height; 
  m.canvas.brush.color := 0; 
  m.canvas.fillrect(m.canvas.cliprect); 
  i := TImagelist.create(nil); 
  i.width := b.width; 
  i.height := b.height; 
  i.add(b, m); 
  ImageList_Draw(i.handle, 0, dc, x, y, u); 
  i.free; 
  m.free; 
end; 
 
// Ein Bitmap wird mit einem feinmaschigen 
// Raster überblendet. 
procedure TForm1.Button1Click(Sender: TObject); 
var 
  bmp: TBitmap; 
  links, oben: integer; 
begin 
  links := 10; 
  oben := 5; 
  bmp := TBitmap.create; 
  bmp.loadfromfile('d:\dbr\frau.bmp'); 
  DrawBlendingBitmap(canvas.handle, bmp, links, oben, ILD_BLEND); 
  bmp.free; 
end; 
 
// Ein Bitmap wird mit einem groben Raster überblendet. 
procedure TForm1.Button2Click(Sender: TObject); 
var 
  bmp: TBitmap; 
  links, oben: integer; 
begin 
  links := 10; 
  oben := 5; 
  bmp := TBitmap.create; 
  bmp.loadfromfile('d:\dbr\frau.bmp'); 
  DrawBlendingBitmap(canvas.handle, bmp, links, oben, ILD_FOCUS); 
  bmp.free; 
end;
 

// Variante 2:
// Getestet mit D4 unter XP

//
Um flexibler und nicht von der Systemfarbe abhängig zu sein, hier eine
// andere Möglichkeit:

type 
  art = 1..5; 
 
procedure punkte(src, dst: TBitmap; farbe: TColor; wie: art); 
var x, y, b3: integer; 
  p: PBytearray; 
var r, g, b: byte; 
begin 
  dst.pixelformat := pf24bit; 
  dst.width := src.width; 
  dst.height := src.height; 
  dst.canvas.draw(0, 0, src); 
  b3 := dst.width * 3; 
  farbe := colortorgb(farbe); 
  r := getrvalue(farbe); 
  g := getgvalue(farbe); 
  b := getbvalue(farbe); 
  for y := 0 to dst.height - 1 do begin 
    p := dst.scanline[y]; 
    x := 0; 
    while x < b3 do begin 
      if (wie = 1) and (odd(y xor x)) 
        or (wie = 2) and (odd(y and x)) 
        or (wie = 3) and (odd(y or x)) 
        or (wie = 4) and (odd(y * 2 or x)) 
        or (wie = 5) and (odd(y or x * 2)) 
        then begin 
        p[x] := b; 
        p[x + 1] := g; 
        p[x + 2] := r; 
      end; 
      inc(x, 3); 
    end; 
  end; 
end; 
 
// Beispielaufruf 
 
procedure TForm1.Button1Click(Sender: TObject); 
var bmp: TBitmap; 
  x: integer; 
begin 
  bmp := TBitmap.create; 
  for x := 1 to 5 do begin 
    punkte(Image1.Picture.Bitmap, bmp, clnavy, x); 
    canvas.draw(image1.left + (image1.width + 10) * x, image1.top, bmp); 
  end; 
  bmp.free; 
end;





 

Zugriffe seit 6.9.2001 auf Delphi-Ecke