canvas.brush.color:=backcolor;
canvas.pen.color:=backcolor;
canvas.Rectangle(10,10,100,100)
//其中backcolor是背景色
canvas.pen.color:=backcolor;
canvas.Rectangle(10,10,100,100)
//其中backcolor是背景色
解决方案 »
- 在DBGridEh的一列如何嵌入DBLookupComboBox?
- DELPHI提示列名无效,!
- 删除选中节点下的子节点
- ▲送分▲如何把dpr▲输出为exe文件▲巨菜问题▲在线等▲不是F9▲
- Delphi 5.x 分布式多层应用电子商务篇
- 关于tatetimepicker
- 如何用TPrinter的哪个属性知道连接的是镭射还是点阵打印机?(或者用Api函数也行)
- 厦门的朋友,或熟悉厦门的朋友进来帮帮忙!
- ORB+smart agent有些搞不清楚。
- 怎么样读取BMP或是JPG图象中的色彩的RGB值
- 请问哪里可以下载数据库对应的 通信波形分析控件 ,谢谢,急,马上给分 ,
- DLL 与quickreport 的关系,立马给分
shape1.shape:=stRoundRect;
然后,写鼠标的三个事件就可以完成
Windows, Messages, SysUtils, Variants, 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;implementation{$R *.dfm}
type
TDrawFlag = (dfToDraw,dfDrawing,dfDrawn);
var
TrackerBrush: TBrush = Nil;
TrackerPen: TPen = Nil;
HalfToneBrush:TBrush = Nil;
OldDragRect: TRect = (Left:0;Top:0;Right:0;Bottom:0);
procedure InitHalfToneBrush;
var grayPattern:array[0..7] of WORD;
grayBitmap:HBITMAP;
I:Integer;
begin
if HalfToneBrush = Nil then
begin
HalfToneBrush := TBrush.Create;
for I := 0 to 7 do
grayPattern[i] := WORD(($5555 shl (I and 1)));
grayBitmap := Windows.CreateBitmap(8, 8, 1, 1, @grayPattern);
if (grayBitmap <> 0) then
begin
HalftoneBrush.Handle := Windows.CreatePatternBrush(grayBitmap);
Windows.DeleteObject(grayBitmap);
end;
end;
end;procedure DrawDragRect(DC:HDC;NewRect:TRect;DragFlag:TDrawFlag;BandWidth:Integer = 3);
var rgnNew,rgnOld,rgnTemp:HRGN;
SaveIndex: Integer;
TempRect: TRect;
begin
SaveIndex := Windows.SaveDC(DC);
try
{ Get the region which is the old border }
if DragFlag = dfToDraw then rgnOld := 0
else begin
TempRect := OldDragRect;
rgnTemp := Windows.CreateRectRgnIndirect(TempRect);
Windows.InflateRect(TempRect,BandWidth,BandWidth);
rgnOld := Windows.CreateRectRgnIndirect(TempRect);
Windows.CombineRgn(rgnOld,rgnOld,rgnTemp,RGN_XOR);
Windows.DeleteObject(HRGN(rgnTemp));
end; { Get the region which is the new border }
if DragFlag = dfDrawn then rgnNew := 0
else begin
TempRect := NewRect;
//RectNormalize(TempRect);
OldDragRect := TempRect;
rgnTemp := Windows.CreateRectRgnIndirect(TempRect);
Windows.InflateRect(TempRect,BandWidth,BandWidth);
rgnNew := Windows.CreateRectRgnIndirect(TempRect);
Windows.CombineRgn(rgnNew,rgnNew,rgnTemp,RGN_XOR);
Windows.DeleteObject(HRGN(rgnTemp));
end; { Get the different region between new and old }
if rgnNew = 0 then rgnNew := Windows.CreateRectRgn(0,0,0,0);
Windows.CombineRgn(rgnNew,rgnNew,rgnOld,RGN_XOR); { Draw into the border region which need to be updated }
Windows.SelectClipRgn(DC,rgnNew);
Windows.GetClipBox(DC,TempRect);
Windows.SelectObject(DC,HalfToneBrush.Handle);
with TempRect do
Windows.PatBlt(DC,Left,Top,Right-Left,Bottom-Top,PATINVERT); if rgnOld <> 0 then Windows.DeleteObject(HRGN(rgnOld));
if rgnNew <> 0 then Windows.DeleteObject(HRGN(rgnNew)); { Remove the clip region }
Windows.SelectClipRgn(DC,0);
finally
Windows.RestoreDC(DC,SaveIndex);
end;
end;
procedure InitGlobalObjects;
var
HatchPattern: Array[0..7] of WORD;
WPattern: WORD;
I: Integer;
HatchBitmap:HBITMAP;
begin
WPattern := $1111;
if TrackerBrush = Nil then
begin
TrackerBrush := TBrush.Create;
{Create the hatch pattern + bitmap}
for I := 0 to 3 do
begin
HatchPattern[i] := WPattern;
HatchPattern[i+4] := WPattern;
WPattern := WPattern shl 1;
end; HatchBitmap := Windows.CreateBitmap(8, 8, 1, 1, @HatchPattern);
if HatchBitmap <> 0 then
begin
{ Create black hatched brush }
TrackerBrush.Handle := Windows.CreatePatternBrush(HatchBitmap);
Windows.DeleteObject(HatchBitmap);
end; if TrackerPen = Nil then
begin
TrackerPen := TPen.Create;
{create black dotted pen}
TrackerPen.Handle := CreatePen(PS_DOT, 0, RGB(0, 0, 0));
end;
end; InitHalfToneBrush;
OldDragRect := Rect(0,0,0,0);
end;procedure ReleaseGlobalObjects;
begin
if HalfToneBrush <> Nil then HalfToneBrush.Free;
if TrackerBrush <> Nil then TrackerBrush.Free;
if TrackerPen <> Nil then TrackerPen.Free;
end;procedure TForm1.FormMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
DrawDragRect(Canvas.Handle,Rect(X,Y,X,Y),dfToDraw,4);
end;procedure TForm1.FormMouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
begin
if ssLeft in Shift then
DrawDragRect(Canvas.Handle,Rect(OldDragRect.Left,OldDragRect.Top,X,Y),dfDrawing,4);
end;procedure TForm1.FormMouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
DrawDragRect(Canvas.Handle,Rect(OldDragRect.Left,OldDragRect.Top,X,Y),dfDrawn,4);
end;Initialization
InitGlobalObjects;
finalization
ReleaseGlobalObjects;end.