Delphi7 image控件图片问题
image1原来的图片是图片1,怎么做鼠标放到image1控件上就换成图片2,离开又换回图片1...
image1原来的图片是图片1,怎么做鼠标放到image1控件上就换成图片2,离开又换回图片1
展开
3个回答
展开全部
// 重写一下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;
展开全部
换图片很简单,在onMouseMove事件中用image.Picture.LoadFormFile(...)。
但是onMouseMove事件只在当前最上层控件才能触发。image的onMouseMove事件无法在自身范围外被触发,同样,image的外层如果是Form或Panel一样也没法在鼠标移进image后触发。
方法1.image.onMouseMove中判断一下是否为图片2,是的话就换成图片1;移出的时候再外层控件的onMouseMove中判断一下是否为图片1,是的话就换成图片2。
方法2.可以在image的边缘位置,判断当鼠标移到边缘的时候换图,这样就只用在image的onMouseMove中判断就行了。
但是onMouseMove事件只在当前最上层控件才能触发。image的onMouseMove事件无法在自身范围外被触发,同样,image的外层如果是Form或Panel一样也没法在鼠标移进image后触发。
方法1.image.onMouseMove中判断一下是否为图片2,是的话就换成图片1;移出的时候再外层控件的onMouseMove中判断一下是否为图片1,是的话就换成图片2。
方法2.可以在image的边缘位置,判断当鼠标移到边缘的时候换图,这样就只用在image的onMouseMove中判断就行了。
本回答被网友采纳
已赞过
已踩过<
评论
收起
你对这个回答的评价是?
展开全部
{ 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;
已赞过
已踩过<
评论
收起
你对这个回答的评价是?
推荐律师服务:
若未解决您的问题,请您详细描述您的问题,通过百度律临进行免费专业咨询