Зернистость

unit Unit1;
 
interface
 
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs;
 
type
  TForm1 = class(TForm)
  private
    { Private declarations }
  public
    { Public declarations }
  end;
 
var
  Form1: TForm1;
  bmp: tbitmap;
dc: hdc;
 
implementation
 
{$R *.dfm}
procedure dither(var bitmap:tbitmap);
type
trgb = record
r,g,b: byte;
end;
argb = array[0..1] of trgb;
pargb = ^argb;
var x,y:integer;
p:pargb;
b:tbitmap;
begin
bitmap.pixelformat := pf24bit;
b:=tbitmap.create;
b.assign(bitmap);
for y:=0 to b.height-1 do
begin
p := b.scanline[y];
for x := 0 to b.width-1 do
begin
if (p[x].r>30)and(p[x].r<225) then p[x].r:=p[x].r-30+random(60);
if (p[x].g>30)and(p[x].g<225) then p[x].g:=p[x].g-30+random(60);
if (p[x].b>30)and(p[x].b<225) then p[x].b:=p[x].b-30+random(60);
end;
end;
bitmap.canvas.draw(0,0,b);
end;
begin
while true do begin
dither(bmp);
Sleep(500);
end;
end.

type
  trgb = packed record
    r,g,b: byte;
  end;

b:=tbitmap.create;

Unit Unit1;
 
Interface
 
Uses
  Windows,
  Messages,
  SysUtils,
  Classes,
  Graphics,
  Controls,
  Forms,
  Dialogs,
  ExtCtrls;
 
Type
  TForm1 = Class(TForm)
    Timer1: TTimer;
    Procedure FormCreate(Sender: TObject);
    Procedure FormDestroy(Sender: TObject);
    Procedure FormResize(Sender: TObject);
    Procedure FormPaint(Sender: TObject);
    Procedure Timer1Timer(Sender: TObject);
  Private
    FBackGround: TBitmap;
    FBackDither: TBitmap;
  End;
 
Var
  Form1: TForm1;
 
Implementation
 
{$R *.dfm}
 
Procedure Dither(ABitmap: TBitmap);
Const
  MAX_BYTE = 255;
  LIM_DECREASE = 30;
  LIM_INCREASE = 30;
Var
  x, y: Integer;
  PPixel: PRGBTriple;
Begin
ABitmap.PixelFormat := pf24bit;
For y := 0 To Pred(ABitmap.Height) Do
  Begin
  PPixel := ABitmap.ScanLine[y];
  For x := 0 To Pred(ABitmap.Width) Do
    Begin
    If (PPixel.rgbtRed > LIM_DECREASE) And (PPixel.rgbtRed < MAX_BYTE - LIM_INCREASE) Then
      PPixel.rgbtRed := PPixel.rgbtRed - LIM_DECREASE + Random(LIM_DECREASE + LIM_INCREASE);
    If (PPixel.rgbtGreen > LIM_DECREASE) And (PPixel.rgbtGreen < MAX_BYTE - LIM_INCREASE) Then
      PPixel.rgbtGreen := PPixel.rgbtGreen - LIM_DECREASE + Random(LIM_DECREASE + LIM_INCREASE);
    If (PPixel.rgbtBlue > LIM_DECREASE) And (PPixel.rgbtBlue < MAX_BYTE - LIM_INCREASE) Then
      PPixel.rgbtBlue := PPixel.rgbtBlue - LIM_DECREASE + Random(LIM_DECREASE + LIM_INCREASE);
    Inc(PPixel);
    End;
  End;
End;
 
Procedure TForm1.FormCreate(Sender: TObject);
Begin
DoubleBuffered := True;
FBackDither := TBitmap.Create();
FBackGround := TBitmap.Create();
FBackGround.LoadFromFile('...');
FBackGround.PixelFormat := pf24bit;
Timer1.Interval := 75;
End;
 
Procedure TForm1.FormDestroy(Sender: TObject);
Begin
FreeAndNil(FBackGround);
FreeAndNil(FBackDither);
End;
 
Procedure TForm1.FormResize(Sender: TObject);
Begin
Repaint();
End;
 
Procedure TForm1.FormPaint(Sender: TObject);
Begin
Canvas.Draw(0, 0, FBackGround);
Canvas.Draw(330, 130, FBackDither);
End;
 
Procedure TForm1.Timer1Timer(Sender: TObject);
Begin
FBackDither.Assign(FBackGround);
Dither(FBackDither);
Repaint();
End;
 
End.

Program Project1;
 
