创建不规则形状的Control

核心提示： 最近接了一个单子，开发一个产品的教学软件（汗，创建不规则形状的Control，程序员开始变成美工了，没办法要混饭吃，所以改变L就可以改变整个图片的亮度，改变以后再转换回RGB色彩空间，只好堕落了），按照领导（老婆）的说法

　　 最近接了一个单子，开发一个产品的教学软件（汗，程序员开始变成美工了，没办法要混饭吃，只好堕落了）。按照领导（老婆）的说法，工期紧、任务重，所以，只能拿起我最擅长的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;
  published
　  { Published declarations }
　  property Align;
　  property Anchors;
　  property AutoSize;
　  property Center: Boolean read FCenter write SetCenter default False;
　  property Constraints;
　  property DragCursor;
　  property DragKind;
　  property DragMode;
　  property Enabled;
　  property IncrementalDisplay: Boolean read FIncrementalDisplay write FIncrementalDisplay default False;
　  property ParentShowHint;
　  property Picture: TBitmap read FPicture write SetPicture;
　  property PopupMenu;
　  property Proportional: Boolean read FProportional write SetProportional default false;
　  property ShowHint;
　  property Stretch: Boolean read FStretch write SetStretch default False;
　  property Visible;
　  property IsHoted:Boolean read FIsHoted;
　  property LightAdd:Integer read FLightAdd write SetLightAdd;
　  property Transparent: Boolean read FTransparent write SetTransparent default True;
　  property OnClick;
　  property OnContextPopup;
　  property OnDblClick;
　  property OnDragDrop;
　  property OnDragOver;
　  property OnEndDock;
　  property OnEndDrag;
　  property OnMouseDown;
　  property OnMouseMove;
　  property OnMouseUp;
　  property OnProgress: TProgressEvent read FOnProgress write FOnProgress;
　  property OnStartDock;
　  property OnStartDrag;
　  property OnHotTrackEnter:THotTrackEvent read FOnHotTrackEnter write FOnHotTrackEnter;
　  property OnHotTrackLeave:THotTrackEvent read FOnHotTrackLeave write FOnHotTrackLeave;
  end;

procedure Register;

implementation

procedure HSLtoRGB(H, S, L: Double; var R, G, B: Integer);
//hsl颜色空间到rgb空间的转换
var //类似于返回多个值的函数
　 Sat, Lum: Double;
begin
　 R := 0;
　 G := 0;
　 B := 0;
　 if (H < 360) and (H >= 0) and (S <= 100) and (S >= 0) and (L <= 100) and (L
　　  >=
　　  0) then
　　  begin
　　　　 if H <= 60 then
　　　　　  begin
　　　　　　　 R := 255;
　　　　　　　 G := Round((255 / 60) * H);
　　　　　　　 B := 0;
　　　　　  end
　　　　 else if H <= 120 then
　　　　　  begin
　　　　　　　 R := Round(255 - (255 / 60) * (H - 60));
　　　　　　　 G := 255;
　　　　　　　 B := 0;
　　　　　  end
　　　　 else if H <= 180 then
　　　　　  begin
　　　　　　　 R := 0;
　　　　　　　 G := 255;
　　　　　　　 B := Round((255 / 60) * (H - 120));
　　　　　  end
　　　　 else if H <= 240 then
　　　　　  begin
　　　　　　　 R := 0;
　　　　　　　 G := Round(255 - (255 / 60) * (H - 180));
　　　　　　　 B := 255;
　　　　　  end
　　　　 else if H <= 300 then
　　　　　  begin
　　　　　　　 R := Round((255 / 60) * (H - 240));
　　　　　　　 G := 0;
　　　　　　　 B := 255;
　　　　　  end
　　　　 else if H < 360 then
　　　　　  begin
　　　　　　　 R := 255;
　　　　　　　 G := 0;
　　　　　　　 B := Round(255 - (255 / 60) * (H - 300));
　　　　　  end;

