1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81
|
unit UScroolbar;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, UDegrade, ExtCtrls;
type
TScroll = class
private
fWidth,fHeight : integer;
FOnMouseover,FOnMouseOut : TNotifyEvent;
Paintbox1 : TPaintbox;
bmp : TBitmap;
procedure DoPaint(sender : TObject);
procedure CMMouseEnter(var msg:TMessage); message CM_MOUSEENTER;
procedure CMMouseLeave(var msg: TMessage); message CM_MOUSELEAVE;
public
constructor create(aowner : TWINCONTROL);reintroduce;
published
property OnMouseover:TNotifyEvent read FOnMouseover write FOnMouseover ;
property OnMouseOut :TNotifyEvent read FOnMouseOut write FOnMouseOut ;
end;
implementation
Uses Unit1;
constructor TScroll.create(aowner : TWINCONTROL);
begin
inherited create;
Paintbox1:=TPaintbox.Create(aowner);
bmp:=TBitmap.Create;
fWidth:=50;
fHeight:=300;
With Paintbox1 do
begin
Parent:=aowner;
Width:=fWidth;;
Height:=fHeight;
OnPaint:=DoPaint;
bmp.Width:=Width;
bmp.Height:=Height;
end;
end;
procedure TScroll.DoPaint(sender : TObject);
begin
With bmp.Canvas do
begin
end;
Paintbox1.Canvas.Draw(0,0,bmp);
end;
procedure TScroll.CMMouseEnter(var msg:TMessage);
begin
inherited;
Form1.Caption:='entre';
if assigned(OnMouseover) then OnMouseover(self);
end;
procedure TScroll.CMMouseLeave(var msg: TMessage);
begin
inherited;
Form1.Caption:='sort';
if assigned(OnMouseOut) then OnMouseOut(self);
end;
end. |
Partager