expertcad/POWERCAD30/UNITS/stylecombos.pas
2025-05-12 10:07:51 +03:00

1055 lines
26 KiB
ObjectPascal

unit StyleCombos;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls,ExtCtrls,Pctypesutils;
type
TStyleCombo = class(TCustomComboBox)
protected
procedure CreateWnd; override;
public
procedure SetStyleList; virtual;
published
property OnChange;
Property Font;
end;
TPenStyleCombo = class(TStyleCombo)
private
function GetSelection: TPenStyle;
procedure SetSelection(Value: TPenStyle);
protected
procedure SetStyle(Value: TComboBoxStyle); override;
procedure DrawItem(Index: Integer; Rect: TRect;
State: TOwnerDrawState); override;
public
constructor Create(AOwner: TComponent); override;
property Selection: TPenStyle read GetSelection write SetSelection;
procedure SetStyleList; override;
end;
TRowCombo = class(TStyleCombo)
private
function GetSelection: TRowStyle;
procedure SetSelection(Value: TRowStyle);
protected
procedure SetStyle(Value: TComboBoxStyle); override;
procedure DrawItem(Index: Integer; Rect: TRect;
State: TOwnerDrawState); override;
public
constructor Create(AOwner: TComponent); override;
Procedure DrawToCanvas(Canvasx:TCanvas;Index: Integer; Rect: TRect);
property Selection: TRowStyle read GetSelection write SetSelection;
procedure SetStyleList; override;
end;
TBrushStyleCombo = class(TStyleCombo)
private
oldidx : integer;
function GetSelection: TBrushStyle;
procedure SetSelection(Value: TBrushStyle);
protected
procedure SetStyle(Value: TComboBoxStyle); override;
procedure DrawItem(Index: Integer; Rect: TRect;
State: TOwnerDrawState); override;
public
constructor Create(AOwner: TComponent); override;
property Selection: TBrushStyle read GetSelection write SetSelection;
procedure SetStyleList; override;
end;
TPenWidthCombo = class(TStyleCombo)
private
function GetSelection: shortint;
procedure SetSelection(Value: shortint);
protected
procedure SetStyle(Value: TComboBoxStyle); override;
procedure DrawItem(Index: Integer; Rect: TRect;
State: TOwnerDrawState); override;
public
constructor Create(AOwner: TComponent); override;
procedure SetStyleList; override;
property Selection: shortint read GetSelection write SetSelection;
end;
TColorCombo = class(TCustomComboBox)
private
function GetSelection: TColor;
procedure SetSelection(Value: TColor);
protected
procedure SetStyle(Value: TComboBoxStyle); override;
procedure DrawItem(Index: Integer; Rect: TRect;
State: TOwnerDrawState); override;
procedure CreateWnd; override;
public
constructor Create(AOwner: TComponent); override;
procedure SetColorList; virtual;
property Selection: TColor read GetSelection write SetSelection;
published
property Color;
property Ctl3D;
property DragMode;
property DragCursor;
property DropDownCount;
property Enabled;
property Font;
property ItemHeight;
property Items;
property MaxLength;
property ParentColor;
property ParentCtl3D;
property ParentFont;
property ParentShowHint;
property PopupMenu;
property ShowHint;
property Sorted;
property TabOrder;
property TabStop;
property Text;
property Visible;
property OnChange;
property OnClick;
property OnDblClick;
property OnDragDrop;
property OnDragOver;
property OnDrawItem;
property OnDropDown;
property OnEndDrag;
property OnEnter;
property OnExit;
property OnKeyDown;
property OnKeyPress;
property OnKeyUp;
property OnMeasureItem;
property OnStartDrag;
end;
TFontComboBox = class(TCustomComboBox)
private
{ Private declarations }
FBitmap: TBitmap;
FCanvas: TControlCanvas;
FTTOnly: Boolean;
FUseItemFont: Boolean;
{added}FUpdateAllForms : boolean;
function IsTrueType(Index: Integer): Boolean;
procedure DrawTT(Background: TColor);
procedure SetTTOnly(Value : boolean);
procedure SetUseItemFont(Value : boolean);
protected
{ Protected declarations }
procedure CreateWnd; override;
{added}procedure CMFontChanged(var Message); message CM_FONTCHANGED;
{added}procedure Change; override;
public
{ Public declarations }
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
procedure DrawItem(Index: Integer; Rect: TRect; State: TOwnerDrawState); override;
published
{ Published declarations }
property Color;
property Ctl3D;
property DragMode;
property DragCursor;
property DropDownCount;
property Enabled;
property Font;
property Items;
property ParentColor;
property ParentCtl3D;
property ParentShowHint;
property PopupMenu;
property ShowHint;
property TabOrder;
property TabStop;
property Visible;
property Text;
property OnChange;
property OnClick;
property OnDblClick;
property OnDragDrop;
property OnDragOver;
property OnDropDown;
property OnEndDrag;
property OnEnter;
property OnExit;
property OnKeyDown;
property OnKeyPress;
property OnKeyUp;
property TTonly : boolean read FTTonly write SetTTonly;
property UseItemFont : boolean read FUseItemFont write SetUseItemFont;
{added}property UpdateAllForms : boolean read FUpdateAllForms write FUpdateAllForms;
end;
TPictureComboBox = class(TCustomComboBox)
private
{ Private declarations }
FImageList : TImageList;
FShadow : Boolean;
FBackgroundColour,
FShadowColour : TColor;
protected
{ Protected declarations }
function GetIconList : TImageList;
procedure SetIconList (AnIconImageList : TImageList);
function GetImageIndex(AnIndex : Integer) : Integer;
function DisplayString(AnIndex : Integer) : string;
procedure ComboBox1MeasureItem(Control: TWinControl; Index: Integer;
var Height: Integer);
procedure Drawitem(Control: TWinControl; Index: Integer;
Rect: TRect; State: TOwnerDrawState);
procedure Loaded; override;
public
{ Public declarations }
constructor Create(AnOwner : TComponent); override;
destructor Destroy; override;
published
{ Published declarations }
property Color;
property Ctl3D;
property DragCursor;
property DragMode;
property DropDownCount;
property Enabled;
property Font;
property ImeMode;
property ImeName;
property ItemHeight;
property Items;
property MaxLength;
property ParentColor;
property ParentCtl3D;
property ParentFont;
property ParentShowHint;
property PopupMenu;
property ShowHint;
property Sorted;
property TabOrder;
property TabStop;
property Visible;
property OnChange;
property OnClick;
property OnDblClick;
property OnDragDrop;
property OnDragOver;
property OnDropDown;
property OnEndDrag;
property OnEnter;
property OnExit;
property OnKeyDown;
property OnKeyPress;
property OnKeyUp;
property OnStartDrag;
property ImageList : TImageList read GetIconList write SetIconList;
property Shadow : Boolean read FShadow write FShadow;
property ShadowColour : TColor read FShadowColour write FShadowColour;
property BackgroundColour : TColor read FBackgroundColour
write FBackgroundColour;
end;
implementation
const
ColorArray: array[0..19] of TColor =
(
clBlack, clMaroon, clGreen, clOlive, clNavy, clPurple, clTeal, clGray,
clSilver, clRed, clLime, clYellow, clBlue, clFuchsia, clAqua, clLtGray,
clDkGray, clWhite, clNone, clDefault
);
function TPenStyleCombo.GetSelection: TPenStyle;
begin
result:=TPenStyle(ItemIndex);
end;
procedure TPenStyleCombo.SetSelection(Value: TPenStyle);
var
i: integer;
begin
for i:=0 to 6 do
if TPenStyle(i) = Value then
begin
ItemIndex :=i;
exit;
end;
end;
procedure TPenStyleCombo.SetStyle(Value: TComboBoxStyle);
begin
inherited SetStyle(csOwnerDrawFixed);
end;
procedure TPenStyleCombo.DrawItem(Index: Integer; Rect: TRect; State: TOwnerDrawState);
var
r: TRect;
ItemColor, c: TColor;
begin
r.top := Rect.top + 3;
r.bottom := Rect.bottom - 3;
r.left := Rect.left ;
r.right := Rect.right;
with Canvas do
begin
FillRect(Rect);
pen.style:=tpenstyle(index);
pen.color:=clBlack;
moveto(r.Left,r.top + (r.Bottom - r.top) div 2);
lineto(r.right,r.top + (r.Bottom - r.top) div 2);
FrameRect(r);
end;
r := Rect;
r.left := r.left + rect.Right;
//inherited DrawItem(Index, r, State);
end;
constructor TPenStyleCombo.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
Style := csOwnerDrawFixed;
end;
procedure TPenStyleCombo.SetStyleList;
var
c: integer;
s: String;
begin
with items do
begin
clear;
for c := 0 to 5 do
Add('');
end;
ItemIndex := 0;
end;
///// TROWCOMBO //
function TRowCombo.GetSelection: TRowStyle;
begin
result:=TRowStyle(ItemIndex);
end;
procedure TRowCombo.SetSelection(Value: TRowStyle);
var
i: integer;
begin
for i:=0 to 6 do
if TRowStyle(i) = Value then
begin
ItemIndex :=i;
exit;
end;
end;
procedure TRowCombo.SetStyle(Value: TComboBoxStyle);
begin
inherited SetStyle(csOwnerDrawFixed);
end;
Procedure TRowCombo.DrawToCanvas(Canvasx:TCanvas;Index: Integer; Rect: TRect);
var y: integer;
begin
with CanvasX do
begin
FillRect(Rect);
Pen.Color := clBlack;
Pen.Width := 1;
Brush.Style := bsSolid;
Brush.color := clBlack;
y := Rect.Top + (Rect.Bottom-Rect.Top) div 2;
MoveTo(rect.Left,y);LineTo(rect.right,y);
Pen.Width := 1;
if Index = 1 then
begin
polygon([point(rect.right,y),point(rect.right - 10, y - 5),
point(rect.right - 10, y + 5)]);
end
else if Index = 2 then
begin
polygon([point(rect.left,y),point(rect.left + 10, y - 5),
point(rect.left + 10, y + 5)]);
end
else if Index = 3 then
begin
polygon([point(rect.right,y),point(rect.right - 10, y - 5),
point(rect.right - 10, y + 5)]);
polygon([point(rect.left,y),point(rect.left + 10, y - 5),
point(rect.left + 10, y + 5)]);
end
else if Index = 4 then
begin
polyline([point(rect.right - 10, y - 5),point(rect.right,y),
point(rect.right - 10, y + 5)]);
end
else if Index = 5 then
begin
polyline([point(rect.left + 10, y - 5),point(rect.left,y),
point(rect.left + 10, y + 5)]);
end
else if Index = 6 then
begin
polyline([point(rect.right - 10, y - 5),point(rect.right,y),
point(rect.right - 10, y + 5)]);
polyline([point(rect.left + 10, y - 5),point(rect.left,y),
point(rect.left + 10, y + 5)]);
end;
//FrameRect(rect);
end;
end;
procedure TRowCombo.DrawItem(Index: Integer; Rect: TRect; State: TOwnerDrawState);
var y: integer;
begin
with Canvas do
begin
FillRect(Rect);
Pen.Color := clBlack;
Pen.Width := 1;
Brush.Style := bsSolid;
Brush.color := clBlack;
y := Rect.Top + (Rect.Bottom-Rect.Top) div 2;
MoveTo(rect.Left,y);LineTo(rect.right,y);
Pen.Width := 1;
if Index = 1 then
begin
polygon([point(rect.right,y),point(rect.right - 10, y - 5),
point(rect.right - 10, y + 5)]);
end
else if Index = 2 then
begin
polygon([point(rect.left,y),point(rect.left + 10, y - 5),
point(rect.left + 10, y + 5)]);
end
else if Index = 3 then
begin
polygon([point(rect.right,y),point(rect.right - 10, y - 5),
point(rect.right - 10, y + 5)]);
polygon([point(rect.left,y),point(rect.left + 10, y - 5),
point(rect.left + 10, y + 5)]);
end
else if Index = 4 then
begin
polyline([point(rect.right - 10, y - 5),point(rect.right,y),
point(rect.right - 10, y + 5)]);
end
else if Index = 5 then
begin
polyline([point(rect.left + 10, y - 5),point(rect.left,y),
point(rect.left + 10, y + 5)]);
end
else if Index = 6 then
begin
polyline([point(rect.right - 10, y - 5),point(rect.right,y),
point(rect.right - 10, y + 5)]);
polyline([point(rect.left + 10, y - 5),point(rect.left,y),
point(rect.left + 10, y + 5)]);
end;
FrameRect(rect);
end;
//inherited DrawItem(Index, r, State);
end;
constructor TRowCombo.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
Style := csOwnerDrawFixed;
end;
procedure TRowCombo.SetStyleList;
var
c: integer;
s: String;
begin
with items do
begin
clear;
for c := 0 to 6 do
Add('');
end;
itemindex := 0;
end;
//////////////// TBRUSHSTYLE //////////////////////////////
function TBrushStyleCombo.GetSelection:TBrushStyle;
begin
result:=TBrushStyle(ItemIndex);
end;
procedure TBrushStyleCombo.SetSelection(Value: TBrushStyle);
var
i: integer;
begin
for i:=0 to 7 do
if TBrushStyle(i) = Value then
begin
ItemIndex :=i;
exit;
end;
end;
procedure TBrushStyleCombo.SetStyle(Value: TComboBoxStyle);
begin
inherited SetStyle(csOwnerDrawFixed);
end;
procedure TBrushStyleCombo.DrawItem(Index: Integer; Rect: TRect; State: TOwnerDrawState);
var
r :TRect;
ItemColor :TColor;
s :TShape;
begin
r.top := Rect.top;
r.bottom := Rect.bottom;
r.left := Rect.left;
r.right := r.left + Rect.Right;
with Canvas do
begin
FillRect(Rect);
pen.color:=clBlack;
canvas.brush.color:=clBlack;
canvas.brush.style:=TBrushStyle(Index);
rectangle(r.left,r.top,r.Right,r.Bottom);
canvas.brush.style:=TBrushStyle(1);
FrameRect(r);
end;
r := Rect;
r.left := r.left + rect.Right;
canvas.brush.style:=bsSolid;
canvas.brush.color:=clSilver;
//inherited DrawItem(Index, r, State);
end;
constructor TBrushStyleCombo.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
Style := csOwnerDrawFixed;
end;
procedure TBrushStyleCombo.SetStyleList;
var
c: integer;
s: String;
begin
with items do
begin
clear;
for c := 0 to 7 do
Add('');
end;
itemindex := 0;
end;
//////////////TPENWIDTH ///////////////////////////////
function TPenWidthCombo.GetSelection: shortint;
begin
result:=ItemIndex+1;
end;
procedure TPenWidthCombo.SetSelection(Value:shortint);
begin
ItemIndex :=value-1;
end;
procedure TPenWidthCombo.SetStyle(Value: TComboBoxStyle);
begin
inherited SetStyle(csOwnerDrawFixed);
end;
procedure TPenWidthCombo.DrawItem(Index: Integer; Rect: TRect; State: TOwnerDrawState);
var
r: TRect;
ItemColor, c: TColor;
begin
r.top := Rect.top + 3;
r.bottom := Rect.bottom - 3;
r.left := Rect.left + 3;
r.right := r.left + rect.right - 20;
with Canvas do
begin
FillRect(Rect);
pen.width:=index+1;
pen.color:=clBlack;
moveto(r.Left+5,r.top + (r.Bottom - r.top) div 2);
lineto(r.right-5,r.top + (r.Bottom - r.top) div 2);
FrameRect(r);
end;
r := Rect;
r.left := r.left + rect.right - 20;
inherited DrawItem(Index, r, State);
end;
constructor TPenWidthCombo.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
Style := csOwnerDrawFixed;
end;
procedure TPenWidthCombo.SetStyleList;
var
c: integer;
s: String;
begin
with items do
begin
clear;
for c := 0 to 9 do
Add(inttostr(c+1));
end;
itemindex := 0;
end;
////////////
////////////////////////////////////////////////////////////////////////////////
// private TColorCombo
//
function TColorCombo.GetSelection: TColor;
begin
result := 0;
if ItemIndex >= 0 then
if not IdentToColor(Items[ItemIndex], LongInt(result)) then
result := 0;
end;
procedure TColorCombo.SetSelection(Value: TColor);
var
c: integer;
i: Longint;
begin
ItemIndex := -1;
for c := 0 to Items.count do
if IdentToColor(Items[c], i) then
if i = Value then
ItemIndex := c;
end;
////////////////////////////////////////////////////////////////////////////////
// protected TColorCombo
//
procedure TColorCombo.SetStyle(Value: TComboBoxStyle);
begin
inherited SetStyle(csOwnerDrawFixed);
end;
procedure TColorCombo.DrawItem(Index: Integer; Rect: TRect; State: TOwnerDrawState);
var
r: TRect;
ItemColor, c: TColor;
begin
r.top := Rect.top + 3;
r.bottom := Rect.bottom - 3;
r.left := Rect.left + 3;
r.right := r.left + 14;
with Canvas do begin
FillRect(Rect);
c := Brush.Color;
if IdentToColor(Items[Index], LongInt(ItemColor)) then
Brush.Color := ItemColor;
FillRect(r);
Brush.Color := clBlack;
FrameRect(r);
Brush.Color := c;
end;
r := Rect;
r.left := r.left + 20;
inherited DrawItem(Index, r, State);
end;
procedure TColorCombo.CreateWnd;
begin
inherited CreateWnd;
SetColorList;
end;
////////////////////////////////////////////////////////////////////////////////
// public TColorCombo
//
constructor TColorCombo.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
Style := csOwnerDrawFixed;
end;
procedure TColorCombo.SetColorList;
var
c: integer;
s: String;
begin
with items do begin
clear;
for c := 0 to High(ColorArray) do
if ColorToIdent(ColorArray[c], s) then
Add(s);
end;
itemindex := 0;
end;
////////////////
constructor TFontComboBox.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
Font.Name := 'Tahoma';
Font.Size := 8;
Sorted := True;
Style := csOwnerDrawFixed;
ItemHeight := Font.Size*2;
{Create a bitmap for drawing}
FBitmap := TBitmap.Create;
FBitmap.Height := 12;
FBitmap.Width := 12;
{Create a Canvas for checking True Type property}
FCanvas := TControlCanvas.Create;
FCanvas.Control := Self;
{added}DropDownCount := 16;
FUpdateAllForms := False;
end;
procedure TFontComboBox.SetTTOnly(value : boolean);
var I:longint;
begin
FTTonly := Value;
if FTTonly = True then
begin
Items.clear;
Items.Assign(Screen.Fonts);
I := 0;
repeat
if Items[I] = 'Default' then
begin
Items.delete(I);
end else inc(I);
until I = Items.count;
ItemIndex := 0;
I := 0;
if FTTonly then
repeat
if not IsTrueType(I) then
begin
Items.delete(I);
end else inc(I);
until I = Items.count;
end else
begin
Items.clear;
Items.Assign(Screen.Fonts);
I := 0;
repeat
if Items[I] = 'Default' then
begin
Items.delete(I);
end else inc(I);
until I = Items.count;
ItemIndex := 0;
end;
end;
procedure TFontComboBox.SetUseItemFont(value : boolean);
begin
FUseItemFont := Value;
SetTTOnly(FTTOnly);
end;
destructor TFontComboBox.Destroy;
begin
FBitmap.Free;
FCanvas.Free;
inherited Destroy;
end;
procedure TFontComboBox.CreateWnd;
var I:longint;
begin
inherited CreateWnd;
Items.Assign(Screen.Fonts);
I := 0;
repeat
if Items[I] = 'Default' then
begin
Items.delete(I);
end else inc(I);
until I = Items.count;
ItemIndex := 0;
end;
procedure TFontComboBox.DrawItem(Index: Integer; Rect: TRect;
State: TOwnerDrawState);
var
lf: TLogFont;
oldFont, newFont: HFont;
begin
NewFont := 0;
OldFont := 0;
if FUseItemFont then
begin
with lf do begin
lfHeight := Font.Height;
lfWidth := 0;
lfEscapement := 0;
if fsBold in Font.Style then
lfWeight := FW_BOLD
else
lfWeight := FW_NORMAL;
lfItalic := Byte(fsItalic in Font.Style);
lfUnderline := Byte(fsUnderline in Font.Style);
lfStrikeOut := Byte(fsStrikeOut in Font.Style);
lfCharSet := DEFAULT_CHARSET;
lfOutPrecision := OUT_DEFAULT_PRECIS;
lfClipPrecision := CLIP_DEFAULT_PRECIS;
lfQuality := DEFAULT_QUALITY;
lfPitchAndFamily := DEFAULT_PITCH or FF_DONTCARE;
StrPCopy(lfFaceName, Items[Index]);
end;
newFont := CreateFontIndirect(lf);
oldFont := SelectObject(Canvas.Handle, newFont);
end;
{ Rect.Left = 3 means drawing on the Static portion of the ComboBox }
with Canvas do begin
FillRect(Rect);
if IsTrueType(Index) and (Rect.Left <> 3) then begin
DrawTT(Brush.Color);
Draw(Rect.Left+2, Rect.Top+2, FBitmap);
end;
//Canvas.Font.Name := Items[Index];
//Canvas.Font.Size := 10;
if (Rect.Left <> 3) then
TextOut(Rect.Left+16, Rect.Top, ' '+Items[Index])
else
TextOut(Rect.Left, Rect.Top, ' '+Items[Index])
end;
if FUseItemFont then
begin
SelectObject(Canvas.Handle, oldFont);
DeleteObject(newFont);
end;
end;
function TFontComboBox.IsTrueType(Index: Integer): Boolean;
var
Metrics: TTextMetric;
lf: TLogFont;
oldFont, newFont: HFont;
begin
with lf do begin
lfHeight := 10;
lfWidth := 10;
lfEscapement := 0;
lfWeight := FW_REGULAR;
lfItalic := 0;
lfUnderline := 0;
lfStrikeOut := 0;
lfCharSet := DEFAULT_CHARSET;
lfOutPrecision := OUT_DEFAULT_PRECIS;
lfClipPrecision := CLIP_DEFAULT_PRECIS;
lfQuality := DEFAULT_QUALITY;
lfPitchAndFamily := DEFAULT_PITCH or FF_DONTCARE;
StrPCopy(lfFaceName, Items[Index]);
end;
newFont := CreateFontIndirect(lf);
oldFont := SelectObject(FCanvas.Handle, newFont);
GetTextMetrics(FCanvas.Handle, Metrics);
Result := (Metrics.tmPitchAndFamily and TMPF_TRUETYPE) <> 0;
SelectObject(FCanvas.Handle, oldFont);
DeleteObject(newFont);
end;
procedure TFontComboBox.DrawTT(Background: TColor);
procedure DrawT(OrgX, OrgY: Integer; Color: TColor);
begin
with FBitmap.Canvas do begin
Brush.Style := bsSolid;
Pen.Color := Color;
MoveTo(OrgX,OrgY);
LineTo(OrgX+7,OrgY);
LineTo(OrgX+7,OrgY+3);
MoveTo(OrgX,OrgY);
LineTo(OrgX,OrgY+3);
MoveTo(OrgX+1,OrgY);
LineTo(OrgX+1,OrgY+1);
MoveTo(OrgX+6,OrgY);
LineTo(OrgX+6,OrgY+1);
MoveTo(OrgX+3,OrgY);
LineTo(OrgX+3,OrgY+8);
MoveTo(OrgX+4,OrgY);
LineTo(OrgX+4,OrgY+8);
MoveTo(OrgX+1,OrgY+8);
LineTo(OrgX+6,OrgY+8);
end;
end;
begin
with FBitmap.Canvas do begin
Brush.Style := bsClear;
Brush.Color := background;
FillRect(Rect(0,0,12,12));
DrawT(0,0,clGray);
DrawT(4,3,clBlack);
end;
end;
procedure TFontComboBox.CMFontChanged(var Message);
begin
// without this, changing the font of the component had no effect
ItemHeight := font.size*2;
RecreateWnd;// on it's appearance (height wasn't adjusted)
repaint;
end;
procedure TFontComboBox.Change;
var i : integer;
begin
inherited Change;
if FUpdateAllForms then // Changing font on all forms
for i := 0 to Application.ComponentCount-1 do
if Application.components[i] is TCustomForm then
(Application.components[i] as TCustomForm).Font.Name := Text;
end;
///////////////
constructor TPictureComboBox.Create(AnOwner : TComponent);
begin
Inherited Create(AnOwner);
Style := csOwnerDrawFixed;
OnDrawItem := DrawItem;
FBackgroundColour := clWhite;
FShadowColour := clBlack;
end;//
destructor TPictureComboBox.Destroy;
begin
Inherited Destroy;
end;//
procedure TPictureComboBox.Loaded;
begin
inherited Loaded;
if not (csDesigning in ComponentState) then
Style := csOwnerDrawFixed;
end;//
function TPictureComboBox.GetImageIndex(AnIndex : Integer) : Integer;
var P : Integer;
begin
result := 0;
P := Pos('|',Items[AnIndex]);
if P > 0 then
result := StrToInt(Copy(Items[AnIndex],P + 1,Length(Items[AnIndex]) - P));
end;//
function TPictureComboBox.DisplayString(AnIndex : Integer) : string;
var P : Integer;
begin
result := Items[AnIndex];
P := Pos('|',Items[AnIndex]);
if P > 0 then
result := Copy(Items[AnIndex],1,P-1);
end;//
procedure TPictureComboBox.ComboBox1MeasureItem(Control: TWinControl; Index: Integer;
var Height: Integer);
begin
Height := Self.Font.Size;
Canvas.Font := Font;
Self.ItemHeight := Canvas.TextHeight('X');
end;
procedure TPictureComboBox.Drawitem(Control: TWinControl; Index: Integer;
Rect: TRect; State: TOwnerDrawState);
var ImageIndex,
TextOffset,
ImageOffset : Integer;
begin
//Clear the area for drawing. This stops mouse moving tracers from been shown
Canvas.Brush.Color := FBackgroundColour;
Canvas.FillRect(Rect);
TextOffset := 0;
if Assigned(FImageList) then
begin
//Draw icon
ImageIndex := GetImageIndex(Index);
ImageOffset := Rect.Top + 2;
FImageList.Draw(Canvas,
Rect.Left,
ImageOffset, ImageIndex);
TextOffset := FImageList.Width + 4;
end;
//Display the shadow item text
if FShadow then
begin
Canvas.Brush.Style := bsClear;
Canvas.Font.Color := FShadowColour;
Canvas.TextOut (Rect.Left + TextOffset - 1,
Rect.Top + (ItemHeight div 2) -
(Canvas.TextHeight('X') Div 2) - 1 ,
DisplayString(Index));
end;//
//Display the item text
Canvas.Font.Color := Font.Color;
Canvas.TextOut (Rect.Left + TextOffset,
Rect.Top + (ItemHeight div 2) - (Canvas.TextHeight('X') Div 2),
DisplayString(Index));
end;//
procedure TPictureComboBox.SetIconList (AnIconImageList : TImageList);
begin
if Assigned(AnIconImageList) then
begin
FImageList := AnIconImageList;
if Font.Size < AnIconImageList.Height + 4 then
ItemHeight := AnIconImageList.Height + 4;
end;
end;//
function TPictureComboBox.GetIconList : TImageList;
begin
result := FImageList;
end;//
{ TStyleCombo }
procedure TStyleCombo.CreateWnd;
begin
inherited CreateWnd;
SetStyleList;
end;
procedure TStyleCombo.SetStyleList;
begin
end;
end.