　　 Sat := Abs((S - 100) / 100);
　　　　 R := Round(R - ((R - 128) * Sat));
　　　　 G := Round(G - ((G - 128) * Sat));
　　　　 B := Round(B - ((B - 128) * Sat));

　　 Lum := (L - 50) / 50;
　　　　 if Lum > 0 then
　　　　　  begin
　　　　　　　 R := Round(R + ((255 - R) * Lum));
　　　　　　　 G := Round(G + ((255 - G) * Lum));
　　　　　　　 B := Round(B + ((255 - B) * Lum));
　　　　　  end
　　　　 else if Lum < 0 then
　　　　　  begin
　　　　　　　 R := Round(R + (R * Lum));
　　　　　　　 G := Round(G + (G * Lum));
　　　　　　　 B := Round(B + (B * Lum));
　　　　　  end;
　　  end;
end;

procedure RGBtoHSL(R, G, B: Integer; var H, S, L: Double);
// RGB空间到HSL空间的转换
var
　 Delta: Double;
　 CMax, CMin: Double;
　 Red, Green, Blue, Hue, Sat, Lum: Double;
begin
　 Red := R / 255;
　 Green := G / 255;
　 Blue := B / 255;
　 CMax := Max(Red, Max(Green, Blue));
　 CMin := Min(Red, Min(Green, Blue));
　 Lum := (CMax + CMin) / 2;
　 if CMax = CMin then
　　  begin
　　　　 Sat := 0;
　　　　 Hue := 0;
　　  end
　 else
　　  begin
　　　　 if Lum < 0.5 then
　　　　　  Sat := (CMax - CMin) / (CMax + CMin)
　　　　 else
　　　　　  Sat := (cmax - cmin) / (2 - cmax - cmin);
　　　　 delta := CMax - CMin;
　　　　 if Red = CMax then
　　　　　  Hue := (Green - Blue) / Delta
　　　　 else if Green = CMax then
　　　　　  Hue := 2 + (Blue - Red) / Delta
　　　　 else
　　　　　  Hue := 4.0 + (Red - Green) / Delta;
　　　　 Hue := Hue / 6;
　　　　 if Hue < 0 then
　　　　　  Hue := Hue + 1;
　　  end;
　 H := (Hue * 360);
　 S := (Sat * 100);
　 L := (Lum * 100);
end;

procedure Register;
begin
  RegisterComponents('Custom', [THotTrackImage]);
end;

{ THotTrackImage }

function THotTrackImage.CanAutoSize(var NewWidth,
  NewHeight: Integer): Boolean;
begin
  Result := True;
  if not (csDesigning in ComponentState) or (FPicture.Width > 0) and
　  (FPicture.Height > 0) then
  begin
　  if Align in [alNone, alLeft, alRight] then
　　  NewWidth := FPicture.Width;
　  if Align in [alNone, alTop, alBottom] then
　　  NewHeight := FPicture.Height;
  end;
end;

{procedure THotTrackImage.Click;

  procedure ReSearch;
  var
　  I:Integer;
　  TempHK:TControl;
  begin
　  for I:=0 to Parent.ControlCount-1 do
　  begin
　　  TempHK:=Parent.Controls[I];
　　  if TempHK is THotTrackImage then
　　  begin
　　　  if not THotTrackImage(TempHK).FSearching3 then
　　　  begin
　　　　  THotTrackImage(TempHK).Click();
　　　　  Exit;
　　　  end;
　　  end;
　  end;
  end;

begin
  if not FSearching3 then
  begin
　  FSearching3:=True;
　  try
　　  if FIsHoted then
　　  begin
　　　  inherited;
　　  end else
　　  begin
　　　  ReSearch;
　　  end;
　  finally
　　  FSearching3:=False;
　  end;
  end;
end;}

