unit u_WMSComponent;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, ExtCtrls, Controls;
type
TWMSPanel = class(TCustomControl)
FPicMouseLeave: TPicture; // 鼠标移出切换的图片
FPicMouseEnter: TPicture; // 鼠标移入切换的图片
FPicMouseDown: TPicture; // 按下状态图片
FPicShow: TPicture; // 当前显示的图片
procedure SetPicMouseLeave(const Value: TPicture);
procedure SetPicMouseEnter(const Value: TPicture);
procedure SetPicMouseDown(const Value: TPicture);
procedure WMS_MSG_MouseLeave(var message: TMessage); message CM_MOUSELEAVE;
procedure WMS_MSG_MouseEnter(var message: TMessage); message CM_MOUSEENTER;
procedure WMS_MSG_LBUTTONDOWN(var message: TMessage); message WM_LBUTTONDOWN;
procedure WMS_MSG_LBUTTONUP(var message: TMessage); message WM_LBUTTONUP;
protected
{ Protected declarations }
FMouseInComponent: Boolean; // 鼠标是否在控件中
function DestRect: TRect;
procedure Paint; override;
public
{ Public declarations }
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
published
property PicMouseLeave: TPicture read FPicMouseLeave write SetPicMouseLeave;
property PicMouseEnter: TPicture read FPicMouseEnter write SetPicMouseEnter;
property PicMouseDown: TPicture read FPicMouseDown write SetPicMouseDown;
end;
procedure Register;
implementation
procedure Register;
begin
RegisterComponents('WMSMX', [TWMSPanel]);
end;
{ TWMSPanel }
constructor TWMSPanel.Create(AOwner: TComponent);
begin
inherited;
DoubleBuffered := True;
FMouseInComponent := False;
FPicMouseLeave := TPicture.Create();
FPicMouseEnter := TPicture.Create();
FPicMouseDown := TPicture.Create();
FPicShow := TPicture.Create();
end;
destructor TWMSPanel.Destroy;
begin
FreeAndNil(FPicShow);
FreeAndNil(FPicMouseLeave);
FreeAndNil(FPicMouseEnter);
FreeAndNil(FPicMouseDown);
inherited;
end;
function TWMSPanel.DestRect: TRect;
var
w, h, cw, ch: Integer;
xyaspect: Double;
begin
w := FPicShow.Width;
h := FPicShow.Height;
cw := ClientWidth;
ch := ClientHeight;
// if (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 TWMSPanel.Paint;
begin
inherited;
if csDesigning in ComponentState then Exit;
if Assigned(FPicShow) then
begin
Canvas.StretchDraw(DestRect, FPicShow.Graphic);
end;
end;
procedure TWMSPanel.SetPicMouseDown(const Value: TPicture);
begin
FPicMouseDown.Assign(Value);
end;
procedure TWMSPanel.SetPicMouseEnter(const Value: TPicture);
begin
FPicMouseEnter.Assign(Value);
end;
procedure TWMSPanel.SetPicMouseLeave(const Value: TPicture);
begin
FPicMouseLeave.Assign(Value);
end;
procedure TWMSPanel.WMS_MSG_MouseEnter(var message: TMessage);
begin
if csDesigning in ComponentState then
Exit;
FMouseInComponent := True;
FPicShow.Assign(FPicMouseEnter);
Refresh;
end;
procedure TWMSPanel.WMS_MSG_MouseLeave(var message: TMessage);
begin
if csDesigning in ComponentState then
Exit;
FMouseInComponent := False;
FPicShow.Assign(FPicMouseLeave);
Refresh;
end;
procedure TWMSPanel.WMS_MSG_LBUTTONDOWN(var message: TMessage);
begin
if csDesigning in ComponentState then
Exit;
if FMouseInComponent then
begin
FPicShow.Assign(FPicMouseDown);
Refresh;
end;
end;
procedure TWMSPanel.WMS_MSG_LBUTTONUP(var message: TMessage);
begin
if csDesigning in ComponentState then
Exit;
if FMouseInComponent then
begin
FPicShow.Assign(FPicMouseEnter);
Refresh;
end;
end;
end.
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, ExtCtrls, Controls;
type
TWMSPanel = class(TCustomControl)
FPicMouseLeave: TPicture; // 鼠标移出切换的图片
FPicMouseEnter: TPicture; // 鼠标移入切换的图片
FPicMouseDown: TPicture; // 按下状态图片
FPicShow: TPicture; // 当前显示的图片
procedure SetPicMouseLeave(const Value: TPicture);
procedure SetPicMouseEnter(const Value: TPicture);
procedure SetPicMouseDown(const Value: TPicture);
procedure WMS_MSG_MouseLeave(var message: TMessage); message CM_MOUSELEAVE;
procedure WMS_MSG_MouseEnter(var message: TMessage); message CM_MOUSEENTER;
procedure WMS_MSG_LBUTTONDOWN(var message: TMessage); message WM_LBUTTONDOWN;
procedure WMS_MSG_LBUTTONUP(var message: TMessage); message WM_LBUTTONUP;
protected
{ Protected declarations }
FMouseInComponent: Boolean; // 鼠标是否在控件中
function DestRect: TRect;
procedure Paint; override;
public
{ Public declarations }
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
published
property PicMouseLeave: TPicture read FPicMouseLeave write SetPicMouseLeave;
property PicMouseEnter: TPicture read FPicMouseEnter write SetPicMouseEnter;
property PicMouseDown: TPicture read FPicMouseDown write SetPicMouseDown;
end;
procedure Register;
implementation
procedure Register;
begin
RegisterComponents('WMSMX', [TWMSPanel]);
end;
{ TWMSPanel }
constructor TWMSPanel.Create(AOwner: TComponent);
begin
inherited;
DoubleBuffered := True;
FMouseInComponent := False;
FPicMouseLeave := TPicture.Create();
FPicMouseEnter := TPicture.Create();
FPicMouseDown := TPicture.Create();
FPicShow := TPicture.Create();
end;
destructor TWMSPanel.Destroy;
begin
FreeAndNil(FPicShow);
FreeAndNil(FPicMouseLeave);
FreeAndNil(FPicMouseEnter);
FreeAndNil(FPicMouseDown);
inherited;
end;
function TWMSPanel.DestRect: TRect;
var
w, h, cw, ch: Integer;
xyaspect: Double;
begin
w := FPicShow.Width;
h := FPicShow.Height;
cw := ClientWidth;
ch := ClientHeight;
// if (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 TWMSPanel.Paint;
begin
inherited;
if csDesigning in ComponentState then Exit;
if Assigned(FPicShow) then
begin
Canvas.StretchDraw(DestRect, FPicShow.Graphic);
end;
end;
procedure TWMSPanel.SetPicMouseDown(const Value: TPicture);
begin
FPicMouseDown.Assign(Value);
end;
procedure TWMSPanel.SetPicMouseEnter(const Value: TPicture);
begin
FPicMouseEnter.Assign(Value);
end;
procedure TWMSPanel.SetPicMouseLeave(const Value: TPicture);
begin
FPicMouseLeave.Assign(Value);
end;
procedure TWMSPanel.WMS_MSG_MouseEnter(var message: TMessage);
begin
if csDesigning in ComponentState then
Exit;
FMouseInComponent := True;
FPicShow.Assign(FPicMouseEnter);
Refresh;
end;
procedure TWMSPanel.WMS_MSG_MouseLeave(var message: TMessage);
begin
if csDesigning in ComponentState then
Exit;
FMouseInComponent := False;
FPicShow.Assign(FPicMouseLeave);
Refresh;
end;
procedure TWMSPanel.WMS_MSG_LBUTTONDOWN(var message: TMessage);
begin
if csDesigning in ComponentState then
Exit;
if FMouseInComponent then
begin
FPicShow.Assign(FPicMouseDown);
Refresh;
end;
end;
procedure TWMSPanel.WMS_MSG_LBUTTONUP(var message: TMessage);
begin
if csDesigning in ComponentState then
Exit;
if FMouseInComponent then
begin
FPicShow.Assign(FPicMouseEnter);
Refresh;
end;
end;
end.