// Querverweis:
ein Bitmap mit einem Raster überblenden
// P.S. 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; |