{procedure THotTrackImage.CMHintShow(var Message: TMessage);

  procedure ReSearch;
  var
　  I:Integer;
　  TempHK:TControl;
  begin
　  for I:=0 to Parent.ControlCount-1 do
　  begin
　　  TempHK:=Parent.Controls[I];
　　  if TempHK is THotTrackImage then
　　  begin
　　　  if not THotTrackImage(TempHK).FSearching5 then
　　　  begin
　　　　  if THotTrackImage(TempHK).ShowHint then
　　　　  begin
　　　　　  TCMHintShow(Message).HintInfo^.HintStr:=THotTrackImage(TempHK).Hint;
　　　　　  THotTrackImage(TempHK).CMHintShow(Message);
　　　　　  Exit;
　　　　  end;
　　　  end;
　　  end;
　  end;
  end;

begin
  if not FSearching5 then
  begin
　  FSearching5:=True;
　  try
　　  if FIsHoted then
　　  begin
　　　  inherited;
　　  end else
　　  begin
　　　  ReSearch;
　　  end;
　  finally
　　  FSearching5:=False;
　  end;
  end;
end;}

procedure THotTrackImage.CMMouseEnter(var Message: TMessage);
begin
  inherited;
  SetHoted(True);
end;

procedure THotTrackImage.CMMouseLeave(var Message: TMessage);
begin
  inherited;
  SetHoted(False);
end;

constructor THotTrackImage.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  ControlStyle := ControlStyle + [csReplicatable];
  FPicture := TBitmap.Create;
  FHotPicture := TBitmap.Create;
  FPicture.Transparent:=False;
  FPicture.TransparentMode:=tmAuto;
  FHotPicture.Transparent:=False;
  FHotPicture.TransparentMode:=tmAuto;
  FPicture.OnChange := PictureChanged;
  FPicture.OnProgress := Progress;
  Height := 105;
  Width := 105;
  FIsHoted:=False;
  FLightAdd:=8;
  FTransparent:=True;
  {FSearching:=False;
  FSearching1:=False;
  FSearching2:=False;
  FSearching3:=False;
  FSearching4:=False;
  FSearching5:=False;
  FSearching6:=False;}
end;

{procedure THotTrackImage.DblClick;

  procedure ReSearch;
  var
　  I:Integer;
　  TempHK:TControl;
  begin
　  for I:=0 to Parent.ControlCount-1 do
　  begin
　　  TempHK:=Parent.Controls[I];
　　  if TempHK is THotTrackImage then
　　  begin
　　　  if not THotTrackImage(TempHK).FSearching4 then
　　　  begin
　　　　  THotTrackImage(TempHK).DblClick();
　　　　  Exit;
　　　  end;
　　  end;
　  end;
  end;

begin
  if not FSearching4 then
  begin
　  FSearching4:=True;
　  try
　　  if FIsHoted then
　　  begin
　　　  inherited;
　　  end else
　　  begin
　　　  ReSearch;
　　  end;
　  finally
　　  FSearching4:=False;
　  end;
  end;
end;}

function THotTrackImage.DestRect: TRect;
var
  w, h, cw, ch: Integer;
  xyaspect: Double;
begin
  w := Picture.Width;
  h := Picture.Height;
  cw := ClientWidth;
  ch := ClientHeight;
  if Stretch or (Proportional and ((w > cw) or (h > ch))) then
  begin
 if Proportional and (w > 0) and (h > 0) then
 begin
　　  xyaspect := w / h;
　　  if w > h then
　　  begin
　　　  w := cw;
　　　  h := Trunc(cw / xyaspect);
　　　  if h > ch then  // woops, too big
　　　  begin
　　　　  h := ch;
　　　　  w := Trunc(ch * xyaspect);
　　　  end;
　　  end
　　  else
　　  begin
　　　  h := ch;
　　　  w := Trunc(ch * xyaspect);
　　　  if w > cw then  // woops, too big
　　　  begin
　　　　  w := cw;
　　　　  h := Trunc(cw / xyaspect);
　　　  end;
　　  end;
　  end
　  else
　  begin
　　  w := cw;
　　  h := ch;
　  end;
  end;

  with Result do
  begin
　  Left := 0;
　  Top := 0;
　  Right := w;
　  Bottom := h;
  end;

  if Center then
 OffsetRect(Result, (cw - w) div 2, (ch - h) div 2);
