mainunit.pas

初学者可往下看本例程的原理： 1、依次获得取样点的颜色 2、在取样点画该颜色的方框 取样越精

unit MainUnit;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, ExtCtrls, Spin, ComCtrls, DXDraws, DXClass;

type
  TForm1 = class(TForm)
    Image1: TImage;
    DXTimer1: TDXTimer;
    DXDraw1: TDXDraw;
    procedure TrackBar2Change(Sender: TObject);
    procedure DXTimer1Timer(Sender: TObject; LagCount: Integer);
    procedure DXDraw1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
  RSize:integer = 50;
  Pocet:integer = 25; // pocet testovanych pixelu

implementation

{$R *.DFM}

procedure TForm1.TrackBar2Change(Sender: TObject);
begin

end;

// DXTIMER ======================
procedure TForm1.DXTimer1Timer
(Sender: TObject; LagCount: Integer);
var
     c: TColor;   // barva testovaneho pixelu z image
     r,g,b: byte; // vysledna barva kruhu
     sr,sg,sb: integer; // pomocne promenne pro barvu
     i,j: integer;// pom. promenne pro cyklus
     ix,iy:integer;// pozice kreslen閔o 鑤verce
begin
   DXDraw1.Surface.Fill(0);

// kreslit pixelovany obrazek, nebo normal ?
if RSize <> 0 then
 begin

   // pocet kruhu, ktere se kresli
   for ix:=0 to (DXDraw1.SurfaceWidth div RSize-1) do
    begin
     for iy:=0 to (DXDraw1.SurfaceHeight div RSize-1) do
      begin
       sr := 0; sg := 0; sb := 0;

        for j:=1 to pocet do
        begin
         // vezmeme nahodny bod z obrazku, ktery je nekde
         // uvnitr kruhu, ktery budeme kreslit...
         c := Image1.Canvas.Pixels
         [ix*(RSize)+random(RSize),iy*RSize+random(RSize)];
         // slozky barvy RGB pricteme k sr,sg,sb
         sr := sr+GetRValue(c); // R slozka barvy
         sg := sg+GetGValue(c); // G    --//--
         sb := sb+GetBValue(c); // B    --//--
        end;

       // delenim promennou pocet ziskame
       // konecnou barvu kresleneho kruhu...
       r := sr div pocet;
       g := sg div pocet;
       b := sb div pocet;

       // takze to uz staci jen nakreslit..
       DXDraw1.Surface.Canvas.pen.Style := psClear;
       DXDraw1.Surface.Canvas.Brush.Color := RGB(r,g,b);
       DXDraw1.Surface.Canvas.Rectangle
       (ix*RSize,iy*RSize,
       (ix*RSize+RSize)+1,(iy*RSIze+RSize)+1);
      end;
    end;

  RSize:=RSize-1;
  if RSize=2 then RSize:=0;

  // podle velikosti ctverce nastavime
  // pocet testovanych pixelu
  Pocet:=(RSize div 2)+1;
  if Pocet = 1 then Pocet:=2;

 end
else
 begin
  // pokud je RSize 0, tj ctverce jsou velke 1 pixel,
  // nekreslime ctverce, ale kopirujeme obrazek...
  DXDraw1.Surface.Canvas.CopyRect
  (rect(0,0,200,300),Image1.Picture.Bitmap.Canvas,
  rect(0,0,200,300));
 end;


   // jeste pridame FPS
   with DXDraw1.Surface.Canvas do
    begin
     Brush.Color:=clBlack;
     Font.Color:=clAqua;
     TextOut(5,5,'FPS: '+IntTOStr(DXTimer1.Framerate));

     Release; // !!!!
    end;

 DXDraw1.Flip;
end;

procedure TForm1.DXDraw1Click(Sender: TObject);
begin
 RSize:=50;
 Pocet:=20;
end;

end.