CSDN博客

img BlueTrees

创建不规则形状的Control

发表于2004/2/15 23:53:00  1208人阅读

分类: Delphi

最近接了一个单子,开发一个产品的教学软件(汗,程序员开始变成美工了,没办法要混饭吃,只好堕落了)。按照领导(老婆)的说法,工期紧、任务重,所以,只能拿起我最擅长的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.

0 0

相关博文

我的热门文章

img
取 消
img