end;

destructor THotTrackImage.Destroy;
begin
  FPicture.Free;
  FHotPicture.Free;
  inherited Destroy;
end;

procedure THotTrackImage.DoHotTrackEnter;
begin
  if Assigned(FOnHotTrackEnter) then
　  FOnHotTrackEnter(Self);
end;

procedure THotTrackImage.DoHotTrackLeave;
begin
  if Assigned(FOnHotTrackLeave) then
　  FOnHotTrackEnter(Self);
end;

procedure THotTrackImage.DoLightBitmap;
var
　 x, y, ScanlineBytes: integer;
　 p: prgbtriplearray;
　 RVALUE, bvalue, gvalue: integer;
　 hVALUE, sVALUE, lVALUE: Double;
begin
  FHotPicture.Assign(FPicture);
  if not FHotPicture.Empty then
  begin
　  FHotPicture.PixelFormat:=pf24bit;
　  p := FHotPicture.ScanLine[0];
　  ScanlineBytes := integer(FHotPicture.ScanLine[1]) - integer(FHotPicture.ScanLine[0]);
　  for y := 0 to FHotPicture.Height - 1 do
　  begin
　　  for x := 0 to FHotPicture.Width - 1 do
　　  begin
　　　  RVALUE := p[x].rgbtRed;
　　　  gVALUE := p[x].rgbtGreen;
　　　  bVALUE := p[x].rgbtBlue;
　　　  RGBtoHSL(RVALUE, gVALUE, bVALUE, hVALUE, sVALUE, lVALUE);
　　　  lVALUE := min(100, lVALUE + FLightAdd);
　　　  HSLtorgb(hVALUE, sVALUE, lVALUE, rVALUE, gVALUE, bVALUE);
　　　  p[x].rgbtRed := RVALUE;
　　　  p[x].rgbtGreen := gVALUE;
　　　  p[x].rgbtBlue := bVALUE;
　　  end;
　　  inc(integer(p), ScanlineBytes);
　  end;
  end;
end;

function THotTrackImage.DoPaletteChange: Boolean;
var
  ParentForm: TCustomForm;
  Tmp: TGraphic;
begin
  Result := False;
  Tmp := FPicture;
  if Visible and (not (csLoading in ComponentState)) and (Tmp <> nil) and
 (Tmp.PaletteModified) then
  begin
 if (Tmp.Palette = 0) then
　 Tmp.PaletteModified := False
 else
 begin
　 ParentForm := GetParentForm(Self);
　 if Assigned(ParentForm) and ParentForm.Active and Parentform.HandleAllocated then
　 begin
　if FDrawing then
　  ParentForm.Perform(wm_QueryNewPalette, 0, 0)
　else
　  PostMessage(ParentForm.Handle, wm_QueryNewPalette, 0, 0);
　Result := True;
　Tmp.PaletteModified := False;
　 end;
 end;
  end;
end;

function THotTrackImage.GetCanvas: TCanvas;
begin
 Result := FPicture.Canvas;
end;

function THotTrackImage.GetPalette: HPALETTE;
begin
 Result := FPicture.Palette;
end;

{procedure THotTrackImage.MouseDown(Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);

  procedure ReSearch;
  var
　  P:TPoint;
　  I:Integer;
　  TempHK:TControl;
  begin
　  for I:=0 to Parent.ControlCount-1 do
　  begin
　　  TempHK:=Parent.Controls[I];
　　  if TempHK is THotTrackImage then
　　  begin
　　　  if not THotTrackImage(TempHK).FSearching1 then
　　　  begin
　　　　  P.X:=X;
　　　　  P.Y:=Y;
　　　　  P:=THotTrackImage(TempHK).ScreenToClient(ClientToScreen(P));
　　　　  THotTrackImage(TempHK).MouseDown(Button,Shift,P.X,P.Y);
　　　　  Exit;
　　　  end;
　　  end;
　  end;
  end;

begin
  if not FSearching1 then
  begin
　  FSearching1:=True;
　  try
　　  if (X>=0)and(X<FPicture.Width)and(Y>=0)and(Y<FPicture.Height) then
　　  begin
　　　  if FPicture.Canvas.Pixels[X,Y]=FPicture.Canvas.Pixels[0,0] then
　　　  begin
　　　　  ReSearch;
　　　  end else
　　　  begin
　　　　  inherited;
　　　  end;
　　  end else
　　  begin
　　　  ReSearch;
　　  end;
　  finally
　　  FSearching1:=False;
　  end;
  end;
end;}

