Tobias Giesen wrote:

>
> Hello Hans,
>
> > I love to share my TDBColorSpeedButton component.
>
> thanks for the free code. Did you accidentally send it to the list? At the
> end of your mail, the list server added "[Non-text portions of this message
> have been removed]". What could that have been?
>
> Note that you can also upload files on www.egroups.com to this group's file
> space in order to share them with others. That will be compatible with
> non-text stuff.
>
> Cheers,
> Tobias

====
unit DBColorSpeedButton;

{$S-,W-,R-}
{$C PRELOAD}

interface

uses Windows, Messages, Classes, Controls, Forms, Graphics, StdCtrls,
ExtCtrls, CommCtrl, Buttons, DB;

type
TFieldDataLink = class(TDataLink)
private
FField: TField;
FFieldName: string;
FControl: TComponent;
FEditing: Boolean;
FModified: Boolean;
FOnDataChange: TNotifyEvent;
FOnEditingChange: TNotifyEvent;
FOnUpdateData: TNotifyEvent;
FOnActiveChange: TNotifyEvent;
procedure SetField(Value: TField);
procedure SetFieldName(const Value: string);
procedure UpdateField;
protected
procedure ActiveChanged; override;
procedure LayoutChanged; override;
procedure RecordChanged(Field: TField); override;
procedure UpdateData; override;
public
constructor Create;
procedure Reset;
property Control: TComponent read FControl write FControl;
property Editing: Boolean read FEditing;
property Field: TField read FField;
property FieldName: string read FFieldName write SetFieldName;
property OnDataChange: TNotifyEvent read FOnDataChange write
FOnDataChange;
property OnEditingChange: TNotifyEvent read FOnEditingChange write
FOnEditingChange;
property OnUpdateData: TNotifyEvent read FOnUpdateData write
FOnUpdateData;
property OnActiveChange: TNotifyEvent read FOnActiveChange write
FOnActiveChange;
end;


type
TButtonLayout = (blGlyphLeft, blGlyphRight, blGlyphTop,
blGlyphBottom);
TButtonState = (bsUp, bsDisabled, bsDown, bsExclusive);
TButtonStyle = (bsAutoDetect, bsNew);
TNumGlyphs = 1..4;

TDBColorSpeedButton = class(TGraphicControl)

private
FGroupIndex: Integer;
FGlyph: Pointer;
FDown: Boolean;
FAlignment : TAlignment;
FDragging: Boolean;
FAllowAllUp: Boolean;
FLayout: TButtonLayout;
FSpacing: Integer;
FMargin: Integer;
FColor : TColor;
FDownColor : TColor;
FClosedCaption : String;
FDisabledColor : TColor;
FMouseInControl: Boolean;
FDataLink: TFieldDataLink;
procedure DataChange(Sender: TObject);
function GetDataField: string;
function GetDataSource: TDataSource;
function GetField: TField;
function GetFieldText: string;
procedure SetDataField(const Value: string);
procedure SetDataSource(Value: TDataSource);

procedure CMGetDataLink(var Message: TMessage); message
CM_GETDATALINK;
protected

procedure GlyphChanged(Sender: TObject);
procedure UpdateExclusive;
function GetGlyph: TBitmap;
procedure SetGlyph(Value: TBitmap);
function GetNumGlyphs: TNumGlyphs;
procedure SetNumGlyphs(Value: TNumGlyphs);
procedure SetDown(Value: Boolean);
procedure SetColor(Value: TColor);
procedure SetAlignment(Value: TAlignment);
procedure SetDownColor(Value: TColor);
procedure SetClosedCaption(Value: String);
procedure SetDisabledColor(Value: TColor);
procedure SetAllowAllUp(Value: Boolean);
procedure SetGroupIndex(Value: Integer);
procedure SetLayout(Value: TButtonLayout);
procedure SetSpacing(Value: Integer);
procedure SetMargin(Value: Integer);
procedure WMLButtonDblClk(var Message: TWMLButtonDown); message
WM_LBUTTONDBLCLK;
procedure CMEnabledChanged(var Message: TMessage); message
CM_ENABLEDCHANGED;
procedure CMButtonPressed(var Message: TMessage); message
CM_BUTTONPRESSED;
procedure CMDialogChar(var Message: TCMDialogChar); message
CM_DIALOGCHAR;
procedure CMFontChanged(var Message: TMessage); message
CM_FONTCHANGED;
procedure CMTextChanged(var Message: TMessage); message
CM_TEXTCHANGED;
procedure CMMouseEnter(var Message: TMessage); message
CM_MOUSEENTER;
procedure CMMouseLeave(var Message: TMessage); message
CM_MOUSELEAVE;

