← →Andrey196
(2001-12-26 19:48)
[5]
COPYRIGHT ANDREY196 @ 2001
Andrey196@mail.ru
Еще горячая тока что написал держи:
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs;
type
TForm1 = class(TForm)
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);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
beginmousex,beginmousey,mouseformx,mouseformy:integer;
moused:integer;
implementation
{$R *.DFM}
procedure TForm1.FormMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
beginmousex:=x;
beginmousey:=y;
moused:=1;
end;
procedure TForm1.FormMouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
begin
if moused=1 then Begin
canvas.brush.style:=bsclear;
canvas.pen.color:=form1.color;
canvas.Rectangle(beginmousex,beginmousey,mouseformx,mouseformy);
mouseformx:=mouse.CursorPos.x-left;
mouseformy:=mouse.CursorPos.y-top;
canvas.pen.color:=clblack;
canvas.brush.style:=bsclear;
canvas.Rectangle(beginmousex,beginmousey,mouseformx,mouseformy);
end;
end;
procedure TForm1.FormMouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
moused:=0;
canvas.Brush.color:=clwhite;
canvas.Rectangle(beginmousex,beginmousey,mouseformx,mouseformy);
end;
end.
Как нарисовать прозрачный прямоугольник Найти похожие ветки
← →