Forum > Third party

TCheckCombobox Proposed Improvements

(1/2) > >>

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

Go to full version