unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs;
type
TForm1 = class(TForm)
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure FormPaint(Sender: TObject);
procedure FormMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure FormMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
procedure FormMouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
var
Rgn: HRGN;
f: Boolean;
x1,y1: Integer;
procedure TForm1.FormCreate(Sender: TObject);
begin
Rgn := CreateEllipticRgn(11, 11, 111, 66);
DoubleBuffered := True; {可以使用双倍缓存来禁止闪烁}
end;
procedure TForm1.FormMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
if PtInRegion(Rgn, X, Y) then {判断鼠标当前点是否在区域内}
begin
f := True;
x1 := X;
y1 := y;
end;
end;
procedure TForm1.FormMouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
begin
if not f then Exit;
OffsetRgn(Rgn, X-x1, Y-y1); {移动区域}
Repaint;
x1 := X;
y1 := y;
end;
procedure TForm1.FormMouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
f := False;
end;
procedure TForm1.FormPaint(Sender: TObject);
begin
Canvas.Brush.Color := clSilver;
Canvas.Brush.Style := bsCross;
FillRgn(Canvas.Handle, Rgn, Canvas.Brush.Handle);
Canvas.Brush.Color := clRed;
Canvas.Brush.Style := bsSolid;
FrameRgn(Canvas.Handle, Rgn, Canvas.Brush.Handle, 2, 2);
end;
procedure TForm1.FormDestroy(Sender: TObject);
begin
DeleteObject(Rgn);
end;
end.
WinAPI: PtInRegion、OffsetRgn
原创
©著作权归作者所有:来自51CTO博客作者JLee79的原创作品,请联系作者获取转载授权,否则将追究法律责任
本例效果图:
提问和评论都可以,用心的回复会被更多人看到
评论
发布评论
相关文章
-
函数的极限
函数极限
邻域 取值 函数极限 -
jquery 效果函数
jquery
jquery -
jquery 封装的动画效果函数
jQuery给我们封装了很多动画效果,最为常见的如下:显示隐藏show(), hide(), toggle()滑动slideDown(),slideUp(), slideToggle()淡入淡
js css animation css3 jquery