创建不规则形状的Control

最近接了一个单子，开发一个产品的教学软件（汗，程序员开始变成美工了，没办法要混饭吃，只好堕落了）。按照领导（老婆）的说法，工期紧、任务重，所以，只能拿起我最擅长的Delphi作为开发利器，Delphi好是好，最困难的在于界面设计，这样的软件，脸面最重要，但是，Delphi的弱点（别砸我，我话还没有说完）也在于此，灰不拉鸡的界面在现在几乎等同于Dos的黑底白字一样不受欢迎（郁闷，这不是很好吗！整天装嫩，什么都要Q，连软件都不放过，发廊妹妹说自己昨天18岁生日，你也要装！）。言归正传，看来只能用TImage混合PhotoShop、CoreDraw做出来的图片了。做出来一看，还行，就是不会动，要动？很简单，弄个透明的Bebvl当作按钮不就可以啦！不行啊！都是方的怎么行，人家的机器上的按钮都是很复杂的形状，都是方的怎么半呢？有办法，我不说，我不说干吗写这篇文章？开玩笑。其实很简单，如果不是TwinControl继承下来的，而是从TControl继承下来的可以做到对于鼠标动作在任意形状区域的响应，TwinControl当然也可以，我比较懒啦！TwinControl怎么作，MSDN上肯定有，无非就是把窗口和一个区域联系起来（关键API连接，SetWindowRgn），当然也可以是响应消息，不过那样窗口不能透明了。Tcontrol实现起来更加简单，关键在一个消息，CM_HITTEST，这是Delphi自定义的消息，别去MSDN查，肯定查不到。这个消息表示测试x,Y是不是落在Control的范围里面，如果你响应这个消息，那么你就可以告诉VCL鼠标是不是落在你的Control范围里面，这样你就可以在矩形之中定义你的Control的任意形状，只要你在响应这个消息的时候“告诉”VCL。这个消息的格式：

TWMNCHitTest = packed record
Msg: Cardinal;
Unused: Longint;
case Integer of
0: (
XPos: Smallint;
YPos: Smallint);
1: (
Pos: TSmallPoint;
Result: Longint);
end;

TCMHitTest = TWMNCHitTest;
这个消息其实就是一个Windows消息的翻版。Result表示返回值，HTCLIENT就是在，HTNOWHERE就是不在。还有其他很多的返回值，有兴趣你可以根据情况多返回一些（没事找事:)）。

下面就是这个组件的源代码，这个组件只能接受Bitmap，根据0,0的像素决定透明色彩，同时决定区域，Transparent属性表明是否透明，影响鼠标动作区域，不透明就是整个矩形。当鼠标移动进入的时候，图像颜色会变成高亮，高亮的算法是RGB色彩空间转换到HSL色彩空间，HSL色彩空间，H表示色度，S表示饱和度，L表示亮度，所以改变L就可以改变整个图片的亮度，改变以后再转换回RGB色彩空间。祝各位愉快。

unit HotTrackImage;

interface

uses
SysUtils, Classes, Controls, Windows, Messages, Graphics, Math, Forms;

const
MaxPixelCount = 65536;

type
pRGBTripleArray = ^TRGBTripleArray;
TRGBTripleArray = array[0..MaxPixelCount - 1] of TRGBTriple;

THotTrackEvent = procedure(Sender:TObject) of object;

THotTrackImage = class(TGraphicControl)
private
{ Private declarations }
{FSearching:Boolean;
FSearching1:Boolean;
FSearching2:Boolean;
FSearching3:Boolean;
FSearching4:Boolean;
FSearching5:Boolean;
FSearching6:Boolean;}
FPicture: TBitmap;
FHotPicture: TBitmap;
FOnProgress: TProgressEvent;
FStretch: Boolean;
FCenter: Boolean;
FIncrementalDisplay: Boolean;
FDrawing: Boolean;
FProportional: Boolean;
FOnHotTrackLeave: THotTrackEvent;
FOnHotTrackEnter: THotTrackEvent;
FIsHoted: Boolean;
FLightAdd: Integer;
FTransparent: Boolean;
function GetCanvas: TCanvas;
procedure SetHoted(Hoted:Boolean);
procedure DoLightBitmap;
procedure PictureChanged(Sender: TObject);
procedure SetCenter(Value: Boolean);
procedure SetPicture(Value: TBitmap);
procedure SetStretch(Value: Boolean);
procedure SetProportional(Value: Boolean);
procedure SetLightAdd(const Value: Integer);
procedure CMMouseEnter(var Message: TMessage); message CM_MOUSEENTER;
procedure CMMouseLeave(var Message: TMessage); message CM_MOUSELEAVE;
//procedure CMHintShow(var Message: TMessage); message CM_HINTSHOW;
procedure CMHitTest(var Message: TCMHitTest); message CM_HITTEST;
procedure SetTransparent(const Value: Boolean);
protected
{ Protected declarations }
function CanAutoSize(var NewWidth, NewHeight: Integer): Boolean; override;
function DestRect: TRect;
function DoPaletteChange: Boolean;
function GetPalette: HPALETTE; override;
procedure Paint; override;
procedure Progress(Sender: TObject; Stage: TProgressStage;
PercentDone: Byte; RedrawNow: Boolean; const R: TRect; const Msg: string); dynamic;
//procedure MouseDown(Button: TMouseButton; Shift: TShiftState;
// X, Y: Integer); override;
//procedure MouseUp(Button: TMouseButton; Shift: TShiftState;
// X, Y: Integer); override;
//procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;
procedure DoHotTrackEnter;
procedure DoHotTrackLeave;
//procedure Click; override;
//procedure DblClick; override;
public
{ Public declarations }
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
property Canvas: TCanvas read GetCanvas;

标签：

版权申明：本站文章部分自网络，如有侵权，请联系：west999com@outlook.com
特别注意：本站所有转载文章言论不代表本站观点，本站所提供的摄影照片，插画，设计作品，如需使用，请与原作者联系，版权归原作者所有