{procedure THotTrackImage.MouseMove(Shift: TShiftState; X, Y: Integer);

  procedure ReSearch;
  var
　  P:TPoint;
　  I:Integer;
　  TempHK:TControl;
  begin
　  for I:=0 to Parent.ControlCount-1 do
　  begin
　　  TempHK:=Parent.Controls[I];
　　  if TempHK is THotTrackImage then
　　  begin
　　　  if not THotTrackImage(TempHK).FSearching then
　　　  begin
　　　　  P.X:=X;
　　　　  P.Y:=Y;
　　　　  P:=THotTrackImage(TempHK).ScreenToClient(ClientToScreen(P));
　　　　  THotTrackImage(TempHK).MouseMove(Shift,P.X,P.Y);
　　　　  Exit;
　　　  end;
　　  end;
　  end;
  end;

  procedure Slicen;
  var
　  I:Integer;
　  TempHK:TControl;
  begin
　  for I:=0 to Parent.ControlCount-1 do
　  begin
　　  TempHK:=Parent.Controls[I];
　　  if TempHK<>Self then
　　  begin
　　　  THotTrackImage(TempHK).SetHoted(False);
　　  end;
　  end;
  end;

begin
  if not FSearching then
  begin
　  FSearching:=True;
　  try
　　  if (X>=0)and(X<FPicture.Width)and(Y>=0)and(Y<FPicture.Height) then
　　  begin
　　　  if FPicture.Canvas.Pixels[X,Y]=FPicture.Canvas.Pixels[0,0] then
　　　  begin
　　　　  SetHoted(False);
　　　　  ReSearch;
　　　  end else
　　　  begin
　　　　  SetHoted(True);
　　　　  Slicen;
　　　　  inherited;
　　　  end;
　　  end else
　　  begin
　　　  SetHoted(False);
　　　  ReSearch;
　　  end;
　  finally
　　  FSearching:=False;
　  end;
  end;
end;}

{procedure THotTrackImage.MouseUp(Button: TMouseButton; Shift: TShiftState;
  X, Y: Integer);

  procedure ReSearch;
  var
　  P:TPoint;
　  I:Integer;
　  TempHK:TControl;
  begin
　  for I:=0 to Parent.ControlCount-1 do
　  begin
　　  TempHK:=Parent.Controls[I];
　　  if TempHK is THotTrackImage then
　　  begin
　　　  if not THotTrackImage(TempHK).FSearching2 then
　　　  begin
　　　　  P.X:=X;
　　　　  P.Y:=Y;
　　　　  P:=THotTrackImage(TempHK).ScreenToClient(ClientToScreen(P));
　　　　  THotTrackImage(TempHK).MouseUp(Button,Shift,P.X,P.Y);
　　　　  Exit;
　　　  end;
　　  end;
　  end;
  end;

begin
  if not FSearching2 then
  begin
　  FSearching2:=True;
　  try
　　  if (X>=0)and(X<FPicture.Width)and(Y>=0)and(Y<FPicture.Height) then
　　  begin
　　　  if FPicture.Canvas.Pixels[X,Y]=FPicture.Canvas.Pixels[0,0] then
　　　  begin
　　　　  ReSearch;
　　　  end else
　　　  begin
　　　　  inherited;
　　　  end;
　　  end else
　　  begin
　　　  ReSearch;
　　  end;
　  finally
　　  FSearching2:=False;
　  end;
  end;
end;}

procedure THotTrackImage.Paint;
var
  Save: Boolean;
begin
  if csDesigning in ComponentState then
 with inherited Canvas do
 begin
