Mega Code Archive
XpBitBtn
<![CDATA[
Title: xpBitBtn
Question: XpBitBtn
This Component Is Complete But Only For stxpBlue Style
Answer:
unit HbtXpBitBtn;
{$S-,W-,R-,H+,X+}
{$C PRELOAD}
interface
uses
Windows,
Messages,
Classes,
Controls,
Forms,
Graphics,
StdCtrls,
ExtCtrls,
CommCtrl;
Const
HbtXPButtonVersion=$0100;// ** 1.00 **
type
TXpStyle =(StxpBlue ,StxpSilver ,StxpOliveGreen,stCoughDropLicorice,
stCoughDropBerry,stCoughDropCherry,stCoughDropCinnamon,
stCoughDropGrape,stCoughDropLime,stCoughDropOrange,stGucciBlue,
stGucciGreen,StPearl);
TButtonLayout = (blGlyphLeft, blGlyphRight, blGlyphTop, blGlyphBottom);
TButtonState = (bsUp, bsDisabled, bsDown, bsExclusive);
TButtonStyle = (bsAutoDetect, bsWin31, bsNew);
TNumGlyphs = 1..4;
TBitBtnKind = (bkCustom, bkOK, bkCancel, bkHelp, bkYes, bkNo, bkClose,
bkAbort, bkRetry, bkIgnore, bkAll);
//----------------------------------------------------------------------------
HbtRGBArray = array[0..2] of Byte;
HbtColor = array of TColor;
THbtXpBitBtn = class(TButton)
private
FCanvas: TCanvas;
FRect : TRect;
Bmp: TBitmap;
FGlyph: Pointer;
FNumGlyphs:Byte;
FBorderColor:TColor;
FMouseInColor :TColor;
FFocusHighlightColor :Tcolor;
FHighLightColor :Tcolor;
FPushHighLightColor: Tcolor;
FLeftTopColor:TColor;
FMiddleColor:Tcolor;
FRightDownColor:TColor;
FMixColor:TColor;
FVersion :Integer;
FxpStyle: TXpStyle;
FStyle: TButtonStyle;
FKind: TBitBtnKind;
FLayout: TButtonLayout;
FSpacing: Integer;
FMargin: Integer;
IsFocused: Boolean;
FModifiedGlyph: Boolean;
FMouseInControl: Boolean;
procedure DrawButton(thisRect: TRect; State: UINT);
Procedure SetGradiantDefualt(Var thisCanvas:TCanvas;Var thisRect:Trect);
Procedure SetGradiantMouseIn(Var thisCanvas:TCanvas;Var thisRect:Trect);
Procedure SetGradiantPush(Var thisCanvas:TCanvas;Var thisRect:Trect);
Procedure SetGradiantDisabled(Var thisCanvas:TCanvas;Var thisRect:Trect);
function GetGlyph: TBitmap;
function GetNumGlyphs: TNumGlyphs;
procedure SetGlyph(Value: TBitmap);
procedure SetNumGlyphs(Value: TNumGlyphs);
procedure GlyphChanged(Sender: TObject);
function IsCustom: Boolean;
function IsCustomCaption: Boolean;
procedure SetStyle(Value: TButtonStyle);
procedure SetKind(Value: TBitBtnKind);
function GetKind: TBitBtnKind;
procedure SetLayout(Value: TButtonLayout);
procedure SetSpacing(Value: Integer);
procedure SetMargin(Value: Integer);
procedure CNMeasureItem(var Message: TWMMeasureItem); message CN_MEASUREITEM;
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 CMMouseEnter(var Message: TMessage); message CM_MOUSEENTER;
procedure CMMouseLeave(var Message: TMessage); message CM_MOUSELEAVE;
procedure WMLButtonDblClk(var Message: TWMLButtonDblClk);message WM_LBUTTONDBLCLK;
function getVersion: String;
procedure SetBorderColor(const Value: TColor);
procedure SetFocuseHighlightColore(const Value: Tcolor);
procedure SetMouseInColor(const Value: TColor);
procedure SetPushHighLightColor(const Value: Tcolor);
procedure SetVersion(const Value: String);
procedure SetxpStyle(const Value: TXpStyle);
procedure sethighLightColor(const Value: Tcolor);
protected
FState: TButtonState;
procedure MouseDown(Button: TMouseButton; Shift: TShiftState;
X, Y: Integer); override;
procedure MouseUp(Button: TMouseButton; Shift: TShiftState;
X, Y: Integer); override;
procedure ActionChange(Sender: TObject; CheckDefaults: Boolean); override;
procedure CreateHandle; override;
procedure CreateParams(var Params: TCreateParams); override;
function GetPalette: HPALETTE; override;
procedure SetButtonStyle(ADefault: Boolean); override;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
procedure Click; override;
published
Property xpStyle : TXpStyle Read FxpStyle Write SetxpStyle default stxpBlue;
Property Version:String Read getVersion Write SetVersion;
Property BorderColor : TColor Read FBorderColor Write SetBorderColor default clNavy;
property MouseInColor : TColor Read FMouseInColor Write SetMouseInColor Default $000097E5;
Property FocusHighlightColor : Tcolor Read FFocusHighlightColor Write SetFocuseHighlightColore Default $00EE8269;
Property PushHighLightColor : Tcolor Read FPushHighLightColor Write SetPushHighLightColor Default ClWhite;
Property HighLightColor : Tcolor Read FHighLightColor Write sethighLightColor Default Clwhite;
property Action;
property Anchors;
property BiDiMode;
property Cancel stored IsCustom;
property Caption stored IsCustomCaption;
property Constraints;
property Default stored IsCustom;
property Enabled;
property Glyph: TBitmap read GetGlyph write SetGlyph stored IsCustom;
property Kind: TBitBtnKind read GetKind write SetKind default bkCustom;
property Layout: TButtonLayout read FLayout write SetLayout default blGlyphLeft;
property Margin: Integer read FMargin write SetMargin default -1;
property ModalResult stored IsCustom;
property NumGlyphs: TNumGlyphs read GetNumGlyphs write SetNumGlyphs stored IsCustom default 1;
property ParentShowHint;
property ParentBiDiMode;
property ShowHint;
//property Style: TButtonStyle read FStyle write SetStyle default bsAutoDetect;
property Spacing: Integer read FSpacing write SetSpacing default 4;
property TabOrder;
property TabStop;
property Visible;
property OnEnter;
property OnExit;
end;
Procedure Register;
implementation
uses Consts, SysUtils, ActnList, ImgList,DrawUtils,themes, DateUtils;
{ THbtXpBitBtn data }
var
BitBtnResNames: array[TBitBtnKind] of PChar = (
nil, 'BBOK', 'BBCANCEL', 'BBHELP', 'BBYES', 'BBNO', 'BBCLOSE',
'BBABORT', 'BBRETRY', 'BBIGNORE', 'BBALL');
BitBtnModalResults: array[TBitBtnKind] of TModalResult = (
0, mrOk, mrCancel, 0, mrYes, mrNo, 0, mrAbort, mrRetry, mrIgnore,
mrAll);
var
BitBtnGlyphs: array[TBitBtnKind] of TBitmap;
function GetBitBtnGlyph(Kind: TBitBtnKind): TBitmap;
begin
if BitBtnGlyphs[Kind] = nil then
begin
BitBtnGlyphs[Kind] := TBitmap.Create;
BitBtnGlyphs[Kind].LoadFromResourceName(HInstance, BitBtnResNames[Kind]);
end;
Result := BitBtnGlyphs[Kind];
end;
type
TGlyphList = class(TImageList)
private
Used: TBits;
FCount: Integer;
function AllocateIndex: Integer;
public
constructor CreateSize(AWidth, AHeight: Integer);
destructor Destroy; override;
function AddMasked(Image: TBitmap; MaskColor: TColor): Integer;
procedure Delete(Index: Integer);
property Count: Integer read FCount;
end;
TGlyphCache = class
private
GlyphLists: TList;
public
constructor Create;
destructor Destroy; override;
function GetList(AWidth, AHeight: Integer): TGlyphList;
procedure ReturnList(List: TGlyphList);
function Empty: Boolean;
end;
TButtonGlyph = class
private
FOriginal: TBitmap;
FGlyphList: TGlyphList;
FIndexs: array[TButtonState] of Integer;
FTransparentColor: TColor;
FNumGlyphs: TNumGlyphs;
FOnChange: TNotifyEvent;
procedure GlyphChanged(Sender: TObject);
procedure SetGlyph(Value: TBitmap);
procedure SetNumGlyphs(Value: TNumGlyphs);
procedure Invalidate;
function CreateButtonGlyph(State: TButtonState): Integer;
//--------------------------------------------------------------------------
procedure DrawButtonGlyph(Canvas: TCanvas; const GlyphPos: TPoint;
State: TButtonState; Transparent: Boolean);Overload;
procedure DrawButtonGlyph(Canvas: TCanvas; const GlyphPos: TPoint;
State: TButtonState; Transparent: Boolean;UseOffset:Boolean);Overload;
//--------------------------------------------------------------------------
procedure DrawButtonText(Canvas: TCanvas; const Caption: string;
TextBounds: TRect; State: TButtonState; BiDiFlags: Longint);Overload;
procedure DrawButtonText(Canvas: TCanvas; const Caption: string;
TextBounds: TRect; State: TButtonState; BiDiFlags: Longint;UseOffset:Boolean);Overload;
//--------------------------------------------------------------------------
procedure CalcButtonLayout(Canvas: TCanvas; const Client: TRect;
const Offset: TPoint; const Caption: string; Layout: TButtonLayout;
Margin, Spacing: Integer; var GlyphPos: TPoint; var TextBounds: TRect;
BiDiFlags: Longint);
//--------------------------------------------------------------------------
public
constructor Create;
destructor Destroy; override;
{ return the text rectangle }
//--------------------------------------------------------------------------
function Draw(Canvas: TCanvas; const Client: TRect; const Offset: TPoint;
const Caption: string; Layout: TButtonLayout; Margin, Spacing: Integer;
State: TButtonState; Transparent: Boolean; BiDiFlags: Longint): TRect;Overload;
function Draw(Canvas: TCanvas; const Client: TRect; const Offset: TPoint;
const Caption: string; Layout: TButtonLayout; Margin, Spacing: Integer;
State: TButtonState; Transparent: Boolean; BiDiFlags: Longint;UseOffset:Boolean): TRect;OverLoad;
//--------------------------------------------------------------------------
property Glyph: TBitmap read FOriginal write SetGlyph;
property NumGlyphs: TNumGlyphs read FNumGlyphs write SetNumGlyphs;
property OnChange: TNotifyEvent read FOnChange write FOnChange;
end;
//------------------------------------------------------------------------------
//------------------------------------------------------------------------------
//------------------------------------------------------------------------------
//------------------------------------------------------------------------------
//--------------------------- { TGlyphList } -----------------------------------
//------------------------------------------------------------------------------
//------------------------------------------------------------------------------
//------------------------------------------------------------------------------
//------------------------------------------------------------------------------
constructor TGlyphList.CreateSize(AWidth, AHeight: Integer);
begin
inherited CreateSize(AWidth, AHeight);
Used := TBits.Create;
end;
//------------------------------------------------------------------------------
destructor TGlyphList.Destroy;
begin
Used.Free;
inherited Destroy;
end;
//------------------------------------------------------------------------------
function TGlyphList.AllocateIndex: Integer;
begin
Result := Used.OpenBit;
if Result = Used.Size then
begin
Result := inherited Add(nil, nil);
Used.Size := Result + 1;
end;
Used[Result] := True;
end;
//------------------------------------------------------------------------------
function TGlyphList.AddMasked(Image: TBitmap; MaskColor: TColor): Integer;
begin
Result := AllocateIndex;
ReplaceMasked(Result, Image, MaskColor);
Inc(FCount);
end;
//------------------------------------------------------------------------------
procedure TGlyphList.Delete(Index: Integer);
begin
if Used[Index] then
begin
Dec(FCount);
Used[Index] := False;
end;
end;
//------------------------------------------------------------------------------
//------------------------------------------------------------------------------
//------------------------------------------------------------------------------
//------------------------------------------------------------------------------
//------------------------ { TGlyphCache } -------------------------------------
//------------------------------------------------------------------------------
//------------------------------------------------------------------------------
//------------------------------------------------------------------------------
constructor TGlyphCache.Create;
begin
inherited Create;
GlyphLists := TList.Create;
end;
//------------------------------------------------------------------------------
destructor TGlyphCache.Destroy;
begin
GlyphLists.Free;
inherited Destroy;
end;
//------------------------------------------------------------------------------
function TGlyphCache.GetList(AWidth, AHeight: Integer): TGlyphList;
var
I: Integer;
begin
for I := GlyphLists.Count - 1 downto 0 do
begin
Result := GlyphLists[I];
with Result do
if (AWidth = Width) and (AHeight = Height) then Exit;
end;
Result := TGlyphList.CreateSize(AWidth, AHeight);
GlyphLists.Add(Result);
end;
//------------------------------------------------------------------------------
procedure TGlyphCache.ReturnList(List: TGlyphList);
begin
if List = nil then Exit;
if List.Count = 0 then
begin
GlyphLists.Remove(List);
List.Free;
end;
end;
//------------------------------------------------------------------------------
function TGlyphCache.Empty: Boolean;
begin
Result := GlyphLists.Count = 0;
end;
//------------------------------------------------------------------------------
var
GlyphCache: TGlyphCache = nil;
ButtonCount: Integer = 0;
//------------------------------------------------------------------------------
//------------------------------------------------------------------------------
//------------------------------------------------------------------------------
//------------------------------------------------------------------------------
//---------------------------- { TButtonGlyph } --------------------------------
//------------------------------------------------------------------------------
//------------------------------------------------------------------------------
//------------------------------------------------------------------------------
//------------------------------------------------------------------------------
constructor TButtonGlyph.Create;
var
I: TButtonState;
begin
inherited Create;
FOriginal := TBitmap.Create;
FOriginal.OnChange := GlyphChanged;
FTransparentColor := clOlive;
FNumGlyphs := 1;
for I := Low(I) to High(I) do
FIndexs[I] := -1;
if GlyphCache = nil then GlyphCache := TGlyphCache.Create;
end;
//------------------------------------------------------------------------------
destructor TButtonGlyph.Destroy;
begin
FOriginal.Free;
Invalidate;
if Assigned(GlyphCache) and GlyphCache.Empty then
begin
GlyphCache.Free;
GlyphCache := nil;
end;
inherited Destroy;
end;
//------------------------------------------------------------------------------
procedure TButtonGlyph.Invalidate;
var
I: TButtonState;
begin
for I := Low(I) to High(I) do
begin
if FIndexs[I] -1 then FGlyphList.Delete(FIndexs[I]);
FIndexs[I] := -1;
end;
GlyphCache.ReturnList(FGlyphList);
FGlyphList := nil;
end;
//------------------------------------------------------------------------------
procedure TButtonGlyph.GlyphChanged(Sender: TObject);
begin
if Sender = FOriginal then
begin
FTransparentColor := FOriginal.TransparentColor;
Invalidate;
if Assigned(FOnChange) then FOnChange(Self);
end;
end;
//------------------------------------------------------------------------------
procedure TButtonGlyph.SetGlyph(Value: TBitmap);
var
Glyphs: Integer;
begin
Invalidate;
FOriginal.Assign(Value);
if (Value nil) and (Value.Height 0) then
begin
FTransparentColor := Value.TransparentColor;
if Value.Width mod Value.Height = 0 then
begin
Glyphs := Value.Width div Value.Height;
if Glyphs 4 then Glyphs := 1;
SetNumGlyphs(Glyphs);
end;
end;
end;
//------------------------------------------------------------------------------
procedure TButtonGlyph.SetNumGlyphs(Value: TNumGlyphs);
begin
if (Value FNumGlyphs) and (Value 0) then
begin
Invalidate;
FNumGlyphs := Value;
GlyphChanged(Glyph);
end;
end;
//------------------------------------------------------------------------------
function TButtonGlyph.CreateButtonGlyph(State: TButtonState): Integer;
const
ROP_DSPDxax = $00E20746;
var
TmpImage, DDB, MonoBmp: TBitmap;
IWidth, IHeight: Integer;
IRect, ORect: TRect;
I: TButtonState;
DestDC: HDC;
begin
if (State = bsDown) and (NumGlyphs Result := FIndexs[State];
if Result -1 then Exit;
if (FOriginal.Width or FOriginal.Height) = 0 then Exit;
IWidth := FOriginal.Width div FNumGlyphs;
IHeight := FOriginal.Height;
if FGlyphList = nil then
begin
if GlyphCache = nil then GlyphCache := TGlyphCache.Create;
FGlyphList := GlyphCache.GetList(IWidth, IHeight);
end;
TmpImage := TBitmap.Create;
try
TmpImage.Width := IWidth;
TmpImage.Height := IHeight;
IRect := Rect(0, 0, IWidth, IHeight);
TmpImage.Canvas.Brush.Color := clBtnFace;
TmpImage.Palette := CopyPalette(FOriginal.Palette);
I := State;
if Ord(I) = NumGlyphs then I := bsUp;
ORect := Rect(Ord(I) * IWidth, 0, (Ord(I) + 1) * IWidth, IHeight);
case State of
bsUp, bsDown,
bsExclusive:
begin
TmpImage.Canvas.CopyRect(IRect, FOriginal.Canvas, ORect);
if FOriginal.TransparentMode = tmFixed then
FIndexs[State] := FGlyphList.AddMasked(TmpImage, FTransparentColor)
else
FIndexs[State] := FGlyphList.AddMasked(TmpImage, clDefault);
end;
bsDisabled:
begin
MonoBmp := nil;
DDB := nil;
try
MonoBmp := TBitmap.Create;
DDB := TBitmap.Create;
DDB.Assign(FOriginal);
DDB.HandleType := bmDDB;
if NumGlyphs 1 then
with TmpImage.Canvas do
begin { Change white & gray to clBtnHighlight and clBtnShadow }
CopyRect(IRect, DDB.Canvas, ORect);
MonoBmp.Monochrome := True;
MonoBmp.Width := IWidth;
MonoBmp.Height := IHeight;
{ Convert white to clBtnHighlight }
DDB.Canvas.Brush.Color := clWhite;
MonoBmp.Canvas.CopyRect(IRect, DDB.Canvas, ORect);
Brush.Color := clBtnHighlight;
DestDC := Handle;
SetTextColor(DestDC, clBlack);
SetBkColor(DestDC, clWhite);
BitBlt(DestDC, 0, 0, IWidth, IHeight,
MonoBmp.Canvas.Handle, 0, 0, ROP_DSPDxax);
{ Convert gray to clBtnShadow }
DDB.Canvas.Brush.Color := clGray;
MonoBmp.Canvas.CopyRect(IRect, DDB.Canvas, ORect);
Brush.Color := clBtnShadow;
DestDC := Handle;
SetTextColor(DestDC, clBlack);
SetBkColor(DestDC, clWhite);
BitBlt(DestDC, 0, 0, IWidth, IHeight,
MonoBmp.Canvas.Handle, 0, 0, ROP_DSPDxax);
{ Convert transparent color to clBtnFace }
DDB.Canvas.Brush.Color := ColorToRGB(FTransparentColor);
MonoBmp.Canvas.CopyRect(IRect, DDB.Canvas, ORect);
Brush.Color := clBtnFace;
DestDC := Handle;
SetTextColor(DestDC, clBlack);
SetBkColor(DestDC, clWhite);
BitBlt(DestDC, 0, 0, IWidth, IHeight,
MonoBmp.Canvas.Handle, 0, 0, ROP_DSPDxax);
end
else
begin
{ Create a disabled version }
with MonoBmp do
begin
Assign(FOriginal);
HandleType := bmDDB;
Canvas.Brush.Color := clBlack;
Width := IWidth;
if Monochrome then
begin
Canvas.Font.Color := clWhite;
Monochrome := False;
Canvas.Brush.Color := clWhite;
end;
Monochrome := True;
end;
with TmpImage.Canvas do
begin
Brush.Color := clBtnFace;
FillRect(IRect);
Brush.Color := clBtnHighlight;
SetTextColor(Handle, clBlack);
SetBkColor(Handle, clWhite);
BitBlt(Handle, 1, 1, IWidth, IHeight,
MonoBmp.Canvas.Handle, 0, 0, ROP_DSPDxax);
Brush.Color := clBtnShadow;
SetTextColor(Handle, clBlack);
SetBkColor(Handle, clWhite);
BitBlt(Handle, 0, 0, IWidth, IHeight,
MonoBmp.Canvas.Handle, 0, 0, ROP_DSPDxax);
end;
end;
finally
DDB.Free;
MonoBmp.Free;
end;
FIndexs[State] := FGlyphList.AddMasked(TmpImage, clDefault);
end;
end;
finally
TmpImage.Free;
end;
Result := FIndexs[State];
FOriginal.Dormant;
end;
//------------------------------------------------------------------------------
procedure TButtonGlyph.DrawButtonGlyph(Canvas: TCanvas; const GlyphPos: TPoint;
State: TButtonState; Transparent: Boolean);
var
Index: Integer;
R: TRect;
begin
if FOriginal = nil then Exit;
if (FOriginal.Width = 0) or (FOriginal.Height = 0) then Exit;
Index := CreateButtonGlyph(State);
with GlyphPos do
begin
if Transparent or (State = bsExclusive) then
begin
Canvas.Brush.Style := bsClear;
ImageList_DrawEx(FGlyphList.Handle, Index, Canvas.Handle, X, Y, 0, 0,
clNone, clNone, ILD_Transparent)
end
else
ImageList_DrawEx(FGlyphList.Handle, Index, Canvas.Handle, X, Y, 0, 0,
ColorToRGB(clBtnFace), clNone, ILD_Normal);
end;
end;
procedure TButtonGlyph.DrawButtonText(Canvas: TCanvas; const Caption: string;
TextBounds: TRect; State: TButtonState; BiDiFlags: LongInt);
begin
with Canvas do
begin
Brush.Style := bsClear;
if State = bsDisabled then
begin
OffsetRect(TextBounds, 1, 1);
Font.Color := clBtnHighlight;
DrawText(Handle, PChar(Caption), Length(Caption), TextBounds,DT_CENTER or DT_VCENTER or BiDiFlags);
OffsetRect(TextBounds, -1, -1);
Font.Color := clBtnShadow;
DrawText(Handle, PChar(Caption), Length(Caption), TextBounds,DT_CENTER or DT_VCENTER or BiDiFlags);
end else
DrawText(Handle, PChar(Caption), Length(Caption), TextBounds,DT_CENTER or DT_VCENTER or BiDiFlags);
end;
end;
procedure TButtonGlyph.CalcButtonLayout(Canvas: TCanvas; const Client: TRect;
const Offset: TPoint; const Caption: string; Layout: TButtonLayout; Margin,
Spacing: Integer; var GlyphPos: TPoint; var TextBounds: TRect;
BiDiFlags: LongInt);
var
TextPos: TPoint;
ClientSize, GlyphSize, TextSize: TPoint;
TotalSize: TPoint;
begin
if (BiDiFlags and DT_RIGHT) = DT_RIGHT then
if Layout = blGlyphLeft then Layout := blGlyphRight
else
if Layout = blGlyphRight then Layout := blGlyphLeft;
{ calculate the item sizes }
ClientSize := Point(Client.Right - Client.Left, Client.Bottom -
Client.Top);
if FOriginal nil then
GlyphSize := Point(FOriginal.Width div FNumGlyphs, FOriginal.Height) else
GlyphSize := Point(0, 0);
if Length(Caption) 0 then
begin
TextBounds := Rect(0, 0, Client.Right - Client.Left, 0);
DrawText(Canvas.Handle, PChar(Caption), Length(Caption), TextBounds,
DT_CALCRECT or BiDiFlags);
TextSize := Point(TextBounds.Right - TextBounds.Left, TextBounds.Bottom -
TextBounds.Top);
end
else
begin
TextBounds := Rect(0, 0, 0, 0);
TextSize := Point(0,0);
end;
{ If the layout has the glyph on the right or the left, then both the
text and the glyph are centered vertically. If the glyph is on the top
or the bottom, then both the text and the glyph are centered horizontally.}
if Layout in [blGlyphLeft, blGlyphRight] then
begin
GlyphPos.Y := (ClientSize.Y - GlyphSize.Y + 1) div 2;
TextPos.Y := (ClientSize.Y - TextSize.Y + 1) div 2;
end
else
begin
GlyphPos.X := (ClientSize.X - GlyphSize.X + 1) div 2;
TextPos.X := (ClientSize.X - TextSize.X + 1) div 2;
end;
{ if there is no text or no bitmap, then Spacing is irrelevant }
if (TextSize.X = 0) or (GlyphSize.X = 0) then
Spacing := 0;
{ adjust Margin and Spacing }
if Margin = -1 then
begin
if Spacing = -1 then
begin
TotalSize := Point(GlyphSize.X + TextSize.X, GlyphSize.Y + TextSize.Y);
if Layout in [blGlyphLeft, blGlyphRight] then
Margin := (ClientSize.X - TotalSize.X) div 3
else
Margin := (ClientSize.Y - TotalSize.Y) div 3;
Spacing := Margin;
end
else
begin
TotalSize := Point(GlyphSize.X + Spacing + TextSize.X, GlyphSize.Y +
Spacing + TextSize.Y);
if Layout in [blGlyphLeft, blGlyphRight] then
Margin := (ClientSize.X - TotalSize.X + 1) div 2
else
Margin := (ClientSize.Y - TotalSize.Y + 1) div 2;
end;
end
else
begin
if Spacing = -1 then
begin
TotalSize := Point(ClientSize.X - (Margin + GlyphSize.X), ClientSize.Y -
(Margin + GlyphSize.Y));
if Layout in [blGlyphLeft, blGlyphRight] then
Spacing := (TotalSize.X - TextSize.X) div 2
else
Spacing := (TotalSize.Y - TextSize.Y) div 2;
end;
end;
case Layout of
blGlyphLeft:
begin
GlyphPos.X := Margin;
TextPos.X := GlyphPos.X + GlyphSize.X + Spacing;
end;
blGlyphRight:
begin
GlyphPos.X := ClientSize.X - Margin - GlyphSize.X;
TextPos.X := GlyphPos.X - Spacing - TextSize.X;
end;
blGlyphTop:
begin
GlyphPos.Y := Margin;
TextPos.Y := GlyphPos.Y + GlyphSize.Y + Spacing;
end;
blGlyphBottom:
begin
GlyphPos.Y := ClientSize.Y - Margin - GlyphSize.Y;
TextPos.Y := GlyphPos.Y - Spacing - TextSize.Y;
end;
end;
{ fixup the result variables }
with GlyphPos do
begin
Inc(X, Client.Left + Offset.X);
Inc(Y, Client.Top + Offset.Y);
end;
OffsetRect(TextBounds, TextPos.X + Client.Left + Offset.X, TextPos.Y + Client.Top + Offset.Y);
end;
function TButtonGlyph.Draw(Canvas: TCanvas; const Client: TRect;
const Offset: TPoint; const Caption: string; Layout: TButtonLayout;
Margin, Spacing: Integer; State: TButtonState; Transparent: Boolean;
BiDiFlags: LongInt): TRect;
var
GlyphPos: TPoint;
begin
CalcButtonLayout(Canvas, Client, Offset, Caption, Layout, Margin, Spacing,
GlyphPos, Result, BiDiFlags);
DrawButtonGlyph(Canvas, GlyphPos, State, Transparent);
DrawButtonText(Canvas, Caption, Result, State, BiDiFlags);
end;
{ TSpeedButtonActionLink }
procedure TButtonGlyph.DrawButtonGlyph(Canvas: TCanvas; const GlyphPos: TPoint;
State: TButtonState;Transparent: Boolean;UseOffset:Boolean);
var
Index: Integer;
R: TRect;
begin
if FOriginal = nil then Exit;
if (FOriginal.Width = 0) or (FOriginal.Height = 0) then Exit;
Index := CreateButtonGlyph(State);
with GlyphPos do
begin
if Transparent or (State = bsExclusive) then
begin
Canvas.Brush.Style := bsClear;
if UseOffset Then
ImageList_DrawEx(FGlyphList.Handle, Index, Canvas.Handle, X+1, Y+1, 0, 0,
clNone, clNone, ILD_Transparent)
else
ImageList_DrawEx(FGlyphList.Handle, Index, Canvas.Handle, X, Y, 0, 0,
clNone, clNone, ILD_Transparent);
end
else
begin
if UseOffset Then
ImageList_DrawEx(FGlyphList.Handle, Index, Canvas.Handle, X+1, Y+1, 0, 0,
ColorToRGB(clBtnFace), clNone, ILD_Normal)
else
ImageList_DrawEx(FGlyphList.Handle, Index, Canvas.Handle, X, Y, 0, 0,
ColorToRGB(clBtnFace), clNone, ILD_Normal);
end;//end of else
end;
end;
function TButtonGlyph.Draw(Canvas: TCanvas; const Client: TRect;
const Offset: TPoint; const Caption: string; Layout: TButtonLayout;
Margin, Spacing: Integer; State: TButtonState; Transparent: Boolean;
BiDiFlags: Integer; UseOffset: Boolean): TRect;
var
GlyphPos: TPoint;
begin
CalcButtonLayout(Canvas, Client, Offset, Caption, Layout, Margin, Spacing,
GlyphPos, Result, BiDiFlags);
DrawButtonGlyph(Canvas, GlyphPos, State, Transparent,UseOffset);
DrawButtonText(Canvas, Caption, Result, State, BiDiFlags,UseOffset);
end;
procedure TButtonGlyph.DrawButtonText(Canvas: TCanvas;
const Caption: string; TextBounds: TRect; State: TButtonState;
BiDiFlags: Integer; UseOffset: Boolean);
begin
with Canvas do
begin
Brush.Style := bsClear;
if State = bsDisabled then
begin
OffsetRect(TextBounds, 1, 1);
Font.Color := clBtnHighlight;
DrawText(Handle, PChar(Caption), Length(Caption), TextBounds,DT_CENTER or DT_VCENTER or BiDiFlags);
OffsetRect(TextBounds, -1, -1);
Font.Color := clBtnShadow;
DrawText(Handle, PChar(Caption), Length(Caption), TextBounds,DT_CENTER or DT_VCENTER or BiDiFlags);
end else
begin
if UseOffset Then
OffsetRect(TextBounds,1,1);
DrawText(Handle, PChar(Caption), Length(Caption), TextBounds,DT_CENTER or DT_VCENTER or BiDiFlags);
end;
end;
end;
//------------------------------------------------------------------------------
//------------------------------------------------------------------------------
//------------------------------------------------------------------------------
//------------------------------------------------------------------------------
//------------------------------------------------------------------------------
//------------------------------ { THbtXpBitBtn } ---------------------------------
//------------------------------------------------------------------------------
//------------------------------------------------------------------------------
//------------------------------------------------------------------------------
//------------------------------------------------------------------------------
//------------------------------------------------------------------------------
//------------------------------------------------------------------------------
constructor THbtXpBitBtn.Create(AOwner: TComponent);
begin
FGlyph := TButtonGlyph.Create;
TButtonGlyph(FGlyph).OnChange := GlyphChanged;
inherited Create(AOwner);
FCanvas := TCanvas.Create;
FStyle := bsAutoDetect;
FxpStyle := StxpBlue;
FBorderColor := ClNavy;
FMouseInColor := $000097E5;
FFocusHighlightColor := $00EE8269;
FHighLightColor := ClWhite;
FVersion := HbtXPButtonVersion;
FPushHighLightColor := Clwhite;
FKind := bkCustom;
FLayout := blGlyphLeft;
FSpacing := 4;
FMargin := -1;
FNumGlyphs:=1;
Height:=23;
width:=80;
ControlStyle := ControlStyle + [csReflector];
DoubleBuffered := True;
end;
destructor THbtXpBitBtn.Destroy;
begin
inherited Destroy;
TButtonGlyph(FGlyph).Free;
FCanvas.Free;
end;
procedure THbtXpBitBtn.CreateHandle;
var
State: TButtonState;
begin
if Enabled then
State := bsUp
else
State := bsDisabled;
inherited CreateHandle;
TButtonGlyph(FGlyph).CreateButtonGlyph(State);
end;
procedure THbtXpBitBtn.CreateParams(var Params: TCreateParams);
begin
inherited CreateParams(Params);
with Params do Style := Style or BS_OWNERDRAW;
end;
procedure THbtXpBitBtn.SetButtonStyle(ADefault: Boolean);
begin
if ADefault IsFocused then
begin
IsFocused := ADefault;
Refresh;
end;
end;
procedure THbtXpBitBtn.Click;
var
Form: TCustomForm;
Control: TWinControl;
begin
case FKind of
bkClose:
begin
Form := GetParentForm(Self);
if Form nil then Form.Close
else inherited Click;
end;
bkHelp:
begin
Control := Self;
while (Control nil) and (Control.HelpContext = 0) do
Control := Control.Parent;
if Control nil then Application.HelpContext(Control.HelpContext)
else inherited Click;
end;
else
inherited Click;
end;
end;
procedure THbtXpBitBtn.CNMeasureItem(var Message: TWMMeasureItem);
begin
with Message.MeasureItemStruct^ do
begin
itemWidth := Width;
itemHeight := Height;
end;
end;
procedure THbtXpBitBtn.CNDrawItem(var Message: TWMDrawItem);
Var
SaveIndex:Integer;
begin
with Message.DrawItemStruct^ do
begin
SaveIndex := SaveDC(hDC);
FCanvas.Lock;
try
FCanvas.Handle := hDC;
FCanvas.Font := Font;
FCanvas.Brush := Brush;
DrawButton(rcItem, itemState);
finally
FCanvas.Handle := 0;
FCanvas.Unlock;
RestoreDC(hDC, SaveIndex);
end;
end;
Message.Result := 1;
end;
procedure THbtXpBitBtn.CMFontChanged(var Message: TMessage);
begin
inherited;
Invalidate;
end;
procedure THbtXpBitBtn.CMEnabledChanged(var Message: TMessage);
begin
inherited;
Invalidate;
end;
procedure THbtXpBitBtn.WMLButtonDblClk(var Message: TWMLButtonDblClk);
begin
Perform(WM_LBUTTONDOWN, Message.Keys, Longint(Message.Pos));
end;
function THbtXpBitBtn.GetPalette: HPALETTE;
begin
Result := Glyph.Palette;
end;
procedure THbtXpBitBtn.SetGlyph(Value: TBitmap);
begin
TButtonGlyph(FGlyph).Glyph := Value as TBitmap;
with (Value as TBitmap).Canvas do
begin
Brush.Style := bsClear;
end;
FModifiedGlyph := True;
Invalidate;
end;
function THbtXpBitBtn.GetGlyph: TBitmap;
begin
Result := TButtonGlyph(FGlyph).Glyph;
end;
procedure THbtXpBitBtn.GlyphChanged(Sender: TObject);
begin
Invalidate;
end;
function THbtXpBitBtn.IsCustom: Boolean;
begin
Result := Kind = bkCustom;
end;
procedure THbtXpBitBtn.SetStyle(Value: TButtonStyle);
begin
if Value FStyle then
begin
FStyle := Value;
Invalidate;
end;
end;
procedure THbtXpBitBtn.SetKind(Value: TBitBtnKind);
begin
if Value FKind then
begin
if Value bkCustom then
begin
Default := Value in [bkOK, bkYes];
Cancel := Value in [bkCancel, bkNo];
ModalResult := BitBtnModalResults[Value];
TButtonGlyph(FGlyph).Glyph := GetBitBtnGlyph(Value);
NumGlyphs := 2;
FModifiedGlyph := False;
end;
FKind := Value;
Invalidate;
end;
end;
function THbtXpBitBtn.IsCustomCaption: Boolean;
begin
//
end;
function THbtXpBitBtn.GetKind: TBitBtnKind;
begin
if FKind bkCustom then
if ((FKind in [bkOK, bkYes]) xor Default) or
((FKind in [bkCancel, bkNo]) xor Cancel) or
(ModalResult BitBtnModalResults[FKind]) or
FModifiedGlyph then
FKind := bkCustom;
Result := FKind;
end;
procedure THbtXpBitBtn.SetLayout(Value: TButtonLayout);
begin
if FLayout Value then
begin
FLayout := Value;
Invalidate;
end;
end;
function THbtXpBitBtn.GetNumGlyphs: TNumGlyphs;
begin
Result := TButtonGlyph(FGlyph).NumGlyphs;
end;
procedure THbtXpBitBtn.SetNumGlyphs(Value: TNumGlyphs);
begin
if Value else if Value 4 then Value := 4;
if Value TButtonGlyph(FGlyph).NumGlyphs then
begin
TButtonGlyph(FGlyph).NumGlyphs := Value;
Invalidate;
end;
end;
procedure THbtXpBitBtn.SetSpacing(Value: Integer);
begin
if FSpacing Value then
begin
FSpacing := Value;
Invalidate;
end;
end;
procedure THbtXpBitBtn.SetMargin(Value: Integer);
begin
if (Value FMargin) and (Value = - 1) then
begin
FMargin := Value;
Invalidate;
end;
end;
procedure THbtXpBitBtn.ActionChange(Sender: TObject; CheckDefaults: Boolean);
procedure CopyImage(ImageList: TCustomImageList; Index: Integer);
begin
with Glyph do
begin
Width := ImageList.Width;
Height := ImageList.Height;
Canvas.Brush.Color := clFuchsia;//! for lack of a better color
Canvas.FillRect(Rect(0,0, Width, Height));
ImageList.Draw(Canvas, 0, 0, Index);
end;
end;
begin
inherited ActionChange(Sender, CheckDefaults);
if Sender is TCustomAction then
with TCustomAction(Sender) do
begin
{ Copy image from action's imagelist }
if (Glyph.Empty) and (ActionList nil) and (ActionList.Images nil) and
(ImageIndex = 0) and (ImageIndex CopyImage(ActionList.Images, ImageIndex);
end;
end;
procedure DestroyLocals; far;
var
I: TBitBtnKind;
begin
for I := Low(TBitBtnKind) to High(TBitBtnKind) do
BitBtnGlyphs[I].Free;
end;
procedure THbtXpBitBtn.CMMouseEnter(var Message: TMessage);
begin
inherited;
FMouseInControl := True;
Invalidate;
end;
procedure THbtXpBitBtn.CMMouseLeave(var Message: TMessage);
begin
inherited;
FMouseInControl := False;
Invalidate;
end;
function THbtXpBitBtn.getVersion: String;
begin
Result := Format( '%d.%d', [ Hi( FVersion ), Lo( FVersion ) ] );
end;
procedure THbtXpBitBtn.SetBorderColor(const Value: TColor);
begin
FBorderColor := Value;
Invalidate;
end;
procedure THbtXpBitBtn.SetFocuseHighlightColore(const Value: Tcolor);
begin
FFocusHighlightColor := Value;
Invalidate;
end;
procedure THbtXpBitBtn.SetMouseInColor(const Value: TColor);
begin
FMouseInColor := Value;
Invalidate;
end;
procedure THbtXpBitBtn.SetPushHighLightColor(const Value: Tcolor);
begin
FPushHighLightColor := Value;
Invalidate;
end;
procedure THbtXpBitBtn.SetVersion(const Value: String);
begin
end;
procedure THbtXpBitBtn.SetxpStyle(const Value: TXpStyle);
begin
FxpStyle := Value;
end;
procedure THbtXpBitBtn.SetGradiantDefualt(var thisCanvas: TCanvas;
var thisRect: Trect);
var
x, y, z, stelle, mx, bis, faColorsh, mass: Integer;
Faktor: double;
A:HbtRGBArray;
B: array of HBtRGBArray;
merkw: integer;
merks: TPenStyle;
merkp: TColor;
FColor:HbtColor;
begin
mass:=0;
SetLength(FColor,4);
case FxpStyle Of
StxpBlue :
begin
FLeftTopColor := $00fdfdfd;
FMiddleColor := $00fdf7f6;
FRightDownColor := $00ecdfde;
FMixColor := $00fdf5f4;
end;
end;
FColor[0]:=FLeftTopColor;
FColor[1]:=FMixColor;
FColor[2]:=FRightDownColor;
FColor[3]:=FMiddleColor;
If thiscanvasNil Then
begin
mx := High(FColor);
if mx 0 then
begin
mass := (thisRect.Bottom) - (thisRect.Top);
SetLength(b, mx + 1);
for x := 0 to mx do
begin
FColor[x] := ColorToRGB(FColor[x]);
b[x][0] := GetRValue(FColor[x]);
b[x][1] := GetGValue(FColor[x]);
b[x][2] := GetBValue(FColor[x]);
end;
merkw := thisCanvas.Pen.Width;
merks := thisCanvas.Pen.Style;
merkp := thisCanvas.Pen.Color;
thisCanvas.Pen.Width := 1;
thisCanvas.Pen.Style := psSolid;
faColorsh := Round(mass / mx);
for y := 0 to mx - 1 do
begin
if y = mx - 1 then
bis := mass - y * faColorsh - 1
else
bis := faColorsh;
for x := 0 to bis do
begin
Stelle := x + y * faColorsh;
faktor := x / bis;
for z := 0 to 2 do
a[z] := Trunc(b[y][z] + ((b[y + 1][z] - b[y][z]) * Faktor));
thisCanvas.Pen.Color := RGB(a[0], a[1], a[2]);
thisCanvas.MoveTo(thisRect.Left , thisRect.Top + Stelle);
thisCanvas.LineTo(thisRect.Right, thisRect.Top + Stelle);
end;
end;
b := nil;
thisCanvas.Pen.Width := merkw;
thisCanvas.Pen.Style := merks;
thisCanvas.Pen.Color := merkp;
end
end;
end;
procedure THbtXpBitBtn.SetGradiantPush(var thisCanvas: TCanvas;
var thisRect: Trect);
var
x, y, z, stelle, mx, bis, faColorsh, mass: Integer;
Faktor: double;
A:HbtRGBArray;
B: array of HBtRGBArray;
merkw: integer;
merks: TPenStyle;
merkp: TColor;
FColor:HbtColor;
begin
mass:=0;
SetLength(FColor,4);
case FxpStyle Of
StxpBlue :
begin
FLeftTopColor := $00BFA6A2;
FMiddleColor := $00ecdfde;
FRightDownColor := $00fdfdfd;
FMixColor := $00ecdfde;
end;
end;
FColor[0]:=FLeftTopColor;
FColor[1]:=FMixColor;
FColor[2]:=FRightDownColor;
FColor[3]:=FMiddleColor;
If thiscanvasNil Then
begin
mx := High(FColor);
if mx 0 then
begin
mass := (thisRect.Bottom) - (thisRect.Top);
SetLength(b, mx + 1);
for x := 0 to mx do
begin
FColor[x] := ColorToRGB(FColor[x]);
b[x][0] := GetRValue(FColor[x]);
b[x][1] := GetGValue(FColor[x]);
b[x][2] := GetBValue(FColor[x]);
end;
merkw := thisCanvas.Pen.Width;
merks := thisCanvas.Pen.Style;
merkp := thisCanvas.Pen.Color;
thisCanvas.Pen.Width := 1;
thisCanvas.Pen.Style := psSolid;
faColorsh := Round(mass / mx);
for y := 0 to mx - 1 do
begin
if y = mx - 1 then
bis := mass - y * faColorsh - 1
else
bis := faColorsh;
for x := 0 to bis do
begin
Stelle := x + y * faColorsh;
faktor := x / bis;
for z := 0 to 2 do
a[z] := Trunc(b[y][z] + ((b[y + 1][z] - b[y][z]) * Faktor));
thisCanvas.Pen.Color := RGB(a[0], a[1], a[2]);
thisCanvas.MoveTo(thisRect.Left , thisRect.Top + Stelle);
thisCanvas.LineTo(thisRect.Right, thisRect.Top + Stelle);
end;
end;
b := nil;
thisCanvas.Pen.Width := merkw;
thisCanvas.Pen.Style := merks;
thisCanvas.Pen.Color := merkp;
end
end;
end;
procedure THbtXpBitBtn.MouseDown(Button: TMouseButton; Shift: TShiftState; X,
Y: Integer);
begin
inherited MouseDown(Button, Shift, X, Y);
if (Button = mbLeft) and Enabled then
begin
FState := bsDown;
Invalidate;
end;
end;
procedure THbtXpBitBtn.MouseUp(Button: TMouseButton; Shift: TShiftState; X,
Y: Integer);
begin
inherited MouseUp(Button, Shift, X, Y);
if (Button = mbLeft) and Enabled then
begin
fstate:= bsUp;
Invalidate;
end;
end;
procedure THbtXpBitBtn.SetGradiantMouseIn(var thisCanvas: TCanvas;
var thisRect: Trect);
var
x, y, z, stelle, mx, bis, faColorsh, mass: Integer;
Faktor: double;
A:HbtRGBArray;
B: array of HBtRGBArray;
merkw: integer;
merks: TPenStyle;
merkp: TColor;
FColor:HbtColor;
begin
mass:=0;
SetLength(FColor,4);
case FxpStyle Of
StxpBlue :
begin
FLeftTopColor := $00fdfdfd;
FMiddleColor := $00fdf7f6;
FRightDownColor := $00ecdfde;
FMixColor := $00fdf5f4;
end;
end;
FColor[0]:=FLeftTopColor;
FColor[1]:=FhighLightColor;
FColor[2]:=FRightDownColor;
FColor[3]:=FHighLightColor;
If thiscanvasNil Then
begin
mx := High(FColor);
if mx 0 then
begin
mass := (thisRect.Bottom) - (thisRect.Top);
SetLength(b, mx + 1);
for x := 0 to mx do
begin
FColor[x] := ColorToRGB(FColor[x]);
b[x][0] := GetRValue(FColor[x]);
b[x][1] := GetGValue(FColor[x]);
b[x][2] := GetBValue(FColor[x]);
end;
merkw := thisCanvas.Pen.Width;
merks := thisCanvas.Pen.Style;
merkp := thisCanvas.Pen.Color;
thisCanvas.Pen.Width := 1;
thisCanvas.Pen.Style := psSolid;
faColorsh := Round(mass / mx);
for y := 0 to mx - 1 do
begin
if y = mx - 1 then
bis := mass - y * faColorsh - 1
else
bis := faColorsh;
for x := 0 to bis do
begin
Stelle := x + y * faColorsh;
faktor := x / bis;
for z := 0 to 2 do
a[z] := Trunc(b[y][z] + ((b[y + 1][z] - b[y][z]) * Faktor));
thisCanvas.Pen.Color := RGB(a[0], a[1], a[2]);
thisCanvas.MoveTo(thisRect.Left , thisRect.Top + Stelle);
thisCanvas.LineTo(thisRect.Right, thisRect.Top + Stelle);
end;
end;
b := nil;
thisCanvas.Pen.Width := merkw;
thisCanvas.Pen.Style := merks;
thisCanvas.Pen.Color := merkp;
end
end;
end;
procedure THbtXpBitBtn.sethighLightColor(const Value: Tcolor);
begin
FHighLightColor := Value;
Invalidate;
end;
procedure THbtXpBitBtn.SetGradiantDisabled(var thisCanvas: TCanvas;
var thisRect: Trect);
var
x, y, z, stelle, mx, bis, faColorsh, mass: Integer;
Faktor: double;
A:HbtRGBArray;
B: array of HBtRGBArray;
merkw: integer;
merks: TPenStyle;
merkp: TColor;
FColor:HbtColor;
begin
mass:=0;
SetLength(FColor,4);
case FxpStyle Of
StxpBlue :
begin
FLeftTopColor := $00EdF1F1;
FMiddleColor := $00EdF1F1;
FRightDownColor := $00EdF1F1;
FMixColor := $00EdF1F1;
end;
end;
FColor[0]:=FLeftTopColor;
FColor[1]:=FMixColor;
FColor[2]:=FRightDownColor;
FColor[3]:=FMiddleColor;
If thiscanvasNil Then
begin
mx := High(FColor);
if mx 0 then
begin
mass := (thisRect.Bottom) - (thisRect.Top);
SetLength(b, mx + 1);
for x := 0 to mx do
begin
FColor[x] := ColorToRGB(FColor[x]);
b[x][0] := GetRValue(FColor[x]);
b[x][1] := GetGValue(FColor[x]);
b[x][2] := GetBValue(FColor[x]);
end;
merkw := thisCanvas.Pen.Width;
merks := thisCanvas.Pen.Style;
merkp := thisCanvas.Pen.Color;
thisCanvas.Pen.Width := 1;
thisCanvas.Pen.Style := psSolid;
faColorsh := Round(mass / mx);
for y := 0 to mx - 1 do
begin
if y = mx - 1 then
bis := mass - y * faColorsh - 1
else
bis := faColorsh;
for x := 0 to bis do
begin
Stelle := x + y * faColorsh;
faktor := x / bis;
for z := 0 to 2 do
a[z] := Trunc(b[y][z] + ((b[y + 1][z] - b[y][z]) * Faktor));
thisCanvas.Pen.Color := RGB(a[0], a[1], a[2]);
thisCanvas.MoveTo(thisRect.Left , thisRect.Top + Stelle);
thisCanvas.LineTo(thisRect.Right, thisRect.Top + Stelle);
end;
end;
b := nil;
thisCanvas.Pen.Width := merkw;
thisCanvas.Pen.Style := merks;
thisCanvas.Pen.Color := merkp;
end
end;
end;
procedure THbtXpBitBtn.DrawButton(thisRect: TRect; State: UINT);
//------------------------------------------------------------------------------
Function CaptionRect(Totalwidth,TotalHeight,TextWidth,TextHeight:Integer):TRect;
Var
Left,Top,Right,Bottom:Integer;
begin
Left := (TotalWidth - TextWidth) Div 2;
Top := (TotalHeight - TextHeight)Div 2;
Right := Left+TextWidth;
Bottom := Top+TextHeight;
Result := Rect(Left,Top,Right,Bottom);
end;
//----------------------------------------------------------------------------
Function ClyphRect(Totalwidth,TotalHeight,TextWidth,TextHeight:Integer):TRect;
Var
GlyphWidth,GlyphHeight:Integer;
Left,Top,Right,Bottom:Integer;
begin
Left := (TotalWidth - TextWidth) Div 2;
Top := (TotalHeight - TextHeight)Div 2;
Right := Left+TextWidth;
Bottom := Top+TextHeight;
Result := Rect(Left,Top,Right,Bottom);
end;
//----------------------------------------------------------------------------
Procedure DrawFocus(Var thisCanvas: Tcanvas ;FocusColor:Tcolor);
Var
FocusRect:TRect;
begin
FocusRect := Rect(FRect.Left+2,FRect.Top+2,FRect.Right-2,FRect.Bottom-2);
with FocusRect do
begin
thisCanvas.Pen.Color := clWindowFrame;
thisCanvas.Brush.Color := FocusColor;
Windows.DrawFocusRect(thisCanvas.Handle,FocusRect);
end;
end;
//---------------------------------------------------------------------------
Procedure DrawHighLight(Var thisCanvas: Tcanvas ;HighLightColor:Tcolor);
Var
HighLightRect:TRect;
begin
HighLightRect := Rect(FRect.Left+1,FRect.Top+1,FRect.Right-1,FRect.Bottom-1);
with HighLightRect do
begin
ExcludeClipRect(thisCanvas.Handle,FRect.Left,FRect.Top,FRect.Right,FRect.Bottom);
SelectClipRgn(thisCanvas.Handle, 0);
thisCanvas.Brush.Style := bsClear;
thisCanvas.Pen.Width := 1;
thisCanvas.Pen.Color := HighLightColor;
thisCanvas.RoundRect(FRect.Left+1,FRect.Top+1,FRect.Right-1,FRect.Bottom-1,3,3);
end;
end;
//----------------------------------------------------------------------------
Procedure DrawCaption(var thisCanvas:Tcanvas;thisCaption:Tcaption;thisFlags:Integer;UseOffset:Boolean);
Var
CaptionFalg: Longint;
H,W:Integer; //W As Caption Width H As Text height
CRect: TRect;
begin
CaptionFalg :=DrawTextBiDiModeFlags(DT_SINGLELINE);
H:= thisCanvas.TextHeight('0');
W:= thisCanvas.TextWidth(Caption);
CRect := CaptionRect(ClientWidth,ClientHeight,w,h);
TButtonGlyph(FGlyph).DrawButtonText(thisCanvas,thisCaption,CRect,FState,CaptionFalg);
end;
//----------------------------------------------------------------------------
Procedure DrawDisabledCaption(var thisCanvas:Tcanvas;thisCaption:Tcaption;thisFlags:Integer);
Var
CaptionFalg: Longint;
H,W:Integer; //W As Caption Width H As Text height
CRect: TRect;
begin
CaptionFalg :=DrawTextBiDiModeFlags(DT_SINGLELINE);
H:= thisCanvas.TextHeight('0');
W:= thisCanvas.TextWidth(Caption);
CRect := CaptionRect(ClientWidth,ClientHeight,w,h);
TButtonGlyph(FGlyph).DrawButtonText(thisCanvas,thisCaption,CRect,FState,CaptionFalg);
end;
//----------------------------------------------------------------------------
Procedure DrawGlyph(var ThisCanvas:TCanvas;thisRect:TRect;ThisOffset:TPoint;ThisLayout:TButtonLayOut;
ThisCaption:TCaption;thisMargin:Integer;ThisSpacing:Integer;Var thisGlyphPos:TPoint;
Var ThisTextBound:TRect;UseOffset:Boolean;ThisBIDIFlags:Integer);
begin
TButtonGlyph(FGlyph).Draw(ThisCanvas,thisRect,ThisOffset,ThisCaption,ThisLayout,thisMargin,ThisSpacing,FState,True,ThisBIDIFlags,UseOffset);
end;
//------------------------------------------------------------------------------
var
// State :Cardinal;
IsDown, IsDefault,IsDisabled: Boolean;
GradiantRect,FocusRoundRect,CRect:TRect;
Flags: Longint;
Offset,GPos: TPoint;
begin
Flags := DFCS_BUTTONPUSH or DFCS_ADJUSTRECT;
IsDown := State and ODS_SELECTED 0;
IsDefault := State and ODS_FOCUS 0;
IsDisabled := State and ODS_DISABLED 0;
if IsDown then Flags := Flags or DFCS_PUSHED;
if IsDisabled then Flags := Flags or DFCS_INACTIVE;
if not Enabled then FState := bsDisabled
else if IsDown then FState := bsDown
else FState := bsUp;
//---------------------------------------------------------------------
//---------------------------------------------------------------------
//-------------------------- NorMal Button ----------------------------
//---------------------------------------------------------------------
//---------------------------------------------------------------------
FRect := ClientRect;
if not IsDisabled Then
begin
case FxpStyle of
StxpBlue : FCanvas.pen.Color := FBorderColor;
end;
end;
FCanvas.Brush.Style := bsSolid;
FCanvas.Pen.Style := psSolid;
FCanvas.Font.Color := Font.Color;
RoundRect(FCanvas.Handle,FRect.Left,FRect.Top,FRect.Right,FRect.Bottom,3,3);
GradiantRect := Rect(FRect.Left+2,FRect.Top+2,FRect.Right-2,FRect.Bottom-2);
//------------------------------------------------------------------------
if not IsDisabled Then
begin
FCanvas.Lock;
try
SetGradiantDefualt(Fcanvas,GradiantRect);
if (Caption '') and (FGlyph = Nil ) Then
DrawCaption(Fcanvas,Caption,Flags,false);
if (Caption '') and (FGlyph Nil ) Then
begin
CRect := CaptionRect(ClientWidth,ClientHeight,FCanvas.TextWidth(Caption),FCanvas.TextHeight(Caption));
DrawGlyph(FCanvas,ClientRect,Offset,FLayout,Caption,FMargin,FSpacing,GPos,CRect,False,DrawTextBiDiModeFlags(0));
end;
finally
FCanvas.Unlock;
end;
end;
if IsDisabled Then
begin
case FxpStyle Of
StxpBlue : FCanvas.Pen.Color := $0092A1A1;
end;//end of Case
FCanvas.Pen.Style := psSolid;
FCanvas.Lock;
try
SetGradiantDisabled(Fcanvas,GradiantRect);
if (Caption '') and (FGlyph = Nil ) Then
DrawCaption(Fcanvas,Caption,Flags,false);
if (Caption '') and (FGlyph Nil ) Then
begin
CRect := CaptionRect(ClientWidth,ClientHeight,FCanvas.TextWidth(Caption),FCanvas.TextHeight(Caption));
DrawGlyph(FCanvas,ClientRect,Offset,FLayout,Caption,FMargin,FSpacing,GPos,CRect,False,DrawTextBiDiModeFlags(0));
end;
finally
FCanvas.Unlock;
end;
end;
//------------------------------------------------------------------------
if not (csDesigning In ComponentState) Then
begin
//---------------------------------------------------------------------
//---------------------------------------------------------------------
//------------------------ {Disabled Button } -------------------------
//---------------------------------------------------------------------
//---------------------------------------------------------------------
if IsDisabled Then
begin
case FxpStyle Of
StxpBlue : FCanvas.Pen.Color := $0092A1A1;
end;//end of Case
FCanvas.Pen.Style := psSolid;
FCanvas.Lock;
try
SetGradiantDisabled(Fcanvas,GradiantRect);
if (Caption '') and (FGlyph = Nil ) Then
DrawCaption(Fcanvas,Caption,Flags,false);
if (Caption '') and (FGlyph Nil ) Then
begin
CRect := CaptionRect(ClientWidth,ClientHeight,FCanvas.TextWidth(Caption),FCanvas.TextHeight(Caption));
DrawGlyph(FCanvas,ClientRect,Offset,FLayout,Caption,FMargin,FSpacing,GPos,CRect,False,DrawTextBiDiModeFlags(0));
end;
finally
FCanvas.Unlock;
end;
end;
//---------------------------------------------------------------------
//---------------------------------------------------------------------
//-------------------------{Down Button }------------------------------
//---------------------------------------------------------------------
//---------------------------------------------------------------------
if IsDown Then
begin
FCanvas.Lock;
Try
SetGradiantPush(Fcanvas,GradiantRect);
DrawFocus(Fcanvas,clBtnFace);
if (Caption '') and (FGlyph = Nil ) Then
DrawCaption(Fcanvas,Caption,Flags,True);
if (Caption '') and (FGlyph Nil ) Then
begin
CRect := CaptionRect(ClientWidth,ClientHeight,FCanvas.TextWidth(Caption),FCanvas.TextHeight(Caption));
DrawGlyph(FCanvas,ClientRect,Offset,FLayout,Caption,FMargin,FSpacing,GPos,CRect,True,DrawTextBiDiModeFlags(0));
end;
Finally
FCanvas.Unlock;
end;//end of Try
end;
//---------------------------------------------------------------------
//------------------------ Focus Button ------------------------------
//---------------------------------------------------------------------
//---------------------------------------------------------------------
if IsFocused then
begin
FCanvas.Lock;
Try
SetGradiantDefualt(Fcanvas,GradiantRect);
DrawFocus(Fcanvas,clBtnface);
DrawHighLight(fcanvas,FFocusHighlightColor);
if (Caption '') and (FGlyph = Nil ) Then
DrawCaption(Fcanvas,Caption,Flags,false);
if (Caption '') and (FGlyph Nil ) Then
begin
CRect := CaptionRect(ClientWidth,ClientHeight,FCanvas.TextWidth(Caption),FCanvas.TextHeight(Caption));
DrawGlyph(FCanvas,ClientRect,Offset,FLayout,Caption,FMargin,FSpacing,GPos,CRect,False,DrawTextBiDiModeFlags(0));
end;
finally
FCanvas.Unlock;
end;
end;
//---------------------------------------------------------------------
//---------------------------------------------------------------------
//--------------------- Focus and Pudh Button -------------------------
//---------------------------------------------------------------------
//---------------------------------------------------------------------
if IsDown and IsFocused Then
begin
FCanvas.Lock;
Try
SetGradiantPush(Fcanvas,GradiantRect);
DrawFocus(FCanvas,clBtnFace);
DrawHighLight(Fcanvas,FPushHighLightColor);
if (Caption '') and (FGlyph = Nil ) Then
DrawCaption(Fcanvas,Caption,Flags,True);
if (Caption '') and (FGlyph Nil ) Then
begin
CRect := CaptionRect(ClientWidth,ClientHeight,FCanvas.TextWidth(Caption),FCanvas.TextHeight(Caption));
DrawGlyph(FCanvas,ClientRect,Offset,FLayout,Caption,FMargin,FSpacing,GPos,CRect,True,DrawTextBiDiModeFlags(0));
end;
Finally
FCanvas.Unlock;
end;//end of Try
end;
//---------------------------------------------------------------------
//---------------------------------------------------------------------
//-------------------------- MouseIn Button ---------------------------
//---------------------------------------------------------------------
//---------------------------------------------------------------------
if FMouseInControl Then
begin
FCanvas.Lock;
try
SetGradiantDefualt(Fcanvas,GradiantRect);
DrawHighLight(fcanvas,FMouseInColor);
if (Caption '') and (FGlyph = Nil )Then
DrawCaption(Fcanvas,Caption,Flags,False);
if (Caption '') and (FGlyph Nil ) Then
begin
CRect := CaptionRect(ClientWidth,ClientHeight,FCanvas.TextWidth(Caption),FCanvas.TextHeight(Caption));
DrawGlyph(FCanvas,ClientRect,Offset,FLayout,Caption,FMargin,FSpacing,GPos,CRect,False,DrawTextBiDiModeFlags(0));
end;
finally
FCanvas.Unlock;
end;
end;
//---------------------------------------------------------------------
//---------------------------------------------------------------------
//--------------------- Focus and MouseIn Button ----------------------
//---------------------------------------------------------------------
//---------------------------------------------------------------------
if IsFocused and FMouseInControl Then
begin
FCanvas.Lock;
Try
SetGradiantDefualt(Fcanvas,GradiantRect);
DrawFocus(Fcanvas,clBtnFace);
DrawHighLight(FCanvas,FMouseInColor);
if (Caption '') and (FGlyph = Nil ) Then
DrawCaption(Fcanvas,Caption,Flags,False);
if (Caption '') and (FGlyph Nil ) Then
begin
CRect := CaptionRect(ClientWidth,ClientHeight,FCanvas.TextWidth(Caption),FCanvas.TextHeight(Caption));
DrawGlyph(FCanvas,ClientRect,Offset,FLayout,Caption,FMargin,FSpacing,GPos,CRect,False,DrawTextBiDiModeFlags(0));
end;
finally
FCanvas.Unlock;
end;
end;
//---------------------------------------------------------------------
//---------------------------------------------------------------------
//--------------------- Focus and MouseIn and ISDown Button -----------
//---------------------------------------------------------------------
//---------------------------------------------------------------------
if IsFocused and IsDown and FMouseInControl Then
begin
FCanvas.Lock;
Try
SetGradiantPush(Fcanvas,GradiantRect);
DrawFocus(FCanvas,clBtnFace);
DrawHighLight(fcanvas,FPushHighLightColor);
if (Caption '') and (FGlyph = Nil ) Then
DrawCaption(Fcanvas,Caption,Flags,True);
if (Caption '') and (FGlyph Nil ) Then
begin
CRect := CaptionRect(ClientWidth,ClientHeight,FCanvas.TextWidth(Caption),FCanvas.TextHeight(Caption));
DrawGlyph(FCanvas,ClientRect,Offset,FLayout,Caption,FMargin,FSpacing,GPos,CRect,True,DrawTextBiDiModeFlags(0));
end;
Finally
FCanvas.Unlock;
end;//end of Try
end;
end;//end of if not CsDesigning ....
end;
Procedure Register;
begin
RegisterComponent('Hbt Xp pack ',[ThbtXpBitBtn]);
end;
initialization
FillChar(BitBtnGlyphs, SizeOf(BitBtnGlyphs), 0);
finalization
DestroyLocals;
end.
]]>