我想在窗口上画一个会动的方框蚂蚁线，请问如何做呢？
我想在窗口上画一个会动的方框蚂蚁线，请问如何做呢？ 问题点数：100、回复次数：2Top
1 楼S.F.（chinasf.cnblogs.com）回复于 2004-07-01 11:56:49 得分 60
来自：卷起千堆雪tyn, 时间：2001-12-24 22:10:00, ID：809383
YB老弟说我没有诚意，唉，那我就来点诚意，无私一把，给大家一点小小技巧－－－－关于蚂蚁线
>以下程序在一个表单上放置一个Timer控件，设置Interval :=100;
>实现PhotoShop里的流动线效果.
>以下程序字节数<512，简练，高效；原来PhotoShop也不过如此～～
unit n;
interface
uses
Windows,Forms,Graphics,Classes,ExtCtrls;
type
TF=class(TForm)
m:TTimer;
procedure mTimer(Sender:TObject);
end;
var
F:TF;
a:Byte;
implementation
{$R *.DFM}
procedure c(X,Y:Integer;t:TCanvas);stdcall;
begin
a:=a shl 1;
if a =0 then a:=1;
if (a and 224)>0 then
t.Pixels[X,Y]:=clWhite
else
t.Pixels[X,Y]:=clBlack;
end;
procedure TF.mTimer(Sender:TObject);
begin
LineDDA(0,0,333,333,@c,LongInt(Canvas));
end;
end.
>运行之后，有没有看见象蚂蚁在爬呢？
最后祝所有的DFW象爬动的蚂蚁般幸福快乐 .
Top
2 楼fei19790920（饭桶超人II（抵制日货））回复于 2004-07-01 11:57:13 得分 40
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.
Top
相关问题
关键词
得分解答快速导航
相关链接
广告也精彩
反馈