　 Pen.Style := psDash;
　 Brush.Style := bsClear;
　 Rectangle(0, 0, Width, Height);
 end;
  Save := FDrawing;
  FDrawing := True;
  try
   with inherited Canvas do
　  begin
　　  if FIsHoted and not(csDesigning in ComponentState) then
　　　 StretchDraw(DestRect, FHotPicture)
　　  else
　　　 StretchDraw(DestRect, FPicture);
　  end;
  finally
　 FDrawing := Save;
  end;
end;

procedure THotTrackImage.PictureChanged(Sender: TObject);
begin
  Picture.Transparent:=FTransparent;
  if AutoSize and (FPicture.Width > 0) and (FPicture.Height > 0) then
 SetBounds(Left, Top, FPicture.Width, FPicture.Height);
  if FTransparent then
　  ControlStyle := ControlStyle - [csOpaque]
  else
　  ControlStyle := ControlStyle + [csOpaque];
  DoLightBitmap;
  if DoPaletteChange and FDrawing then Update;
  if not FDrawing then Invalidate;
end;

procedure THotTrackImage.Progress(Sender: TObject; Stage: TProgressStage;
  PercentDone: Byte; RedrawNow: Boolean; const R: TRect;
  const Msg: string);
begin
  if FIncrementalDisplay and RedrawNow then
  begin
 if DoPaletteChange then Update
 else Paint;
  end;
  if Assigned(FOnProgress) then FOnProgress(Sender, Stage, PercentDone, RedrawNow, R, Msg);
end;

procedure THotTrackImage.SetCenter(Value: Boolean);
begin
  if FCenter <> Value then
  begin
 FCenter := Value;
 PictureChanged(Self);
  end;
end;

procedure THotTrackImage.CMHitTest(var Message: TCMHitTest);
var
  X,Y:Integer;
begin
  if (Message.XPos>=0)and(Message.XPos<FPicture.Width)and(Message.YPos>=0)and(Message.YPos<FPicture.Height)then
  begin
　  if FTransparent then
　  begin
　　  X:=Round(Message.XPos*Picture.Height/Height);
　　  Y:=Round(Message.YPos*Picture.Height/Height);
　　  if(FPicture.Canvas.Pixels[X,Y]<>FPicture.Canvas.Pixels[0,0]) then
　　　  Message.Result := HTCLIENT
　　  else
　　　  Message.Result := HTNOWHERE
　  end else
　　  Message.Result := HTCLIENT;
  end else
　  Message.Result := HTNOWHERE;
end;

procedure THotTrackImage.SetHoted(Hoted: Boolean);
begin
  if FIsHoted<>Hoted then
  begin
　  FIsHoted:=Hoted;
　  Invalidate;
　  if Hoted then
　  begin
　　  //SetCaptureControl(Self);
　　  DoHotTrackEnter;
　  end else
　  begin
　　  //SetCaptureControl(nil);
　　  DoHotTrackLeave;
　  end;
  end;
end;

procedure THotTrackImage.SetLightAdd(const Value: Integer);
begin
  FLightAdd := Value;
  DoLightBitmap;
  if FIsHoted then
　  Invalidate;
end;

procedure THotTrackImage.SetPicture(Value: TBitmap);
begin
  if Value<>nil then
  begin
　  Value.Transparent:=FTransparent;
　  Value.TransparentMode:=tmAuto;
  end;
  FPicture.Assign(Value);
end;

procedure THotTrackImage.SetProportional(Value: Boolean);
begin
  if FProportional <> Value then
  begin
 FProportional := Value;
 PictureChanged(Self);
  end;
end;

procedure THotTrackImage.SetStretch(Value: Boolean);
begin
  if Value <> FStretch then
  begin
 FStretch := Value;
 PictureChanged(Self);
  end;
end;

procedure THotTrackImage.SetTransparent(const Value: Boolean);
begin
  if FTransparent<>Value then
  begin
　  FTransparent := Value;
   PictureChanged(Self);
  end;
end;

end.