Recent

Author Topic: TCheckCombobox Proposed Improvements  (Read 671 times)

Joanna

  • Jr. Member
  • **
  • Posts: 74
TCheckCombobox Proposed Improvements
« on: April 13, 2022, 01:11:48 am »
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  [Select][+][-]
  1. USES
  2. ComboEx,CLASSES, SYSUTILS, FILEUTIL, FORMS, CONTROLS, ExtCtrls, Dialogs,
  3.  StdCtrls,Graphics ,Themes,GraphUtil,LCLType ,LCLIntf;
  4.  
  5. TYPE
  6.  
  7.  { TMyCheckComboBox }
  8.  
  9.  TMyCheckComboBox= CLASS (TCheckComboBox)   //this is modified code from tcustomcheckcombobox drawitem
  10.    TIMER:TTimer; // handles all delayed events
  11.   CONSTRUCTOR CREATE( AOWNER: TCOMPONENT) ; OVERRIDE; // creates timer
  12.   PUBLIC
  13.     DESTRUCTOR DESTROY; OVERRIDE; // to deallocate the timer
  14.     PROCEDURE KEYDOWN( VAR KEY: WORD; SHIFT: TSHIFTSTATE) ; OVERRIDE;
  15.    PROCEDURE CLICK; OVERRIDE; // try to solve the strange behavior when selected checkbox is changed
  16.   PROTECTED   { protected declarations }
  17.     PROCEDURE DROPDOWN; OVERRIDE; //enables timer and toggles single item value when only one item
  18.     PROCEDURE DRAWITEM( INDEX: INTEGER; ARECT: TRECT; MYSTATE: TOWNERDRAWSTATE) ; OVERRIDE;  // i need this to control the colors of the checkcombobox
  19.     PROCEDURE SELECT; OVERRIDE;
  20.   PRIVATE { private declarations }
  21.      FUNCTION GET_PURPOSE: SHORTSTRING;
  22.      PROCEDURE SET_PURPOSE( AVALUE: SHORTSTRING) ;
  23.    PROPERTY PURPOSE:ShortString READ GET_PURPOSE WRITE SET_PURPOSE; // this decides what happens in timer event
  24.      PROCEDURE ENTER_EVENT (SENDER:TObject); // hilite it when i enter
  25.      PROCEDURE EXIT_EVENT(SENDER:TOBJECT); // unhilite it when i leave
  26.     PROCEDURE TIMER_EVENT (SENDER:TObject);  // handles all things that needs delayed event
  27.   VAR
  28.   PURPOSE_VAR:ShortString;
  29.   SELECTED_CHECKED:Boolean; //experiment to close when checkbox is clicked rather than arrow
  30.   IS_KEY_EVENT:BOOLEAN; // only will be set true inside keypress event
  31.  END;  
  32.  
  33. IMPLEMENTATION
  34.  
  35. {$R *.lfm}
  36.  
  37. { TMyCheckComboBox }
  38.  
  39.  CONSTRUCTOR TMYCHECKCOMBOBOX.CREATE( AOWNER: TCOMPONENT) ;
  40. BEGIN
  41.   INHERITED CREATE( AOWNER) ;
  42.   {$IF DEFINED(LCLWin32) or DEFINED(LCLWin64)}
  43.       FRejectToggleOnSelect:=True; // do not allow arrow keys to toggle
  44.   {$ENDIF}
  45.   IS_KEY_EVENT := FALSE;
  46.   DropDownCount := 20;
  47.   TIMER:= TTimer.Create(SELF);
  48.   WITH TIMER DO
  49.        BEGIN
  50.        Interval := 1;
  51.        Enabled := False;
  52.        OnTimer := @TIMER_EVENT;
  53.        END;
  54.   OnEnter := @ENTER_EVENT;
  55.   OnExit := @EXIT_EVENT;
  56.   DoubleBuffered := True;
  57. END;
  58.  
  59.  FUNCTION TMYCHECKCOMBOBOX.GET_PURPOSE: SHORTSTRING;
  60. BEGIN
  61.   RESULT:= PURPOSE_VAR;
  62. END;
  63.  
  64.  PROCEDURE TMYCHECKCOMBOBOX.SET_PURPOSE( AVALUE: SHORTSTRING) ;
  65. BEGIN
  66. PURPOSE_VAR := AVALUE;
  67. TIMER.Enabled := (PURPOSE <> '');  // to carry out the purpose
  68. END;
  69.  
  70.  DESTRUCTOR TMYCHECKCOMBOBOX.DESTROY;
  71. BEGIN
  72.   TIMER.Free;
  73.   INHERITED DESTROY;
  74. END;
  75.  
  76.  PROCEDURE TMYCHECKCOMBOBOX.TIMER_EVENT( SENDER: TOBJECT) ;
  77.  BEGIN
  78.  WITH SENDER AS TTimer DO
  79.       ENABLED:= False; // turn off the timer
  80.  CASE PURPOSE OF
  81.       'SPIN':ItemIndex := (Count -1) * ORD(ItemIndex = 0) ; // if item index = 0 it will go to last one otherwise it will be zero
  82.       'REOPEN':BEGIN
  83.                DroppedDown := FALSE;
  84.                DroppedDown := TRUE;
  85.                END;
  86.       OTHERWISE DroppedDown := FALSE;
  87.       END;
  88.  PURPOSE_var := '';  // done here instead of keydown event
  89.  IS_KEY_EVENT:= False; // for keys not triggering change event
  90.  END;
  91.  
  92.  PROCEDURE TMYCHECKCOMBOBOX.KEYDOWN( VAR KEY: WORD; SHIFT: TSHIFTSTATE) ;
  93. BEGIN
  94. IS_KEY_EVENT := True;// for the benefit of select event ?
  95. CASE KEY OF
  96.      VK_ESCAPE: TIMER.Enabled := TRUE; // simply close it does not need purpose
  97.      VK_RIGHT,VK_DOWN:IF ItemIndex =  Count -1// last item
  98.                          THEN PURPOSE := 'SPIN';// if it is last item select first
  99.      VK_LEFT,VK_UP:IF ITEMINDEX = 0  //first item
  100.                       THEN PURPOSE := 'SPIN'; // if it is first item select last
  101.      VK_RETURN:IF NOT DroppedDown AND (Count > 1)
  102.                   THEN DroppedDown:= True  // open the dropdown if its closed and has more than one item
  103.                   ELSE IF (ItemIndex>=0) and ItemEnabled[ItemIndex]
  104.                           THEN BEGIN
  105.                                Toggle(ItemIndex);   // toggle the lone item then then close up
  106.                                DroppedDown:=False; // should i use timer to close it ?
  107.                                END;
  108.      VK_SPACE:BEGIN  //32
  109.               Toggle(ItemIndex);
  110.               IF Items.Count > 1
  111.                  THEN PURPOSE:= 'REOPEN'; // refreshes the dropdown after change
  112.               END;
  113.     END;                                                                   {,VK_RIGHT,VK_DOWN,VK_LEFT,VK_UP}
  114.  IF KEY IN [VK_ESCAPE,VK_SPACE,VK_RETURN] // keys processed in case  statement
  115.     THEN Key:= 0;  // to make case statements in ancestor skip key
  116.  INHERITED KEYDOWN( KEY, SHIFT) ;  // return key does not open combobox if i dont call this
  117. END;
  118.  
  119.  PROCEDURE TMYCHECKCOMBOBOX.CLICK; // this does not apply to clicking dropdown part
  120. BEGIN
  121. INHERITED CLICK;
  122. IF SELECTED_CHECKED <> Checked[ItemIndex]
  123.    THEN BEGIN
  124.         SELECTED_CHECKED := Checked[ItemIndex];  // store it in a variable for next comparison
  125.         TIMER.Enabled := TRUE;
  126.         END ;
  127. END;
  128.  
  129. PROCEDURE TMYCHECKCOMBOBOX.DROPDOWN; // toggles the lone combobox
  130.            {$IF DEFINED(LCLWin32) or DEFINED(LCLWin64)}
  131.           {$ELSE}
  132.           var aCursorPos: TPoint;
  133.               aRect: TRect;
  134.           {$ENDIF}
  135. BEGIN
  136. {$IF DEFINED(LCLWin32) or DEFINED(LCLWin64)}
  137. FRejectDropDown:=  False;
  138. {$ELSE}
  139. aCursorPos:=ScreenToControl(Mouse.CursorPos);
  140. aRect:=Rect(FHiLiteLeft, 0, FHiLiteRight, Height);
  141. FRejectDropDown:=PtInRect(aRect, aCursorPos);
  142. {$ENDIF}
  143.                              // my code
  144. IF NOT FRejectDropDown  AND (items.Count > 1) // more than one checkbox
  145.    THEN FRejectToggleOnSelect:=False
  146.    ELSE IF ItemEnabled[ItemIndex]
  147.            THEN Toggle(ItemIndex);  //it toggles the lone checkbox
  148. IF (Count < 2 )
  149.     THEN TIMER.Enabled := TRUE; // close it immediatedly if it has less than two items
  150. END;
  151.  
  152.  PROCEDURE TMYCHECKCOMBOBOX.DRAWITEM( INDEX: INTEGER; ARECT: TRECT; MYSTATE: TOWNERDRAWSTATE) ;
  153.           CONST
  154.           caCheckThemes: ARRAY [Boolean, TCheckBoxState, Boolean] of TThemedButton =
  155.                            { normal, highlighted }
  156.         (((tbCheckBoxUncheckedDisabled, tbCheckBoxUncheckedDisabled),  { disabled, unchecked }
  157.           (tbCheckBoxCheckedDisabled, tbCheckBoxCheckedDisabled),      { disabled, checked }
  158.           (tbCheckBoxMixedDisabled, tbCheckBoxMixedDisabled)),         { disabled, greyed }
  159.          ((tbCheckBoxUncheckedNormal, tbCheckBoxUncheckedHot),         { enabled, unchecked }
  160.           (tbCheckBoxCheckedNormal, tbCheckBoxCheckedHot),             { enabled, checked }
  161.           (tbCheckBoxMixedNormal, tbCheckBoxMixedHot)));               { enabled, greyed }
  162.           cCheckIndent: SmallInt = 2;
  163.           cTextIndent: SmallInt = 5;
  164.           VAR
  165.           aDetail: TThemedElementDetails;
  166.           aDropped: Boolean;
  167.           aEnabled: Boolean;
  168.           aFlags: Cardinal;
  169.           aFocusedEditableMainItemNoDD: Boolean;  { combo has edit-like line edit in csDropDownList (Win) and is closed (not DroppedDown }
  170.           anyRect: TRect;
  171.           aState: TCheckBoxState;
  172. BEGIN
  173. ADROPPED:=DROPPEDDOWN;   // is this an alias ?
  174. IF ADROPPED AND FREJECTDROPDOWN
  175.    THEN BEGIN
  176.         DROPPEDDOWN:=FALSE;
  177.         EXIT;  { EXIT! }
  178.         END;
  179. aEnabled:=IsEnabled;
  180. IF NOT (csDesigning IN ComponentState)
  181.    THEN aEnabled:= (aEnabled AND PTCheckComboItemState(Items.Objects[Index])^.Enabled);
  182. {$IF DEFINED(LCLWin32) or DEFINED(LCLWin64)}
  183. aFocusedEditableMainItemNoDD := (Focused and (ARect.Left>0) and not aDropped);
  184. {$ELSE}
  185. aFocusedEditableMainItemNoDD := False;
  186. {$ENDIF}             //maybe the focused edit part is not necessary
  187. IF (ARect.Left=0) //OR aFocusedEditableMainItemNoDD
  188.    THEN WITH Canvas,Brush DO // draw the background colors of the items and edit area
  189.              BEGIN
  190.              IF (odSelected in MYSTATE) OR aFocusedEditableMainItemNoDD
  191.                 THEN Color := Parent.Font.Color  // nice hilite by swapping colors
  192.                 ELSE Color:=  Parent.Color;// match parent by default
  193.              Style:=bsSolid;
  194.              FillRect(ARect);  // fill in the background color
  195.              END;
  196. IF NOT (csDesigning IN ComponentState)
  197.    THEN aState:=pTCheckComboItemState(Items.Objects[Index])^.State
  198.    ELSE aState:=cbUnchecked;
  199. aDetail:=ThemeServices.GetElementDetails(caCheckThemes[aEnabled, aState, NOT aDropped AND FCheckHighlight]);
  200. IF FNeedMeasure
  201.    THEN BEGIN
  202.         FCheckSize:= ThemeServices.GetDetailSize(aDetail); //size of the checkbox
  203.         FTextHeight:=Canvas.TextHeight('ŠjÁÇ');
  204.         IF NOT aDropped
  205.            THEN BEGIN
  206.                 IF NOT FRightToLeft
  207.                    THEN BEGIN
  208.                         FHiLiteLeft:=-1;
  209.                         FHiLiteRight:=ARect.Right;
  210.                         END
  211.                    ELSE BEGIN
  212.                         FHiLiteLeft:=ARect.Left;
  213.                         FHiLiteRight:=ARect.Right;
  214.                         END;
  215.                 FNeedMeasure := False;
  216.                 END;
  217.         END; //FNeedMeasure
  218. WITH anyRect DO  // prepare the checkbox
  219.      BEGIN
  220.      IF NOT FRightToLeft
  221.         THEN Left:= ARect.Left+cCheckIndent
  222.         ELSE Left:= ARect.Right-cCheckIndent-FCheckSize.cx;
  223.      Right:= Left+FCheckSize.cx; // this is drawing the checkbox
  224.      Top:=(ARect.Bottom+ARect.Top-FCheckSize.cy) DIV 2;
  225.      Bottom:= Top+FCheckSize.cy;
  226.      END;
  227. ThemeServices.DrawElement(CANVAS.Handle, aDetail, anyRect);  //draw the checkbox
  228. WITH CANVAS,FONT DO // prepare the font colors
  229.      BEGIN
  230.      Brush.Style:=  bsClear;  // dont see any difference when i change to bssolid
  231.      IF (odSelected in MYSTATE) OR aFocusedEditableMainItemNoDD  //{(odSelected in MYSTATE) OR} aFocusedEditableMainItemNoDD  // item is in the edit area or selected in the items dropdown
  232.          THEN BEGIN
  233.               Color := Parent.color; // use parent background for font color
  234.               self.Color := parent.Font.Color; ///when control is selected make it contrast
  235.               END
  236.          ELSE BEGIN Color := Parent.Font.COLOR;  // pink same font color as parent
  237.               self.Color := Parent.Color;
  238.               END ;
  239.       IF aFocusedEditableMainItemNoDD
  240.          THEN BEGIN // draw a dotted line in checkcombobox when focused to highlite it
  241.               LCLIntf.SetBkColor(Handle, ColorToRGB(InvertColor(color))); // this code isnt called ?
  242.               LCLIntf.DrawFocusRect(Handle, aRect);
  243.               END;
  244.      END;
  245. aFlags:=DT_END_ELLIPSIS+DT_VCENTER+DT_SINGLELINE+DT_NOPREFIX;
  246. WITH anyRect DO  // prepare the edit text and item strings in the dropdown
  247.      BEGIN
  248.      IF NOT FRightToLeft
  249.         THEN BEGIN
  250.              Left:=ARect.Left+cCheckIndent+FCheckSize.cx+cTextIndent;
  251.              Right:=ARect.Right;
  252.              END
  253.         ELSE BEGIN
  254.              Right:=anyRect.Left-cTextIndent;
  255.              Left:=ARect.Left;
  256.              aFlags:=aFlags OR DT_RIGHT OR DT_RTLREADING;
  257.              END;
  258.      Top:=(ARect.Top+ARect.Bottom-FTextHeight) div 2;
  259.      Bottom:= Top+FTextHeight;
  260.      END;
  261. ThemeServices.DrawText(Canvas, aDetail, Items[Index], anyRect, aFlags, 0);  // draw the text for edit area and dropdown items
  262. END;
  263.  
  264.  PROCEDURE TMYCHECKCOMBOBOX.SELECT;  //  arrow keys and clicks
  265. BEGIN  // how to tell if its an arrow key or a click
  266. IF IS_KEY_EVENT
  267.    THEN IS_KEY_EVENT := false  // do not do much for arrow keys navigating
  268.    ELSE BEGIN  // IT WAS CLICK SO CHANGE AND REOPEN
  269.         INHERITED Select; //toggle the item clicked and reopen the dropdown
  270.         PURPOSE := 'REOPEN';
  271.         END;
  272. END;
  273.  
  274.  PROCEDURE TMYCHECKCOMBOBOX.ENTER_EVENT( SENDER: TOBJECT) ;
  275.  BEGIN
  276.  Color := InvertColor(Parent.Font.Color); // hilite the backcolor
  277.  END;
  278.  
  279.  PROCEDURE TMYCHECKCOMBOBOX.EXIT_EVENT( SENDER: TOBJECT) ;
  280.  BEGIN
  281.  Color := Parent.Color;  // return back color to normal
  282.  TIMER.Enabled := true;
  283.  END;
« Last Edit: April 13, 2022, 01:15:17 am by Joanna »
Come chat on IRC .. IRC.LIBERA.CHAT  Ports [6667 plaintext ] or [SASL 6697] channels  #fpc #lazarus #pascal 
type /msg nickserv help register to get started

stoffman

  • New Member
  • *
  • Posts: 44
Re: TCheckCombobox Proposed Improvements
« Reply #1 on: April 13, 2022, 04:45:27 pm »
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

  • Hero Member
  • *****
  • Posts: 9899
Re: TCheckCombobox Proposed Improvements
« Reply #2 on: April 13, 2022, 07:54:00 pm »
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

  • Jr. Member
  • **
  • Posts: 74
Re: TCheckCombobox Proposed Improvements
« Reply #3 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.
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.
« Last Edit: April 14, 2022, 12:55:51 pm by Joanna »
Come chat on IRC .. IRC.LIBERA.CHAT  Ports [6667 plaintext ] or [SASL 6697] channels  #fpc #lazarus #pascal 
type /msg nickserv help register to get started

Gald

  • Full Member
  • ***
  • Posts: 105
Re: TCheckCombobox Proposed Improvements
« Reply #4 on: April 14, 2022, 06:52:15 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.

It sounds like fixes for me, not improvements.
What about report it on bugtracker?
Lazarus 2.0.12 r64642 FPC 3.2.0 x86_64-win64-win32/win64/Manjaro KDE 21
AMD Ryzen 3 1300X Quad-Core Processor 3.50 GHz / 8,00 GB RAM / GTX 1500 TI / 2TB M.2 NVMe

Joanna

  • Jr. Member
  • **
  • Posts: 74
Re: TCheckCombobox Proposed Improvements
« Reply #5 on: April 14, 2022, 12:53:40 pm »
I tried reporting it in the bug tracker and asked about it in forums  awhile back and it didn’t work out for me so I decided to have a go at it myself.

My idea of how it should behave doesn’t always coincide with how other people want it to behave and as far as I can tell very few people use this control.

I don’t really know what the difference between a fix and an improvement is because I didn’t make original code.

Has anyone tested my code?
Come chat on IRC .. IRC.LIBERA.CHAT  Ports [6667 plaintext ] or [SASL 6697] channels  #fpc #lazarus #pascal 
type /msg nickserv help register to get started

 

TinyPortal © 2005-2018