//蚂蚁线
unit ScreenMarchingAnts;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
ExtCtrls, StdCtrls;
type
TFormMarchingAnts = class(TForm)
Timer1: TTimer;
Image1: TImage;
Image3: TImage;
procedure FormCreate(Sender: TObject);
procedure Timer1Timer(Sender: TObject);
procedure ImageMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure ImageMouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
procedure ImageMouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
private
X1, Y1, X2, Y2: Integer;
procedure RemoveTheRect;
procedure DrawTheRect;
public
{ Public declarations }
end;
var
FormMarchingAnts: TFormMarchingAnts;
Counter: Byte;
CounterStart: Byte;
Looper: LongInt;
implementation
{$R *.DFM}
procedure RestrictCursorToDrawingArea(const Image: TImage);
var
CursorClipArea: TRect;
begin
CursorClipArea := Bounds(Image.ClientOrigin.X, Image.ClientOrigin.Y,
Image.Width, Image.Height);
Windows.ClipCursor(@CursorClipArea)
end {RestrictCursorToDrawingArea};
procedure RemoveCursorRestrictions;
begin
Windows.ClipCursor(nil)
end {RemoveCursorRestrictions};
procedure MovingDots(X, Y: Integer; TheCanvas: TCanvas); stdcall;
begin
Inc(Looper);
{$R-}
Counter := Counter shl 1; // Shift the bit left one
{$R+}
if Counter = 0
then Counter := 1; // If it shifts off left, reset it
if (Counter and 224) > 0 // Are any of the left 3 bits set?
then TheCanvas.Pixels[X, Y] := clWhite // Erase the pixel
else TheCanvas.Pixels[X, Y] := clBlack; // Draw the pixel
end;
function NormalizeRect(R: TRect): TRect;
begin
// This routine normalizes a rectangle. It makes sure that the Left,Top
// coords are always above and to the left of the Bottom,Right coords.
with R do
begin
if Left > Right
then
if Top > Bottom
then Result := Rect(Right, Bottom, Left, Top)
else Result := Rect(Right, Top, Left, Bottom)
else
if Top > Bottom
then Result := Rect(Left, Bottom, Right, Top)
else Result := Rect(Left, Top, Right, Bottom);
end
end;
procedure TFormMarchingAnts.FormCreate(Sender: TObject);
begin
X1 := 0;
Y1 := 0;
X2 := 0;
Y2 := 0;
Canvas.Pen.Color := Color;
Canvas.Brush.Color := Color;
CounterStart := 128;
Timer1.Interval := 100;
Timer1.Enabled := True;
Looper := 0;
self.DoubleBuffered := true;
FormMarchingAnts.ControlStyle := FormMarchingAnts.ControlStyle + [csOpaque];
end;
procedure TFormMarchingAnts.RemoveTheRect;
var
R: TRect;
begin
R := NormalizeRect(Rect(X1, Y1, X2, Y2)); // Rectangle might be flipped
InflateRect(R, 1, 1); // Make the rectangle 1 pixel larger , 其实是left-1,right+1,故而widht加2 ,top和bottom相似
InvalidateRect(Handle, @R, True); // Mark the area as invalid
InflateRect(R, -2, -2); // Now shrink the rectangle 2 pixels
ValidateRect(Handle, @R); // And validate this new rectangle.
// This leaves a 2 pixel band all the way around
// the rectangle that will be erased & redrawn
UpdateWindow(Handle);
end;
procedure TFormMarchingAnts.DrawTheRect;
begin
// Determines starting pixel color of Rect
Counter := CounterStart;
// Use LineDDA to draw each of the 4 edges of the rectangle
LineDDA(X1, Y1, X2, Y1, @MovingDots, LongInt(Canvas));
LineDDA(X2, Y1, X2, Y2, @MovingDots, LongInt(Canvas));
LineDDA(X2, Y2, X1, Y2, @MovingDots, LongInt(Canvas));
LineDDA(X1, Y2, X1, Y1, @MovingDots, LongInt(Canvas));
end;
procedure TFormMarchingAnts.Timer1Timer(Sender: TObject);
begin
CounterStart := CounterStart shr 2; // Shl 1 will move rect slower
if CounterStart = 0 // If bit is lost, reset it
then CounterStart := 128;
DrawTheRect // Draw the rectangle
end;
// ===================================================================
// Use "quick and dirty" fix to get ants to march on top of an image
procedure TFormMarchingAnts.ImageMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
X := X + (Sender as TImage).Left;
Y := Y + (Sender as TImage).Top;
RemoveTheRect; // Erase any existing rectangle
X1 := X;
Y1 := Y;
X2 := X;
Y2 := Y;
// Force mouse movement to stay within TImage
RestrictCursorToDrawingArea((Sender as TImage))
end;
procedure TFormMarchingAnts.ImageMouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
begin
if ssLeft in Shift
then begin
X := X + (Sender as TImage).Left;
Y := Y + (Sender as TImage).top;
RemoveTheRect; // Erase any existing rectangle
X2 := X; Y2 := Y; // Save the new corner where the mouse is
DrawTheRect; // Draw the Rect now... don't wait for the timer!
end;
end;
procedure TFormMarchingAnts.ImageMouseUp(Sender: TObject;
Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
RemoveCursorRestrictions
end;
end.