Here are 2 combo boxes 1 for color selection and 1 for pen style.
Both should work with GTK,QT,Win32 and generally most of the widget sets I have made sure to stay in the lcl boundaries for those.
They where my test cases when I started with lazarus I hope some one finds them useful.
uses
Classes, SysUtils, FPCanvas, Controls, StdCtrls, Graphics, LCLType,
LCLStrConsts, typinfo;
type
{ TEvsColorComboBox }
TEvsColorComboBox = class(TCustomComboBox)
private
FColorValues : array of TColor;
FUseKnownColors : Boolean;
FPopulated : Boolean;
function GetItemColor(Index : Integer) : TColor;
function GetSelectedColor : TColor;
procedure SetItemColor(Index : Integer; aValue : TColor);
procedure SetUseKnownColors(aValue : Boolean);
protected
procedure DrawItem(Index : Integer; ARect : TRect; State : TOwnerDrawState); override;
procedure GetItems; override;
procedure EnumColors(const s:AnsiString);
public
constructor Create(TheOwner : TComponent); override;
procedure AddColor(const aColorName:String;const aColor:TColor);
property Colors[Index:Integer]:TColor read GetItemColor write SetItemColor;
property SelectedColor : TColor Read GetSelectedColor;
published
property UseKnownColors : Boolean read FUseKnownColors write SetUseKnownColors default True;
property Align;
property Anchors;
property ArrowKeysTraverseList;
property AutoComplete;
property AutoCompleteText;
property AutoDropDown;
property AutoSelect;
property AutoSize;// Note: windows has a fixed height in some styles
property BidiMode;
property BorderSpacing;
property BorderStyle;
property CharCase;
property Color;
property Constraints;
property DragCursor;
property DragKind;
property DragMode;
property DropDownCount;
property Enabled;
property Font;
property ItemHeight;
property ItemIndex;
property Items;
property ItemWidth;
property MaxLength;
property OnChange;
property OnChangeBounds;
property OnClick;
property OnCloseUp;
property OnContextPopup;
property OnDblClick;
property OnDragDrop;
property OnDragOver;
property OnDrawItem;
property OnEndDrag;
property OnDropDown;
property OnEditingDone;
property OnEnter;
property OnExit;
property OnGetItems;
property OnKeyDown;
property OnKeyPress;
property OnKeyUp;
property OnMeasureItem;
property OnMouseDown;
property OnMouseEnter;
property OnMouseLeave;
property OnMouseMove;
property OnMouseUp;
property OnStartDrag;
property OnSelect;
property OnUTF8KeyPress;
property ParentBidiMode;
property ParentColor;
property ParentFont;
property ParentShowHint;
property PopupMenu;
property ReadOnly;
property ShowHint;
property TabOrder;
property TabStop;
property Visible;
end;
{ TEvsPenStyleComboBox }
TEvsPenStyleComboBox = class(TCustomComboBox)
private
FLineStyle : TPenStyle;
function GetPenStyle : TPenStyle;
procedure SetPenStyle(aValue : TPenStyle);
protected
function GetStyle(const aIndex:Integer):TPenStyle;
procedure GetItems; override;
procedure DrawItem(Index : Integer; ARect : TRect; State : TOwnerDrawState); override;
public
constructor Create(TheOwner : TComponent); override;
published
property PenStyle : TPenStyle read GetPenStyle write SetPenStyle;
property Align;
property Anchors;
property ArrowKeysTraverseList;
property AutoComplete;
property AutoCompleteText;
property AutoDropDown;
property AutoSelect;
property AutoSize;// Note: windows has a fixed height in some styles
property BidiMode;
property BorderSpacing;
property BorderStyle;
property CharCase;
property Color;
property Constraints;
property DragCursor;
property DragKind;
property DragMode;
property DropDownCount;
property Enabled;
property Font;
property ItemHeight;
property ItemIndex;
property Items;
property ItemWidth;
property MaxLength;
property OnChange;
property OnChangeBounds;
property OnClick;
property OnCloseUp;
property OnContextPopup;
property OnDblClick;
property OnDragDrop;
property OnDragOver;
property OnDrawItem;
property OnEndDrag;
property OnDropDown;
property OnEditingDone;
property OnEnter;
property OnExit;
property OnGetItems;
property OnKeyDown;
property OnKeyPress;
property OnKeyUp;
property OnMeasureItem;
property OnMouseDown;
property OnMouseEnter;
property OnMouseLeave;
property OnMouseMove;
property OnMouseUp;
property OnStartDrag;
property OnSelect;
property OnUTF8KeyPress;
property ParentBidiMode;
property ParentColor;
property ParentFont;
property ParentShowHint;
property PopupMenu;
property ReadOnly;
property ShowHint;
property TabOrder;
property TabStop;
property Visible;
end;
resourcestring
rsUnknownStyle = 'Unknown Style %S';
implementation
const
cTxtStyle : TTextStyle =(Alignment:taLeftJustify; Layout:tlCenter; SingleLine :True;
Clipping : True; ExpandTabs : False; ShowPrefix :False;
Wordbreak : False; Opaque :False; SystemFont : false;
RightToLeft : False; EndEllipsis :True);
{$REGION ' TEvsPenStyleComboBox '}
procedure TEvsPenStyleComboBox.SetPenStyle(aValue : TPenStyle);
var
vIdx : Integer;
vStr : string;
begin
vStr := GetEnumName(TypeInfo(TPenStyle),Ord(aValue));
vIdx := Items.IndexOf(vStr);
if vIdx > -1 then ItemIndex := vIdx
else raise Exception.CreateFmt(rsUnknownStyle,[vStr]);
end;
function TEvsPenStyleComboBox.GetStyle(const aIndex : Integer) : TPenStyle;
begin
Result := TPenStyle(GetEnumValue(TypeInfo(TPenStyle),Items[aIndex]));
end;
function TEvsPenStyleComboBox.GetPenStyle : TPenStyle;
begin
Result := GetStyle(ItemIndex);
end;
procedure TEvsPenStyleComboBox.GetItems;
var
Cnt : TFPPenStyle;
begin
if Items.Count > 0 then Exit;
for Cnt := Low(TPenStyle) to High(TPenStyle) do
Items.Add(GetEnumName(TypeInfo(TPenStyle), Ord(Cnt)));
end;
procedure TEvsPenStyleComboBox.DrawItem(Index : Integer; ARect : TRect;
State : TOwnerDrawState);
var
vPenClr : TColor;
vPenStyle : TPenStyle;
vBrushStyle : TBrushStyle;
vFontClr : TColor;
vHeight : Integer;
vStyle : TTextStyle;
begin
if Assigned(OnDrawItem) then OnDrawItem(Self,Index,ARect,State)
else begin
vPenClr := Canvas.Pen.Color;
vPenStyle := Canvas.Pen.Style;
vBrushStyle := Canvas.Brush.Style;
vFontClr := Canvas.Font.Color;
if odFocused in State then begin
Canvas.Brush.Color := clHighlight;
Canvas.Pen.Color := clHighlightText;
Canvas.Font.Color := clHighlightText;
end;
Canvas.FillRect(ARect);
try
vHeight := ARect.Bottom-ARect.Top;
if (odSelected in State) or (odFocused in State) then Canvas.Pen.Color := clHighlightText else Canvas.Pen.Color := clBlack;
Canvas.Brush.Style := bsClear;
Canvas.Pen.Style := GetStyle(Index);
Canvas.Rectangle(ARect.Left+1, ARect.Top+1, ARect.Left+(vHeight*2)-1,ARect.Bottom-1);
Canvas.Pen.Style := vPenStyle;
Canvas.Pen.Color := vPenClr;
Canvas.Brush.Style := vBrushStyle;
ARect.Left := ARect.Left+(vHeight*2)+2;
vStyle := cTxtStyle;
Canvas.TextRect(ARect,ARect.Left, ARect.Top,Items[Index],vStyle);
finally
Canvas.Pen.Color := vPenClr;
Canvas.Pen.Style := vPenStyle;
Canvas.Brush.Style := vBrushStyle;
Canvas.Font.Color := vFontClr;
end;
end;
end;
constructor TEvsPenStyleComboBox.Create(TheOwner : TComponent);
begin
inherited Create(TheOwner);
Style := csOwnerDrawFixed;
ItemHeight := 13;
end;
{$ENDREGION}
{$REGION ' TEvsColorComboBox '}
procedure TEvsColorComboBox.SetUseKnownColors(aValue : Boolean);
begin
if FUseKnownColors = aValue then Exit;
FUseKnownColors := aValue;
end;
function TEvsColorComboBox.GetItemColor(Index : Integer) : TColor;
begin
if (Index < 0) or (Index>=items.Count) then raise Exception.CreateFmt(rsIndexOutOfBounds,[Color,Index,Items.Count-1]);
Result := FColorValues[Index];
end;
function TEvsColorComboBox.GetSelectedColor : TColor;
begin
Result := FColorValues[ItemIndex];
end;
procedure TEvsColorComboBox.SetItemColor(Index : Integer; aValue : TColor);
begin
if (Index < 0) or (Index>=items.Count) then raise Exception.CreateFmt(rsIndexOutOfBounds,[Color,Index,Items.Count-1]);
FColorValues[Index]:= aValue;
end;
procedure TEvsColorComboBox.DrawItem(Index : Integer; ARect : TRect;
State : TOwnerDrawState);
var
vPenClr : TColor =clDefault;
VbrshClr : TColor = clDefault;
vStyle : TTextStyle;
vItmH : TColor;
VbrshStl : TBrushStyle;
vFontClr : TColor;
begin
if Assigned(OnDrawItem) then OnDrawItem(Self, Index, ARect, State)
else begin
vPenClr := Canvas.Pen.Color;
VbrshClr := Canvas.Brush.Color;
VbrshStl := Canvas.Brush.Style;
vFontClr := Canvas.Font.Color;
if odFocused in State then begin
Canvas.Brush.Color := clHighlight;
Canvas.Pen.Color := clHighlightText;
Canvas.Font.Color := clHighlightText;
end;
Canvas.FillRect(ARect);
try
vStyle:= cTxtStyle;
vStyle.RightToLeft := BiDiMode in[bdRightToLeft, bdRightToLeftNoAlign];
if (odFocused in State) or (odSelected in State) then Canvas.Pen.Color := clHighlightText;
Canvas.Brush.Color := FColorValues[Index];
Canvas.Brush.Style := bsSolid;
vItmH := (ARect.Bottom-ARect.Top);
Canvas.Rectangle(ARect.Left+1, ARect.Top+1, ARect.Left+vItmH-1,ARect.Bottom-1);
Canvas.Brush.Color := VbrshClr;
Canvas.Pen.Color := vPenClr;
Canvas.Brush.Style := VbrshStl;
ARect.Left := ARect.Left+vItmH+2;
Canvas.TextRect(ARect,ARect.Left,ARect.Top,Items[Index], vStyle);
finally
Canvas.Pen.Color := vPenClr;
Canvas.Brush.Color := VbrshClr;
Canvas.Brush.Style := VbrshStl;
Canvas.Font.Color := vFontClr;
end;
end;
end;
procedure TEvsColorComboBox.GetItems;
begin
if FPopulated then Exit;
if FUseKnownColors then begin
SetLength(FColorValues,300);
GetColorValues(@EnumColors);
SetLength(FColorValues, Items.Count);//trancate extraspaces;
end;
inherited;
FPopulated := True;
end;
procedure TEvsColorComboBox.EnumColors(const s : AnsiString);
var
Tmp:string;
begin
if Items.Count >= Length(FColorValues) then SetLength(FColorValues,length(FColorValues)+300);
Tmp := Copy(s,1,2);
if SameText(tmp,'cl') then Tmp := Copy(s,3,length(s)) else Tmp := s;
FColorValues[Items.Add(Tmp)] := StringToColor(s);
end;
constructor TEvsColorComboBox.Create(TheOwner : TComponent);
begin
inherited Create(TheOwner);
FUseKnownColors := True;
Style := csOwnerDrawFixed;
ItemHeight := 13;
FPopulated := False;
end;
procedure TEvsColorComboBox.AddColor(const aColorName : String;
const aColor : TColor);
begin
SetLength(FColorValues,Length(FColorValues)+1);
FColorValues[Items.Add(aColorName)] := aColor;
end;
{$ENDREGION}
I had to do some clean up to remove some dependencies on some of my units but you shouldn't have any problems with them if you do, I'll try to fix them as time permits.