protected
FState: TButtonState;
function GetPalette: HPALETTE; override;
procedure Loaded; override;
procedure MouseDown(Button: TMouseButton; Shift: TShiftState;
X, Y: Integer); override;
procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;
procedure MouseUp(Button: TMouseButton; Shift: TShiftState;
X, Y: Integer); override;
procedure Paint; override;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
procedure Click; override;
//
property Field: TField read GetField;
published

property AllowAllUp: Boolean read FAllowAllUp write SetAllowAllUp
default False;
property GroupIndex: Integer read FGroupIndex write SetGroupIndex
default 0;
property Down: Boolean read FDown write SetDown default False;
property DownColor: TColor read FDownColor write SetDownColor
default clBtnFace;
property ClosedCaption: string read FClosedCaption write
SetClosedCaption; // default Name;
property DisabledColor: TColor read FDisabledColor write
SetDisabledColor default clBtnFace;
property Caption;
property Align;
property Enabled;
property Color: TColor read FColor write SetColor default clBtnFace;
property Alignment: TAlignment read FAlignment write SetAlignment
default taCenter; //LeftJustify;

property Font;
property Glyph: TBitmap read GetGlyph write SetGlyph;
property Layout: TButtonLayout read FLayout write SetLayout default
blGlyphLeft;
property Margin: Integer read FMargin write SetMargin default -1;
property NumGlyphs: TNumGlyphs read GetNumGlyphs write SetNumGlyphs
default 1;
property ParentFont;
property ParentShowHint;
property ShowHint;
property Spacing: Integer read FSpacing write SetSpacing default 4;
property Visible;
property OnClick;
property OnDblClick;
property OnMouseDown;
property OnMouseMove;
property OnMouseUp;
property OnStartDrag;
property OnDragDrop;
property OnDragOver;
property OnEndDrag;

property DataField: string read GetDataField write SetDataField;
property DataSource: TDataSource read GetDataSource write
SetDataSource;
end;

TBitBtnKind = (bkCustom, bkOK, bkCancel, bkHelp, bkYes, bkNo, bkClose,
bkAbort, bkRetry, bkIgnore, bkAll);

procedure Register;

implementation

uses Consts;

//{$R BUTTONS.RES}

{ TColorBitBtn data }
{
var
BitBtnResNames: array[TBitBtnKind] of PChar = (
nil, 'BBOK', 'BBCANCEL', 'BBHELP', 'BBYES', 'BBNO', 'BBCLOSE',
'BBABORT', 'BBRETRY', 'BBIGNORE', 'BBALL');
BitBtnCaptions: array[TBitBtnKind] of Pointer = (
nil,nil,nil,nil,nil,nil,nil,nil,nil,nil,nil);

BitBtnModalResults: array[TBitBtnKind] of TModalResult = (
0, mrOk, mrCancel, 0, mrYes, mrNo, 0, mrAbort, mrRetry, mrIgnore,
mrAll);

var
ColorBitBtnGlyphs: array[TBitBtnKind] of TBitmap;


function GetColorBitBtnGlyph(Kind: TBitBtnKind): TBitmap;
begin
if ColorBitBtnGlyphs[Kind] = nil then
begin
ColorBitBtnGlyphs[Kind] := TBitmap.Create;
ColorBitBtnGlyphs[Kind].LoadFromResourceName(HInstance,
BitBtnResNames[Kind]);
end;
Result := ColorBitBtnGlyphs[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;

TColorButtonGlyph = 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});
procedure DrawButtonText(Canvas: TCanvas; const Caption: string;
TextBounds: TRect; State: TButtonState);
procedure CalcButtonLayout(Canvas: TCanvas; const Client: TRect;
const Offset: TPoint; const Caption: string; Layout:
TButtonLayout;
Margin, Spacing: Integer; var GlyphPos: TPoint; var TextBounds:
TRect;
Alignment: TALignment);
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; Alignment: TAlignment{; Transparent:
Boolean}): TRect;
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;
Pattern: TBitmap = nil;
ButtonCount: Integer = 0;

