{
untERDCombobox v1.0.0 -
Custom comboboxes with DropDownList style
for Delphi 2010 - 10.4 by Ernst Reidinga
[url]https://erdesigns.eu[/url]
This unit is part of the ERDesigns Component Pack.
(c) Copyright 2021 Ernst Reidinga <ernst@erdesigns.eu>
Bugfixes / Updates:
- Initial Release 1.0.0
}
unit untERDCombobox;
interface
uses
System.SysUtils, System.Classes, Vcl.Controls, Vcl.StdCtrls, Winapi.Messages,
System.Types, Vcl.Graphics, Winapi.Windows;
const
ERDComboVersion = '1.0.0.0';
ERDBooleanComboVersion = '1.0.0.0';
const
CBRO_NORMAL = 1;
CBRO_HOT = 2;
CBRO_PRESSED = 3;
CBRO_DISABLED = 4;
OM_FIRST = $7F00;
OM_AFTERENTER = OM_FIRST + 8;
OM_AFTEREXIT = OM_FIRST + 9;
type
TERDCustomComboStyle = (csFixedItemSize, csVariableItemSize);
TERDCustomCombo = class(TCustomComboBox)
private
{ Private declarations }
FCurrentState : Cardinal;
FNewState : Cardinal;
FBufferedPaintInitialized : Boolean;
FKillFocus : Boolean;
FComboStyle : TERDCustomComboStyle;
FFocusRect : Boolean;
FItemHeight : Integer;
procedure SetItemHeight(const I: Integer);
procedure CNCommand(var Message: TWmCommand); message CN_COMMAND;
procedure CNCtlColorEdit(var Message: TMessage); message CN_CTLCOLOREDIT;
procedure WMKillFocus(var Msg : TWMKillFocus); message WM_KILLFOCUS;
procedure WMSetFocus(var Msg : TWMSetFocus); message WM_SETFOCUS;
procedure WMSize(var Message: TMessage); message WM_SIZE;
procedure WMPaint(var Msg : TWMPaint); message WM_PAINT;
procedure CMMouseEnter(var Message : TMessage); message CM_MOUSEENTER;
procedure CMMouseLeave(var Message : TMessage); message CM_MOUSELEAVE;
procedure CMEnabledChanged(var Message: TMessage); message CM_ENABLEDCHANGED;
procedure CMFontChanged(var Message: TMessage); message CM_FONTCHANGED;
procedure CMFocusChanged(var Message: TCMFocusChanged); message CM_FOCUSCHANGED;
protected
{ Protected declarations }
procedure DrawItem(Index: Integer; ItemRect: TRect; State: TOwnerDrawState); override;
procedure CreateParams(var Params: TCreateParams); override;
procedure SetStyle(const S : TERDCustomComboStyle); reintroduce;
procedure Select; override;
procedure SetItemIndex(const Value: Integer); override;
procedure PaintWindow(DC : HDC); override;
procedure PaintState(DC: HDC; State: Cardinal);
procedure StartAnimation(NewState: Cardinal);
procedure CloseUp; override;
procedure DrawItemX(Index: Integer; ItemRect: TRect; State: TOwnerDrawState; Themed: Boolean); virtual;
public
{ Public declarations }
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
published
{ Published declarations }
property Style: TERDCustomComboStyle read FComboStyle write SetStyle default csFixedItemSize;
property FocusRect: Boolean read FFocusRect write FFocusRect default True;
property ItemHeight: Integer read FItemHeight write SetItemHeight default 16;
end;
TERDCombobox = class(TERDCustomCombo)
private
{ Private declarations }
FImages: TImageList;
procedure SetImages(const I: TImageList);
protected
{ Protected declarations }
procedure DrawItemX(Index: Integer; ItemRect: TRect; State: TOwnerDrawState; Themed: Boolean); override;
published
property Images: TImageList read FImages write SetImages;
property Anchors;
property Constraints;
property DragKind;
property Align;
property Color;
property Ctl3D;
property Cursor;
property DragCursor;
property DragMode;
property DropDownCount;
property DoubleBuffered;
property Enabled;
property Font;
property FocusRect;
property ImeMode;
property ImeName;
property Items;
property ItemIndex;
//property ItemHeight;
property MaxLength;
property ParentColor;
property ParentCtl3D;
property ParentFont;
property ParentShowHint;
property PopupMenu;
property ShowHint;
property Sorted;
//property Style default csFixedItemSize;
property TabOrder;
property TabStop;
property Text;
property Visible;
property OnClick;
property OnDblClick;
property OnDragDrop;
property OnDragOver;
property OnDropDown;
property OnEndDrag;
property OnEnter;
property OnExit;
property OnKeyDown;
property OnKeyPress;
property OnKeyUp;
property OnSelect;
property OnStartDrag;
property OnMouseWheel;
end;
TERDBooleanComboValueChangeEvent = procedure(Sender: TObject; Value: Boolean) of object;
TERDBooleanCombobox = class(TERDCustomCombo)
private
{ Private declarations }
FOnValue : TERDBooleanComboValueChangeEvent;
FTrueString : string;
FFalseString : string;
procedure SetTrueString(const S: string);
procedure SetFalseString(const S: string);
procedure SetValue(const B: Boolean);
function GetValue : Boolean;
protected
{ Protected declarations }
procedure CreateWnd; override;
procedure Select; override;
procedure DrawItemX(Index: Integer; ItemRect: TRect; State: TOwnerDrawState; Themed: Boolean); override;
public
{ Public declarations }
constructor Create(AOwner: TComponent); override;
published
property TrueString: string read FTrueString write SetTrueString;
property FalseString: string read FFalseString write SetFalseString;
property Value: Boolean read GetValue write SetValue default True;
property OnValue: TERDBooleanComboValueChangeEvent read FOnValue write FOnValue;
property Anchors;
property Constraints;
property DragKind;
property Align;
property Color;
property Ctl3D;
property Cursor;
property DragCursor;
property DragMode;
property DoubleBuffered;
property Enabled;
property Font;
property FocusRect;
property ImeMode;
property ImeName;
property ParentColor;
property ParentCtl3D;
property ParentFont;
property ParentShowHint;
property PopupMenu;
property ShowHint;
property TabOrder;
property TabStop;
property Visible;
property OnClick;
property OnDblClick;
property OnDragDrop;
property OnDragOver;
property OnDropDown;
property OnEndDrag;
property OnEnter;
property OnExit;
property OnKeyDown;
property OnKeyPress;
property OnKeyUp;
property OnStartDrag;
property OnMouseWheel;
end;
implementation
uses Winapi.UxTheme, Vcl.Themes;
(******************************************************************************)
(*
(* ERD Custom Combobox (TERDCustomCombo)
(*
(******************************************************************************)
constructor TERDCustomCombo.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
if Style = csFixedItemSize then ControlStyle := ControlStyle + [csFixedHeight];
FFocusRect := True;
FBufferedPaintInitialized := Succeeded(BufferedPaintInit);
end;
destructor TERDCustomCombo.Destroy;
begin
if FBufferedPaintInitialized then BufferedPaintUnInit;
inherited Destroy;
end;
procedure TERDCustomCombo.SetItemHeight(const I: Integer);
begin
if ItemHeight <> I then
begin
FItemHeight := I;
RecreateWnd;
end;
end;
procedure TERDCustomCombo.CNCommand(var Message: TWmCommand);
begin
inherited;
case Message.NotifyCode of
CBN_DROPDOWN:
begin
StartAnimation(CBRO_PRESSED);
end;
CBN_CLOSEUP:
begin
if (ItemIndex > -1) then
begin
Text := Items[ItemIndex];
Invalidate;
end;
end;
end;
end;
procedure TERDCustomCombo.CNCtlColorEdit(var Message: TMessage);
begin
if StyleServices.Enabled then
Message.Result := GetStockObject(NULL_BRUSH)
end;
procedure TERDCustomCombo.WMKillFocus(var Msg : TWMKillFocus);
begin
FKillFocus := True;
inherited;
FKillFocus := False;
PostMessage(Handle, OM_AFTEREXIT, 0, 0);
end;
procedure TERDCustomCombo.WMSetFocus(var Msg : TWMSetFocus);
begin
inherited;
PostMessage(Handle, OM_AFTERENTER, 0, 0);
end;
procedure TERDCustomCombo.WMSize(var Message: TMessage);
begin
if StyleServices.Enabled then BufferedPaintStopAllAnimations(Handle);
inherited;
end;
procedure TERDCustomCombo.WMPaint(var Msg : TWMPaint);
begin
ControlState := ControlState + [csCustomPaint];
inherited;
ControlState := ControlState - [csCustomPaint];
end;
procedure TERDCustomCombo.CMMouseEnter(var Message: TMessage);
begin
if Enabled then StartAnimation(CBRO_HOT);
Invalidate;
inherited;
end;
procedure TERDCustomCombo.CMMouseLeave(var Message: TMessage);
begin
if not DroppedDown and Enabled then StartAnimation(CBRO_NORMAL);
Invalidate;
inherited;
end;
procedure TERDCustomCombo.CMEnabledchanged(var Message: TMessage);
begin
inherited;
if not (csDesigning in ComponentState) then
begin
if Enabled then
StartAnimation(CBRO_NORMAL)
else
StartAnimation(CBRO_DISABLED);
end else
Invalidate;
end;
procedure TERDCustomCombo.CMFontChanged(var Message: TMessage);
begin
inherited;
if (Items.Count > 0) then
begin
ItemIndex := Items.IndexOf(Font.Name);
Invalidate;
end;
end;
procedure TERDCustomCombo.CMFocusChanged(var Message: TCMFocusChanged);
begin
//Repaint;
//Invalidate;
end;
procedure TERDCustomCombo.DrawItem(Index : Integer; ItemRect: TRect; State : TOwnerDrawState);
var
BkColor : TColor;
BkMode : Integer;
begin
if FKillFocus then Exit;
with Canvas do
begin
if (StyleServices.Enabled) then
BKColor := StyleServices.GetSystemColor(clWindow)
else
BkColor := Color;
if odSelected in State then
begin
if StyleServices.Enabled then
Brush.Color := StyleServices.GetSystemColor(clHighlight);
end else
Brush.Color := BkColor;
FillRect(ItemRect);
BkMode := GetBkMode(Canvas.Handle);
SetBkMode(Canvas.Handle, TRANSPARENT);
DrawItemX(Index, ItemRect, State, False);
SetBkMode(Canvas.Handle, BkMode);
Brush.Color := clBlack;
end;
end;
procedure TERDCustomCombo.CreateParams(var Params : TCreateParams);
begin
inherited CreateParams(Params);
Params.Style := Params.Style or (WS_VSCROLL or CBS_HASSTRINGS or CBS_AUTOHSCROLL);
Params.Style := Params.Style or CBS_DROPDOWNLIST;
if Style = csVariableItemSize then
begin
Params.Style := Params.Style - CBS_OWNERDRAWFIXED;
Params.Style := Params.Style + CBS_OWNERDRAWVARIABLE;
end else
begin
Params.Style := Params.Style - CBS_OWNERDRAWVARIABLE;
Params.Style := Params.Style + CBS_OWNERDRAWFIXED;
end;
if NewStyleControls and Ctl3D then
Params.ExStyle := Params.ExStyle or WS_EX_CLIENTEDGE;
end;
procedure TERDCustomCombo.SetStyle(const S : TERDCustomComboStyle);
begin
if Style <> S then
begin
FComboStyle := S;
if S = csFixedItemSize then
ControlStyle := ControlStyle + [csFixedHeight]
else
ControlStyle := ControlStyle - [csFixedHeight];
RecreateWnd;
end;
end;
procedure TERDCustomCombo.Select;
begin
inherited;
Invalidate;
end;
procedure TERDCustomCombo.SetItemIndex(const Value: Integer);
begin
inherited;
Invalidate;
end;
procedure TERDCustomCombo.PaintWindow(DC : HDC);
var
animParams : BP_ANIMATIONPARAMS;
CR : TRect;
hbpAnimation : HANIMATIONBUFFER;
hdcFrom, hdcTo : HDC;
begin
if (not HandleAllocated) then Exit;
if StyleServices.Enabled then
begin
TControlCanvas(Canvas).UpdateTextFlags;
if not BufferedPaintRenderAnimation(Handle, Canvas.Handle) then
begin
FillChar(animParams, sizeof(animParams), 0);
animParams.cbSize := sizeof(BP_ANIMATIONPARAMS);
animParams.style := BPAS_LINEAR;
GetThemeTransitionDuration(StyleServices.Theme[teComboBox], CP_READONLY, FCurrentState, FNewState, TMT_TRANSITIONDURATIONS, animParams.dwDuration);
CR := ClientRect;
hbpAnimation := BeginBufferedAnimation(Handle, DC, CR, BPBF_COMPATIBLEBITMAP, nil, &animParams, &hdcFrom, &hdcTo);
if hbpAnimation <> 0 then
begin
if hdcFrom <> 0 then PaintState(hdcFrom, FCurrentState);
if hdcTo <> 0 then PaintState(hdcTo, FNewState);
FCurrentState := FNewState;
EndBufferedAnimation(hbpAnimation, TRUE);
end;
end;
end else
begin
inherited PaintWindow(DC);
Canvas.Handle := DC;
try
//
finally
Canvas.Handle := 0;
end;
end;
end;
procedure TERDCustomCombo.PaintState(DC: HDC; State: Cardinal);
var
Details : TThemedElementDetails;
R : TRect;
Original : HGDIOBJ;
PCBI : TComboBoxInfo;
begin
if (not HandleAllocated) then Exit;
Details.Element := teComboBox;
Details.Part := CP_READONLY;
Details.State := State;
R := ClientRect;
FillChar(PCBI, SizeOf(PCBI), 0);
PCBI.cbSize := SizeOf(PCBI);
GetComboBoxInfo(Handle, PCBI);
StyleServices.DrawParentBackground(Handle, DC, Details, True, @R);
StyleServices.DrawElement(DC, Details, ClientRect);
R := PCBI.rcItem;
Inc(R.Left, 1);
Canvas.Font := Font;
Original := SelectObject(DC, Font.Handle);
if Focused and (not DroppedDown) and not (csDesigning in ComponentState) then
begin
if FocusRect then DrawFocusRect(DC, pcbi.rcItem);
end;
Canvas.Handle := DC;
try
DrawItemX(ItemIndex, R, [], True);
finally
Canvas.Handle := 0;
end;
SelectObject(DC, Original);
Details.Part := CP_DROPDOWNBUTTONRIGHT;
Details.State := 0;
if Enabled then
Details.State := 0
else
Details.State := CBRO_DISABLED;
StyleServices.DrawElement(DC, Details, PCBI.rcButton);
end;
procedure TERDCustomCombo.StartAnimation(NewState: Cardinal);
begin
FNewState := NewState;
if StyleServices.Enabled then InvalidateRect(Handle, nil, True);
end;
procedure TERDCustomCombo.CloseUp;
begin
inherited;
StartAnimation(CBRO_NORMAL);
end;
procedure TERDCustomCombo.DrawItemX(Index: Integer; ItemRect: TRect; State: TOwnerDrawState; Themed: Boolean);
begin
end;
(******************************************************************************)
(*
(* ERD Combobox (TERDCombobox)
(*
(******************************************************************************)
procedure TERDCombobox.SetImages(const I: TImageList);
begin
FImages := I;
Invalidate;
end;
procedure TERDCombobox.DrawItemX(Index: Integer; ItemRect: TRect; State: TOwnerDrawState; Themed: Boolean);
var
R : TRect;
begin
if (Items.Count <= 0) or (Index = -1) then Exit;
{ Clear brush }
Canvas.Brush.Style := bsClear;
{ Set Rect }
R := ItemRect;
if Themed then
R.Left := 4
else
R.Left := 2;
{ Draw Image }
if Assigned(FImages) then
begin
if (Index < FImages.Count) then
FImages.Draw(Canvas, R.Left, R.Top + ((R.Height div 2) - (FImages.Height div 2)), Index);
R.Left := R.Left + FImages.Width + 2;
end;
{ Draw text }
DrawText(Canvas.Handle, Items[Index], Length(Items[Index]), R, DT_LEFT or DT_VCENTER or DT_SINGLELINE or DT_END_ELLIPSIS);
end;
(******************************************************************************)
(*
(* ERD Boolean Combobox (TERDBooleanCombobox)
(*
(******************************************************************************)
constructor TERDBooleanCombobox.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
FTrueString := 'True';
FFalseString := 'False';
end;
procedure TERDBooleanCombobox.SetTrueString(const S: string);
begin
if TrueString <> S then
begin
FTrueString := S;
Items[0] := S;
Invalidate;
end;
end;
procedure TERDBooleanCombobox.SetFalseString(const S: string);
begin
if FalseString <> S then
begin
FFalseString := S;
Items[1] := S;
Invalidate;
end;
end;
procedure TERDBooleanCombobox.SetValue(const B: Boolean);
begin
if Value <> B then
begin
if B then
ItemIndex := 0
else
ItemIndex := 1;
end;
end;
function TERDBooleanCombobox.GetValue : Boolean;
begin
Result := ItemIndex = 0;
end;
procedure TERDBooleanCombobox.CreateWnd;
begin
inherited CreateWnd;
Items.Clear;
Items.Add(TrueString);
Items.Add(FalseString);
ItemIndex := 0;
Invalidate;
end;
procedure TERDBooleanCombobox.Select;
begin
inherited;
if Assigned(FOnValue) then FOnValue(Self, ItemIndex = 0);
end;
procedure TERDBooleanCombobox.DrawItemX(Index: Integer; ItemRect: TRect; State: TOwnerDrawState; Themed: Boolean);
var
R : TRect;
begin
if (not HandleAllocated) then Exit;
if (Items.Count <= 0) or (Index = -1) or (not HandleAllocated) then Exit;
{ Clear brush }
Canvas.Brush.Style := bsClear;
{ Set Rect }
R := ItemRect;
if Themed then
R.Left := 22
else
R.Left := 20;
{ Draw the text before we draw the checkbox - because else our brush is not clear and will draw a background color }
DrawText(Canvas.Handle, Items[Index], Length(Items[Index]), R, DT_LEFT or DT_VCENTER or DT_SINGLELINE or DT_END_ELLIPSIS);
{ Draw Check/Radio }
R := ItemRect;
if Themed then
R.Left := 4
else
R.Left := 2;
R.Right := R.Left + 16;
if StyleServices.Enabled then
begin
if Enabled then
case Index of
0: StyleServices.DrawElement(Canvas.Handle, StyleServices.GetElementDetails(tbCheckBoxCheckedNormal), R);
1: StyleServices.DrawElement(Canvas.Handle, StyleServices.GetElementDetails(tbCheckBoxUncheckedNormal), R);
end
else
StyleServices.DrawElement(Canvas.Handle, StyleServices.GetElementDetails(tbCheckBoxUncheckedNormal), R);
end
else
if Enabled then
case Index of
0: DrawFrameControl(Canvas.Handle, R, DFC_BUTTON, DFCS_BUTTONCHECK or DFCS_CHECKED);
1: DrawFrameControl(Canvas.Handle, R, DFC_BUTTON, DFCS_BUTTONCHECK);
end
else
DrawFrameControl(Canvas.Handle, R, DFC_BUTTON, DFCS_BUTTONCHECK or DFCS_INACTIVE);
end;
end.
Bookmarks