Delphi7 image控件图片问题

image1原来的图片是图片1,怎么做鼠标放到image1控件上就换成图片2,离开又换回图片1... image1原来的图片是图片1,怎么做鼠标放到image1控件上就换成图片2,离开又换回图片1 展开
 我来答
sxdtgsh
2013-12-31 · TA获得超过2221个赞
知道小有建树答主
回答量:913
采纳率:75%
帮助的人:801万
展开全部
// 重写一下TImage 把OnMouseEnter和OnMouseLeave事件放出来。
// 然后在OnMouseEnter及OnMouseLeave事件中换图片。
// 下面是TMYImage,已经把OnMouseEnter和OnMouseLeave事件放出来了。
type
  TMYImage = class(TGraphicControl)
  private
    FOnMouseEnter: TNotifyEvent;
    FOnMouseLeave: TNotifyEvent;
    FPicture: TPicture;
    FOnProgress: TProgressEvent;
    FStretch: Boolean;
    FCenter: Boolean;
    FIncrementalDisplay: Boolean;
    FTransparent: Boolean;
    FDrawing: Boolean;
    FProportional: Boolean;    
    function GetCanvas: TCanvas;
    procedure PictureChanged(Sender: TObject);
    procedure SetCenter(Value: Boolean);
    procedure SetPicture(Value: TPicture);
    procedure SetStretch(Value: Boolean);
    procedure SetTransparent(Value: Boolean);
    procedure SetProportional(Value: Boolean);
  protected
    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 MouseEnter; virtual;
    procedure MouseLeave; virtual;
    procedure CM_MouseEnter(var msg: TMessage); message CM_MOUSEENTER;
    procedure CM_MouseLeave(var msg: TMessage); message CM_MOUSELEAVE;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    property Canvas: TCanvas read GetCanvas;
  published
    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: TPicture 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 Transparent: Boolean read FTransparent write SetTransparent default False;
    property Visible;
    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 OnMouseEnter: TNotifyEvent read FOnMouseEnter write FOnMouseEnter;
    property OnMouseLeave: TNotifyEvent read FOnMouseLeave write FOnMouseLeave;
  end;

constructor TMYImage.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  ControlStyle := ControlStyle + [csReplicatable];
  FPicture := TPicture.Create;
  FPicture.OnChange := PictureChanged;
  FPicture.OnProgress := Progress;
  Height := 105;
  Width := 105;
end;

destructor TMYImage.Destroy;
begin
  FPicture.Free;
  inherited Destroy;
end;

function TMYImage.GetPalette: HPALETTE;
begin
  Result := 0;
  if FPicture.Graphic <> nil then
Result := FPicture.Graphic.Palette;
end;

function TMYImage.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;

procedure TMYImage.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
  StretchDraw(DestRect, Picture.Graphic);
  finally
FDrawing := Save;
  end;
end;

function TMYImage.DoPaletteChange: Boolean;
var
  ParentForm: TCustomForm;
  Tmp: TGraphic;
begin
  Result := False;
  Tmp := Picture.Graphic;
  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;

procedure TMYImage.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;

function TMYImage.GetCanvas: TCanvas;
var
  Bitmap: TBitmap;
begin
  if Picture.Graphic = nil then
  begin
Bitmap := TBitmap.Create;
try
  Bitmap.Width := Width;
  Bitmap.Height := Height;
  Picture.Graphic := Bitmap;
finally
  Bitmap.Free;
end;
  end;
  if Picture.Graphic is TBitmap then
Result := TBitmap(Picture.Graphic).Canvas
  else
raise EInvalidOperation.Create(SImageCanvasNeedsBitmap);
end;

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

procedure TMYImage.SetPicture(Value: TPicture);
begin
  FPicture.Assign(Value);
end;

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

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

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

procedure TMYImage.PictureChanged(Sender: TObject);
var
  G: TGraphic;
  D : TRect;
begin
  if AutoSize and (Picture.Width > 0) and (Picture.Height > 0) then
SetBounds(Left, Top, Picture.Width, Picture.Height);
  G := Picture.Graphic;
  if G <> nil then
  begin
if not ((G is TMetaFile) or (G is TIcon)) then
  G.Transparent := FTransparent;
        D := DestRect;
if (not G.Transparent) and (D.Left <= 0) and (D.Top <= 0) and
   (D.Right >= Width) and (D.Bottom >= Height) then
  ControlStyle := ControlStyle + [csOpaque]
else  // picture might not cover entire clientrect
  ControlStyle := ControlStyle - [csOpaque];
if DoPaletteChange and FDrawing then Update;
  end
  else ControlStyle := ControlStyle - [csOpaque];
  if not FDrawing then Invalidate;
end;

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

procedure TMYImage.MouseEnter;
begin
  if Assigned(FOnMouseEnter) then
    FOnMouseEnter(Self);
end;

procedure TMYImage.MouseLeave;
begin
  if Assigned(FOnMouseLeave) then
    FOnMouseLeave(Self);
end;

procedure TMYImage.CM_MouseEnter(var msg: TMessage);
begin
  Inherited;
  MouseEnter;
end;

procedure TMYImage.CM_MouseLeave(var msg: TMessage);
begin
  Inherited;
  MouseLeave;
end;
百度网友f3153a6
2013-12-31 · TA获得超过672个赞
知道小有建树答主
回答量:545
采纳率:0%
帮助的人:327万
展开全部
换图片很简单,在onMouseMove事件中用image.Picture.LoadFormFile(...)。
但是onMouseMove事件只在当前最上层控件才能触发。image的onMouseMove事件无法在自身范围外被触发,同样,image的外层如果是Form或Panel一样也没法在鼠标移进image后触发。
方法1.image.onMouseMove中判断一下是否为图片2,是的话就换成图片1;移出的时候再外层控件的onMouseMove中判断一下是否为图片1,是的话就换成图片2。
方法2.可以在image的边缘位置,判断当鼠标移到边缘的时候换图,这样就只用在image的onMouseMove中判断就行了。
本回答被网友采纳
已赞过 已踩过<
你对这个回答的评价是?
评论 收起
D调的聪
2013-12-31 · TA获得超过241个赞
知道小有建树答主
回答量:220
采纳率:100%
帮助的人:168万
展开全部
{ image1的OnMouseMove事件 }
procedure TForm1.image1MouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
  if image1.Tag=0 then { 防止图片频繁加载 }
  begin
    image1.Picture.LoadFromFile('D:\Desktop\4315.jpg'); { 加载图片2 }
    image1.Tag := 9;
  end;
end;

{ Form的OnMouseMove事件 }
procedure TForm1.FormMouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
  if image1.Tag=9 then
  begin
    image1.Picture.LoadFromFile('D:\Desktop\25465.jpg'); { 加载图片1 }
    image1.Tag := 0;
  end;
end;
已赞过 已踩过<
你对这个回答的评价是?
评论 收起
收起 更多回答(1)
推荐律师服务: 若未解决您的问题,请您详细描述您的问题,通过百度律临进行免费专业咨询

为你推荐:

下载百度知道APP,抢鲜体验
使用百度知道APP,立即抢鲜体验。你的手机镜头里或许有别人想知道的答案。
扫描二维码下载
×

类别

我们会通过消息、邮箱等方式尽快将举报结果通知您。

说明

0/200

提交
取消

辅 助

模 式