// Einer Bitmap wird eine scheinbare Wasserspiegelung angefügt. Dazu
// müssen ein paar einigermaßen senkrecht verlaufende Linien im Bild
// vorhanden sein, da sonst der Effekt nicht gut zu erkennen ist.


// Getestet mit D4 unter XP

procedure spiegeln 
  (Src, Dst: TBitmap; abstand, abdunkeln, streifen, Freq: Shortint); 
var 
  z, f: double; 
  hlp: TBitmap; 
  ph, pd: PBytearray; 
  dr, x, y, i, b3, hll, pls, v, h, d3: integer; 
  function rechnen(a, b: integer): byte; 
  asm 
  SUB  EAX, b 
  CMP  EAX, 255 
  JG   @MAX 
  CMP  EAX, 0 
  JGE  @OK 
  XOR  EAX, EAX 
  JMP  @OK 
@MAX: 
  MOV  EAX,255 
@OK: 
  MOV  @RESULT, AL 
  end; 
begin 
  abstand := abs(abstand); 
  randseed := 123456; 
  dst.width := src.width; 
  dr := src.height div 2; 
  dst.height := dr + src.height + abstand; 
  hlp := TBitmap.create; 
  hlp.width := src.width; 
  hlp.height := dr; 
  b3 := src.width * 3; 
  d3 := src.width div 3; 
  hlp.pixelformat := pf24bit; 
  dst.pixelformat := pf24bit; 
  SetStretchBltMode(hlp.canvas.handle, STRETCH_HALFTONE); 
  StretchBlt(hlp.canvas.handle, 0, 0, hlp.width, 
    hlp.height, src.canvas.handle, 0, src.height - 1, 
    src.width, -src.height, SRCCOPY); 
  z := 0.0; 
  f := Freq / 100; 
  for y := 0 to dr - 1 do begin 
    x := 0; 
    ph := hlp.scanline[y]; 
    pd := dst.scanline[y + src.height + abstand]; 
    i := trunc(sin(z) * 3) * 3; 
    hll := ord(i > random(2) + 2) * streifen; 
    v := random(d3) * 3; 
    h := (src.width - random(d3)) * 3; 
    while x < b3 do begin 
      if (x + i >= 0) and (i + x < b3) then begin 
        pls := ord(not ((x < v) or (x > h))) * hll; 
        pd[x] := rechnen(ph[x + i], abdunkeln - pls); 
        pd[x + 1] := rechnen(ph[x + 1 + i], abdunkeln - pls); 
        pd[x + 2] := rechnen(ph[x + 2 + i], abdunkeln - pls); 
      end else begin 
        pd[x] := rechnen(ph[x], abdunkeln); 
        pd[x + 1] := rechnen(ph[x + 1], abdunkeln); 
        pd[x + 2] := rechnen(ph[x + 2], abdunkeln); 
      end; 
      inc(x, 3); 
    end; 
    z := z + f; 
  end; 
  hlp.free; 
  Bitblt(dst.canvas.handle, 0, 0, dst.width, src.height, 
    src.canvas.handle, 0, 0, SRCCOPY); 
end; 
 
 
// Beispielaufruf 
 
procedure TForm1.Button1Click(Sender: TObject); 
var 
  bm: TBitmap; 
begin 
  bm := TBitmap.create; 
  spiegeln(Image1.picture.bitmap, bm, 0, 33, 26, 75); 
  canvas.draw(10, 10, bm); 
  bm.free; 
end;



 

Zugriffe seit 6.9.2001 auf Delphi-Ecke