創建不規則形狀的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;
　　  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.