这样的图案如何画(50分)

  • 主题发起人 主题发起人 holyszq
  • 开始时间 开始时间
H

holyszq

Unregistered / Unconfirmed
GUEST, unregistred user!
如何画类似下面这样的图案,要代码,谢谢!!!!
_____________
| |
| |
| |
|_____ ____|
/ .~
/.~
 
用 textout
 
用不规则窗体,很简单,代码还是自己写好一点。
 
是做hint吧?有这样的控件的,不用自已做。
 
对,有控件,我记得叫TDanHint
 
是创建不规则窗体,希望有代码,谢谢!!!
 
office助手那样的动画小人,也有类似的不规则窗体。显示一个类似窗体。
 
我写的一篇没有被发表的文章,也许对你有用。其中的makeregion函数可以根据一幅位图的轮廓形成一个不规则窗口
===============================================================================
用delphi做一个会在桌面上跳舞的小猪
————兼谈不规则窗口的制作
dodo505
也许大家对office助手都有印象:一个小孙悟空或一个小狗不时地在桌面上耍来耍去,玩弄出各种姿态和花样,用鼠标单击它时还会弹出菜单选项与用户交互。那么它是怎么作出来的呢?本文便向大家介绍如何制作一个象office助手那样的会在桌面上跳舞的小猪。
编程思路:要做一个在桌面上跳舞的小猪,我们可以用位图拷贝函数BitBlt通过各种不同的掩膜组合向桌面上连续绘制不同的透明图片(图片如下图1)这样就会形成小猪在桌面上跳舞的动画。
图1(图片见附件)
但这样做有一个极大的缺点,那就是这样作成的小猪只顾自己跳舞无法与用户交互,也就是说无论我们用鼠标单击或双击小猪,它都没有任何反应,更不会弹出什么菜单选项了。那又该怎么办呢?最直接的解决办法就是使用不规则窗口,即先按照第一张小猪跳舞图片中小猪的轮廓形成一个不规则窗口(如图2),
图2
这时再把该图片放到该不规则窗口中时,则此窗口只显示出小猪来,其余部分自然是透明的(如图3)。
图3
依此类推再处理第二张,形成又一个不规则窗口,然后显示出来,再处理第三张......。如此不停地显示便形成了小猪在桌面上跳舞的动画。由于该动画本身就是一个窗口,所以可以响应各种窗口消息事件如双击、单击等等。
那么现在的关键问题就是如何根据一幅位图的轮廓形成一个不规则窗口,这就要用到几个windows的api函数:CreateRectRgn,CreateEllipticRgn,CombineRgn,SetWindowRgn。其中CreateRectRgn函数用来创建一个矩形区域,CreateEllipticRgn函数用来创建一个圆或椭圆形区域。SetWindowRgn函数用来设置窗口的形状,SetWindowRgn函数的定义如下:
int SetWindowRgn( HWND hWnd, HRGN hRgn, BOOL bRedrawflag);
窗口的形状由参数 hRgn 所标志的区域 (region) 决定。通过创建不同的区域就可以创建不同形状窗口。例如下面的代码,可以产生一个圆形的窗口。(如图4)
图4
var
R : HRgn;
begin
R := CreateEllipticRgn(0,0,300,300);
SetWindowRgn( handle,R , TRUE ) ;
end;

CombineRgn函数可以混合两个区域成为一个区域。其函数原形为
int CombineRgn(

HRGN hrgnDest, // 目标区域的句柄
HRGN hrgnSrc1, // 源区域1的句柄
HRGN hrgnSrc2, // 源区域2的句柄
int fnCombineMode // 两个区域混合的方式
);

比如下面代码混合三个圆形区域形成一个米老鼠形的区域。(如图5)
图5
var
R1,R2,R3 : HRgn;
begin
//分别创建三个圆形区域R1,R2,R3
R1 := CreateEllipticRgn(0,0,60,60);
R2 := CreateEllipticRgn(150,0,210,60);
R3 := CreateEllipticRgn(30,30,180,180);
//混合这三个圆形区域则形成一个米老鼠形区域
combinergn(R1,R1,R2,rgn_or);
combinergn(R1,R1,R3,rgn_or);
//将这个米老鼠形区域赋给本窗口,则形成一个米老鼠形窗口
SetWindowRgn( handle,R1 , TRUE ) ;
end;
由于窗口是米老鼠形状的所以在米老鼠形窗口里放置一个图片框,则图片框里的图片只会显示成米老鼠的形状。(如图6)
图6
有了上面的介绍我们就可以用CreateRectRgn函数和CombineRgn函数通过一种算法来根据一幅位图的轮廓形成一个不规则窗口了。具体方法如下:在窗口中放入一Image图片框,在图片框中加载一幅图片,我们采用一个两重循环,逐行扫描图片中不透明的区域,用CreateRectRgn函数得到一个个连续的不透明的小矩形区域,然后将这些小矩形区域用CombineRgn函数组成一个整个的区域便得到了这个图片轮廓的区域,即按照该图片的轮廓形成了一个不规则区域。再用SetWindowRgn函数将该区域赋给窗口便按照该图片的轮廓形成了一个不规则窗口。
知道了如何根据一幅图片的轮廓形成一个不规则窗口,那么利用不规则窗口连续显示不同的图片以形成动画,就可以制作出我们的在桌面上跳舞的小猪了。(制作出的画面如图7)。
图7
用这种方法制作出来的小猪可以响应我们的鼠标事件,比如本程序中我们用鼠标单击小猪则可以弹出一个弹出菜单,选其中的“退出”选项则可关闭该程序。由于本程序中采用的算法是一行一行地扫描而不是一个点一个点地扫描所以速度很快。
程序源代码如下:
unit Unit1;

