var 
  Original, Raster: TBitmap; 
 
procedure TForm1.FormCreate(Sender: TObject); 
begin 
  Original := TBitmap.create; 
  Raster := TBitmap.create; 
end; 
 
procedure TForm1.FormDestroy(Sender: TObject); 
begin 
  Raster.free; 
  Original.free; 
end; 
 
function Rastern(farbe: TColor; gerastert, vergroessern: boolean; 
  einfaerbung: single): boolean; 
var 
  p1, p2: PBytearray; 
  x, y, gr, br, r, g, b, d, r2, g2, b2: integer; 
  function a3(p: pointer): integer; stdcall; 
  asm 
    xor ecx,ecx 
    mov edx,p 
    mov cl,[edx] 
    mov eax,ecx 
    inc edx 
    mov cl,[edx] 
    add eax,ecx 
    inc edx 
    mov cl,[edx] 
    add eax,ecx 
    mov @result,eax 
  end; 
  function g255(i: integer): byte; stdcall; 
  asm 
    mov eax,i 
    cmp eax,$FF 
    jle @fertig 
    mov eax,$FF 
   @fertig: 
    mov @result,al 
  end; 
  procedure k0(i, j, k: pointer); stdcall; 
  asm 
    mov edx,i 
    mov ecx,[edx] 
    cmp ecx,0 
    jge @hinter_i 
    xor eax,eax 
    mov [edx],eax 
    mov edx,j 
    mov eax,[edx] 
    sub eax,ecx 
    mov [edx],eax 
    mov edx,k 
    mov eax,[edx] 
    sub eax,ecx 
    mov [edx],eax 
   @hinter_i: 
    mov edx,j 
    mov ecx,[edx] 
    cmp ecx,0 
    jge @hinter_j 
    xor eax,eax 
    mov [edx],eax 
    mov edx,i 
    mov eax,[edx] 
    sub eax,ecx 
    mov [edx],eax 
    mov edx,k 
    mov eax,[edx] 
    sub eax,ecx 
    mov [edx],eax 
   @hinter_j: 
    mov edx,k 
    mov ecx,[edx] 
    cmp ecx,0 
    jge @hinter_k 
    xor eax,eax 
    mov [edx],eax 
    mov edx,i 
    mov eax,[edx] 
    sub eax,ecx 
    mov [edx],eax 
    mov edx,j 
    mov eax,[edx] 
    sub eax,ecx 
    mov [edx],eax 
   @hinter_k: 
  end; 
  procedure anpassen; 
  begin 
    Raster.width := Original.width; 
    Raster.height := Original.height; 
  end; 
  procedure addieren; 
  begin 
    b2 := d + b; 
    g2 := d + g; 
    r2 := d + r; 
    k0(@b2, @g2, @r2); 
    p2[x] := g255(b2); 
    p2[x + 1] := g255(g2); 
    p2[x + 2] := g255(r2); 
  end; 
begin 
  result := false; 
  if (Original.width < 5) or 
    (Original.height < 5) then exit; 
  try 
    Original.pixelformat := pf24bit; 
    Raster.pixelformat := pf24bit; 
    if einfaerbung < 1 then einfaerbung := 1 else 
      if einfaerbung > 5 then einfaerbung := 5; 
    einfaerbung := abs(einfaerbung - 6); 
    einfaerbung := einfaerbung * einfaerbung / 6 + 1; 
    farbe := colortorgb(farbe); 
    r := getrvalue(farbe); 
    g := getgvalue(farbe); 
    b := getbvalue(farbe); 
    d := (r + g + b) div 3; 
    r := round((r - d) / einfaerbung); 
    g := round((g - d) / einfaerbung); 
    b := round((b - d) / einfaerbung); 
    gr := ord(vergroessern) * 2 - 1; 
    anpassen; 
    Raster.canvas.draw(0, 0, Original); 
    while frac((Original.width - 2) / 3) <> 0 do 
      Original.width := Original.width + gr; 
    while frac((Original.height - 2) / 3) <> 0 do 
      Original.height := Original.height + gr; 
    Original.canvas.stretchdraw(rect 
      (0, 0, Original.width, Original.height), Raster); 
    anpassen; 
    br := Original.width * 3; 
    for y := 0 to Original.height - 1 do begin 
      p1 := Original.ScanLine[y]; 
      p2 := Raster.ScanLine[y]; 
      x := 0; 
      while x < br do begin 
        if gerastert and ((x mod 9 = 6) 
          or (y mod 3 = 2)) 
          then zeromemory(@p2[x], 3) 
        else begin 
          d := a3(@p1[x]) div 3; 
          addieren; 
        end; 
        inc(x, 3); 
      end; 
    end; 
  except exit end; 
  result := true; 
end; 
 
// Beispielaufruf (siehe obige Abbildung) 
 
procedure TForm1.Button1Click(Sender: TObject); 
begin 
  Original.loadfromfile('d:\bilder\frau8.bmp'); 
  rastern(clyellow, true, true, 3.5); 
  canvas.draw(5, 5, Original); 
  canvas.draw(Raster.width + 10, 5, Raster); 
  rastern(clmaroon, true, true, 4); 
  canvas.draw(Raster.width * 2 + 15, 5, Raster); 
  rastern(clblue, true, true, 2.5); 
  canvas.draw(Raster.width * 3 + 20, 5, Raster); 
 { 
  // eine Reihe ohne Raster (nur eingefärbt) erzeugen: 
  rastern(clyellow, false, true, 3.5); 
  canvas.draw(Raster.width + 10, Raster.height + 10, Raster); 
  rastern(clmaroon, false, true, 4); 
  canvas.draw(Raster.width * 2 + 15, Raster.height + 10, Raster); 
  rastern(clblue, false, true, 2.5); 
  canvas.draw(Raster.width * 3 + 20, Raster.height + 10, Raster); 
 } 
end;