paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-08-18 19:39:17 +02:00
Code Issues Packages Projects Releases Wiki Activity

Revert r49699 #57795c6d42, "LCL: Prevent opening custom color selection dialog in ColorBox wrongly."

Browse Source 
git-svn-id: trunk@49869 -
This commit is contained in:
juha 2015-09-23 09:19:55 +00:00
parent 2e36d4e2c3
commit e2932283ec
1 changed files with 2 additions and 32 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

34
lcl/colorbox.pas
View File

@ -40,7 +40,6 @@ type
cbPrettyNames, // use good looking color names - like Red for clRed cbPrettyNames, // use good looking color names - like Red for clRed
cbCustomColors); // call OnGetColors after all other colors processing cbCustomColors); // call OnGetColors after all other colors processing
TColorBoxStyle = set of TColorBoxStyles; TColorBoxStyle = set of TColorBoxStyles;
TColorBoxCloseKey = (cbckNone, cbckReturn, cbckOther);
TGetColorsEvent = procedure(Sender: TCustomColorBox; Items: TStrings) of object; TGetColorsEvent = procedure(Sender: TCustomColorBox; Items: TStrings) of object;
TCustomColorBox = class(TCustomComboBox) TCustomColorBox = class(TCustomComboBox)
@ -52,7 +51,6 @@ type
FOnGetColors: TGetColorsEvent; FOnGetColors: TGetColorsEvent;
FStyle: TColorBoxStyle; FStyle: TColorBoxStyle;
FSelected: TColor; FSelected: TColor;
FCloseMode: TColorBoxCloseKey;
function GetColor(Index : Integer): TColor; function GetColor(Index : Integer): TColor;
function GetColorName(Index: Integer): string; function GetColorName(Index: Integer): string;
function GetSelected: TColor; function GetSelected: TColor;
@ -70,9 +68,7 @@ type
procedure Loaded; override; procedure Loaded; override;
procedure InitializeWnd; override; procedure InitializeWnd; override;
procedure DoGetColors; virtual; procedure DoGetColors; virtual;
procedure DropDown; override;
procedure CloseUp; override; procedure CloseUp; override;
procedure KeyDownBeforeInterface(var Key: Word; Shift: TShiftState); override;
function PickCustomColor: Boolean; virtual; function PickCustomColor: Boolean; virtual;
public public
constructor Create(AOwner: TComponent); override; constructor Create(AOwner: TComponent); override;
@ -670,36 +666,10 @@ begin
OnGetColors(Self, Items) OnGetColors(Self, Items)
end; end;
procedure TCustomColorBox.KeyDownBeforeInterface(var Key: Word; Shift: TShiftState);
begin
if DroppedDown then
begin
if Key = VK_Return then
FCloseMode := cbckReturn
else
FCloseMode := cbckOther; // other keys: Escape, Tab, Space etc.
end;
inherited KeyDownBeforeInterface(Key, Shift);
end;
procedure TCustomColorBox.DropDown;
begin
FCloseMode := cbckNone;
inherited DropDown;
end;
procedure TCustomColorBox.CloseUp; procedure TCustomColorBox.CloseUp;
var
mp, co: TPoint;
cr: TRect;
begin begin
mp := Mouse.CursorPos; if (cbCustomColor in Style) and (ItemIndex = 0) then // custom color has been selected
co := ClientOrigin; PickCustomColor;
cr := Rect(co.x, co.y+Height+BorderWidth, co.x+Width, co.y+Height+ItemHeight);
if (cbCustomColor in Style) and (ItemIndex = 0) and (
(PtInRect(cr, mp) and (FCloseMode <> cbckOther)) or (FCloseMode = cbckReturn)
) then
PickCustomColor; // custom color has been selected
if ItemIndex <> -1 then if ItemIndex <> -1 then
Selected := Colors[ItemIndex]; Selected := Colors[ItemIndex];
inherited CloseUp; inherited CloseUp;