procedure CreateBrushPattern;
var
X, Y: Integer;
begin
Pattern := TBitmap.Create;
Pattern.Width := 8;
Pattern.Height := 8;
with Pattern.Canvas do
begin
Brush.Style := bsSolid;
Brush.Color := clBtnFace;
FillRect(Rect(0, 0, Pattern.Width, Pattern.Height));
for Y := 0 to 7 do
for X := 0 to 7 do
if (Y mod 2) = (X mod 2) then { toggles between even/odd pixles
}
Pixels[X, Y] := clBtnHighlight; { on even/odd rows }
end;
end;


{ TColorButtonGlyph }

constructor TColorButtonGlyph.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 TColorButtonGlyph.Destroy;
begin
FOriginal.Free;
Invalidate;
if Assigned(GlyphCache) and GlyphCache.Empty then
begin
GlyphCache.Free;
GlyphCache := nil;
end;
inherited Destroy;
end;

procedure TColorButtonGlyph.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 TColorButtonGlyph.GlyphChanged(Sender: TObject);
begin
if Sender = FOriginal then
begin
FTransparentColor := FOriginal.TransparentColor;
Invalidate;
if Assigned(FOnChange) then FOnChange(Self);
end;
end;

procedure TColorButtonGlyph.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 TColorButtonGlyph.SetNumGlyphs(Value: TNumGlyphs);
begin
if (Value <> FNumGlyphs) and (Value > 0) then
begin
Invalidate;
FNumGlyphs := Value;
GlyphChanged(Glyph);
end;
end;

function TColorButtonGlyph.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 < 3) then State := bsUp;
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 TColorButtonGlyph.DrawButtonGlyph(Canvas: TCanvas; const
GlyphPos: TPoint;
State: TButtonState{; Transparent: Boolean});
var
Index: Integer;
begin
if FOriginal = nil then Exit;
if (FOriginal.Width = 0) or (FOriginal.Height = 0) then Exit;
Index := CreateButtonGlyph(State);
with GlyphPos do
if {Transparent or} (State = bsExclusive) then
ImageList_DrawEx(FGlyphList.Handle, Index, Canvas.Handle, X, Y, 0,
0,
clNone, clNone, ILD_Transparent)
else
ImageList_DrawEx(FGlyphList.Handle, Index, Canvas.Handle, X, Y, 0,
0,
ColorToRGB(clBtnFace), clNone, ILD_Transparent {ILD_Normal});
end;

procedure TColorButtonGlyph.DrawButtonText(Canvas: TCanvas; const
Caption: string;
TextBounds: TRect; State: TButtonState);
begin
with Canvas do
begin
Brush.Style := bsClear;

DrawText(Handle, PChar(Caption), Length(Caption), TextBounds,
DT_CENTER or DT_VCENTER {or DT_SINGLELINE} or DT_WordBreak or
DT_NoClip);

end;
end;

procedure TColorButtonGlyph.CalcButtonLayout(Canvas: TCanvas; const
Client: TRect;
const Offset: TPoint; const Caption: string; Layout: TButtonLayout;
Margin,
Spacing: Integer; var GlyphPos: TPoint; var TextBounds: TRect;
Alignment: TALignment);
var
TextPos: TPoint;
ClientSize, GlyphSize, TextSize: TPoint;
TotalSize: TPoint;
begin
{ 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
if Layout <> blGlyphLeft then // hans
TextBounds := Rect(0, 0, Client.Right - Client.Left , 0)
else
TextBounds := Rect(0, 0, Client.Right - Client.Left - GlyphSize.x,
0);

DrawText(Canvas.Handle, PChar(Caption), Length(Caption), TextBounds,
DT_CALCRECT + DT_WORDBREAK);
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 //hans
if GlyphSize.X > 0 then
// Margin := 1;
Margin := 0;

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 }
if GlyphSize.X > 0 then //Hans

