{$R *.DFM}
function Tform1.makeregion(imagebox:Timage):hrgn;
//该函数的作用是按照imagebox中的位图形状形成一个不规则区域
var
lineregion,fullregion:hrgn;//定义区域
x,y,startlinex:integer;//存放位置坐标
transparentcolor:longword;//存放所指定的透明色
infirstregion,inlinea:boolean;
picwidth,picheight:integer; //图象的宽和高
hdc:hwnd;//图象框的句柄
begin
hdc:=imagebox.canvas.handle;//得到图象框的句柄
picwidth:=imagebox.width;//得到图象框的宽和高
picheight:=imagebox.height;
infirstregion:=true;
inlinea:=false;
startlinex:=0;
fullregion:=0;
transparentcolor:=getpixel(hdc,0,0);//指定透明色
//下面的两重循环逐行地扫描不透明色,将连续的不透明色形成一个个小的区域
//然后将这些小区域混合成一个大的不规则区域即位图中不透明区域的形状
//由于是一行行地扫描而不是一个点一个点地扫描所以速度快多了。
for y:=0 to picheight-1 do
begin
for x:=0 to picwidth-1 do
begin
if ((getpixel(hdc,x,y)=transparentcolor) or (x=picwidth)) then
begin
if (inlinea=true) then
begin
inlinea:=false;
//将连续的不透明色组成一个小的矩形区域
lineregion:=createrectrgn(startlinex,y,x,y+1);
if (infirstregion=true)then
begin
fullregion:=lineregion;
infirstregion:=false;
end
else
begin
//混合小的矩形区域到一个大区域,循环结束后,此大区域就是整个不规则窗口
combinergn(fullregion,fullregion,lineregion,rgn_or);
deleteobject(lineregion);
end;
end;
end
else
begin
if (inlinea=false)then
begin
inlinea:=true;
startlinex:=x;
end;
end;
end;
end;
result:= fullregion; //返回所形成的不规则区域
end;
procedure TForm1.creat(Sender: TObject);
begin
//窗体式样为无边框
form1.BorderStyle:=bsNone;
//初始化a
a:=0;
end;
procedure TForm1.clicked(Sender: TObject);
begin
//得到当前鼠标位置
getcursorpos(mousepos);
//弹出菜单
popupmenu1.Popup(mousepos.x,mousepos.y);
end;
procedure TForm1.Timer1Timer(Sender: TObject);
var
aa:hrgn;//用于存储得到的区域
picture:string;//存储要显示的位图文件的文件名
begin
image1.AutoSize:=true;//按位图尺寸自动调整大小
a:=a+1;//每经过一个计时器事件,就换一幅位图
if a<8 then
begin
picture:='pig'+inttostr(a)+'.bmp' ;
image1.Picture.LoadFromFile(picture) ;
end
else
a:=0;
//按照image1中的位图形状形成一个不规则区域
aa:=makeregion(image1);
//将形成的不规则区域赋给本窗体以形成一个不规则窗体
setwindowrgn(handle,aa,true);
end;
procedure TForm1.N1Click(Sender: TObject);
begin
//单击窗体,在弹出的菜单中选“退出”时关闭本程序
application.Terminate;
end;
function Max(A, B: Longint): Longint;
begin
if A > B then
Result := A
else
Result := B;
end;
function Min(A, B: Longint): Longint;
begin
if A < B then
Result := A
else
Result := B;
end;
function WidthOf(R: TRect): Integer;
begin
Result := R.Right - R.Left;
end;
function HeightOf(R: TRect): Integer;
begin
Result := R.Bottom - R.Top;
end;
function CreateBrushPattern(Color1: TColor): TBitmap;
begin
Result := TBitmap.Create;
Result.Width := 8;
Result.Height := 8;
with Result.Canvas do
begin
Brush.Style := bsSolid;
Brush.Color := Color1;
FillRect(Rect(0, 0, Result.Width, Result.Height));
end;
end;
procedure RegisterHintWindow(AClass: THintWindowClass);
begin
HintWindowClass := AClass;
end;
constructor THyHintWindow.Create(AOwner: TComponent);
var
l: longint;
begin
inherited Create(AOwner);
try
if hintfont = nil then
StandardHintFont(Canvas.Font)
else
begin
canvas.Font := hintfont;
freeandnil(hintfont);
end;
except;
end;
end;
destructor THyHintWindow.Destroy;
begin
if Image <> nil then
Image.Free;
inherited Destroy;
end;
procedure THyHintWindow.CreateParams(var Params: TCreateParams);
begin
inherited CreateParams(Params);
Params.Style := Params.Style and not WS_BORDER;
end;
procedure THyHintWindow.WMEraseBkgnd(var Message: TMessage);
begin
Message.Result := 1;
end;
function CreatePolyRgn(const Points: array of TPoint): HRgn;
begin
Result := CreatePolygonRgn((@Points)^, 3, WINDING);
end;
function THyHintWindow.CreateRegion(Shade: Boolean): HRgn;
var
R: TRect;
W, TileOffs: Integer;
Tail, Dest: HRgn;
P: TPoint;
begin
R := FRect;
Result := 0;
if Shade then
OffsetRect(R, HintShadowSize, HintShadowSize);
case HintStyle of
hsRoundRect:
Result := CreateRoundRectRgn(R.Left, R.Top, R.Right, R.Bottom,
FRoundFactor, FRoundFactor);
hsRectangle: Result := CreateRectRgnIndirect(R);
end;
if HintTail then
begin
R := FTextRect;
GetCursorPos(P);
TileOffs := 0;
if FPos in [hpTopLeft, hpBottomLeft] then
TileOffs := Width;
if Shade then
begin
OffsetRect(R, HintShadowSize, HintShadowSize);
Inc(TileOffs, HintShadowSize);
end;
W := Min(Max(8, Min(WidthOf(R), HeightOf(R)) div 4), WidthOf(R) div 2);
case FPos of
hpTopRight:
Tail := CreatePolyRgn([Point(TileOffs, Height - HintShadowSize),
Point(R.Left + W div 4, R.Bottom), Point(R.Left + 2 * W, R.Bottom)]);
hpTopLeft:
Tail := CreatePolyRgn([Point(TileOffs, Height - HintShadowSize),
Point(R.Right - W div 4, R.Bottom), Point(R.Right - 2 * W, R.Bottom)]);
hpBottomRight:
Tail := CreatePolyRgn([Point(TileOffs, 0),
Point(R.Left + W div 4, R.Top), Point(R.Left + 2 * W, R.Top)]);
else {hpBottomLeft}
Tail := CreatePolyRgn([Point(TileOffs, 0),
Point(R.Right - W div 4, R.Top), Point(R.Right - 2 * W, R.Top)]);
end;
try
Dest := Result;
Result := CreateRectRgnIndirect(R);
try
CombineRgn(Result, Dest, Tail, RGN_OR);
finally
if Dest <> 0 then
DeleteObject(Dest);
end;
finally
DeleteObject(Tail);
end;
end;
//Result := CreateEllipticRgnIndirect(r) // 椭圆
end;
procedure THyHintWindow.FillRegion(Rgn: HRgn; Shade: Boolean);
begin
end;
procedure THyHintWindow.PaintText(R: TRect);
const
Flag: array[TAlignment] of Longint = (DT_LEFT, DT_RIGHT, DT_CENTER);
var
i, m: integer;
begin
try
SetWindowRgn(Handle, CreateRegion(True), True);
if (Image <> nil) and UseBk then
begin
Canvas.Draw(0, 0, Image);
end;
if (MarkImage <> nil) and (UseMark) then
begin
Canvas.Draw(R.Right - MarkImage.Width - 1, R.Top + 1, MarkImage);
R.Top := R.Top + MarkImage.Height + 3;
end;
Canvas.Brush.Color := GetShadeColor(Canvas, clbtnface, 60);
FrameRgn(Canvas.Handle, CreateRegion(True), Canvas.Brush.Handle, 1, 1);
SetBkMode(Canvas.Handle, TRANSPARENT);
DrawText(Canvas.Handle, PChar(Caption),
-1, R, DT_NOPREFIX or DT_WORDBREAK or Flag[HintAlignment]);
except
;
end;
end;
procedure THyHintWindow.Paint;
var
R: TRect;
begin
try
R := ClientRect;
R := FTextRect;
if HintAlignment = taLeftJustify then
Inc(R.Left, 2);
PaintText(R);
except
;
end;
end;
procedure THyHintWindow.ActivateHint(Rect: TRect; const AHint: string);
var
R: TRect;
P: TPoint;
begin
try
Caption := AHint;
GetCursorPos(P);
FPos := hpBottomRight;
R := CalcHintRect(Screen.Width, AHint, nil);
OffsetRect(R, Rect.Left - R.Left, Rect.Top - R.Top);
Rect := R;
BoundsRect := Rect;
if HintTail then
begin
Rect.Top := P.Y - Height - 3;
if Rect.Top < 0 then
Rect.Top := BoundsRect.Top
else
Rect.Bottom := Rect.Top + HeightOf(BoundsRect);
Rect.Left := P.X + 1;
if Rect.Left < 0 then
Rect.Left := BoundsRect.Left
else
Rect.Right := Rect.Left + WidthOf(BoundsRect);
end;
if Rect.Top + Height > Screen.Height then
begin
Rect.Top := Screen.Height - Height;
if Rect.Top <= P.Y then
Rect.Top := P.Y - Height - 3;
end;
if Rect.Left + Width > Screen.Width then
begin
Rect.Left := Screen.Width - Width;
if Rect.Left <= P.X then
Rect.Left := P.X - Width - 3;
end;
if Rect.Left < 0 then
begin
Rect.Left := 0;
if Rect.Left + Width >= P.X then
Rect.Left := P.X - Width - 1;
end;
if Rect.Top < 0 then
begin
Rect.Top := 0;
if Rect.Top + Height >= P.Y then
Rect.Top := P.Y - Height - 1;
end;
if (HintStyle <> hsRectangle) or (HintShadowSize > 0) or HintTail then
begin
FPos := hpBottomRight;
if (Rect.Top + Height < P.Y) then
FPos := hpTopRight;
if (Rect.Left + Width < P.X) then
begin
if FPos = hpBottomRight then
FPos := hpBottomLeft
else
FPos := hpTopLeft;
end;
if HintTail then
begin
if (FPos in [hpBottomRight, hpBottomLeft]) then
begin
OffsetRect(FRect, 0, FTileSize.Y);
OffsetRect(FTextRect, 0, FTileSize.Y);
end;
if (FPos in [hpBottomRight, hpTopRight]) then
begin
OffsetRect(FRect, FTileSize.X, 0);
OffsetRect(FTextRect, FTileSize.X, 0);
end;
end;
if HandleAllocated then
begin
SetWindowPos(Handle, HWND_BOTTOM, 0, 0, 0, 0, SWP_HIDEWINDOW or
SWP_NOACTIVATE or SWP_NOSIZE or SWP_NOMOVE);
if Screen.ActiveForm <> nil then
UpdateWindow(Screen.ActiveForm.Handle);
end;
end;
SetWindowPos(Handle, HWND_TOPMOST, Rect.Left, Rect.Top, 0,
0, SWP_SHOWWINDOW or SWP_NOACTIVATE or SWP_NOSIZE);
except
;
end;
end;
function THyHintWindow.CalcHintRect(MaxWidth: Integer; const AHint: string;
AData: Pointer): TRect;
const
Flag: array[TAlignment] of Longint = (DT_LEFT, DT_RIGHT, DT_CENTER);
begin
Result := Rect(0, 0, MaxWidth, 0);
DrawText(Canvas.Handle, PChar(AHint),
-1, Result, DT_CALCRECT or DT_WORDBREAK or DT_NOPREFIX or Flag[HintAlignment]);
Inc(Result.Right, 8);
Inc(Result.Bottom, 4);
FRect := Result;
FTextRect := Result;
if (useMark) and (MarkImage <> nil) then //////////////////
begin
FTextRect.Bottom := FTextRect.Bottom + MarkImage.Height;
FRect := FTextRect
end;
InflateRect(FTextRect, -1, -1);
case HintAlignment of
taCenter: OffsetRect(FTextRect, -1, 0);
taRightJustify: OffsetRect(FTextRect, -4, 0);
end;
FRoundFactor := Max(6, Min(WidthOf(Result), HeightOf(Result)) div 4);
if HintStyle = hsRoundRect then
InflateRect(FRect, FRoundFactor div 4, FRoundFactor div 4);
Result := FRect;
OffsetRect(FRect, -Result.Left, -Result.Top);
OffsetRect(FTextRect, -Result.Left, -Result.Top);
Inc(Result.Right, HintShadowSize);
Inc(Result.Bottom, HintShadowSize);
if HintTail then
begin
FTileSize.Y := Max(14, Min(WidthOf(FTextRect), HeightOf(FTextRect)) div 2);
FTileSize.X := FTileSize.Y - 8;
Inc(Result.Right, FTileSize.X);
Inc(Result.Bottom, FTileSize.Y);
end;
end;