Forum > Third party
TCheckCombobox Proposed Improvements
Joanna:
Here are some improvements I've made to tcheckcombobox which make it more usable for me. feel free to test it and give feedback
--- Code: Pascal [+][-]window.onload = function(){var x1 = document.getElementById("main_content_section"); if (x1) { var x = document.getElementsByClassName("geshi");for (var i = 0; i < x.length; i++) { x[i].style.maxHeight='none'; x[i].style.height = Math.min(x[i].clientHeight+15,306)+'px'; x[i].style.resize = "vertical";}};} ---USESComboEx,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) ;BEGINPURPOSE_VAR := AVALUE;TIMER.Enabled := (PURPOSE <> ''); // to carry out the purposeEND; 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) ;BEGINIS_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 thisEND; PROCEDURE TMYCHECKCOMBOBOX.CLICK; // this does not apply to clicking dropdown partBEGININHERITED 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 codeIF NOT FRejectDropDown AND (items.Count > 1) // more than one checkbox THEN FRejectToggleOnSelect:=False ELSE IF ItemEnabled[ItemIndex] THEN Toggle(ItemIndex); //it toggles the lone checkboxIF (Count < 2 ) THEN TIMER.Enabled := TRUE; // close it immediatedly if it has less than two itemsEND; 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;BEGINADROPPED:=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 necessaryIF (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; //FNeedMeasureWITH 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 checkboxWITH 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 itemsEND; PROCEDURE TMYCHECKCOMBOBOX.SELECT; // arrow keys and clicksBEGIN // how to tell if its an arrow key or a clickIF 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;
stoffman:
Hi,
It would really help to explain and list what your improvements do. I really want to know. But I'll not read the code and just blindly copying it will not make any sense as I don't know what I'm looking for.
Thanks,
Yoni
wp:
Maybe I should draw your attention to the ExCtrls package which contains an improved TCheckCombobox, too: https://wiki.freepascal.org/ExCtrls#TCheckComboBoxEx. Download location is mentioned in that wiki article.
Joanna:
Some of things I improved are :
1. The colors used are the parent and font color.
2. The checkcombobox dropdown spins when arrow navigates to top or bottom.
3. Select event simulates using checkboxes in the dropdown part being selected when it is reopening to display changes.
4. Escape key closes up checkcombobox
5. The combobox does not dropdown when there is only one item, it toggles
6.Enter key either drops down checkcombobox or toggles selected item and closes.
7. Both space bar and mouse click can be used to toggle checkbox values
I did not know how to fix the error of it not detecting that it was dropped down.
I like this control A lot because it is compact. I created a frame Using it that has buttons for selecting or clearing all the checkboxes.
Gald:
--- Quote from: Joanna on April 14, 2022, 01:04:26 am ---Some of things I improved are :
1. The colors used are the parent and font color.
2. The checkcombobox dropdown spins when arrow navigates to top or bottom.
3. Select event simulates using checkboxes in the dropdown part being selected when it is reopening to display changes.
4. Escape key closes up checkcombobox
5. The combobox does not dropdown when there is only one item, it toggles
6.Enter key either drops down checkcombobox or toggles selected item and closes.
I did not know how to fix the error of it not detecting that it was dropped down.
I like this control A lot because it is compact. I created a frame Using it that has buttons for selecting or clearing all the checkboxes.
--- End quote ---
It sounds like fixes for me, not improvements.
What about report it on bugtracker?
Navigation
[0] Message Index
[#] Next page