with GlyphPos do
begin
Inc(X, Client.Left + Offset.X);
Inc(Y, Client.Top + Offset.Y);
end;

if Alignment = taCenter then // little
less
OffsetRect(TextBounds, TextPos.X + Client.Left + Offset.X { -1},
TextPos.Y + Client.Top + Offset.X)
else
if Alignment = taLeftJustify then
begin
OffsetRect(TextBounds, Client.Left + Offset.X + GlyphPos.X +
GlyphSize.X,
TextPos.Y + Client.Top + Offset.X);
end
else
OffsetRect(TextBounds, Client.Right-TextBounds.Right-TextBounds.Left
-3 + Offset.X ,
TextPos.Y + Client.Top + Offset.X);

end;

function TColorButtonGlyph.Draw(Canvas: TCanvas; const Client: TRect;
const Offset: TPoint; const Caption: string; Layout: TButtonLayout;
Margin, Spacing: Integer; State: TButtonState; Alignment: TAlignment{;
Transparent: Boolean}): TRect;
var
GlyphPos: TPoint;
begin
CalcButtonLayout(Canvas, Client, Offset, Caption, Layout, Margin,
Spacing,
GlyphPos, Result, Alignment);
DrawButtonGlyph(Canvas, GlyphPos, State{, Transparent});
DrawButtonText(Canvas, Caption, Result, State);
end;

{ TDBColorSpeedButton }

constructor TDBColorSpeedButton.Create(AOwner: TComponent);
begin
FGlyph := TColorButtonGlyph.Create;
TColorButtonGlyph(FGlyph).OnChange := GlyphChanged;
inherited Create(AOwner);
SetBounds(0, 0, 25, 25);
ControlStyle := [csCaptureMouse, csOpaque, csDoubleClicks];
ParentFont := True;
FSpacing := 4;
FMargin := -1;
FLayout := blGlyphLeft;
Inc(ButtonCount);

FDataLink := TFieldDataLink.Create;
FDataLink.Control := Self;
FDataLink.OnDataChange := DataChange;
end;

destructor TDBColorSpeedButton.Destroy;
begin
Dec(ButtonCount);
if ButtonCount = 0 then
begin
Pattern.Free;
Pattern := nil;
end;

FDataLink.Free;
FDataLink := nil;

inherited Destroy;
TColorButtonGlyph(FGlyph).Free;
end;

procedure TDBColorSpeedButton.Paint;
const
DownStyles: array[Boolean] of Integer = (BDR_RAISEDINNER,
BDR_SUNKENOUTER);
FillStyles: array[Boolean] of Integer = (BF_MIDDLE, 0);
var
PaintRect: TRect;
DrawFlags: Integer;
Offset: TPoint;
begin
if not Enabled then
begin
FState := bsDisabled;
FDragging := False;
end
else
if FState = bsDisabled then
if FDown and (GroupIndex <> 0) then
FState := bsExclusive
else
FState := bsUp;

Canvas.Font := Self.Font;
PaintRect := Rect(0, 0, Width, Height);

//if not FFlat then
begin
DrawFlags := DFCS_BUTTONPUSH or DFCS_ADJUSTRECT;

if FState in [bsDown, bsExclusive] then
DrawFlags := DrawFlags or DFCS_PUSHED;

// Frame or No Frame
DrawFrameControl(Canvas.Handle, PaintRect, DFC_BUTTON, DrawFlags);
end;

if FState in [bsDown, bsExclusive] then
begin
if (FState = bsExclusive) and ({not FFlat or }not FMouseInControl)
then
begin
if Pattern = nil then
CreateBrushPattern;