interface

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls,
Forms, Dialogs,StdCtrls, ExtCtrls, Menus;

type
TForm1 = class(TForm)
Image1: TImage;
Timer1: TTimer;
PopupMenu1: TPopupMenu;
N1: TMenuItem;
N2: TMenuItem;
N3: TMenuItem;
procedure creat(Sender: TObject);
procedure clicked(Sender: TObject);
procedure Timer1Timer(Sender: TObject);
procedure N1Click(Sender: TObject);
private
{ Private declarations }
a:integer;
mousepos:Tpoint;//存放鼠标指针位置
function makeregion(imagebox:Timage):hrgn;
//上面函数的作用是按照imagebox中的位图形状形成一个不规则区域
public
{ Public declarations }
end;

var
Form1: TForm1;

implementation

{$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;

end.
以上程序在Delphi6,WindowsMe下调试通过。
==================================================================
 
没人理我呀!!!
 
{用于设定提示信息的表示
hfg

背弃了兰,离开了莉。以前一直以为莉是一个if,兰是else,两者择一;不是if
就是else...却未曾想过,生命或是一个loop,但进去时,或许选项已空,或许不容
我如此迭代,一个exit就要我跳出来了...,我真的痴心以为有人会为我守候一生
一世哩! ___________________________________<<台北爱情故事>>
}
unit Hints;

interface
uses Windows, Messages, Graphics, Classes, Controls, Forms, Dialogs, sysutils;
type
THintStyle = (hsRectangle, hsRoundRect);
THintPos = (hpTopRight, hpTopLeft, hpBottomRight, hpBottomLeft);
THintShadowSize = 0..5;
THyHintWindow = class(THintWindow)
private
FPos: THintPos;
FRect: TRect;
FTextRect: TRect;
FTileSize: TPoint;
FRoundFactor: Integer;
procedure WMEraseBkgnd(var Message: TMessage); message WM_ERASEBKGND;
function CreateRegion(Shade: Boolean): HRgn;
procedure FillRegion(Rgn: HRgn; Shade: Boolean);
procedure PaintText(R: TRect);
protected
procedure CreateParams(var Params: TCreateParams); override;
procedure Paint; override;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
procedure ActivateHint(Rect: TRect; const AHint: string); override;
procedure ActivateHintData(Rect: TRect; const AHint: string;
AData: Pointer); override;
function CalcHintRect(MaxWidth: Integer; const AHint: string;
AData: Pointer): TRect; override;
end;
procedure sethintstyle(style: THintStyle; ShadowSize: THintShadowSize;
tail: Boolean; Alignment: TAlignment);
procedure sethintfont(name: string; size: integer; color: TColor);
procedure SetBK(Bk: TBitmap);
procedure SetMarK(Mark: TBitmap);
procedure SetImage(Bk, Mark: Boolean);
implementation
var
HintStyle: THintStyle = hsRectangle;
HintShadowSize: THintShadowSize = 0;
HintTail: Boolean = False;
HintAlignment: TAlignment = taLeftJustify;
var
hintfont: tfont;
Image: TBitmap;
MarkImage: TBitmap;
UseBk, UseMark: Boolean;

function GetShadeColor(ACanvas: TCanvas; clr: TColor; Value: integer): TColor;
var
r, g, b: integer;

begin
clr := ColorToRGB(clr);
r := Clr and $000000FF;
g := (Clr and $0000FF00) shr 8;
b := (Clr and $00FF0000) shr 16;

r := (r - value);
if r < 0 then
r := 0;
if r > 255 then
r := 255;

g := (g - value) + 2;
if g < 0 then
g := 0;
if g > 255 then
g := 255;

b := (b - value);
if b < 0 then
b := 0;
if b > 255 then
b := 255;

//Result := Windows.GetNearestColor(ACanvas.Handle, RGB(r, g, b));
Result := RGB(r, g, b);
end;

procedure SetImage(Bk, Mark: Boolean);
begin
UseBk := bk;
UseMark := Mark;
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;

procedure sethintstyle(Style: THintStyle; ShadowSize: THintShadowSize;
Tail: Boolean; Alignment: TAlignment);
begin
HintStyle := Style;
HintShadowSize := ShadowSize;
HintTail := Tail;
HintAlignment := Alignment;
RegisterHintWindow(THyHintWindow);
end;

procedure SetMark(Mark: TBitmap);
var
myrect: Trect;
begin
//
myrect := rect(0, 0, Mark.Width, Mark.Height);

MarkImage := TBitmap.Create;
MarkImage.Height := Mark.Height;
MarkImage.Width := Mark.Width;
MarkImage.Canvas.CopyRect(myrect, Mark.Canvas, myrect);
MarkImage.Transparent := True;
end;

procedure SetBK(BK: TBitmap);
var
myrect: Trect;
begin
//
myrect := rect(1, 1, bk.Width, bk.Height);
Image := TBitmap.Create;
Image.Height := bk.Height;
Image.Width := bk.Width;
Image.Canvas.CopyRect(myrect, bk.Canvas, myrect);
end;

procedure sethintfont(name: string; size: integer; color: TColor);
begin
hintfont := tfont.create;
hintfont.Name := name;
hintfont.Size := size;
hintfont.Color := color;
end;

procedure StandardHintFont(AFont: TFont);
begin
AFont.Name := 'MS Sans Serif';
AFont.Size := 8;
AFont.Color := clWindowText;
end;

function SetLayeredWindowAttributes(hwnd: HWND; crKey: Longint; bAlpha: byte; dwFlags: longint): longint; stdcall; external user32; //函数声明

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;

procedure THyHintWindow.ActivateHintData(Rect: TRect; const AHint: string;
AData: Pointer);
begin
ActivateHint(Rect, AHint);

end;

end.
 
谢谢!!!
 
后退
顶部