N_M_B
Messages postés
94
Date d'inscription
mardi 9 mai 2006
Statut
Membre
Dernière intervention
1 mars 2008
5 juil. 2006 à 16:13
unit NMBBtn;
interface
uses
SysUtils,Windows, Classes, Controls,Graphics,ExtCtrls,messages,Dialogs,forms;
type
TGradationType=(H,V);
TOnBeforePaint=procedure (Sender: TObject;var CanPaint:Boolean)of Object;
TOnCantResize=procedure (_Width,_Height,LastWidth,LastHeight:integer;var Resize,ResiseBorder:Boolean)of object;
TMouseHistory=(SEnter,SLeave);
TState=(SNormal,SHot,SDown);
TStyle=(VDefaut,VCourbe,Horizontal);
TCustomBtn = class(TCustomControl)
private
{ Déclarations privées }
protected
{ Déclarations protégées }
public
{ Déclarations publiques }
constructor create(AOwner:TComponent); override;
Destructor Destroy; override;
property Canvas;
published
property Anchors;
property Font;
property Constraints;
property ParentShowHint;
property ShowHint;
property Visible;
property OnMouseMove;
property OnClick;
end;
Tcolors = class(TPersistent)
private
FColor1,FColor2,FColor3,FColor4:Tcolor;
procedure SetColor(Index: Integer; Value: Tcolor);
public
FOwner:TCustomBtn;
Constructor Create(AOwner: TCustomBtn);
protected
published
property Color1:Tcolor index 0 read FColor1 write SetColor ;
property Color2:Tcolor index 1 read FColor2 write SetColor ;
property Color3:Tcolor index 2 read FColor3 write SetColor ;
property Color4:Tcolor index 3 read FColor4 write SetColor;
end;
TNMBBtn = class(TCustomBtn)
private
FCaption:string;
FEFFECTENABLED:Boolean;
FTimer:TTimer;
FTimerInterval:Cardinal;
FEffectBorder:integer;
FTimerDefaultBorder:integer;
FTimer2:TTimer;
FNormalColors:Tcolors;
FHotColors:TColors;
FDawnColors:Tcolors;
FStateVisualiser:TState;
FBorderWidth:integer;
FStyle:TStyle;
FOnMouseEnter: TNotifyEvent;
FOnMouseLeave:TNotifyEvent;
FOnMouseDawn:TMouseEvent;
FOnMouseUp:TMouseEvent;
FOnStateChange:TNotifyEvent;
FState:TState;
FCharged:Boolean;
FOnBeforePaint:TOnBeforePaint;
FOnCantResize:TOnCantResize;
FlastWidth:integer;
FlastHeight:integer;
FNewStyle:TStyle;
FBorderColor:TColor;
FOnAfterPaint:TNotifyEvent;
procedure setCaption(Avalue:string);
procedure SetState(Avalue:Tstate);
procedure SetStateVisualiser(Avalue:Tstate);
procedure SetStyle(Avalue:TStyle);
procedure SetBorderWidth(Avalue:integer);
procedure CMMouseEnter(var msg: TMessage); message CM_MOUSEENTER;
procedure CMMouseLeave(var msg: TMessage); message CM_MOUSELEAVE;
procedure MouseDown(Button:TMouseButton; Shift:TShiftState; X, Y :integer); override;
procedure Mouseup(Button: TmouseButton; Shift:TShiftState; X,Y: Integer); override;
procedure SetTimerInterval(Avalue:Cardinal);
procedure OnTimer(Sender: TObject); virtual;
procedure OnTimer2(Sender: TObject); virtual;
procedure SetEffectState(Avalue:Boolean);
procedure Resize; override;
procedure Draw(_Style:TStyle;_State:TState;BorderMargin:integer);
procedure SetBorderColor(Avalue:TColor);
procedure CMFocusChanged(var Message: TMessage); message CM_FOCUSCHANGED;//********************
procedure CMDialogKey(var Message: TCMDialogKey); message CM_DIALOGKEY;
protected
procedure Paint; override;
procedure CreateWnd; override;
public
procedure DrawBorder(_Width:integer;Color:TColor);
procedure Drawdegradee(GradationType: TGradationType; FirstColor, LastColor: TColor; R: TRect);
procedure DrawCaption;
constructor Create(AOwner:TComponent); override;
destructor Destroy; override;
property State:TState read FState write SetState;
property Charged:Boolean read FCharged write FCharged;
function MaxBorderFor(_Style:TStyle;_Height,_Width:integer):integer;
function MinHeightFor(_Style:TStyle;_BorderWidth:integer):integer;
function MinWidthFor(_Style:TStyle;_BorderWidth:integer):integer;
published
property TabOrder; //***********
property TabStop ; //***********
property OnAfterPaint:TNotifyEvent read FOnAfterPaint write FOnAfterPaint;
property BorderColor:TColor read FBorderColor write setBorderColor;
property EffectBorder:integer read FEffectBorder write FEffectBorder;
property EffectDefaultBorder:integer read FTimerDefaultBorder write FTimerDefaultBorder;
property EffectInterval:Cardinal read FTimerInterval write SetTimerInterval;
property EffectEnabled:Boolean read FEffectEnabled write SetEffectState;
property OnStateChange:TNotifyEvent read FOnStateChange write FOnStateChange;
property Style:TStyle read FStyle write SetStyle;
property OnBeforePaint:TOnBeforePaint read FOnBeforePaint write FOnBeforePaint;
property OnCantResize:TOnCantResize read FOnCantResize write FOnCantResize;
property NormalColors:Tcolors read FNormalColors write FNormalColors ;
property HotColors:Tcolors read FHotColors write FHotColors ;
property DawnColors:Tcolors read FDawnColors write FDawnColors;
property StateVisualiser:TState read FStateVisualiser Write SetStateVisualiser;
property BorderWidth:integer read FBorderWidth write SetBorderWidth;
property OnMouseEnter:TNotifyEvent read FOnMouseEnter write FOnMouseEnter;
property OnMouseLeave:TNotifyEvent read FOnMouseLeave write FOnMouseLeave;
property OnMouseDown:TMouseEvent read FOnMouseDawn write FOnMouseDawn;
property OnMouseUp:TMouseEvent read FOnMouseUp write FOnMouseUp;
property Caption: string read FCaption write setcaption;
end;
procedure Register;
implementation
procedure Register;
begin
RegisterComponents('Delphifr', [TNMBBtn]);
end;
/////////////////////TCustomBtn/////////////////////
constructor TCustomBtn.Create(AOwner:TComponent);
begin
inherited Create(AOwner);
(aowner as Twincontrol).DoubleBuffered:=true;
end;
Destructor TcustomBtn.Destroy;
begin
inherited Destroy;
end;
//////////////////////TColors//////////////////////////////
Constructor Tcolors.Create(AOwner: TCustomBtn);
begin
inherited Create;
FOwner:= AOwner;
FColor1:=clGray;
FColor2:=clWhite;
FColor3:=$00FBFBFB;
FColor4:=$00ADADAD;
end;
procedure Tcolors.SetColor(Index: Integer; Value: Tcolor);
begin
case index of
0:FColor1:=value;
1:FColor2:=value;
2:FColor3:=value;
3:FColor4:=value;
end;
Fowner.invalidate;
//Fowner.Invalidate;
end;
///////////////////////////////////////////////////////////
//////////////////////TNMBbtn////////////////////////////
constructor TNMBbtn.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
Height:= 25;
Width:= 89;
FOnMouseEnter:=Nil;
FOnMouseLeave:=Nil;
FOnCantResize:=Nil;
FOnBeforePaint:=Nil;
FOnAfterPaint:=Nil;
FBorderColor:=clBlack;
FBorderWidth:=4;
FNormalColors:=TColors.Create(self);
FState:=SNormal;
FStyle:=VCourbe;
FHotColors:=TColors.Create(self);
FHotColors.FColor1:=clSilver;
FHotColors.FColor2:=clWhite;
FHotColors.FColor3:=$00FBFBFB;
FHotColors.FColor4:=$00FFBFBF;
FDawnColors:=TColors.Create(self);
FDawnColors.FColor1:=clSilver;
FDawnColors.FColor2:=$009F9F9F;
FDawnColors.FColor3:=$009F9F9F;
FDawnColors.FColor4:=clGray;
FCharged:=False;
FTimer:=TTimer.Create(self);
FEffectBorder:=1;
FTimer.Enabled:=False;
FTimer.OnTimer:=OnTimer;
FTimer2:=TTimer.Create(self);
FTimer2.Enabled:=false;
FTimer2.OnTimer:=OnTimer2;
EffectDefaultBorder:=4;
EffectInterval:=35;
FEffectEnabled:=True;
DoubleBuffered:=true;
end;
procedure TNMBbtn.CreateWnd;
begin
inherited;
if (csDesigning in ComponentState) then
if (Caption='') then
Caption:=Name;
end;
Destructor TNMBBtn.Destroy;
begin
FTimer.Free;
FTimer2.Free;
FHotColors:=nil;
FNormalColors:=nil;
FDawnColors:=nil;
FOnMouseEnter:=nil;
FOnMouseLeave:=nil;
FOnMouseDawn:=nil;
FOnMouseUp:=nil;
FHotColors.Free;
FNormalColors.Free;
FDawnColors.Free;
Inherited Destroy;
end;
procedure TNMBbtn.setCaption(Avalue:string);
begin
Fcaption:=Avalue;
invalidate;
end;
procedure TNMBbtn.DrawCaption;
var TXheight,TXWidth:integer;
flags:longint;
Arect:Trect;
sdf:pdrawtextparams;
begin
//aRect := ClientRect;
//Flags := DT_Center Or DT_VCENTER Or DT_EXPANDTABS Or DT_SINGLELINE;
//DrawText(Canvas.Handle, PChar(Caption), -1,Arect , Flags);
canvas.Brush.Style:=bsClear; // pdrawtextparams
TXheight:=canvas.TextHeight(FCaption);
TXWidth:=canvas.TextWidth(FCaption);
//canvas.Font.Color:=clwhite;
//canvas.TextOut(((width-TXWidth)div 2)+1, ((height-TXheight)div 2)+1,FCaption);
canvas.Font.Assign(Font);
canvas.TextOut((width-TXWidth)div 2, (height-TXheight)div 2,FCaption);
end;
procedure TNMBbtn.CMMouseEnter(var Msg: TMessage);
begin
if csDesigning in ComponentState then exit;
if Enabled
then if Assigned(FOnMouseEnter) then FOnMouseEnter(Self);
if FCharged then State:=SDown else State:=SHot;
if (Not(csDesigning in ComponentState))and(FEFFECTENABLED) then
begin
FTimer2.Enabled:=False;
FTimer.Enabled:=True;
end;
end;
Procedure TNMBbtn.CMMouseLeave(var Msg: TMessage);
begin
if Enabled
then
if Assigned(FOnMouseleave) then FOnMouseLeave(Self);
if FState=SDown then FCharged:=True;
State:=SNormal;
if Not((csDesigning in ComponentState))and(FEFFECTENABLED) then
begin
FTimer.Enabled:=False;
FTimer2.Enabled:=True;;
end;
end;
procedure TNMBbtn.MouseDown(Button: TmouseButton; Shift:TShiftState; X,Y: Integer);
begin
if Enabled
then
if Assigned(FOnMouseDawn) then FOnMouseDawn(self,Button,Shift,X,Y);
if not Focused and CanFocus then
SetFocus;
State:=SDown;
end;
procedure TNMBbtn.MouseUp(Button: TmouseButton; Shift:TShiftState; X,Y: Integer);
begin
if Enabled
then
if Assigned(FOnMouseUp) then FOnMouseUp(self,Button,Shift,X,Y);
FCharged:=false;
if (x<width) and (x>0) and (y<height) and (y>0) then
State:=SHot else State:=SNormal;
end;
procedure TNMBbtn.Setstate(Avalue:TState);
begin
//if self=nil then exit;
FState:=Avalue;
if Assigned(FOnStateChange) then FOnStateChange(self);
invalidate;
Update;
////////////////////////invalidate; par rapport au customcontrol
end;
procedure TNMBbtn.SetBorderWidth(Avalue:integer);
begin
//calcul de la bordure la plus grande possible pour ne pas créer d'erreurs
if Avalue > MaxBorderFor(FStyle,height,width)
then Avalue:=MaxBorderFor(FStyle,height,width);
FBorderWidth:=Avalue;
//if FEffectEnabled then self.Update ;//Update; //pour le clignotement du caption
invalidate;
end;
procedure TNMBbtn.SetStyle(Avalue:TStyle);
begin
FNewStyle:=Avalue;
self.Resize; //chaque style a sa bordure maximal alor on le redimentione si bordure> max
FStyle:=Avalue;
//invalidate;
invalidate;
end;
procedure TNMBbtn.paint;
var FCanPaint:Boolean;
Border:integer;
r:trect;
begin
inherited Paint;
FCanPaint:=true;
if self<>nil then if assigned(FOnBeforePaint) then FOnBeforePaint(self,FCanPaint);
if not(FCanPaint) then EXIT;
Border:=FBorderWidth;
if (csDesigning in ComponentState)
then draw(FStyle,FStateVisualiser,Border)
else draw(FStyle,FState,Border);
DrawCaption; // elle est déja dans drawdegrede
DrawBorder(FBorderWidth,FBorderColor);
if self.Focused then
begin
R := GetClientRect;
InflateRect(R, -2, -2);
DrawFocusRect(Canvas.Handle, R);
end;
if self<>nil then if assigned(FOnAfterPaint) then FOnAfterPaint(self);
update;
end;
procedure TNMBBtn.Resize;
var Resize,ResizeBorder:Boolean;
TempHSize,TempWSize:integer;
begin
inherited Resize;
if (Width<MinWidthFor(FNewStyle,FBorderWidth))or(Height<MinHeightFor(FNewStyle,FBorderWidth)) then
begin
Resize:=True;
ResizeBorder:=False;
TempHSize:=Height;
TempWSize:=Width;
Height:=FlastHeight; // Pour Ne Pas faire un paint avec des tailles
Width:=FlastWidth; // incorrectes come un showmessage a l'evenement OnCantResize
if Assigned(FOnCantResize) then FOnCantResize(TempWSize,TempHSize,FlastWidth,FlastHeight,Resize,ResizeBorder);
if resize then
begin
if ResizeBorder then
BorderWidth:=MaxBorderFor(FNewStyle,TempHSize,TempWSize)
else
begin
if (TempWSize<MinWidthFor(FNewStyle,FBorderWidth))then Width:=MinWidthFor(FNewStyle,FBorderWidth);
if (TempHSize<MinHeightFor(FNewStyle,FBorderWidth))then Height:=MinHeightFor(FNewStyle,FBorderWidth);
end;
end;
end;
FlastWidth :=Width;
FlastHeight:=Height;
end;
function TNMBBtn.MaxBorderFor(_Style: TStyle; _Height,
_Width: integer): integer;
var R:integer; //R:= nombe de dégradées du style
begin
case _Style of
Horizontal,VDefaut:R:=2;
VCourbe :R:=3;
end;
_Height:=Trunc(_Height/R);
_Width:=_Width div 2;
if _Height<=_Width then result:=_Height else result:=_Width;
end;
function TNMBBtn.MinHeightFor(_Style: TStyle;
_BorderWidth: integer): integer;
var R:integer; //R:= nombe de dégradées du style
begin
case _Style of
VDefaut,Horizontal:R :=2; // Ok //Ok
VCourbe:R :=3; //Ok
end;
result:=(_BorderWidth*(R));
end;
function TNMBBtn.MinWidthFor(_Style: TStyle;
_BorderWidth: integer): integer;
begin
Result:=_BorderWidth *2; //OK
end;
procedure TNMBBtn.SetStateVisualiser(Avalue: Tstate);
begin
FStateVisualiser:=Avalue;
//invalidate;
invalidate;
end;
procedure TNMBBtn.SetTimerInterval(Avalue: Cardinal);
begin
FTimerInterval:=Avalue;
FTimer.Interval:=FTimerInterval;
FTimer2.Interval:=FTimerInterval;
end;
procedure TNMBBtn.OnTimer(Sender: TObject);
begin
if BorderWidth=FEffectBorder then begin FTimer.Enabled:=false;EXIT end;
if FTimerDefaultBorder<FEffectBorder then
BorderWidth:=BorderWidth+1
else BorderWidth:=BorderWidth-1;
end;
procedure TNMBBtn.OnTimer2(Sender: TObject);
begin
if BorderWidth=FTimerDefaultBorder then begin FTimer2.Enabled:=false;EXIT end;
if FTimerDefaultBorder>FEffectBorder then
BorderWidth:=BorderWidth+1
else BorderWidth:=BorderWidth-1;
end;
procedure TNMBBtn.SetEffectState(Avalue: Boolean);
begin
FEffectEnabled:=Avalue;
FTimer.Enabled:=false;
FTimer2.Enabled:=False;
self.BorderWidth:=FTimerDefaultBorder;
end;
procedure TNMBBtn.Draw(_Style: TStyle; _State: TState;
BorderMargin: integer);
var Colors:TColors;
ARect:TRect;
begin
case _State of
SNormal:Colors:=FNormalColors;
SHot :Colors:=FHotColors;
SDown :Colors:=FDawnColors;
end;
Case _Style of
VCourbe:
begin
ARect:=Rect(BorderMargin,BorderMargin,width-BorderMargin,(height)div 3);
Drawdegradee(V, Colors.FColor1, Colors.FColor2 , ARect);
ARect:=rect(BorderMargin,(height)div 3,width-BorderMargin,(height)div 2);
Drawdegradee(V, Colors.FColor2, Colors.FColor3 , ARect);
ARect:=Rect(BorderMargin,(height)div 2,width-BorderMargin,height-BorderMargin);
Drawdegradee(V, Colors.FColor3, Colors.FColor4 , ARect);
end;
VDefaut:
begin
ARect:=Rect(BorderMargin,BorderMargin,width-BorderMargin,(height)div 2);
Drawdegradee(V, Colors.FColor1, Colors.FColor2, ARect);
ARect:=Rect(BorderMargin,(height)div 2,width-BorderMargin,height-BorderMargin);
Drawdegradee(V, Colors.FColor3, Colors.FColor4, ARect);
end;
Horizontal:
begin
ARect:=rect(BorderMargin,BorderMargin,width div 2,height-BorderMargin);
Drawdegradee(H, Colors.FColor1, Colors.FColor2 ,ARect);
ARect:=rect( width div 2,BorderMargin,width-BorderMargin,height-BorderMargin);
Drawdegradee(H, Colors.FColor3, Colors.FColor4 ,ARect);
end;
end;
end;
procedure TNMBBtn.DrawBorder(_Width:integer;Color:TColor);
begin
if FBorderWidth*2>0 then
begin
canvas.Pen.Color:=Color;
Canvas.Pen.Width:=_Width*2;
canvas.Rectangle(rect(0,0,Width+1,Height+1));
end;
end;
procedure TNMBBtn.SetBorderColor(Avalue: TColor);
begin
FBorderColor:=Avalue;
invalidate;
end;
procedure TNMBbtn.Drawdegradee(GradationType: TGradationType; FirstColor, LastColor: TColor; R: TRect);
function CtrlByte(N: integer): byte;
begin
if N < 0 then Result:= 0
else if N > 255 then Result:= 255
else Result:= N;
end;
type
TRGBArray = array[0..0] of TRGBTriple;
PRGBArray = ^TRGBArray;
var
GSize, X, Y, N: integer;
Red, Green, Blue: byte;
StepR, StepG, StepB: extended;
Line: PRGBArray;
Bmp: TBitmap;
begin
if GradationType = H then
GSize:= R.Right - R.Left
else
GSize:= R.Bottom - R.Top;
if GSize=0 then inc(GSize);
Red:= GetRValue(FirstColor);
Green:= GetGValue(FirstColor);
Blue:= GetBValue(FirstColor);
StepR:= (GetRValue(LastColor) - Red) / GSize;
StepG:= (GetGValue(LastColor) - Green) / GSize;
StepB:= (GetBValue(LastColor) - Blue) / GSize;
Bmp:= TBitmap.Create;
try
Bmp.Width:= R.Right - R.Left;
Bmp.Height:= R.Bottom - R.Top;
Bmp.PixelFormat:= pf24bit;
for Y:= 0 to Bmp.Height -1 do
begin
Line := Bmp.ScanLine[Y];
for X:= 0 to Bmp.Width - 1 do
begin
if GradationType = H then N:= X
else N:= Y;
Line[X].RGBTRed:= CtrlByte (Round(Red + (StepR * N)));
Line[X].RGBTGreen:= CtrlByte (Round(Green + (StepG * N)));
Line[X].RGBTBlue:= CtrlByte (Round(Blue + (StepB * N)));
end;
end;
canvas.Draw(R.Left, R.Top, Bmp);
finally
Bmp.Free;
end;
end;
procedure TNMBBtn.CMFocusChanged(var Message: TMessage);
begin
invalidate;
end;
procedure TNMBBtn.CMDialogKey(var Message: TCMDialogKey);
begin
inherited;
with Message do
if (((CharCode = VK_RETURN) and (Focused))
or ((CharCode VK_ESCAPE)) and (KeyDataToShiftState(KeyData) []))
and CanFocus then
begin
Click;
Result := 1;
end
else
inherited;
end;
end.
