CombBx3D
unit CombBx3D;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls;
type
TComboBox3DBevel = (bvNone,bvLowered,bvRaised,bvShadow);
TComboBox3DPressState = (bvNonePress,bvPress);
TComboBox3D = class(TCustomComboBox)
private
FHighLightColor: TColor;
FShadowColor: TColor;
FBevel: TComboBox3DBevel;
FShadowSize: Byte;
FPressState: TComboBox3DPressState;
procedure CNDrawItem(var Message: TWMDrawItem); message CN_DRAWITEM;
procedure DoDrawShadowText(ColorHigh,ColorLow: TColor;Rect: TRect;
Index: Integer;State: TOwnerDrawState);
function GetTextHeight: LongInt;
procedure SetBevel(Value: TComboBox3DBevel);
procedure SetHighLightColor(Value: TColor);
procedure SetShadowColor(Value: TColor);
procedure SetShadowSize(Value: Byte);
protected
procedure DrawItem(Index: Integer; Rect: TRect;
State: TOwnerDrawState); override;
procedure MeasureItem(Index: Integer; var iHeight: Integer); override;
public
constructor Create(AOwner: TComponent); override;
published
property HighLightColor: TColor read FHighLightColor
write SetHighLightColor default clBtnHighLight;
property ShadowColor: TColor read FShadowColor
write SetShadowColor default clBtnShadow;
property Bevel: TComboBox3DBevel read FBevel
write SetBevel default bvRaised;
property ShadowSize: Byte read FShadowSize
write SetShadowSize default 1;
property PressState: TComboBox3DPressState read FPressState
write FPressState default bvNonePress;
{}
property Style; {Must be published before Items}
property Color;
property Ctl3D;
property DragMode;
property DragCursor;
property DropDownCount;
property Enabled;
property Font;
property ItemHeight;
property Items;
property MaxLength;
property ParentColor;
property ParentCtl3D;
property ParentFont;
property ParentShowHint;
property PopupMenu;
property ShowHint;
property Sorted;
property TabOrder;
property TabStop;
property Text;
property Visible;
property OnChange;
property OnClick;
property OnDblClick;
property OnDragDrop;
property OnDragOver;
property OnDropDown;
property OnEndDrag;
property OnEnter;
property OnExit;
property OnKeyDown;
property OnKeyPress;
property OnKeyUp;
property OnStartDrag;
end;
procedure Register;
implementation
procedure Register;
begin
RegisterComponents('3DElements', [TComboBox3D]);
end;
{
class TComboBox3D
~~~~~~~~~~~~~~~~
}
constructor TComboBox3D.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
Style:=csOwnerDrawVariable;
FHighLightColor:=clBtnHighLight;
FShadowColor:=clBtnShadow;
FBevel:=bvRaised;
FShadowSize:=1;
FPressState:=bvNonePress;
end;
procedure TComboBox3D.DoDrawShadowText(ColorHigh,ColorLow: TColor;Rect: TRect;
Index: Integer;State: TOwnerDrawState);
var
R: TRect;
OldColor: TColor;
Flags: Word;
begin
Flags:=DT_VCENTER or DT_SINGLELINE;
OldColor:=Canvas.Font.Color;
{High shadow text}
if FBevel <> bvShadow then
begin
R:=Rect;
OffsetRect(R,-FShadowSize,-FShadowSize);
Inc(R.Left,2+FShadowSize);
Canvas.Font.Color:=ColorHigh;
if Enabled then
DrawText(Canvas.Handle,PChar(Items[Index]),Length(Items[Index]),
R,Flags);
end;
{Low shadow text}
if (FBevel = bvShadow) and (odSelected in State) then
else
begin
R:=Rect;
OffsetRect(R,FShadowSize,FShadowSize);
Inc(R.Left,2+FShadowSize);
Canvas.Font.Color:=ColorLow;
DrawText(Canvas.Handle,PChar(Items[Index]),Length(Items[Index]),
R,Flags);
end;
{Text}
Canvas.Font.Color:=OldColor;
if not Enabled then Canvas.Font.Color:=clGrayText;
Inc(Rect.Left,2+FShadowSize);
DrawText(Canvas.Handle,PChar(Items[Index]),Length(Items[Index]),
Rect,Flags);
end;
procedure TComboBox3D.DrawItem(Index: Integer; Rect: TRect;
State: TOwnerDrawState);
var
R: TRect;
begin
if Assigned(OnDrawItem) then OnDrawItem(Self,Index,Rect,State)
else
begin
Canvas.FillRect(Rect);
if odSelected in State then
begin
R:=Rect;
DrawFrameControl(Canvas.Handle,R,DFC_BUTTON,DFCS_BUTTONPUSH);
end;
if Index < Items.Count then
begin
Canvas.Brush.Style:=bsClear;
if FBevel = bvNone then
begin
Canvas.Font:=Font;
Canvas.TextOut(Rect.Left+2,Rect.Top,Items[Index]);
end
else
if (odSelected in State) and (FPressState = bvPress) then
case FBevel of
bvRaised : DoDrawShadowText(FShadowColor,FHighLightColor,
Rect,Index,State);
bvLowered: DoDrawShadowText(FHighLightColor,FShadowColor,
Rect,Index,State);
bvShadow : DoDrawShadowText(0,FShadowColor,Rect,Index,State);
end
else
case FBevel of
bvRaised : DoDrawShadowText(FHighLightColor,FShadowColor,
Rect,Index,State);
bvLowered: DoDrawShadowText(FShadowColor,FHighLightColor,
Rect,Index,State);
bvShadow : DoDrawShadowText(0,FShadowColor,Rect,Index,State);
end;
end;
end;
end;
procedure TComboBox3D.CNDrawItem(var Message: TWMDrawItem);
var
State: TOwnerDrawState;
begin
with Message.DrawItemStruct^ do
begin
Inc(rcItem.Bottom);
State:=TOwnerDrawState(WordRec(LongRec(itemState).Lo).Lo);
Canvas.Handle:=hDC;
Canvas.Font:=Font;
Canvas.Brush:=Brush;
if Integer(itemID) >= 0 then
DrawItem(itemID,rcItem,State)
else
Canvas.FillRect(rcItem);
if (Integer(itemID) >= 0) and (odSelected in State) then
Canvas.Brush.Color:=clHighlight;
if odFocused in State then
begin
InflateRect(rcItem,-2,-2);
Canvas.Pen.Color:=clWindowFrame;
Canvas.Brush.Color:=clBtnFace;
DrawFocusRect(Canvas.Handle,rcItem);
end;
Canvas.Handle:=0;
end;
end;
function TComboBox3D.GetTextHeight: LongInt;
var
hdcf: HDC;
TM: TTextMetric;
SaveFont: HFont;
begin
hdcf:=GetDC(0);
SaveFont:=SelectObject(hdcf,Font.Handle);
GetTextMetrics(hdcf,TM);
Result:=TM.tmHeight;
SelectObject(hdcf,SaveFont);
ReleaseDC(0,hdcf);
end;
procedure TComboBox3D.MeasureItem(Index: Integer; var iHeight: Integer);
begin
iHeight:=GetTextHeight+2;
if FBevel <> bvNone then
iHeight:=iHeight+2*FShadowSize;
end;
procedure TComboBox3D.SetBevel(Value: TComboBox3DBevel);
begin
if FBevel <> Value then
begin
FBevel:=Value;
Invalidate;
end;
end;
procedure TComboBox3D.SetHighLightColor(Value: TColor);
begin
if FHighLightColor <> Value then
begin
FHighLightColor:=Value;
Invalidate;
end;
end;
procedure TComboBox3D.SetShadowColor(Value: TColor);
begin
if FShadowColor <> Value then
begin
FShadowColor:=Value;
Invalidate;
end;
end;
procedure TComboBox3D.SetShadowSize(Value: Byte);
begin
if FShadowSize <> Value then
begin
FShadowSize:=Value;
ItemHeight:=GetTextHeight+2;
if FBevel <> bvNone then
ItemHeight:=ItemHeight+2*FShadowSize;
Height:=ItemHeight;
Invalidate;
end;
end;
end.
Delphi - .....................................
3d Button
unit Button3D;
interface
uses
Windows,Messages,SysUtils,Classes,Graphics,Controls,Forms,Dialogs,
StdCtrls,Buttons;
type
TButton3DBevel = (bvNone,bvLowered,bvRaised,bvShadow);
TButton3DPressState = (bvNonePress,bvPress);
TButton3D = class(TButton)
private
FCanvas: TCanvas;
FHighLightColor: TColor;
FShadowColor: TColor;
FBevel: TButton3DBevel;
FShadowSize: Byte;
FPressState: TButton3DPressState;
IsFocused: Boolean;
IsDown: Boolean;
procedure CNDrawItem(var Message: TWMDrawItem); message CN_DRAWITEM;
procedure CMFontChanged(var Message: TMessage); message CM_FONTCHANGED;
procedure CMEnabledChanged(var Message: TMessage); message CM_ENABLEDCHANGED;
procedure CNMeasureItem(var Message: TWMMeasureItem); message CN_MEASUREITEM;
procedure DrawButtonText(Canvas: TCanvas; const Caption: string;
TextBounds: TRect; State: TButtonState);
procedure DrawItem(const DrawItemStruct: TDrawItemStruct);
procedure DoDrawShadowText(ColorHigh,ColorLow: TColor;Rect: TRect);
procedure SetBevel(Value: TButton3DBevel);
procedure SetHighLightColor(Value: TColor);
procedure SetShadowColor(Value: TColor);
procedure SetShadowSize(Value: Byte);
procedure WMLButtonDblClk(var Message: TWMLButtonDblClk); message WM_LBUTTONDBLCLK;
protected
procedure CreateParams(var Params: TCreateParams); override;
procedure SetButtonStyle(ADefault: Boolean); override;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
published
property HighLightColor: TColor read FHighLightColor
write SetHighLightColor default clBtnHighLight;
property ShadowColor: TColor read FShadowColor
write SetShadowColor default clBtnShadow;
property Bevel: TButton3DBevel read FBevel
write SetBevel default bvRaised;
property ShadowSize: Byte read FShadowSize
write SetShadowSize default 1;
property PressState: TButton3DPressState read FPressState
write FPressState default bvNonePress;
end;
procedure Register;
implementation
procedure Register;
begin
RegisterComponents('3DElements',[TButton3D]);
end;
{
class TButton3D
~~~~~~~~~~~~~~~
}
constructor TButton3D.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
FCanvas:=TCanvas.Create;
FHighLightColor:=clBtnHighLight;
FShadowColor:=clBtnShadow;
FBevel:=bvRaised;
FShadowSize:=1;
FPressState:=bvNonePress;
end;
destructor TButton3D.Destroy;
begin
FCanvas.Free;
inherited Destroy;
end;
procedure TButton3D.CreateParams(var Params: TCreateParams);
begin
inherited CreateParams(Params);
with Params do Style:=Style or BS_OWNERDRAW;
end;
procedure TButton3D.CNDrawItem(var Message: TWMDrawItem);
begin
DrawItem(Message.DrawItemStruct^);
end;
procedure TButton3D.CMFontChanged(var Message: TMessage);
begin
inherited;
Invalidate;
end;
procedure TButton3D.CMEnabledChanged(var Message: TMessage);
begin
inherited;
Invalidate;
end;
procedure TButton3D.CNMeasureItem(var Message: TWMMeasureItem);
begin
with Message.MeasureItemStruct^ do
begin
itemWidth:=Width;
itemHeight:=Height;
end;
end;
procedure TButton3D.DrawButtonText(Canvas: TCanvas; const Caption: string;
TextBounds: TRect; State: TButtonState);
begin
with Canvas do
begin
Brush.Style:=bsClear;
if State = bsDisabled then
begin
OffsetRect(TextBounds,1,1);
Font.Color:=clWhite;
DrawText(Handle,PChar(Caption),Length(Caption),TextBounds,
DT_CENTER or DT_VCENTER or DT_SINGLELINE);
OffsetRect(TextBounds,-1,-1);
Font.Color:=clDkGray;
DrawText(Handle,PChar(Caption),Length(Caption),TextBounds,
DT_CENTER or DT_VCENTER or DT_SINGLELINE);
end
else
begin
Canvas.Font:=Font;
if FBevel = bvNone then
DrawText(Canvas.Handle,PChar(Caption),Length(Caption),TextBounds,
DT_CENTER or DT_VCENTER or DT_SINGLELINE)
else
if IsDown and (FPressState = bvPress) then
case FBevel of
bvRaised : DoDrawShadowText(FShadowColor,FHighLightColor,TextBounds);
bvLowered: DoDrawShadowText(FHighLightColor,FShadowColor,TextBounds);
bvShadow : DoDrawShadowText(0,FShadowColor,TextBounds);
end
else
case FBevel of
bvRaised : DoDrawShadowText(FHighLightColor,FShadowColor,TextBounds);
bvLowered: DoDrawShadowText(FShadowColor,FHighLightColor,TextBounds);
bvShadow : DoDrawShadowText(0,FShadowColor,TextBounds);
end;
end;
end;
end;
procedure TButton3D.DrawItem(const DrawItemStruct: TDrawItemStruct);
var
IsDefault: Boolean;
State: TButtonState;
R: TRect;
Flags: Longint;
begin
FCanvas.Handle:=DrawItemStruct.hDC;
R:=ClientRect;
with DrawItemStruct do
begin
IsDown:=itemState and ODS_SELECTED <> 0;
IsDefault:=itemState and ODS_FOCUS <> 0;
if not Enabled then State:=bsDisabled
else if IsDown then State:=bsDown
else State:=bsUp;
end;
Flags:=DFCS_BUTTONPUSH or DFCS_ADJUSTRECT;
if IsDown then Flags:=Flags or DFCS_PUSHED;
if DrawItemStruct.itemState and ODS_DISABLED <> 0 then
Flags:=Flags or DFCS_INACTIVE;
{ DrawFrameControl doesn't allow for drawing a button as the
default button,so it must be done here. }
if IsFocused or IsDefault then
begin
FCanvas.Pen.Color:=clWindowFrame;
FCanvas.Pen.Width:=1;
FCanvas.Brush.Style:=bsClear;
FCanvas.Rectangle(R.Left,R.Top,R.Right,R.Bottom);
{ DrawFrameControl must draw within this border }
InflateRect(R,-1,-1);
end;
{ DrawFrameControl does not draw a pressed button correctly }
if IsDown then
begin
FCanvas.Pen.Color:=clBtnShadow;
FCanvas.Pen.Width:=1;
FCanvas.Brush.Color:=clBtnFace;
FCanvas.Rectangle(R.Left,R.Top,R.Right,R.Bottom);
InflateRect(R,-1,-1);
end
else
DrawFrameControl(DrawItemStruct.hDC,R,DFC_BUTTON,Flags);
if IsFocused then
begin
R:=ClientRect;
InflateRect(R,-1,-1);
end;
FCanvas.Font:=Self.Font;
if IsDown then
OffsetRect(R,1,1);
DrawButtonText(FCanvas,Caption,R,State);
if IsFocused then
begin
R:=ClientRect;
InflateRect(R,-4,-4);
FCanvas.Pen.Color:=clWindowFrame;
FCanvas.Brush.Color:=clBtnFace;
DrawFocusRect(FCanvas.Handle,R);
end;
FCanvas.Handle:=0;
end;
procedure TButton3D.DoDrawShadowText(ColorHigh,ColorLow: TColor;Rect: TRect);
var
R: TRect;
Flags: Word;
begin
Flags:=DT_CENTER or DT_VCENTER or DT_SINGLELINE;
{High shadow text}
if FBevel <> bvShadow then
begin
R:=Rect;
OffsetRect(R,-FShadowSize,-FShadowSize);
FCanvas.Font.Color:=ColorHigh;
DrawText(FCanvas.Handle,PChar(Caption),Length(Caption),R,Flags);
end;
{Low shadow text}
if (FBevel = bvShadow) and (IsDown) then
else
begin
R:=Rect;
OffsetRect(R,FShadowSize,FShadowSize);
FCanvas.Font.Color:=ColorLow;
DrawText(FCanvas.Handle,PChar(Caption),Length(Caption),R,Flags);
end;
{Text}
FCanvas.Font:=Font;
DrawText(FCanvas.Handle,PChar(Caption),Length(Caption),Rect,Flags);
end;
procedure TButton3D.SetButtonStyle(ADefault: Boolean);
begin
if ADefault <> IsFocused then
begin
IsFocused:=ADefault;
Refresh;
end;
end;
procedure TButton3D.SetBevel(Value: TButton3DBevel);
begin
if FBevel <> Value then
begin
FBevel:=Value;
Invalidate;
end;
end;
procedure TButton3D.SetHighLightColor(Value: TColor);
begin
if FHighLightColor <> Value then
begin
FHighLightColor:=Value;
Invalidate;
end;
end;
procedure TButton3D.SetShadowColor(Value: TColor);
begin
if FShadowColor <> Value then
begin
FShadowColor:=Value;
Invalidate;
end;
end;
procedure TButton3D.SetShadowSize(Value: Byte);
begin
if FShadowSize <> Value then
begin
FShadowSize:=Value;
Invalidate;
end;
end;
procedure TButton3D.WMLButtonDblClk(var Message: TWMLButtonDblClk);
begin
Perform(WM_LBUTTONDOWN, Message.Keys, Longint(Message.Pos));
end;
end.
Delphi - .....................................
W3d Canvas
unit W3DCanvas;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
ExtCtrls;
type
TW3DStyle = (dsRaised,dsInlaid,dsNormal);
TW3DCanvas = class(TGraphicControl)
private
{ Private declarations }
protected
{ Protected declarations }
sStyle:TW3DStyle;
sPen:Tpen;
swidth:integer;
hicol:TColor;
ShadCol:Tcolor ;
topcol,botcol:TColor; // actual color used based on drawstyle
mfont:Tfont;
Procedure setstyle(styl:tw3dstyle);
public
{ Public declarations }
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
procedure MoveTo(X, Y: Integer);
Procedure LineTo(X, Y: Integer);
Property Canvas;
published
{ Published declarations }
Property DrawStyle:TW3DStyle read sstyle write setstyle default dsRaised;
Property DrawWidth:Integer read sWidth write sWidth default 1;
Property HighLightColor:Tcolor read topcol write topcol default clWhite;
Property ShadowColor:Tcolor read botcol write botcol default clGray;
Property Font;
//------ Utility Procedures
procedure shiftarray(var Points: array of TPoint;offset:integer);
//------ functions of canvas
procedure TextOut(X, Y: Integer;Text: string);
procedure Ellipse(X1, Y1, X2, Y2: Integer);
procedure Chord(X1, Y1, X2, Y2, X3, Y3, X4, Y4: Integer);
procedure Rectangle(X1, Y1, X2, Y2: Integer);
procedure Pie(X1, Y1, X2, Y2, X3, Y3, X4, Y4: Longint);
procedure RoundRect(X1, Y1, X2, Y2, X3, Y3: Integer);
procedure Arc(X1, Y1, X2, Y2, X3, Y3, X4, Y4: Integer);
procedure FrameRect(Rect: TRect);
procedure Polygon(Points: array of TPoint);
procedure Polyline(Points: array of TPoint);
end;
procedure Register;
implementation
//------------------------------------------------------------------------------
procedure Register;
begin
RegisterComponents('WAISS', [TW3DCanvas]);
end;
//------------------------------------------------------------------------------
destructor TW3DCanvas.Destroy;
begin
inherited destroy;
end;
//------------------------------------------------------------------------------
constructor TW3DCanvas.Create(AOwner: TComponent);
begin
inherited create(AOwner);
hicol := clWhite;
shadcol := clGray;
topcol :=clWhite;
botcol := clgray;
drawwidth := 1;
canvas.Brush.style:=bsClear;
canvas.Pen.width:=1;
end;
//------------------------------------------------------------------------------
procedure TW3DCanvas.TextOut(X, Y: Integer;Text: string);
begin
with canvas do
begin
font.size := self.Font.Size;
font.name:= self.Font.Name;
brush.style:=bsClear;
font.Color :=hicol;
textout(x,y,text);
font.color :=shadcol;
textout(x+2,y+2,text);
font.color :=clbtnface;
textout(x+1,y+1,text);
end;
end;
//------------------------------------------------------------------------------
procedure TW3DCanvas.Ellipse(X1, Y1, X2, Y2: Integer);
begin
with canvas do
begin
brush.style:=bsSolid;
brush.Color := hicol;
pen.Color := hicol;
ellipse(x1,y1,x2,y2);////
brush.Color := shadcol;
pen.Color := shadcol;
ellipse(x1+2,y1+2,x2+2,y2+2);///
brush.Color := clBtnFace;
pen.Color := clBtnFace;
ellipse(x1+1,y1+1,x2+1,y2+1);
end;
end;
//------------------------------------------------------------------------------
procedure TW3DCanvas.Chord(X1, Y1, X2, Y2, X3, Y3, X4, Y4: Integer);
begin
with canvas do
begin
brush.style:=bsSolid;
brush.Color := hicol;
pen.Color := hicol;
Chord(X1, Y1, X2, Y2, X3, Y3, X4, Y4);////
brush.Color := shadcol;
pen.Color := shadcol;
Chord(X1+2, Y1+2, X2+2, Y2+2, X3+2, Y3+2, X4+2, Y4+2);///
brush.Color := clBtnFace;
pen.Color := clBtnFace;
Chord(X1+1, Y1+1, X2+1, Y2+1, X3+1, Y3+1, X4+1, Y4+1);
end;
end;
//------------------------------------------------------------------------------
procedure TW3DCanvas.Rectangle(X1, Y1, X2, Y2: Integer);
begin
with canvas do
begin
brush.style:=bsSolid;
brush.Color := hicol;
pen.Color := hicol;
Rectangle(x1,y1,x2,y2);////
brush.Color := shadcol;
pen.Color := shadcol;
Rectangle(x1+2,y1+2,x2+2,y2+2);///
brush.Color := clBtnFace;
pen.Color := clBtnFace;
Rectangle(x1+1,y1+1,x2+1,y2+1);
end;
end;
//------------------------------------------------------------------------------
procedure TW3DCanvas.Pie(X1, Y1, X2, Y2, X3, Y3, X4, Y4: Longint);
begin
with canvas do
begin
brush.style:=bsSolid;
brush.Color := hicol;
pen.Color := hicol;
Pie(X1, Y1, X2, Y2, X3, Y3, X4, Y4);////
brush.Color := shadcol;
pen.Color := shadcol;
Pie(X1+2, Y1+2, X2+2, Y2+2, X3+2, Y3+2, X4+2, Y4+2);///
brush.Color := clBtnFace;
pen.Color := clBtnFace;
Pie(X1+1, Y1+1, X2+1, Y2+1, X3+1, Y3+1, X4+1, Y4+1);
end;
end;
//------------------------------------------------------------------------------
procedure TW3DCanvas.RoundRect(X1, Y1, X2, Y2,X3,Y3: Integer);
begin
with canvas do
begin
brush.style:=bsSolid;
brush.Color := hicol;
pen.Color := hicol;
RoundRect(x1,y1,x2,y2,X3,Y3);////
brush.Color := shadcol;
pen.Color := shadcol;
RoundRect(x1+2,y1+2,x2+2,y2+2,X3+2,Y3+2);///
brush.Color := clBtnFace;
pen.Color := clBtnFace;
RoundRect(x1+1,y1+1,x2+1,y2+1,X3+1,Y3+1);
end;
end;
//------------------------------------------------------------------------------
procedure TW3DCanvas.Arc(X1, Y1, X2, Y2, X3, Y3, X4, Y4: Integer);
begin
with canvas do
begin
brush.style:=bsSolid;
brush.Color := hicol;
pen.Color := hicol;
Arc(X1, Y1, X2, Y2, X3, Y3, X4, Y4);////
brush.Color := shadcol;
pen.Color := shadcol;
Arc(X1+2, Y1+2, X2+2, Y2+2, X3+2, Y3+2, X4+2, Y4+2);///
brush.Color := clBtnFace;
pen.Color := clBtnFace;
Arc(X1+1, Y1+1, X2+1, Y2+1, X3+1, Y3+1, X4+1, Y4+1);
end;
end;
//------------------------------------------------------------------------------
procedure TW3DCanvas.FrameRect(Rect: TRect);
begin
with canvas do
begin
offsetrect(rect,1,1);
brush.Color := shadcol;
framerect(rect);
offsetrect(rect,-1,-1);
brush.color := hicol;
framerect(rect);
end;
end;
//------------------------------------------------------------------------------
procedure TW3DCanvas.Polygon(Points: array of TPoint);
begin
with canvas do
begin
brush.style:=bsSolid;
brush.Color := hicol;
pen.Color := hicol;
polygon(points);////
shiftarray(points,2);
brush.Color := shadcol;
pen.Color := shadcol;
polygon(points);///
shiftarray(points,-1);
brush.Color := clBtnFace;
pen.Color := clBtnFace;
polygon(points);
end;
end;
//------------------------------------------------------------------------------
procedure TW3DCanvas.Polyline(Points: array of TPoint);
begin
with canvas do
begin
pen.color :=hicol;
polyline(points);
shiftarray(points,1);
pen.color :=shadcol;
polyline(points);
end;
end;
//------------------------------------------------------------------------------
procedure TW3DCanvas.shiftarray(var Points: array of TPoint;offset:integer);
var i:integer;
begin
for i := 0 to high(points) do
begin
points[i].x:=points[i].x+offset;
points[i].y:=points[i].y+offset;
end;
end;
//------------------------------------------------------------------------------
Procedure TW3DCanvas.setstyle(styl:tw3dstyle);
begin
sstyle := styl;
if styl = dsRaised then
begin
hicol := topcol;
shadcol := botcol;
end
else
begin
hicol := botcol;
shadcol := topcol;
end;
end;
//------------------------------------------------------------------------------
procedure TW3DCanvas.MoveTo(X, Y: Integer);
begin
canvas.moveto(x,y);
end;
//------------------------------------------------------------------------------
Procedure TW3DCanvas.LineTo(X, Y: Integer);
var t:Tpoint ;
begin
with canvas do
begin
t:= penpos;
pen.color :=hicol;
lineto(x,y);
pen.color :=shadcol;
moveto(t.x-2,t.y+2);
lineto(x-2,y+2);
pen.color := clBtnFace;
moveto(t.x-1,t.y+1) ;
lineto(x-1,y+1);
end;
end;
end.
Delphi - .....................................
rvNavigator
unit rvNavigator;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
ExtCtrls, DB, DbCtrls, Buttons;
const
InitRepeatPause = 400;
RepeatPause = 100;
SpaceSize = 5;
type
TrvNavButton = class;
TrvNavDataLink = class;
TrvNavigateBtn = (nbFirst, nbPrior, nbNext, nbLast, nbInsert, nbDelete,
nbEdit, nbPost, nbCancel, nbRefresh);
TrvButtonSet = set of TrvNavigateBtn;
TrvNavButtonStyle = set of (nsAllowTimer, nsFocusRect);
TOrientation = (noHorizontal, noVertical);
rvBeforeClick = procedure(Sender: TObject; Button: TrvNavigateBtn;
var DoOperation: Boolean) of object;
rvNavClick = procedure(Sender: TObject; Button: TrvNavigateBtn) of object;
TrvNavigator = class(TCustomPanel)
private
{ Private declarations }
FDataLink: TrvNavDataLink;
FVisibleButtons: TrvButtonSet;
FHints: TStrings;
ButtonWidth: Integer;
MinBtnSize: TPoint;
FOnNavClick: rvNavClick;
FBeforeAction: rvBeforeClick;
FocusedButton: TrvNavigateBtn;
FConfirmDelete: Boolean;
FConfirmText: string;
FFlat: Boolean;
FGlyphs: TImageList;
FGlyphChangeLink: TChangeLink;
FOrientation: Torientation;
FAlign: TAlign;
procedure ClickHandler(Sender: TObject);
function GetDataSource: TDataSource;
procedure SetDataSource(Value: TDataSource);
procedure InitButtons;
procedure InitHints;
procedure BtnMouseDown (Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure SetVisible(Value: TrvButtonSet);
procedure AdjustSize (var W: Integer; var H: Integer);
procedure HintsChanged(Sender: TObject);
procedure SetHints(Value: TStrings);
procedure SetFlat(Value: Boolean);
procedure WMSize(var Message: TWMSize); message WM_SIZE;
procedure WMSetFocus(var Message: TWMSetFocus); message WM_SETFOCUS;
procedure WMKillFocus(var Message: TWMKillFocus); message WM_KILLFOCUS;
procedure WMGetDlgCode(var Message: TWMGetDlgCode); message WM_GETDLGCODE;
procedure CMEnabledChanged(var Message: TMessage); message CM_ENABLEDCHANGED;
procedure SetGlyphs( Value: TImageList );
procedure ShowGlyphs;
procedure GlyphListChange( Sender: TObject );
procedure SetOrientation( Value: TOrientation );
procedure SetAlign( Value: TAlign);
protected
{ Protected declarations }
Buttons: array[TrvNavigateBtn] of TrvNavButton;
procedure DataChanged;
procedure EditingChanged;
procedure ActiveChanged;
procedure Loaded; override;
procedure KeyDown(var Key: Word; Shift: TShiftState); override;
procedure Notification(AComponent: TComponent;
Operation: TOperation); override;
procedure GetChildren(Proc: TGetChildProc; Root: TComponent); override;
public
{ Public declarations }
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
procedure SetBounds(ALeft, ATop, AWidth, AHeight: Integer); override;
procedure BtnClick(Index: TrvNavigateBtn);
published
{ Published declarations }
property DataSource: TDataSource read GetDataSource write SetDataSource;
property VisibleButtons: TrvButtonSet read FVisibleButtons write SetVisible
default [nbFirst, nbPrior, nbNext, nbLast, nbInsert, nbDelete,
nbEdit, nbPost, nbCancel, nbRefresh];
property Align read FAlign write SetAlign default alNone;
property DragCursor;
property DragMode;
property Enabled;
property Flat: Boolean read FFlat write SetFlat default False;
property Ctl3D;
property Hints: TStrings read FHints write SetHints;
property ParentCtl3D;
property ParentShowHint;
property PopupMenu;
property ConfirmDelete: Boolean read FConfirmDelete write FConfirmDelete default True;
property ConfirmText: string read FConfirmText write FConfirmText;
property ShowHint;
property TabOrder;
property TabStop;
property Visible;
property BeforeAction: rvBeforeClick read FBeforeAction write FBeforeAction;
property OnClick: rvNavClick read FOnNavClick write FOnNavClick;
property OnDblClick;
property OnDragDrop;
property OnDragOver;
property OnEndDrag;
property OnEnter;
property OnExit;
property OnResize;
property OnStartDrag;
property Glyphs: TImageList read FGlyphs write SetGlyphs;
property Orientation: TOrientation
read FOrientation
write SetOrientation
default noHorizontal;
end;
{ TNavButton }
TrvNavButton = class(TSpeedButton)
private
FIndex: TrvNavigateBtn;
FNavStyle: TrvNavButtonStyle;
FRepeatTimer: TTimer;
procedure TimerExpired(Sender: TObject);
protected
procedure Paint; override;
procedure MouseDown(Button: TMouseButton; Shift: TShiftState;
X, Y: Integer); override;
procedure MouseUp(Button: TMouseButton; Shift: TShiftState;
X, Y: Integer); override;
public
destructor Destroy; override;
property NavStyle: TrvNavButtonStyle read FNavStyle write FNavStyle;
property Index : TrvNavigateBtn read FIndex write FIndex;
end;
{ TNavDataLink }
TrvNavDataLink = class(TDataLink)
private
FNavigator: TrvNavigator;
protected
procedure EditingChanged; override;
procedure DataSetChanged; override;
procedure ActiveChanged; override;
public
constructor Create(ANav: TrvNavigator);
destructor Destroy; override;
end;
procedure Register;
implementation
{$IFDEF WIN32}
{$R RVDBNAV32.RES}
{$ELSE}
{$R RVDBNAV16.RES}
{$ENDIF}
var
BtnTypeName: array[TrvNavigateBtn] of PChar = ('FIRST', 'PRIOR', 'NEXT',
'LAST', 'INSERT', 'DELETE', 'EDIT', 'POST', 'CANCEL', 'REFRESH');
BtnHintId: array[TrvNavigateBtn] of PChar = ('First', 'Prior',
'Next', 'Last', 'Insert', 'Delete', 'Edit',
'Post', 'Cancel', 'Refresh');
constructor TrvNavigator.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
ControlStyle := ControlStyle - [csAcceptsControls, csSetCaption] + [csOpaque];
if not NewStyleControls then ControlStyle := ControlStyle + [csFramed];
FDataLink := TrvNavDataLink.Create(Self);
FVisibleButtons := [nbFirst, nbPrior, nbNext, nbLast, nbInsert,
nbDelete, nbEdit, nbPost, nbCancel, nbRefresh];
FHints := TStringList.Create;
TStringList(FHints).OnChange := HintsChanged;
InitButtons;
BevelOuter := bvNone;
BevelInner := bvNone;
Width := 241;
Height := 25;
ButtonWidth := 0;
FocusedButton := nbFirst;
FConfirmDelete := True;
FullRepaint := False;
FconfirmText := 'Delete record?';
FGlyphChangeLink := TChangeLink.Create;
FGlyphChangeLink.OnChange := GlyphListChange;
end;
destructor TrvNavigator.Destroy;
begin
FDataLink.Free;
FHints.Free;
FDataLink := nil;
FGlyphs := nil;
FGlyphChangeLink.Free;
inherited Destroy;
end;
procedure TrvNavigator.GlyphListChange( Sender: TObject );
var
TempGlyphs: TImageList;
begin
TempGlyphs := FGlyphs;
FGlyphs := nil;
ShowGlyphs;
FGlyphs := TempGlyphs;
ShowGlyphs;
end;
procedure TrvNavigator.SetGlyphs(Value: TImageList);
begin
if Assigned( FGlyphs ) then
FGlyphs.UnRegisterChanges(FGlyphChangeLink);
Fglyphs := Value;
if Assigned( FGlyphs ) then
FGlyphs.RegisterChanges(FGlyphChangeLink);
ShowGlyphs;
end;
procedure TrvNavigator.ShowGlyphs;
var
I: TrvNavigateBtn;
J: Integer;
ResName: string;
begin
J := 0;
for I := Low(Buttons) to High(Buttons) do
begin
FmtStr(ResName, 'RV_%s', [BtnTypeName[I]]);
if not Assigned(FGlyphs) then
begin
Buttons[I].Glyph.LoadFromResourceName(HInstance, ResName);
Buttons[I].NumGlyphs := 2
end else
begin
If (J < FGlyphs.Count) then
begin
Buttons[I].Glyph := nil;
FGlyphs.GetBitmap(J, Buttons[I].Glyph);
Buttons[I].NumGlyphs := 2;
end;
end;
Inc(J);
Invalidate;
end;
end;
procedure TrvNavigator.SetOrientation( Value: TOrientation );
var
W, H: integer;
begin
if FOrientation <> Value then
begin
FOrientation := Value;
if( NOT( csLoading in ComponentState ) )then
begin
H := Height;
W := Width;
inherited Height := W;
inherited Width := H;
AdjustSize(W, H);
SetVisible(FVisibleButtons);
Invalidate;
end;
end;
end;
procedure TrvNavigator.SetAlign( Value: TAlign );
begin
FAlign := Value;
if (FAlign in [alRight, alLeft]) and (FOrientation <> noVertical) then
begin
inherited Align := alNone;
SetOrientation(noVertical);
end;
if (FAlign in [alTop, alBottom]) and (FOrientation <> noHorizontal) then
begin
inherited Align := alNone;
SetOrientation(noHorizontal);
end;
inherited Align := FAlign;
end;
procedure TrvNavigator.InitButtons;
var
I: TrvNavigateBtn;
Btn: TrvNavButton;
X: Integer;
ResName: string;
begin
MinBtnSize := Point(20, 18);
X := 0;
for I := Low(Buttons) to High(Buttons) do
begin
Btn := TrvNavButton.Create (Self);
Btn.Flat := Flat;
Btn.Index := I;
Btn.Visible := I in FVisibleButtons;
Btn.Enabled := True;
Btn.SetBounds (X, 0, MinBtnSize.X, MinBtnSize.Y);
FmtStr(ResName, 'RV_%s', [BtnTypeName[I]]);
Btn.Glyph.LoadFromResourceName(HInstance, ResName);
Btn.NumGlyphs := 2;
Btn.Enabled := False;
Btn.Enabled := True;
Btn.OnClick := ClickHandler;
Btn.OnMouseDown := BtnMouseDown;
Btn.Parent := Self;
Buttons[I] := Btn;
X := X + MinBtnSize.X;
end;
InitHints;
Buttons[nbPrior].NavStyle := Buttons[nbPrior].NavStyle + [nsAllowTimer];
Buttons[nbNext].NavStyle := Buttons[nbNext].NavStyle + [nsAllowTimer];
end;
procedure TrvNavigator.InitHints;
var
I: Integer;
J: TrvNavigateBtn;
begin
for J := Low(Buttons) to High(Buttons) do
Buttons[J].Hint := BtnHintId[J];
J := Low(Buttons);
for I := 0 to (FHints.Count - 1) do
begin
if FHints.Strings[I] <> '' then Buttons[J].Hint := FHints.Strings[I];
if J = High(Buttons) then Exit;
Inc(J);
end;
end;
procedure TrvNavigator.HintsChanged(Sender: TObject);
begin
InitHints;
end;
procedure TrvNavigator.SetFlat(Value: Boolean);
var
I: TrvNavigateBtn;
begin
if FFlat <> Value then
begin
FFlat := Value;
for I := Low(Buttons) to High(Buttons) do
Buttons[I].Flat := Value;
end;
end;
procedure TrvNavigator.SetHints(Value: TStrings);
begin
FHints.Assign(Value);
end;
procedure TrvNavigator.GetChildren(Proc: TGetChildProc; Root: TComponent);
begin
end;
procedure TrvNavigator.Notification(AComponent: TComponent;
Operation: TOperation);
begin
inherited Notification(AComponent, Operation);
if (Operation = opRemove) and (FDataLink <> nil) and
(AComponent = DataSource) then DataSource := nil;
if (Operation = opRemove) and (AComponent = FGlyphs) then
Glyphs := nil;
end;
procedure TrvNavigator.SetVisible(Value: TrvButtonSet);
var
I: TrvNavigateBtn;
W, H: Integer;
begin
W := Width;
H := Height;
FVisibleButtons := Value;
for I := Low(Buttons) to High(Buttons) do
Buttons[I].Visible := I in FVisibleButtons;
AdjustSize (W, H);
if (W <> Width) or (H <> Height) then
inherited SetBounds (Left, Top, W, H);
Invalidate;
end;
procedure TrvNavigator.AdjustSize (var W: Integer; var H: Integer);
var
Count: Integer;
MinW: Integer;
I: TrvNavigateBtn;
Space, Temp, Remain: Integer;
X, Y: Integer;
begin
if FOrientation = noHorizontal then
begin
if (csLoading in ComponentState) then Exit;
if Buttons[nbFirst] = nil then Exit;
Count := 0;
for I := Low(Buttons) to High(Buttons) do
begin
if Buttons[I].Visible then
begin
Inc(Count);
end;
end;
if Count = 0 then Inc(Count);
MinW := Count * MinBtnSize.X;
if W < MinW then W := MinW;
if H < MinBtnSize.Y then H := MinBtnSize.Y;
ButtonWidth := W div Count;
Temp := Count * ButtonWidth;
if Align = alNone then W := Temp;
X := 0;
Remain := W - Temp;
Temp := Count div 2;
for I := Low(Buttons) to High(Buttons) do
begin
if Buttons[I].Visible then
begin
Space := 0;
if Remain <> 0 then
begin
Dec(Temp, Remain);
if Temp < 0 then
begin
Inc(Temp, Count);
Space := 1;
end;
end;
Buttons[I].SetBounds(X, 0, ButtonWidth + Space, Height);
Inc(X, ButtonWidth + Space);
end
else
Buttons[I].SetBounds (Width + 1, 0, ButtonWidth, Height);
end;
end else
begin
if (csLoading in ComponentState) then Exit;
if Buttons[nbFirst] = nil then Exit;
Count := 0;
for I := Low(Buttons) to High(Buttons) do
begin
if Buttons[I].Visible then
begin
Inc(Count);
end;
end;
if Count = 0 then Inc(Count);
MinW := Count * MinBtnSize.X;
if H < MinW then H := MinW;
if W < MinBtnSize.Y then W := MinBtnSize.Y;
ButtonWidth := H div Count;
Temp := Count * ButtonWidth;
if Align = alNone then H := Temp;
Y := 0;
Remain := H - Temp;
Temp := Count div 2;
for I := Low(Buttons) to High(Buttons) do
begin
if Buttons[I].Visible then
begin
Space := 0;
if Remain <> 0 then
begin
Dec(Temp, Remain);
if Temp < 0 then
begin
Inc(Temp, Count);
Space := 1;
end;
end;
Buttons[I].SetBounds(0, Y, Width, ButtonWidth + Space);
Inc(Y, ButtonWidth + Space);
end
else
Buttons[I].SetBounds (0, Height + 1, Width, ButtonWidth);
end;
end;
end;
procedure TrvNavigator.SetBounds(ALeft, ATop, AWidth, AHeight: Integer);
var
W, H: Integer;
begin
W := AWidth;
H := AHeight;
if not HandleAllocated then AdjustSize (W, H);
inherited SetBounds (ALeft, ATop, W, H);
end;
procedure TrvNavigator.WMSize(var Message: TWMSize);
var
W, H: Integer;
begin
inherited;
{ check for minimum size }
W := Width;
H := Height;
AdjustSize (W, H);
if (W <> Width) or (H <> Height) then
inherited SetBounds(Left, Top, W, H);
Message.Result := 0;
end;
procedure TrvNavigator.ClickHandler(Sender: TObject);
begin
BtnClick (TrvNavButton (Sender).Index);
end;
procedure TrvNavigator.BtnMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
var
OldFocus: TrvNavigateBtn;
begin
OldFocus := FocusedButton;
FocusedButton := TrvNavButton (Sender).Index;
if TabStop and (GetFocus <> Handle) and CanFocus then
begin
SetFocus;
if (GetFocus <> Handle) then
Exit;
end
else if TabStop and (GetFocus = Handle) and (OldFocus <> FocusedButton) then
begin
Buttons[OldFocus].Invalidate;
Buttons[FocusedButton].Invalidate;
end;
end;
procedure TrvNavigator.BtnClick(Index: TrvNavigateBtn);
var
bDoOP: Boolean;
begin
bDoOp := True;
if (DataSource <> nil) and (DataSource.State <> dsInactive) then
begin
if not (csDesigning in ComponentState) and Assigned(FBeforeAction) then
FBeforeAction(Self, Index, bDoOp);
if bDoOp = True then
begin
with DataSource.DataSet do
begin
case Index of
nbPrior: Prior;
nbNext: Next;
nbFirst: First;
nbLast: Last;
nbInsert: Insert;
nbEdit: Edit;
nbCancel: Cancel;
nbPost: Post;
nbRefresh: Refresh;
nbDelete:
if not FConfirmDelete or
(MessageDlg(FConfirmText, mtConfirmation,
mbOKCancel, 0) <> mrCancel) then Delete;
end;
end;
end;
end;
if not (csDesigning in ComponentState) and Assigned(FOnNavClick) then
FOnNavClick(Self, Index);
end;
procedure TrvNavigator.WMSetFocus(var Message: TWMSetFocus);
begin
Buttons[FocusedButton].Invalidate;
end;
procedure TrvNavigator.WMKillFocus(var Message: TWMKillFocus);
begin
Buttons[FocusedButton].Invalidate;
end;
procedure TrvNavigator.KeyDown(var Key: Word; Shift: TShiftState);
var
NewFocus: TrvNavigateBtn;
OldFocus: TrvNavigateBtn;
begin
OldFocus := FocusedButton;
case Key of
VK_RIGHT:
begin
NewFocus := FocusedButton;
repeat
if NewFocus < High(Buttons) then
NewFocus := Succ(NewFocus);
until (NewFocus = High(Buttons)) or (Buttons[NewFocus].Visible);
if NewFocus <> FocusedButton then
begin
FocusedButton := NewFocus;
Buttons[OldFocus].Invalidate;
Buttons[FocusedButton].Invalidate;
end;
end;
VK_LEFT:
begin
NewFocus := FocusedButton;
repeat
if NewFocus > Low(Buttons) then
NewFocus := Pred(NewFocus);
until (NewFocus = Low(Buttons)) or (Buttons[NewFocus].Visible);
if NewFocus <> FocusedButton then
begin
FocusedButton := NewFocus;
Buttons[OldFocus].Invalidate;
Buttons[FocusedButton].Invalidate;
end;
end;
VK_SPACE:
begin
if Buttons[FocusedButton].Enabled then
Buttons[FocusedButton].Click;
end;
end;
end;
procedure TrvNavigator.WMGetDlgCode(var Message: TWMGetDlgCode);
begin
Message.Result := DLGC_WANTARROWS;
end;
procedure TrvNavigator.DataChanged;
var
UpEnable, DnEnable: Boolean;
begin
UpEnable := Enabled and FDataLink.Active and not FDataLink.DataSet.BOF;
DnEnable := Enabled and FDataLink.Active and not FDataLink.DataSet.EOF;
Buttons[nbFirst].Enabled := UpEnable;
Buttons[nbPrior].Enabled := UpEnable;
Buttons[nbNext].Enabled := DnEnable;
Buttons[nbLast].Enabled := DnEnable;
Buttons[nbDelete].Enabled := Enabled and FDataLink.Active and
FDataLink.DataSet.CanModify and
not (FDataLink.DataSet.BOF and FDataLink.DataSet.EOF);
end;
procedure TrvNavigator.EditingChanged;
var
CanModify: Boolean;
begin
CanModify := Enabled and FDataLink.Active and FDataLink.DataSet.CanModify;
Buttons[nbInsert].Enabled := CanModify;
Buttons[nbEdit].Enabled := CanModify and not FDataLink.Editing;
Buttons[nbPost].Enabled := CanModify and FDataLink.Editing;
Buttons[nbCancel].Enabled := CanModify and FDataLink.Editing;
Buttons[nbRefresh].Enabled := CanModify;
end;
procedure TrvNavigator.ActiveChanged;
var
I: TrvNavigateBtn;
begin
if not (Enabled and FDataLink.Active) then
for I := Low(Buttons) to High(Buttons) do
Buttons[I].Enabled := False
else
begin
DataChanged;
EditingChanged;
end;
end;
procedure TrvNavigator.CMEnabledChanged(var Message: TMessage);
begin
inherited;
if not (csLoading in ComponentState) then
ActiveChanged;
end;
procedure TrvNavigator.SetDataSource(Value: TDataSource);
begin
FDataLink.DataSource := Value;
if not (csLoading in ComponentState) then
ActiveChanged;
if Value <> nil then Value.FreeNotification(Self);
end;
function TrvNavigator.GetDataSource: TDataSource;
begin
Result := FDataLink.DataSource;
end;
procedure TrvNavigator.Loaded;
var
W, H: Integer;
begin
inherited Loaded;
W := Width;
H := Height;
AdjustSize (W, H);
if (W <> Width) or (H <> Height) then
inherited SetBounds (Left, Top, W, H);
InitHints;
ActiveChanged;
end;
{TNavButton}
destructor TrvNavButton.Destroy;
begin
if FRepeatTimer <> nil then
FRepeatTimer.Free;
inherited Destroy;
end;
procedure TrvNavButton.MouseDown(Button: TMouseButton; Shift: TShiftState;
X, Y: Integer);
begin
inherited MouseDown (Button, Shift, X, Y);
if nsAllowTimer in FNavStyle then
begin
if FRepeatTimer = nil then
FRepeatTimer := TTimer.Create(Self);
FRepeatTimer.OnTimer := TimerExpired;
FRepeatTimer.Interval := InitRepeatPause;
FRepeatTimer.Enabled := True;
end;
end;
procedure TrvNavButton.MouseUp(Button: TMouseButton; Shift: TShiftState;
X, Y: Integer);
begin
inherited MouseUp (Button, Shift, X, Y);
if FRepeatTimer <> nil then
FRepeatTimer.Enabled := False;
end;
procedure TrvNavButton.TimerExpired(Sender: TObject);
begin
FRepeatTimer.Interval := RepeatPause;
if (FState = bsDown) and MouseCapture then
begin
try
Click;
except
FRepeatTimer.Enabled := False;
raise;
end;
end;
end;
procedure TrvNavButton.Paint;
var
R: TRect;
begin
inherited Paint;
if (GetFocus = Parent.Handle) and
(FIndex = TrvNavigator(Parent).FocusedButton) then
begin
R := Bounds(0, 0, Width, Height);
InflateRect(R, -3, -3);
if FState = bsDown then
OffsetRect(R, 1, 1);
DrawFocusRect(Canvas.Handle, R);
end;
end;
{ TNavDataLink }
constructor TrvNavDataLink.Create(ANav: TrvNavigator);
begin
inherited Create;
FNavigator := ANav;
end;
destructor TrvNavDataLink.Destroy;
begin
FNavigator := nil;
inherited Destroy;
end;
procedure TrvNavDataLink.EditingChanged;
begin
if FNavigator <> nil then FNavigator.EditingChanged;
end;
procedure TrvNavDataLink.DataSetChanged;
begin
if FNavigator <> nil then FNavigator.DataChanged;
end;
procedure TrvNavDataLink.ActiveChanged;
begin
if FNavigator <> nil then FNavigator.ActiveChanged;
end;
procedure Register;
begin
RegisterComponents('RVDataPack', [TrvNavigator]);
end;
end.
Delphi - .....................................
