Title: EasyOfficeComboBox
Question: This article contains the unit EasyOfficeComboBox. This is a new ComboBox making it possible to make a Office 2003 etc. ComboBox look-alike.
NOTE!
You need the other posts to be able to compile this components.
You must disable the Compiled Resources (*.dcr) to compile this components. I'll send the dcr's to the admins and tell them to attach them.
Answer:
Unit EasyOfficeComboBox;
Interface
Uses Classes, Controls, StdCtrls, ExtCtrls, Windows, Graphics, Messages, Forms,
EasyToolBar;
Type
TEasyOfficeComboBox = Class;
TEasyOfficeDropForm = Class;
TEasyOfficeComboBoxItem = Class(TCustomControl)
Private
{ Private declarations }
fText : String;
fOwner : TEasyOfficeDropForm;
GotMouse : Boolean;
Procedure UpdateLabelFocus;
Function GetItemIndex: Integer;
Protected
{ Protected declarations }
Procedure WMEraseBkGnd(var Msg: TWMEraseBkgnd); message WM_ERASEBKGND;
Procedure CMChanged(var Msg: TMessage); message CM_CHANGED;
Procedure CMMouseEnter(var msg: TMessage); message CM_MOUSEENTER;
Procedure CMMouseLeave(var msg: TMessage); message CM_MOUSELEAVE;
Procedure Notification(AComponent: TComponent; Operation: TOperation); override;
Function CalcWidth: Integer;
Public
{ Public declarations }
Constructor Create(AOwner: TComponent); override;
Destructor Destroy; override;
Procedure Paint; override;
Procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
Procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
Procedure MouseDownHandler(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
Procedure MouseUpHandler(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
Published
{ Published declarations }
Property Visible;
Property Width;
Property Height;
Property Text: String read fText write fText;
Property ItemIndex: Integer read GetItemIndex;
End;
TEasyOfficeDropForm = Class(TForm)
Private
{ Private declarations }
fOwner : TEasyOfficeComboBox;
fHideTime : TDateTime;
Scroller : TScrollBox;
Function CalcWidth: Integer;
Function CalcHeight: Integer;
Procedure SelectItem(Item: TEasyOfficeComboBoxItem);
Function GetItem(Index: Integer) : TEasyOfficeComboBoxItem;
Function GetItemCount: Integer;
Procedure ScrollMouseWheelHandler(Sender: TObject; Shift: TShiftState; WheelDelta: Integer; MousePos: TPoint; var Handled: Boolean);
Protected
{ Protected declarations }
Procedure WMEraseBkGnd(var Message: TWMEraseBkgnd); message WM_ERASEBKGND;
Procedure Deactivate; override;
Procedure AdjustClientRect(var Rect: TRect); override;
Procedure Paint; override;
Function DoMouseWheel(Shift: TShiftState; WheelDelta: Integer; MousePos: TPoint) : Boolean; override;
Public
{ Public declarations }
Constructor Create(AOwner: TComponent); override;
Destructor Destroy; override;
Procedure ShowDrop(TopLeft: TPoint);
Procedure ClearItems;
Function AddItem: TEasyOfficeComboBoxItem;
Function IndexOf(S: String) : Integer; overload;
Function IndexOf(Item: TEasyOfficeComboBoxItem) : Integer; overload;
Procedure AlphaSort;
Property Items[Index: Integer] : TEasyOfficeComboBoxItem read GetItem;
Property ItemCount: Integer read GetItemCount;
Published
{ Published declarations }
End;
TEasyOfficeComboBox = Class(TCustomControl)
Private
{ Private declarations }
fOwner : TComponent;
fEdit : TEdit;
fReadOnly : Boolean;
fDropForm : TEasyOfficeDropForm;
fItemIndex : Integer;
GotMouse : Boolean;
fOnChange : TNotifyEvent;
fTrueTypeFontBitmap : TBitmap;
Procedure SetReadOnly(NewReadOnly: Boolean);
Procedure SetItemIndex(NewIndex: Integer);
Procedure EditExit(Sender: TObject);
Procedure EditEnter(Sender: TObject);
Procedure EditKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
Function GetItem(Index: Integer) : TEasyOfficeComboBoxItem;
Function GetItemCount: Integer;
Function GetTabStop : Boolean;
Procedure SetTabStop(NewTabStop: Boolean);
Function GetText : String;
Procedure SetText(NewText: String);
Protected
{ Protected declarations }
Procedure WMEraseBkGnd(var Message: TWMEraseBkgnd); message WM_ERASEBKGND;
Procedure CMMouseEnter(var msg: TMessage); message CM_MOUSEENTER;
Procedure CMMouseLeave(var msg: TMessage); message CM_MOUSELEAVE;
Procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
Function DoMouseWheel(Shift: TShiftState; WheelDelta: Integer; MousePos: TPoint) : Boolean; override;
Public
{ Public declarations }
Constructor Create(AOwner: TComponent); override;
Destructor Destroy; override;
Procedure AdjustClientRect(var Rect: TRect); override;
Procedure Resize; override;
Procedure SetFocus; override;
Procedure Paint; override;
Procedure ClearItems;
Function AddItem: TEasyOfficeComboBoxItem;
Function IndexOf(S: String) : Integer;
Procedure AlphaSort;
Procedure HideDropDownMenu;
Procedure ShowDropDownMenu;
Procedure ListFonts;
Property ItemIndex: Integer read fItemIndex write SetItemIndex;
Property ItemCount: Integer read GetItemCount;
Property Items[Index: Integer] : TEasyOfficeComboBoxItem read GetItem;
Published
{ Published declarations }
Property Align;
Property Enabled;
Property ReadOnly: Boolean read fReadOnly write SetReadOnly;
Property Cursor;
Property TabStop: Boolean read GetTabStop write SetTabStop;
Property TabOrder;
Property Text: String read GetText write SetText;
Property OnChange: TNotifyEvent read fOnChange write fOnChange;
End;
Procedure Register;
Implementation
Uses EasyGraphicsFunctions, SysUtils;
{$R *.dcr}
Procedure Register;
Begin
RegisterComponents('EasyWare - Visual', [TEasyOfficeComboBox]);
End;
(******************************************************************************)
(******************************************************************************)
(******************************************************************************)
Constructor TEasyOfficeComboBoxItem.Create(AOwner: TComponent);
Begin
Inherited Create(AOwner);
fOwner := TEasyOfficeDropForm(AOwner);
ControlStyle := ControlStyle + [csAcceptsControls, csOpaque, csFixedWidth, csFixedHeight];
ControlStyle := ControlStyle - [csSetCaption];
Height := 18;
Width := 50;
fText := '';
DoubleBuffered := True;
GotMouse := False;
End;
Destructor TEasyOfficeComboBoxItem.Destroy;
Begin
Inherited Destroy;
End;
Procedure TEasyOfficeComboBoxItem.WMEraseBkGnd(var Msg: TWMEraseBkgnd);
Begin
// Prevent erasing of the background...
Msg.Result := 1;
End;
Procedure TEasyOfficeComboBoxItem.CMChanged(var Msg: TMessage);
Begin
Invalidate;
End;
Procedure TEasyOfficeComboBoxItem.CMMouseEnter(var msg: TMessage);
Begin
// IF (not GotMouse) Then
Begin
GotMouse := True;
IF (Enabled) Then
Begin
UpdateLabelFocus;
Repaint;
End;
End;
End;
Procedure TEasyOfficeComboBoxItem.CMMouseLeave(var msg: TMessage);
Begin
IF (GotMouse) Then
Begin
GotMouse := False;
IF (Enabled) Then
Begin
UpdateLabelFocus;
Repaint;
End;
End;
End;
Procedure TEasyOfficeComboBoxItem.Notification(AComponent: TComponent; Operation: TOperation);
Begin
Case Operation of
opInsert : Begin
// In Delphi 5 the OnMouseDown & OnMouseUp events isn't derived from TControl which it says in the Delphi 5 help...?
IF (AComponent is TPanel) Then
Begin
TPanel(AComponent).OnMouseDown := MouseDownHandler;
TPanel(AComponent).OnMouseUp := MouseUpHandler;
End;
IF (AComponent is TLabel) Then
Begin
TLabel(AComponent).OnMouseDown := MouseDownHandler;
TLabel(AComponent).OnMouseUp := MouseUpHandler;
End;
IF (AComponent is TImage) Then
Begin
TImage(AComponent).OnMouseDown := MouseDownHandler;
TImage(AComponent).OnMouseUp := MouseUpHandler;
End;
End;
opRemove : ;
End;
End;
Procedure TEasyOfficeComboBoxItem.UpdateLabelFocus;
Var
I : Integer;
Lbl : TLabel;
Begin
For I := 0 to ControlCount-1 do
Begin
IF (Controls[I] is TLabel) Then
Begin
Lbl := TLabel(Controls[I]);
IF (GotMouse) Then Lbl.Font.Color := clWhite
Else Lbl.Font.Color := clBlack;
End;
End;
End;
Function TEasyOfficeComboBoxItem.CalcWidth: Integer;
Var
I : Integer;
Begin
Result := 0;
For I := 0 to ControlCount-1 do
Begin
Inc(Result, Controls[I].Width);
End;
Inc(Result, 8);
End;
Function TEasyOfficeComboBoxItem.GetItemIndex: Integer;
Begin
Result := fOwner.IndexOf(self);
End;
Procedure TEasyOfficeComboBoxItem.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
Begin
Inherited MouseDown(Button, Shift, X, Y);
IF (Button = mbLeft) Then
Begin
ReleaseCapture;
fOwner.SelectItem(self);
End;
End;
Procedure TEasyOfficeComboBoxItem.MouseDownHandler(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
Begin
MouseDown(Button, Shift, X, Y);
End;
Procedure TEasyOfficeComboBoxItem.MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
Begin
Inherited MouseUp(Button, Shift, X, Y);
IF (Button = mbLeft) Then
Begin
ReleaseCapture;
fOwner.SelectItem(self);
End;
End;
Procedure TEasyOfficeComboBoxItem.MouseUpHandler(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
Begin
MouseUp(Button, Shift, X, Y);
End;
Procedure TEasyOfficeComboBoxItem.Paint;
Begin
Inherited Paint;
Canvas.Brush.Style := bsSolid;
IF (GotMouse) Then Canvas.Brush.Color := RGB(0, 0, 128)
Else Canvas.Brush.Color := clWindow;
Canvas.FillRect(ClientRect);
End;
(******************************************************************************)
(******************************************************************************)
(******************************************************************************)
Constructor TEasyOfficeDropForm.Create(AOwner: TComponent);
Begin
Inherited CreateNew(AOwner);
Parent := NIL;
fOwner := TEasyOfficeComboBox(AOwner);
BorderStyle := bsNone;
Color := clWindow;
DoubleBuffered := True;
SetWindowLong(self.Handle, GWL_STYLE, Integer(WS_CHILD+WS_CLIPCHILDREN));
SetWindowLong(self.Handle, GWL_EXSTYLE, Integer(WS_EX_LEFT+WS_EX_LTRREADING+WS_EX_RIGHTSCROLLBAR));
Scroller := TScrollBox.Create(self);
Scroller.Parent := self;
Scroller.BorderStyle := bsNone;
Scroller.VertScrollBar.Visible := True;
Scroller.VertScrollBar.Tracking := True;
Scroller.HorzScrollBar.Visible := False;
Scroller.HorzScrollBar.Tracking := True;
Scroller.Visible := True;
Scroller.Align := alClient;
Scroller.OnMouseWheel := ScrollMouseWheelHandler;
Visible := False;
fHideTime := Now;
End;
Destructor TEasyOfficeDropForm.Destroy;
Begin
Scroller.Free;
Inherited Destroy;
End;
Procedure TEasyOfficeDropForm.WMEraseBkGnd(var Message: TWMEraseBkgnd);
Begin
// Prevent erasing of the background...
Message.Result := 1;
End;
Procedure TEasyOfficeDropForm.AdjustClientRect(var Rect: TRect);
Begin
Inherited AdjustClientRect(Rect);
Rect.Left := 1;
Rect.Top := 1;
Rect.Right := ClientWidth-1;
Rect.Bottom := ClientHeight-1;
End;
Procedure TEasyOfficeDropForm.SelectItem(Item: TEasyOfficeComboBoxItem);
Begin
Deactivate;
fOwner.ItemIndex := Item.ItemIndex;
// This emulates the Office 2003 ComboBox:
// IF (fOwner.fEdit.Focused) Then Windows.SetFocus(0);
//fOwner.fEdit.SetFocus;
End;
Function TEasyOfficeDropForm.GetItem(Index: Integer) : TEasyOfficeComboBoxItem;
Begin
Result := NIL;
IF (Index = 0) and (Index Begin
Result := TEasyOfficeComboBoxItem(Scroller.Controls[Index]);
End;
End;
Function TEasyOfficeDropForm.GetItemCount: Integer;
Begin
Result := Scroller.ControlCount;
End;
Procedure TEasyOfficeDropForm.Deactivate;
Begin
Inherited;
Hide;
fHideTime := Now;
fOwner.Invalidate;
End;
Procedure TEasyOfficeDropForm.ScrollMouseWheelHandler(Sender: TObject; Shift: TShiftState; WheelDelta: Integer; MousePos: TPoint; var Handled: Boolean);
Begin
Handled := True;
IF (WheelDelta 0) Then
Begin
Scroller.VertScrollBar.Position := Scroller.VertScrollBar.Position - 1;
End
Else
IF (WheelDelta Begin
Scroller.VertScrollBar.Position := Scroller.VertScrollBar.Position + 1;
End;
End;
Function TEasyOfficeDropForm.DoMouseWheel(Shift: TShiftState; WheelDelta: Integer; MousePos: TPoint) : Boolean;
Var
H : Integer;
Control : TControl;
Item : TEasyOfficeComboBoxItem;
Idx : Integer;
Begin
Result := True;
Control := Scroller.ControlAtPos(Point(0, 0), True, True);
While (Assigned(Control)) and (not (Control is TEasyOfficeComboBoxItem)) do Control := Control.Parent;
IF (Assigned(Control)) Then
Begin
Item := TEasyOfficeComboBoxItem(Control);
Idx := Item.ItemIndex;
// Align to the top view of the scrollbox...
H := Item.Top;
IF (WheelDelta 0) Then
Begin
Item := Items[Idx-1];
IF (Assigned(Item)) Then
Begin
Scroller.VertScrollBar.Position := Scroller.VertScrollBar.Position - (-H) - Item.Height;
End;
End
Else
IF (WheelDelta Begin
Scroller.VertScrollBar.Position := Scroller.VertScrollBar.Position - H + Item.Height;
End;
End;
End;
Function TEasyOfficeDropForm.CalcWidth: Integer;
Var
I : Integer;
P : TEasyOfficeComboBoxItem;
W : Integer;
Begin
Result := 0;
For I := 0 to Scroller.ControlCount-1 do
Begin
IF (Scroller.Controls[I] is TEasyOfficeComboBoxItem) Then
Begin
P := TEasyOfficeComboBoxItem(Scroller.Controls[I]);
W := P.CalcWidth;
IF (W Result) Then Result := W;
End;
End;
Inc(Result, 2);
End;
Function TEasyOfficeDropForm.CalcHeight: Integer;
Var
I : Integer;
P : TEasyOfficeComboBoxItem;
Begin
Result := 0;
For I := 0 to Scroller.ControlCount-1 do
Begin
IF (Scroller.Controls[I] is TEasyOfficeComboBoxItem) Then
Begin
P := TEasyOfficeComboBoxItem(Scroller.Controls[I]);
Inc(Result, P.Height);
End;
End;
Inc(Result, 2);
End;
Procedure TEasyOfficeDropForm.ShowDrop(TopLeft: TPoint);
Var
NW, NH : Integer;
Begin
VertScrollBar.Visible := False;
HorzScrollBar.Visible := False;
NH := CalcHeight;
IF (NH IF (NH 200) Then NH := 200;
IF (TopLeft.y+NH Screen.Height) Then NH := Screen.Height-TopLeft.y;
NW := CalcWidth;
NW := NW + GetSystemMetrics(SM_CXHSCROLL); // Add the size of the scrollbar...
IF (NW IF (TopLeft.x+NW Screen.Width) Then NW := Screen.Width-TopLeft.x;
MoveWindow(Handle, TopLeft.x, TopLeft.y, NW, NH, True);
Show;
SetFocus;
End;
Procedure TEasyOfficeDropForm.ClearItems;
Begin
While (Scroller.ControlCount 0) do
Begin
Scroller.Controls[0].Free;
End;
End;
Function TEasyOfficeDropForm.AddItem: TEasyOfficeComboBoxItem;
Begin
Result := TEasyOfficeComboBoxItem.Create(self);
Result.Parent := Scroller;
Result.BevelOuter := bvNone;
Result.ParentColor := True;
Result.Top := CalcHeight + 10;
Result.Align := altop;
End;
Function TEasyOfficeDropForm.IndexOf(S: String) : Integer;
Var
I : Integer;
Begin
Result := -1;
S := UpperCase(S);
For I := 0 to ItemCount-1 do
Begin
IF (UpperCase(Items[I].Text) = S) Then
Begin
Result := I;
Break;
End;
End;
End;
Function TEasyOfficeDropForm.IndexOf(Item: TEasyOfficeComboBoxItem) : Integer;
Var
I : Integer;
Begin
Result := -1;
For I := 0 to ItemCount-1 do
Begin
IF (Items[I] = Item) Then
Begin
Result := I;
Break;
End;
End;
End;
Procedure TEasyOfficeDropForm.AlphaSort;
Function GetItemValue(Index: Integer) : String;
Begin
Result := '';
IF (Index = 0) and (Index End;
Function CompareItems(Value1, Value2: String) : Integer;
Begin
IF (Value1 Else
IF (Value1 Value2) Then Result := 1
Else Result := 0;
End;
Procedure SwapItems(Item1, Item2: Integer);
Var
TmpItem : TEasyOfficeComboBoxItem;
Begin
TmpItem := GetItem(Item1);
SetChildOrder(GetItem(Item2), Item1);
SetChildOrder(TmpItem, Item2);
End;
Procedure QuickSort(iLo, iHi: Integer);
Var
Lo, Hi : Integer;
Mid : String;
CompareRes : Integer;
Begin
Lo := iLo;
Hi := iHi;
Mid := GetItemValue((Lo + Hi) div 2);
Repeat
While (True) do
Begin
CompareRes := CompareItems(GetItemValue(Lo), Mid);
IF (CompareRes Else Break;
End;
While (True) do
Begin
CompareRes := CompareItems(GetItemValue(Hi), Mid);
IF (CompareRes 0) Then Dec(Hi)
Else Break;
End;
IF Lo Begin
SwapItems(Lo, Hi);
Inc(Lo);
Dec(Hi);
End;
Until Lo Hi;
IF Hi iLo Then QuickSort(iLo, Hi);
IF Lo End;
Var
I : Integer;
Y : Integer;
Begin
IF (ItemCount 1) Then
Begin
Try
QuickSort(0, ItemCount-1);
Except
End;
End;
Y := 0;
For I := 0 to ItemCount-1 do
Begin
Items[I].Align := alNone;
Items[I].Top := Y+200;
Items[I].Align := alTop;
Inc(Y, Items[I].Height);
End;
End;
Procedure TEasyOfficeDropForm.Paint;
Begin
Inherited;
Canvas.Pen.Color := RGB(0, 0, 128);
Canvas.Rectangle(ClientRect);
End;
(******************************************************************************)
(******************************************************************************)
(******************************************************************************)
Constructor TEasyOfficeComboBox.Create(AOwner: TComponent);
Procedure OffsetPoly(var P: Array of TPoint; X, Y: Integer);
Var
I : Integer;
Begin
For I := Low(P) to High(P) do
Begin
P[I].X := P[I].X + X;
P[I].Y := P[I].Y + Y;
End;
End;
Var
FontOutline : Array[1..21] of TPoint;
Begin
Inherited Create(AOwner);
ControlStyle := ControlStyle + [csOpaque, csFixedWidth, csFixedHeight];
ControlStyle := ControlStyle - [csSetCaption];
fOwner := AOwner;
Width := 150;
Height := 25;
Align := alNone;
Inherited TabStop := False;
fReadOnly := False;
fItemIndex := -1;
fOnChange := NIL;
GotMouse := False;
DoubleBuffered := True;
fEdit := TEdit.Create(self);
fEdit.Parent := self;
fEdit.BorderStyle := bsNone;
fEdit.OnExit := EditExit;
fEdit.OnEnter := EditEnter;
fEdit.OnKeyDown := EditKeyDown;
fEdit.TabStop := True;
fDropForm := TEasyOfficeDropForm.Create(self);
fTrueTypeFontBitmap := TBitmap.Create;
fTrueTypeFontBitmap.Width := 18;
fTrueTypeFontBitmap.Height := 16;
fTrueTypeFontBitmap.PixelFormat := pf24bit;
fTrueTypeFontBitmap.Canvas.Brush.Color := clWhite;
fTrueTypeFontBitmap.Canvas.FillRect(Rect(0,0,18,16));
fTrueTypeFontBitmap.TransparentColor := fTrueTypeFontBitmap.Canvas.Brush.Color;
fTrueTypeFontBitmap.Transparent := True;
FontOutline[1] := Point(0, 0);
FontOutline[2] := Point(10, 0);
FontOutline[3] := Point(10, 4);
FontOutline[4] := Point(9, 4);
FontOutline[5] := Point(9, 2);
FontOutline[6] := Point(8, 2);
FontOutline[7] := Point(8, 1);
FontOutline[8] := Point(6, 1);
FontOutline[9] := Point(6, 10);
FontOutline[10] := Point(8, 10);
FontOutline[11] := Point(8, 11);
FontOutline[12] := Point(2, 11);
FontOutline[13] := Point(2, 10);
FontOutline[14] := Point(4, 10);
FontOutline[15] := Point(4, 1);
FontOutline[16] := Point(2, 1);
FontOutline[17] := Point(2, 2);
FontOutline[18] := Point(1, 2);
FontOutline[19] := Point(1, 4);
FontOutline[20] := Point(0, 4);
FontOutline[21] := Point(0, 0);
fTrueTypeFontBitmap.Canvas.Pen.Style := psClear;
OffsetPoly(FontOutline, 1, 1);
fTrueTypeFontBitmap.Canvas.Brush.Color := RGB(192, 192, 192);
fTrueTypeFontBitmap.Canvas.Polygon(FontOutline);
OffsetPoly(FontOutline, -1, -1);
fTrueTypeFontBitmap.Canvas.Brush.Color := RGB(128, 128, 128);
fTrueTypeFontBitmap.Canvas.Polygon(FontOutline);
OffsetPoly(FontOutline, 7, 5);
fTrueTypeFontBitmap.Canvas.Brush.Color := RGB(192, 192, 192);
fTrueTypeFontBitmap.Canvas.Polygon(FontOutline);
OffsetPoly(FontOutline, -1, -1);
fTrueTypeFontBitmap.Canvas.Brush.Color := RGB(0, 0, 255);
fTrueTypeFontBitmap.Canvas.Polygon(FontOutline);
End;
Destructor TEasyOfficeComboBox.Destroy;
Begin
fTrueTypeFontBitmap.Free;
fDropForm.Free;
fEdit.Free;
Inherited Destroy;
End;
Procedure TEasyOfficeComboBox.HideDropDownMenu;
Begin
fDropForm.Hide;
End;
Procedure TEasyOfficeComboBox.ShowDropDownMenu;
Var
P : TPoint;
Begin
P := ClientToScreen(Point(0, ClientHeight));
IF (Parent is TEasyToolBar) Then P.y := P.y-2
Else P.y := P.y;
fDropForm.ShowDrop(P);
SetCapture(0); // Make sure we get the mouse events even when the mouse is still pressed...
End;
Procedure TEasyOfficeComboBox.CMMouseEnter(var msg: TMessage);
Begin
GotMouse := True;
IF (Enabled) Then Repaint;
End;
Procedure TEasyOfficeComboBox.CMMouseLeave(var msg: TMessage);
Begin
GotMouse := False;
IF (Enabled) Then Repaint;
End;
Procedure TEasyOfficeComboBox.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
Begin
Inherited;
GotMouse := True;
IF (not fDropForm.Visible) and (Button = mbLeft) Then
Begin
IF (Now fDropForm.fHideTime+(1/24/60/60/4)) Then
Begin
ShowDropDownMenu;
End;
End;
Invalidate;
End;
Function TEasyOfficeComboBox.DoMouseWheel(Shift: TShiftState; WheelDelta: Integer; MousePos: TPoint) : Boolean;
Var
Key : Word;
Begin
Result := True;
IF (WheelDelta 0) Then
Begin
Key := VK_UP;
EditKeyDown(self, Key, []);
End
Else
IF (WheelDelta Begin
Key := VK_DOWN;
EditKeyDown(self, Key, []);
End;
End;
Procedure TEasyOfficeComboBox.SetReadOnly(NewReadOnly: Boolean);
Begin
IF (NewReadOnly fReadOnly) Then
Begin
fReadOnly := NewReadOnly;
fEdit.ReadOnly := fReadOnly;
fEdit.Enabled := (not fReadOnly);
Invalidate;
End;
End;
Function TEasyOfficeComboBox.GetTabStop : Boolean;
Begin
Result := fEdit.TabStop;
End;
Procedure TEasyOfficeComboBox.SetTabStop(NewTabStop: Boolean);
Begin
fEdit.TabStop := NewTabStop;
End;
Function TEasyOfficeComboBox.GetText : String;
Begin
Result := fEdit.Text;
End;
Procedure TEasyOfficeComboBox.SetText(NewText: String);
Begin
fEdit.Text := NewText;
End;
Procedure TEasyOfficeComboBox.SetItemIndex(NewIndex: Integer);
Begin
// IF (fItemIndex NewIndex) Then
Begin
fItemIndex := NewIndex;
IF (fItemIndex = 0) and (fItemIndex Begin
fEdit.Text := Items[fItemIndex].Text;
fEdit.SelectAll;
End
Else fEdit.Text := '';
IF (Assigned(fOnChange)) Then fOnChange(self);
End;
End;
Procedure TEasyOfficeComboBox.EditExit(Sender: TObject);
Begin
Invalidate;
End;
Procedure TEasyOfficeComboBox.EditEnter(Sender: TObject);
Begin
fEdit.SelectAll;
Invalidate;
End;
Procedure TEasyOfficeComboBox.EditKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
Var
Idx : Integer;
Begin
IF ((Key = VK_UP) or (Key = VK_DOWN)) and (ssAlt in Shift) Then
Begin
IF (not fDropForm.Visible) Then ShowDropDownMenu
Else HideDropDownMenu;
Exit;
Key := 0;
End;
Case Key of
VK_UP : Begin
Idx := IndexOf(fEdit.Text);
IF (Idx = 0) Then
Begin
// Only decrease index if text match on upper/lowercase.
IF (Items[Idx].Text = fEdit.Text) Then Dec(Idx);
End;
IF (Idx
ItemIndex := Idx;
Key := 0;
End;
VK_DOWN : Begin
Idx := IndexOf(fEdit.Text);
IF (Idx = 0) Then
Begin
// Only increase index if text match on upper/lowercase.
IF (Items[Idx].Text = fEdit.Text) Then Inc(Idx);
End
Else Idx := 0;
IF (Idx ItemCount-1) Then Idx := ItemCount-1;
ItemIndex := Idx;
Key := 0;
End;
// ***********
End;
End;
Procedure TEasyOfficeComboBox.Paint;
Var
StartC, EndC : TColor;
Poly : Array[1..3] of TPoint;
DisplayRect : TRect;
Begin
Inherited Paint;
DisplayRect := ClientRect;
AdjustClientRect(DisplayRect);
Canvas.Brush.Style := bsSolid;
Canvas.Pen.Style := psSolid;
Canvas.Brush.Color := clWhite;
Canvas.Pen.Color := RGB(0, 0, 128);
IF (GotMouse) or (fDropForm.Visible) or (fEdit.Focused) Then
Begin
Canvas.Rectangle(DisplayRect);
Canvas.MoveTo(DisplayRect.Right-13, DisplayRect.Top);
Canvas.LineTo(DisplayRect.Right-13, DisplayRect.Bottom);
IF (fDropForm.Visible) Then
Begin
StartC := RGB(255, 213, 140);
EndC := RGB(255, 173, 85);
End
Else
Begin
StartC := RGB(255, 244, 204);
EndC := RGB(255, 208, 145);
End;
End
Else
Begin
Canvas.FillRect(DisplayRect);
StartC := RGB(221, 236, 254);
EndC := RGB(129, 169, 226);
End;
// Down button...
DrawFadedBarEx(
Canvas,
Rect(DisplayRect.Right-12, DisplayRect.Top+1, DisplayRect.Right-1, DisplayRect.Bottom-2),
False,
StartC,
EndC
);
Poly[1] := Point(DisplayRect.Right-9, DisplayRect.Top+((DisplayRect.Bottom-DisplayRect.Top) div 2)-1);
Poly[2] := Point(Poly[1].x+4, Poly[1].y);
Poly[3] := Point(Poly[1].x+2, Poly[1].y+2);
Canvas.Pen.Color := clBlack;
Canvas.Brush.Color := clBlack;
Canvas.Polygon(Poly);
// fEdit.SetBounds(DisplayRect.Left+1, DisplayRect.Top+1, DisplayRect.Right-12-DisplayRect.Left-2, DisplayRect.Bottom-DisplayRect.Top-2);
fEdit.SetBounds(DisplayRect.Left+2, DisplayRect.Top+2, DisplayRect.Right-12-DisplayRect.Left-3, DisplayRect.Bottom-DisplayRect.Top-3);
End;
Procedure TEasyOfficeComboBox.AdjustClientRect(var Rect: TRect);
Var
Region : HRGN;
Begin
Inherited AdjustClientRect(Rect);
IF (Parent is TEasyToolBar) Then
Begin
Rect.Left := 0;
Rect.Top := 2;
Rect.Right := ClientWidth;
Rect.Bottom := ClientHeight-2;
Region := CreateRectRgn(Rect.Left, Rect.Top, Rect.Right, Rect.Bottom);
SetWindowRgn(Handle, Region, True);
DeleteObject(Region);
End;
End;
Procedure TEasyOfficeComboBox.WMEraseBkGnd(var Message: TWMEraseBkgnd);
Begin
// Prevent erasing of the background...
Message.Result := 1;
End;
Procedure TEasyOfficeComboBox.Resize;
Begin
Inherited Resize;
End;
Procedure TEasyOfficeComboBox.SetFocus;
Begin
Inherited SetFocus;
fEdit.SelectAll;
End;
Procedure TEasyOfficeComboBox.ClearItems;
Begin
fDropForm.ClearItems;
End;
Function TEasyOfficeComboBox.AddItem: TEasyOfficeComboBoxItem;
Begin
Result := fDropForm.AddItem;
End;
Function TEasyOfficeComboBox.GetItemCount: Integer;
Begin
Result := fDropForm.ItemCount;
End;
Function TEasyOfficeComboBox.GetItem(Index: Integer) : TEasyOfficeComboBoxItem;
Begin
Result := fDropForm.Items[Index];
End;
Function TEasyOfficeComboBox.IndexOf(S: String) : Integer;
Begin
Result := fDropForm.IndexOf(S);
End;
Procedure TEasyOfficeComboBox.AlphaSort;
Begin
fDropForm.AlphaSort;
End;
Function EnumFontFamProc(lpelf: PENUMLOGFONT; lpntm: PNEWTEXTMETRIC; FontType: Integer; lParam: Integer) : Integer; stdcall;
Var
NewItem : TEasyOfficeComboBoxItem;
Img : TImage;
Lbl : TLabel;
H : Integer;
Combo : TEasyOfficeComboBox;
Begin
Combo := TEasyOfficeComboBox(lParam);
IF (FontType = TRUETYPE_FONTTYPE) Then
Begin
IF (lpntm^.tmCharSet = ANSI_CHARSET) or (lpntm^.tmCharSet = SYMBOL_CHARSET) Then
Begin
NewItem := Combo.AddItem;
NewItem.Height := 32;
NewItem.Text := lpelf^.elfLogFont.lfFaceName;
Img := TImage.Create(NewItem);
Img.Parent := NewItem;
Img.Picture.Assign( Combo.fTrueTypeFontBitmap );
Img.Align := alLeft;
Img.Width := Img.Picture.Width+8;
Img.Transparent := True;
Img.Center := True;
// GetFontLanguageInfo
IF (lpntm^.tmCharSet ANSI_CHARSET) Then
Begin
Lbl := TLabel.Create(NewItem);
Lbl.Parent := NewItem;
Lbl.Alignment := taLeftJustify;
Lbl.Layout := tlCenter;
Lbl.Caption := NewItem.Text + ' ';
Lbl.Align := alLeft;
Lbl.Transparent := True;
Lbl.Font.Name := 'Arial';
Lbl.Font.Size := 10;
Combo.Canvas.Font.Assign(Lbl.Font);
H := Combo.Canvas.TextHeight(Lbl.Caption);
End
Else H := 0;
Lbl := TLabel.Create(NewItem);
Lbl.Parent := NewItem;
Lbl.Alignment := taLeftJustify;
Lbl.Layout := tlCenter;
IF (lpntm^.tmCharSet ANSI_CHARSET) Then Lbl.Caption := 'ABCDEFGHIJ'
Else Lbl.Caption := NewItem.Text;
Lbl.Align := alLeft;
Lbl.Transparent := True;
Lbl.Font.Handle := CreateFontIndirect(lpElf^.elfLogFont);
Lbl.Font.Size := 14;
Combo.Canvas.Font.Assign(Lbl.Font);
IF (Combo.Canvas.TextHeight(Lbl.Caption) H) Then H := Combo.Canvas.TextHeight(Lbl.Caption);
IF (H
// This can be removed ...
IF (H 22) Then H := 22;
NewItem.Height := H;
End;
End;
Result := 1;
End;
Procedure TEasyOfficeComboBox.ListFonts;
Begin
ClearItems;
EnumFontFamilies(Canvas.Handle, NIL, @EnumFontFamProc, Integer(self));
AlphaSort;
ItemIndex := 0;
End;
End.