USES
ComboEx,CLASSES, SYSUTILS, FILEUTIL, FORMS, CONTROLS, ExtCtrls, Dialogs,
StdCtrls,Graphics ,Themes,GraphUtil,LCLType ,LCLIntf;
TYPE
{ TMyCheckComboBox }
TMyCheckComboBox= CLASS (TCheckComboBox) //this is modified code from tcustomcheckcombobox drawitem
TIMER:TTimer; // handles all delayed events
CONSTRUCTOR CREATE( AOWNER: TCOMPONENT) ; OVERRIDE; // creates timer
PUBLIC
DESTRUCTOR DESTROY; OVERRIDE; // to deallocate the timer
PROCEDURE KEYDOWN( VAR KEY: WORD; SHIFT: TSHIFTSTATE) ; OVERRIDE;
PROCEDURE CLICK; OVERRIDE; // try to solve the strange behavior when selected checkbox is changed
PROTECTED { protected declarations }
PROCEDURE DROPDOWN; OVERRIDE; //enables timer and toggles single item value when only one item
PROCEDURE DRAWITEM( INDEX: INTEGER; ARECT: TRECT; MYSTATE: TOWNERDRAWSTATE) ; OVERRIDE; // i need this to control the colors of the checkcombobox
PROCEDURE SELECT; OVERRIDE;
PRIVATE { private declarations }
FUNCTION GET_PURPOSE: SHORTSTRING;
PROCEDURE SET_PURPOSE( AVALUE: SHORTSTRING) ;
PROPERTY PURPOSE:ShortString READ GET_PURPOSE WRITE SET_PURPOSE; // this decides what happens in timer event
PROCEDURE ENTER_EVENT (SENDER:TObject); // hilite it when i enter
PROCEDURE EXIT_EVENT(SENDER:TOBJECT); // unhilite it when i leave
PROCEDURE TIMER_EVENT (SENDER:TObject); // handles all things that needs delayed event
VAR
PURPOSE_VAR:ShortString;
SELECTED_CHECKED:Boolean; //experiment to close when checkbox is clicked rather than arrow
IS_KEY_EVENT:BOOLEAN; // only will be set true inside keypress event
END;
IMPLEMENTATION
{$R *.lfm}
{ TMyCheckComboBox }
CONSTRUCTOR TMYCHECKCOMBOBOX.CREATE( AOWNER: TCOMPONENT) ;
BEGIN
INHERITED CREATE( AOWNER) ;
{$IF DEFINED(LCLWin32) or DEFINED(LCLWin64)}
FRejectToggleOnSelect:=True; // do not allow arrow keys to toggle
{$ENDIF}
IS_KEY_EVENT := FALSE;
DropDownCount := 20;
TIMER:= TTimer.Create(SELF);
WITH TIMER DO
BEGIN
Interval := 1;
Enabled := False;
OnTimer := @TIMER_EVENT;
END;
OnEnter := @ENTER_EVENT;
OnExit := @EXIT_EVENT;
DoubleBuffered := True;
END;
FUNCTION TMYCHECKCOMBOBOX.GET_PURPOSE: SHORTSTRING;
BEGIN
RESULT:= PURPOSE_VAR;
END;
PROCEDURE TMYCHECKCOMBOBOX.SET_PURPOSE( AVALUE: SHORTSTRING) ;
BEGIN
PURPOSE_VAR := AVALUE;
TIMER.Enabled := (PURPOSE <> ''); // to carry out the purpose
END;
DESTRUCTOR TMYCHECKCOMBOBOX.DESTROY;
BEGIN
TIMER.Free;
INHERITED DESTROY;
END;
PROCEDURE TMYCHECKCOMBOBOX.TIMER_EVENT( SENDER: TOBJECT) ;
BEGIN
WITH SENDER AS TTimer DO
ENABLED:= False; // turn off the timer
CASE PURPOSE OF
'SPIN':ItemIndex := (Count -1) * ORD(ItemIndex = 0) ; // if item index = 0 it will go to last one otherwise it will be zero
'REOPEN':BEGIN
DroppedDown := FALSE;
DroppedDown := TRUE;
END;
OTHERWISE DroppedDown := FALSE;
END;
PURPOSE_var := ''; // done here instead of keydown event
IS_KEY_EVENT:= False; // for keys not triggering change event
END;
PROCEDURE TMYCHECKCOMBOBOX.KEYDOWN( VAR KEY: WORD; SHIFT: TSHIFTSTATE) ;
BEGIN
IS_KEY_EVENT := True;// for the benefit of select event ?
CASE KEY OF
VK_ESCAPE: TIMER.Enabled := TRUE; // simply close it does not need purpose
VK_RIGHT,VK_DOWN:IF ItemIndex = Count -1// last item
THEN PURPOSE := 'SPIN';// if it is last item select first
VK_LEFT,VK_UP:IF ITEMINDEX = 0 //first item
THEN PURPOSE := 'SPIN'; // if it is first item select last
VK_RETURN:IF NOT DroppedDown AND (Count > 1)
THEN DroppedDown:= True // open the dropdown if its closed and has more than one item
ELSE IF (ItemIndex>=0) and ItemEnabled[ItemIndex]
THEN BEGIN
Toggle(ItemIndex); // toggle the lone item then then close up
DroppedDown:=False; // should i use timer to close it ?
END;
VK_SPACE:BEGIN //32
Toggle(ItemIndex);
IF Items.Count > 1
THEN PURPOSE:= 'REOPEN'; // refreshes the dropdown after change
END;
END; {,VK_RIGHT,VK_DOWN,VK_LEFT,VK_UP}
IF KEY IN [VK_ESCAPE,VK_SPACE,VK_RETURN] // keys processed in case statement
THEN Key:= 0; // to make case statements in ancestor skip key
INHERITED KEYDOWN( KEY, SHIFT) ; // return key does not open combobox if i dont call this
END;
PROCEDURE TMYCHECKCOMBOBOX.CLICK; // this does not apply to clicking dropdown part
BEGIN
INHERITED CLICK;
IF SELECTED_CHECKED <> Checked[ItemIndex]
THEN BEGIN
SELECTED_CHECKED := Checked[ItemIndex]; // store it in a variable for next comparison
TIMER.Enabled := TRUE;
END ;
END;
PROCEDURE TMYCHECKCOMBOBOX.DROPDOWN; // toggles the lone combobox
{$IF DEFINED(LCLWin32) or DEFINED(LCLWin64)}
{$ELSE}
var aCursorPos: TPoint;
aRect: TRect;
{$ENDIF}
BEGIN
{$IF DEFINED(LCLWin32) or DEFINED(LCLWin64)}
FRejectDropDown:= False;
{$ELSE}
aCursorPos:=ScreenToControl(Mouse.CursorPos);
aRect:=Rect(FHiLiteLeft, 0, FHiLiteRight, Height);
FRejectDropDown:=PtInRect(aRect, aCursorPos);
{$ENDIF}
// my code
IF NOT FRejectDropDown AND (items.Count > 1) // more than one checkbox
THEN FRejectToggleOnSelect:=False
ELSE IF ItemEnabled[ItemIndex]
THEN Toggle(ItemIndex); //it toggles the lone checkbox
IF (Count < 2 )
THEN TIMER.Enabled := TRUE; // close it immediatedly if it has less than two items
END;
PROCEDURE TMYCHECKCOMBOBOX.DRAWITEM( INDEX: INTEGER; ARECT: TRECT; MYSTATE: TOWNERDRAWSTATE) ;
CONST
caCheckThemes: ARRAY [Boolean, TCheckBoxState, Boolean] of TThemedButton =
{ normal, highlighted }
(((tbCheckBoxUncheckedDisabled, tbCheckBoxUncheckedDisabled), { disabled, unchecked }
(tbCheckBoxCheckedDisabled, tbCheckBoxCheckedDisabled), { disabled, checked }
(tbCheckBoxMixedDisabled, tbCheckBoxMixedDisabled)), { disabled, greyed }
((tbCheckBoxUncheckedNormal, tbCheckBoxUncheckedHot), { enabled, unchecked }
(tbCheckBoxCheckedNormal, tbCheckBoxCheckedHot), { enabled, checked }
(tbCheckBoxMixedNormal, tbCheckBoxMixedHot))); { enabled, greyed }
cCheckIndent: SmallInt = 2;
cTextIndent: SmallInt = 5;
VAR
aDetail: TThemedElementDetails;
aDropped: Boolean;
aEnabled: Boolean;
aFlags: Cardinal;
aFocusedEditableMainItemNoDD: Boolean; { combo has edit-like line edit in csDropDownList (Win) and is closed (not DroppedDown }
anyRect: TRect;
aState: TCheckBoxState;
BEGIN
ADROPPED:=DROPPEDDOWN; // is this an alias ?
IF ADROPPED AND FREJECTDROPDOWN
THEN BEGIN
DROPPEDDOWN:=FALSE;
EXIT; { EXIT! }
END;
aEnabled:=IsEnabled;
IF NOT (csDesigning IN ComponentState)
THEN aEnabled:= (aEnabled AND PTCheckComboItemState(Items.Objects[Index])^.Enabled);
{$IF DEFINED(LCLWin32) or DEFINED(LCLWin64)}
aFocusedEditableMainItemNoDD := (Focused and (ARect.Left>0) and not aDropped);
{$ELSE}
aFocusedEditableMainItemNoDD := False;
{$ENDIF} //maybe the focused edit part is not necessary
IF (ARect.Left=0) //OR aFocusedEditableMainItemNoDD
THEN WITH Canvas,Brush DO // draw the background colors of the items and edit area
BEGIN
IF (odSelected in MYSTATE) OR aFocusedEditableMainItemNoDD
THEN Color := Parent.Font.Color // nice hilite by swapping colors
ELSE Color:= Parent.Color;// match parent by default
Style:=bsSolid;
FillRect(ARect); // fill in the background color
END;
IF NOT (csDesigning IN ComponentState)
THEN aState:=pTCheckComboItemState(Items.Objects[Index])^.State
ELSE aState:=cbUnchecked;
aDetail:=ThemeServices.GetElementDetails(caCheckThemes[aEnabled, aState, NOT aDropped AND FCheckHighlight]);
IF FNeedMeasure
THEN BEGIN
FCheckSize:= ThemeServices.GetDetailSize(aDetail); //size of the checkbox
FTextHeight:=Canvas.TextHeight('ŠjÁÇ');
IF NOT aDropped
THEN BEGIN
IF NOT FRightToLeft
THEN BEGIN
FHiLiteLeft:=-1;
FHiLiteRight:=ARect.Right;
END
ELSE BEGIN
FHiLiteLeft:=ARect.Left;
FHiLiteRight:=ARect.Right;
END;
FNeedMeasure := False;
END;
END; //FNeedMeasure
WITH anyRect DO // prepare the checkbox
BEGIN
IF NOT FRightToLeft
THEN Left:= ARect.Left+cCheckIndent
ELSE Left:= ARect.Right-cCheckIndent-FCheckSize.cx;
Right:= Left+FCheckSize.cx; // this is drawing the checkbox
Top:=(ARect.Bottom+ARect.Top-FCheckSize.cy) DIV 2;
Bottom:= Top+FCheckSize.cy;
END;
ThemeServices.DrawElement(CANVAS.Handle, aDetail, anyRect); //draw the checkbox
WITH CANVAS,FONT DO // prepare the font colors
BEGIN
Brush.Style:= bsClear; // dont see any difference when i change to bssolid
IF (odSelected in MYSTATE) OR aFocusedEditableMainItemNoDD //{(odSelected in MYSTATE) OR} aFocusedEditableMainItemNoDD // item is in the edit area or selected in the items dropdown
THEN BEGIN
Color := Parent.color; // use parent background for font color
self.Color := parent.Font.Color; ///when control is selected make it contrast
END
ELSE BEGIN Color := Parent.Font.COLOR; // pink same font color as parent
self.Color := Parent.Color;
END ;
IF aFocusedEditableMainItemNoDD
THEN BEGIN // draw a dotted line in checkcombobox when focused to highlite it
LCLIntf.SetBkColor(Handle, ColorToRGB(InvertColor(color))); // this code isnt called ?
LCLIntf.DrawFocusRect(Handle, aRect);
END;
END;
aFlags:=DT_END_ELLIPSIS+DT_VCENTER+DT_SINGLELINE+DT_NOPREFIX;
WITH anyRect DO // prepare the edit text and item strings in the dropdown
BEGIN
IF NOT FRightToLeft
THEN BEGIN
Left:=ARect.Left+cCheckIndent+FCheckSize.cx+cTextIndent;
Right:=ARect.Right;
END
ELSE BEGIN
Right:=anyRect.Left-cTextIndent;
Left:=ARect.Left;
aFlags:=aFlags OR DT_RIGHT OR DT_RTLREADING;
END;
Top:=(ARect.Top+ARect.Bottom-FTextHeight) div 2;
Bottom:= Top+FTextHeight;
END;
ThemeServices.DrawText(Canvas, aDetail, Items[Index], anyRect, aFlags, 0); // draw the text for edit area and dropdown items
END;
PROCEDURE TMYCHECKCOMBOBOX.SELECT; // arrow keys and clicks
BEGIN // how to tell if its an arrow key or a click
IF IS_KEY_EVENT
THEN IS_KEY_EVENT := false // do not do much for arrow keys navigating
ELSE BEGIN // IT WAS CLICK SO CHANGE AND REOPEN
INHERITED Select; //toggle the item clicked and reopen the dropdown
PURPOSE := 'REOPEN';
END;
END;
PROCEDURE TMYCHECKCOMBOBOX.ENTER_EVENT( SENDER: TOBJECT) ;
BEGIN
Color := InvertColor(Parent.Font.Color); // hilite the backcolor
END;
PROCEDURE TMYCHECKCOMBOBOX.EXIT_EVENT( SENDER: TOBJECT) ;
BEGIN
Color := Parent.Color; // return back color to normal
TIMER.Enabled := true;
END;
Recent