Canvas.Brush.Bitmap := Pattern;
Canvas.FillRect(PaintRect);
end;

Offset.X := 1;
Offset.Y := 1;
end
else
begin
Offset.X := 0;
Offset.Y := 0;
end;

//hans
if FState in [bsUp] then
Canvas.Brush.color := Color
else
if FState in [bsDisabled] then
Canvas.Brush.Color := DisabledColor
else
Canvas.Brush.Color := DownColor;

Canvas.FillRect(PaintRect);

TColorButtonGlyph(FGlyph).Draw(Canvas, PaintRect, Offset,
GetFieldText{Caption}, FLayout, FMargin,
FSpacing, FState, FAlignment{, FFlat});

end;

procedure TDBColorSpeedButton.Loaded;
var
State: TButtonState;
begin
inherited Loaded;
if Enabled then
State := bsUp
else
State := bsDisabled;
TColorButtonGlyph(FGlyph).CreateButtonGlyph(State);
end;

procedure TDBColorSpeedButton.MouseDown(Button: TMouseButton; Shift:
TShiftState;
X, Y: Integer);
begin
inherited MouseDown(Button, Shift, X, Y);
if (Button = mbLeft) and Enabled then
begin
if not FDown then
begin
FState := bsDown;
Invalidate;
end;
FDragging := True;
end;
end;

procedure TDBColorSpeedButton.MouseMove(Shift: TShiftState; X, Y:
Integer);
var
NewState: TButtonState;
begin
inherited MouseMove(Shift, X, Y);

if FDragging then
begin
if not FDown then NewState := bsUp
else NewState := bsExclusive;
if (X >= 0) and (X < ClientWidth) and (Y >= 0) and (Y <=
ClientHeight) then
if FDown then NewState := bsExclusive else NewState := bsDown;
if NewState <> FState then
begin
FState := NewState;
Invalidate;
end;
end;

end;

procedure TDBColorSpeedButton.MouseUp(Button: TMouseButton; Shift:
TShiftState;
X, Y: Integer);
var
DoClick: Boolean;
begin
inherited MouseUp(Button, Shift, X, Y);

if FDragging then
begin
FDragging := False;
DoClick := (X >= 0) and (X < ClientWidth) and (Y >= 0) and (Y <=
ClientHeight);
if FGroupIndex = 0 then
begin
// Redraw face in-case mouse is captured
FState := bsUp;
FMouseInControl := False;
if DoClick and not (FState in [bsExclusive, bsDown]) then
Invalidate;
end
else
if DoClick then
begin
SetDown(not FDown);
if FDown then Repaint;
end
else
begin
if FDown then FState := bsExclusive;
Repaint;
end;
if DoClick then Click;
// UpdateTracking;
end;

end;

procedure TDBColorSpeedButton.Click;
begin
inherited Click;
end;

function TDBColorSpeedButton.GetPalette: HPALETTE;
begin
Result := Glyph.Palette;
end;

function TDBColorSpeedButton.GetGlyph: TBitmap;
begin
Result := TColorButtonGlyph(FGlyph).Glyph;
end;

procedure TDBColorSpeedButton.SetGlyph(Value: TBitmap);
begin
TColorButtonGlyph(FGlyph).Glyph := Value;
Invalidate;
end;

function TDBColorSpeedButton.GetNumGlyphs: TNumGlyphs;
begin
Result := TColorButtonGlyph(FGlyph).NumGlyphs;
end;

procedure TDBColorSpeedButton.SetNumGlyphs(Value: TNumGlyphs);
begin
if Value < 0 then Value := 1
else if Value > 4 then Value := 4;
if Value <> TColorButtonGlyph(FGlyph).NumGlyphs then
begin
TColorButtonGlyph(FGlyph).NumGlyphs := Value;
Invalidate;
end;
end;

procedure TDBColorSpeedButton.GlyphChanged(Sender: TObject);
begin
Invalidate;
end;

procedure TDBColorSpeedButton.UpdateExclusive;
var
Msg: TMessage;
begin
if (FGroupIndex <> 0) and (Parent <> nil) then
begin
Msg.Msg := C