Uses
  Windows,
  Forms,
  Graphics;
 
Procedure MakeScreenShot(ABitmap: TBitmap);
Const
  CAPTUREBLT = $40000000;
Var
  ScreenDC: HDC;
Begin
ABitmap.PixelFormat := pf24bit;
ABitmap.SetSize(Screen.DesktopWidth, Screen.DesktopHeight);
ScreenDC := GetDC(0);
Try
  BitBlt(ABitmap.Canvas.Handle, 0, 0, Screen.DesktopWidth, Screen.DesktopHeight, ScreenDC, Screen.DesktopLeft, Screen.DesktopTop, SRCCOPY Or CAPTUREBLT);
Finally
  ReleaseDC(0, ScreenDC);
End;
End;
 
Procedure Dither(ABitmap: TBitmap);
Const
  MAX_BYTE     = 255;
  LIM_DECREASE = 30;
  LIM_INCREASE = 30;
Var
  x, y: Integer;
  PPixel: PRGBTriple;
Begin
ABitmap.PixelFormat := pf24bit;
For y := 0 To Pred(ABitmap.Height) Do
  Begin
  PPixel := ABitmap.ScanLine[y];
  For x := 0 To Pred(ABitmap.Width) Do
    Begin
    If (PPixel.rgbtRed > LIM_DECREASE) And (PPixel.rgbtRed < MAX_BYTE - LIM_INCREASE) Then
      PPixel.rgbtRed := PPixel.rgbtRed - LIM_DECREASE + Random(LIM_DECREASE + LIM_INCREASE);
    If (PPixel.rgbtGreen > LIM_DECREASE) And (PPixel.rgbtGreen < MAX_BYTE - LIM_INCREASE) Then
      PPixel.rgbtGreen := PPixel.rgbtGreen - LIM_DECREASE + Random(LIM_DECREASE + LIM_INCREASE);
    If (PPixel.rgbtBlue > LIM_DECREASE) And (PPixel.rgbtBlue < MAX_BYTE - LIM_INCREASE) Then
      PPixel.rgbtBlue := PPixel.rgbtBlue - LIM_DECREASE + Random(LIM_DECREASE + LIM_INCREASE);
    Inc(PPixel);
    End;
  End;
End;
 
Procedure DrawToScreen(ABitmap: TBitmap);
Var
  ScreenDC: HDC;
Begin
ScreenDC := GetDC(0);
Try
  BitBlt(ScreenDC, Screen.DesktopLeft, Screen.DesktopTop, ABitmap.Width, ABitmap.Height, ABitmap.Canvas.Handle, 0, 0, SRCCOPY);
Finally
  ReleaseDC(0, ScreenDC);
End;
End;
 
Procedure MainWork();
Var
  ScreenShot: TBitmap;
  ChangedShot: TBitmap;
Begin
ScreenShot := TBitmap.Create();
ChangedShot := TBitmap.Create();
Try
  MakeScreenShot(ScreenShot);
  While GetAsyncKeyState(VK_ESCAPE) = 0 Do
    Begin
    ChangedShot.Assign(ScreenShot);
    Dither(ChangedShot);
    DrawToScreen(ChangedShot);
    // Sleep(Random(150) + 150);
    End;
Finally
  ChangedShot.Free();
  ScreenShot.Free();
End;
End;
 
Begin
 
Randomize();
MainWork();
 
End.

unit Unit1;
 
interface
 
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs;
 
type
  TForm1 = class(TForm)
  private
    { Private declarations }
  public
    { Public declarations }
  end;
 
var
  Form1: TForm1;
  bmp: tbitmap;
dc: hdc;
 
implementation
 
{$R *.dfm}
procedure dither(var bitmap:tbitmap);
type
trgb = record
r,g,b: byte;
end;
argb = array[0..1] of trgb;
pargb = ^argb;
var x,y:integer;
p:pargb;
b:tbitmap;
begin
bitmap.pixelformat := pf24bit;
b:=tbitmap.create;
b.assign(bitmap);
for y:=0 to b.height-1 do
begin
p := b.scanline[y];
for x := 0 to b.width-1 do
begin
if (p[x].r>30)and(p[x].r<225) then p[x].r:=p[x].r-30+random(60);
if (p[x].g>30)and(p[x].g<225) then p[x].g:=p[x].g-30+random(60);
if (p[x].b>30)and(p[x].b<225) then p[x].b:=p[x].b-30+random(60);
end;
end;
bitmap.canvas.draw(0,0,b);
end;
begin
while true do begin
dither(bmp);
Sleep(500);
end;
end.