From 13d54fc4cbe72433111d08545fc8e4957172bc33 Mon Sep 17 00:00:00 2001 From: Juha Date: Tue, 1 Aug 2023 11:44:19 +0300 Subject: [PATCH] LCL: Refactor Colorbox code. Issue #40376, patch by n7800. --- lcl/colorbox.pas | 184 +++++++++++++++++---------------- lcl/include/customcombobox.inc | 21 ++-- 2 files changed, 104 insertions(+), 101 deletions(-) diff --git a/lcl/colorbox.pas b/lcl/colorbox.pas index 97d5307e33..1f4ada1cb1 100644 --- a/lcl/colorbox.pas +++ b/lcl/colorbox.pas @@ -64,7 +64,7 @@ type procedure SetSelected(Value: TColor); procedure SetStyle(const AValue: TColorBoxStyle); reintroduce; procedure ColorProc(const s: AnsiString); - procedure UpdateCombo; + procedure SetIndexOnColor(aColor: TColor); protected function ColorRectWidthStored: Boolean; procedure DrawItem(Index: Integer; Rect: TRect; State: TOwnerDrawState); override; @@ -89,7 +89,7 @@ type property DefaultColorColor: TColor read FDefaultColorColor write SetDefaultColorColor default clBlack; property NoneColorColor: TColor read FNoneColorColor write SetNoneColorColor default clBlack; property OnGetColors: TGetColorsEvent read FOnGetColors write FOnGetColors; - property ColorDialog:TcolorDialog read FColorDialog write FcolorDialog; + property ColorDialog: TColorDialog read FColorDialog write FColorDialog; end; { TColorBox } @@ -188,6 +188,7 @@ type procedure SetSelected(Value: TColor); procedure SetStyle(const AValue: TColorBoxStyle); reintroduce; procedure ColorProc(const s: AnsiString); + procedure SetIndexOnColor(aColor: TColor); protected function ColorRectWidthStored: Boolean; procedure DrawItem(Index: Integer; Rect: TRect; State: TOwnerDrawState); override; @@ -499,7 +500,7 @@ begin Exit; FSelected := Value; - UpdateCombo; + SetIndexOnColor(FSelected); inherited Change; end; @@ -571,29 +572,28 @@ begin end; end; -procedure TCustomColorBox.UpdateCombo; +procedure TCustomColorBox.SetIndexOnColor(aColor: TColor); var - c: integer; + i: integer; begin - if HandleAllocated then - begin - for c := Ord(cbCustomColor in Style) to Items.Count - 1 do + if not HandleAllocated then exit; + // find color in list + for i := ord(cbCustomColor in Style) to Items.Count - 1 do + if Colors[i] = aColor then begin - if Colors[c] = FSelected then - begin - ItemIndex := c; - Exit; - end; + ItemIndex := i; + exit; end; - if cbCustomColor in Style then - begin - Items.Objects[0] := TObject(PtrInt(FSelected)); - ItemIndex := 0; - Invalidate; - end - else - ItemIndex := -1; + // check custom color + if cbCustomColor in Style then + begin + Items.Objects[0] := TObject(PtrInt(aColor)); + ItemIndex := 0; + Invalidate; + exit; end; + // color not found + ItemIndex := -1; end; {------------------------------------------------------------------------------ @@ -695,7 +695,7 @@ end; procedure TCustomColorBox.InitializeWnd; begin inherited InitializeWnd; - UpdateCombo; + SetIndexOnColor(FSelected); end; procedure TCustomColorBox.DoGetColors; @@ -706,37 +706,38 @@ end; procedure TCustomColorBox.CloseUp; begin - if (cbCustomColor in Style) and (ItemIndex = 0) then // custom color has been selected + // if custom color has been selected + if (cbCustomColor in Style) and (ItemIndex = 0) then PickCustomColor; - if ItemIndex <> -1 then + + // select color and call OnChange + if ItemIndex >= 0 then Selected := Colors[ItemIndex]; + inherited CloseUp; end; function TCustomColorBox.PickCustomColor: Boolean; -Var - FreeDialog:Boolean; +var + FreeDialog: boolean; begin if csDesigning in ComponentState then - begin - Result := False; - Exit; - end; - FreeDialog := FcolorDialog = NIL; - If FColorDialog = Nil Then FcolorDialog := TcolorDialog.Create(GetTopParent); - Try - With FColorDialog do - Begin - Color := Colors[0]; - Result := Execute; - If Result Then - Begin - items.objects[0]:= TObject(PtrInt(COlor)); - Invalidate; - end; + exit(false); + + FreeDialog := FColorDialog = nil; + if FreeDialog then + FColorDialog := TColorDialog.Create(GetTopParent); + try + FColorDialog.Color := Colors[0]; + result := FColorDialog.Execute; + if result then + begin + Items.Objects[0] := TObject(PtrInt(FColorDialog.Color)); + Invalidate; end; finally - If FreeDialog Then FreeAndNil(FcolorDialog); + if FreeDialog then + FreeAndNil(FColorDialog); end; end; @@ -867,31 +868,12 @@ end; ------------------------------------------------------------------------------} procedure TCustomColorListBox.SetSelected(Value: TColor); -var - c: integer; begin - if HandleAllocated then - begin - FSelected := Value; - for c := Ord(cbCustomColor in Style) to Items.Count - 1 do - begin - if Colors[c] = Value then - begin - ItemIndex := c; - Exit; - end; - end; - if cbCustomColor in Style then - begin - Items.Objects[0] := TObject(PtrInt(Value)); - ItemIndex := 0; - invalidate; - end - else - ItemIndex := -1; - end - else - FSelected := Value; + if FSelected = Value then + exit; + + FSelected := Value; + SetIndexOnColor(FSelected); end; procedure TCustomColorListBox.SetStyle(const AValue: TColorBoxStyle); @@ -941,6 +923,30 @@ begin end; end; +procedure TCustomColorListBox.SetIndexOnColor(aColor: TColor); +var + i: integer; +begin + if not HandleAllocated then exit; + // find color in list + for i := ord(cbCustomColor in Style) to Items.Count - 1 do + if Colors[i] = aColor then + begin + ItemIndex := i; + exit; + end; + // check custom color + if cbCustomColor in Style then + begin + Items.Objects[0] := TObject(PtrInt(aColor)); + ItemIndex := 0; + Invalidate; + exit; + end; + // color not found + ItemIndex := -1; +end; + function TCustomColorListBox.ColorRectWidthStored: Boolean; begin Result := FColorRectWidth >= 0; @@ -1070,38 +1076,40 @@ procedure TCustomColorListBox.DoSelectionChange(User: Boolean); begin if User then begin - if (cbCustomColor in Style) and (ItemIndex = 0) then // custom color has been selected + // if custom color has been selected + if (cbCustomColor in Style) and (ItemIndex = 0) then PickCustomColor; - if ItemIndex <> -1 then + + // select color + if ItemIndex >= 0 then FSelected := Colors[ItemIndex]; end; + + // call OnSelectionChange inherited DoSelectionChange(User); end; function TCustomColorListBox.PickCustomColor: Boolean; -Var - FreeDialog:Boolean; +var + FreeDialog: boolean; begin if csDesigning in ComponentState then - begin - Result := False; - Exit; - end; - FreeDialog := FcolorDialog = NIL; - If FColorDialog = Nil Then FcolorDialog := TcolorDialog.Create(GetTopParent); - Try - With FColorDialog do - Begin - Color := Colors[0]; - Result := Execute; - If Result Then - Begin - items.objects[0]:= TObject(PtrInt(COlor)); - Invalidate; - end; + exit(false); + + FreeDialog := FColorDialog = nil; + if FreeDialog then + FColorDialog := TColorDialog.Create(GetTopParent); + try + FColorDialog.Color := Colors[0]; + result := FColorDialog.Execute; + if result then + begin + Items.Objects[0] := TObject(PtrInt(FColorDialog.Color)); + Invalidate; end; finally - If FreeDialog Then FreeAndNil(FcolorDialog); + if FreeDialog then + FreeAndNil(FColorDialog); end; end; diff --git a/lcl/include/customcombobox.inc b/lcl/include/customcombobox.inc index 7ec600a9d7..5a4baf45e5 100644 --- a/lcl/include/customcombobox.inc +++ b/lcl/include/customcombobox.inc @@ -586,11 +586,10 @@ end; procedure TCustomComboBox.KeyDown(var Key: Word; Shift: TShiftState); var - Skip, UserDropDown, PreventDropDown: Boolean; + UserDropDown, PreventDropDown: Boolean; begin FEditingDone := Key = VK_RETURN; - Skip := False; - UserDropDown := ((Shift *[ssAlt] = [ssAlt]) and (Key = VK_DOWN)); + UserDropDown := (Key = VK_DOWN) and (ssAlt in Shift); if Style = csSimple then PreventDropDown := Key in [VK_RETURN, VK_ESCAPE] else @@ -602,9 +601,8 @@ begin // if AutoDropDown then don't close DropDown, like in Delphi, issue #31247 if AutoDropDown then PreventDropDown := PreventDropDown or (ssAlt in Shift) - or (Key in [VK_UNKNOWN..VK_MODECHANGE, VK_END..VK_LEFT, - VK_RIGHT, VK_SELECT..VK_HELP, - VK_LWIN..VK_SLEEP, VK_F1..VK_UNDEFINED]); + or (not (Key in [VK_SPACE, VK_PRIOR, VK_NEXT, VK_UP, VK_DOWN, VK_0..VK_Z, VK_NUMPAD0..VK_DIVIDE])); + if AutoDropDown or UserDropDown or FReturnArrowState then begin if PreventDropDown then @@ -615,22 +613,19 @@ begin FReturnArrowState := False; end; end - else - begin + else begin if not ArrowKeysTraverseList then begin ArrowKeysTraverseList := True; //we need?? this here, else we cannot traverse popup list FReturnArrowState := True; - Skip := True; + Key := VK_UNKNOWN; end; DroppedDown := True; if UserDropDown then - Skip := True; + Key := VK_UNKNOWN; end; end; - if Skip then - Key := VK_UNKNOWN - else + if Key <> VK_UNKNOWN then inherited KeyDown(Key, Shift); end;