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

lcl: reinstating Readonly property for ComboBox with a new meaning of TEdit-like Readonly. Implementation is provided for Win32, Qt5, Gtk2 and Cocoa

Browse Source 
git-svn-id: trunk@63253 -
This commit is contained in:
dmitry 2020-05-30 17:48:43 +00:00
commit c2955d01ee
8 changed files with 103 additions and 2 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

17
docs/xml/lcl/stdctrls.xml
View File

@ -775,6 +775,7 @@ properties</short>
<element name="TCustomComboBox.FOnGetItems"/>
<element name="TCustomComboBox.FOnMeasureItem"/>
<element name="TCustomComboBox.FOnSelect"/>
<element name="TCustomComboBox.FReadOnly"/>
<element name="TCustomComboBox.FSelLength"/>
<element name="TCustomComboBox.FSelStart"/>
<element name="TCustomComboBox.FSorted"/>
@ -1466,6 +1467,20 @@ properties</short>
<!-- property Visibility: protected -->
<element name="TCustomComboBox.ParentColor" link="#LCL.Controls.TControl.ParentColor"/>
<!-- property Visibility: public -->
<element name="TCustomComboBox.ReadOnly">
<short>Disallows entry of free text into ComboBox edit field.</short>
<descr>When True, the text can be changed only by selecting an item from the comboBox items list.
When False the text can be changed by free form entry.
Changing the property value doesn't affect the style in any manner.
Changing the style doesn't affect the property as well.
For some styles (such as csDropDownList) the property might have no effect at all and is ignored.</descr>
<seealso><link id="TCustomComboBox.AutoComplete"/>
</seealso>
<seealso><link id="TCustomComboBox.Style"/>
</seealso>
</element>
<!-- property Visibility: public -->
<element name="TCustomComboBox.SelLength">
<short>The number of selected UTF-8 characters in the edit box.</short>
<descr>
@ -1547,6 +1562,7 @@ Assign an new string to replace the selected text.</descr>
</p>
</descr>
<seealso>
<link id="TCustomComboBox.ReadOnly"/>
<link id="TCustomComboBox.Style"/>
<link id="TCustomComboBox.AutoComplete"/>
<link id="TCustomComboBox.Text"/>
@ -1636,6 +1652,7 @@ Assign an new string to replace the selected text.</descr>
<element name="TComboBox.ParentFont" link="#LCL.Controls.TControl.ParentFont"/>
<element name="TComboBox.ParentShowHint" link="#LCL.Controls.TControl.ParentShowHint"/>
<element name="TComboBox.PopupMenu" link="#LCL.Controls.TControl.PopupMenu"/>
<element name="TComboBox.ReadOnly" link="#LCL.StdCtrls.TCustomComboBox.ReadOnly"/>
<element name="TComboBox.ShowHint" link="#LCL.Controls.TControl.ShowHint"/>
<element name="TComboBox.Sorted" link="#LCL.StdCtrls.TCustomComboBox.Sorted"/>
<element name="TComboBox.Style" link="#LCL.StdCtrls.TCustomComboBox.Style"/>

11
lcl/include/customcombobox.inc
View File

@ -42,6 +42,7 @@ begin
TWSCustomComboBoxClass(WidgetSetClass).SetItemIndex(Self, FItemIndex);
TWSCustomComboBoxClass(WidgetSetClass).SetStyle(Self, FStyle);
TWSCustomComboBoxClass(WidgetSetClass).SetArrowKeysTraverseList(Self, FArrowKeysTraverseList);
TWSCustomComboBoxClass(WidgetSetClass).SetReadOnly(Self, FReadOnly);
TWSCustomComboBoxClass(WidgetSetClass).SetMaxLength(Self, FMaxLength);
TWSCustomComboBoxClass(WidgetSetClass).SetDropDownCount(Self, FDropDownCount);
@ -1080,6 +1081,16 @@ begin
end;
end;
procedure TCustomComboBox.SetReadOnly(const AValue: Boolean);
begin
if FReadOnly = AValue then
Exit;
FReadOnly := AValue;
if (not HandleAllocated) or (csLoading in ComponentState) then
Exit;
TWSCustomComboBoxClass(WidgetSetClass).SetReadOnly(Self, FReadOnly);
end;
{------------------------------------------------------------------------------
procedure TCustomComboBox.UpdateSorted;
------------------------------------------------------------------------------}

26
lcl/interfaces/cocoa/cocoawsstdctrls.pas
View File

@ -86,8 +86,9 @@ type
class procedure SetSelStart(const ACustomComboBox: TCustomComboBox; NewStart: integer); override;
class procedure SetSelLength(const ACustomComboBox: TCustomComboBox; NewLength: integer); override;}
class procedure SetItemIndex(const ACustomComboBox: TCustomComboBox; NewIndex: integer); override;
{class procedure SetMaxLength(const ACustomComboBox: TCustomComboBox; NewLength: integer); override;
class procedure SetStyle(const ACustomComboBox: TCustomComboBox; NewStyle: TComboBoxStyle); override;}
{class procedure SetMaxLength(const ACustomComboBox: TCustomComboBox; NewLength: integer); override;}
class procedure SetStyle(const ACustomComboBox: TCustomComboBox; NewStyle: TComboBoxStyle); override;
class procedure SetReadOnly(const ACustomComboBox: TCustomComboBox; NewReadOnly: boolean); override;
class procedure SetDropDownCount(const ACustomComboBox: TCustomComboBox; NewCount: Integer); override;
class function GetItems(const ACustomComboBox: TCustomComboBox): TStrings; override;
@ -1854,6 +1855,27 @@ begin
TCocoaComboBox(ACustomComboBox.Handle).selectItemAtIndex(NewIndex);
end;
class procedure TCocoaWSCustomComboBox.SetStyle(
const ACustomComboBox: TCustomComboBox; NewStyle: TComboBoxStyle);
begin
if (not Assigned(ACustomComboBox)) or (not ACustomComboBox.HandleAllocated) then
Exit;
RecreateWnd(ACustomComboBox);
end;
class procedure TCocoaWSCustomComboBox.SetReadOnly(
const ACustomComboBox: TCustomComboBox; NewReadOnly: boolean);
var
box : NSComboBox;
begin
if (not Assigned(ACustomComboBox)) or (not ACustomComboBox.HandleAllocated) then
Exit;
if not (NSObject(ACustomComboBox.Handle).isKindOfClass(NSComboBox)) then Exit;
box := NSComboBox(ACustomComboBox.Handle);
box.setEditable(not NewReadOnly);
box.setSelectable_(1);
end;
class procedure TCocoaWSCustomComboBox.SetDropDownCount(const ACustomComboBox:
TCustomComboBox;NewCount:Integer);
begin

14
lcl/interfaces/gtk2/gtk2wsstdctrls.pp
View File

@ -129,6 +129,7 @@ type
class procedure SetItemIndex(const ACustomComboBox: TCustomComboBox; NewIndex: integer); override;
class procedure SetMaxLength(const ACustomComboBox: TCustomComboBox; NewLength: integer); override;
class procedure SetStyle(const ACustomComboBox: TCustomComboBox; NewStyle: TComboBoxStyle); override;
class procedure SetReadOnly(const ACustomComboBox: TCustomComboBox; NewReadOnly: boolean); override;
class function GetItems(const ACustomComboBox: TCustomComboBox): TStrings; override;
class procedure Sort(const ACustomComboBox: TCustomComboBox; {%H-}AList: TStrings; IsSorted: boolean); override;
@ -2014,6 +2015,19 @@ begin
ReCreateCombo(ACustomComboBox, NeedEntry, WidgetInfo);
end;
class procedure TGtk2WSCustomComboBox.SetReadOnly(
const ACustomComboBox: TCustomComboBox; NewReadOnly: boolean);
var
WidgetInfo: PWidgetInfo;
Entry: PGtkEntry;
begin
WidgetInfo := GetWidgetInfo({%H-}Pointer(ACustomComboBox.Handle));
Entry := GetComboBoxEntry(WidgetInfo^.CoreWidget);
if (Entry<>nil) and (ACustomComboBox.Style in [csDropDown, csOwnerDrawEditableFixed, csOwnerDrawEditableVariable, csSimple]) then
gtk_entry_set_editable(PGtkEditable(Entry), not NewReadOnly);
end;
class function TGtk2WSCustomComboBox.GetItems(
const ACustomComboBox: TCustomComboBox): TStrings;
var

12
lcl/interfaces/qt5/qtwsstdctrls.pp
View File

@ -90,6 +90,7 @@ type
class procedure SetItemIndex(const ACustomComboBox: TCustomComboBox; NewIndex: integer); override;
class procedure SetMaxLength(const ACustomComboBox: TCustomComboBox; NewLength: integer); override;
class procedure SetStyle(const ACustomComboBox: TCustomComboBox; NewStyle: TComboBoxStyle); override;
class procedure SetReadOnly(const ACustomComboBox: TCustomComboBox; NewReadOnly: boolean); override;
class procedure Sort(const ACustomComboBox: TCustomComboBox; AList: TStrings; IsSorted: boolean); override;
@ -1589,6 +1590,17 @@ begin
inherited SetStyle(ACustomComboBox, NewStyle);
end;
class procedure TQtWSCustomComboBox.SetReadOnly(const ACustomComboBox: TCustomComboBox; NewReadOnly: boolean);
var
LineEdit : TQtLineEdit;
begin
if not WSCheckHandleAllocated(ACustomComboBox, 'SetReadOnly') then
Exit;
LineEdit := TQtComboBox(ACustomComboBox.Handle).LineEdit;
if LineEdit <> nil then
LineEdit.setReadOnly(NewReadOnly);
end;
{------------------------------------------------------------------------------
Method: TQtWSCustomComboBox.GetItems
Params: None

15
lcl/interfaces/win32/win32wsstdctrls.pp
View File

@ -99,6 +99,7 @@ type
class procedure SetItemIndex(const ACustomComboBox: TCustomComboBox; NewIndex: integer); override;
class procedure SetMaxLength(const ACustomComboBox: TCustomComboBox; NewLength: integer); override;
class procedure SetStyle(const ACustomComboBox: TCustomComboBox; NewStyle: TComboBoxStyle); override;
class procedure SetReadOnly(const ACustomComboBox: TCustomComboBox; NewReadOnly: boolean); override;
class function GetItems(const ACustomComboBox: TCustomComboBox): TStrings; override;
class procedure Sort(const ACustomComboBox: TCustomComboBox; AList: TStrings; IsSorted: boolean); override;
@ -1091,6 +1092,20 @@ begin
RecreateWnd(ACustomComboBox);
end;
class procedure TWin32WSCustomComboBox.SetReadOnly(const ACustomComboBox: TCustomComboBox;
NewReadOnly: boolean);
var
Info: TComboboxInfo;
begin
if not ACustomComboBox.HandleAllocated then
Exit;
Info.cbSize := SizeOf(Info);
Win32Extra.GetComboBoxInfo(ACustomComboBox.Handle, @Info);
if (info.hwndItem<>0) and (info.hwndItem<>INVALID_HANDLE_VALUE) then
SendMessage(info.hwndItem, EM_SETREADONLY, WParam(NewReadOnly), 0);
end;
class function TWin32WSCustomComboBox.GetItemIndex(const ACustomComboBox: TCustomComboBox): integer;
begin
Result := SendMessage(ACustomComboBox.Handle, CB_GETCURSEL, 0, 0);

4
lcl/stdctrls.pp
View File

@ -299,6 +299,7 @@ type
FOnGetItems: TNotifyEvent;
FOnMeasureItem: TMeasureItemEvent;
FOnSelect: TNotifyEvent;
FReadOnly: Boolean;
FSelLength: integer;
FSelStart: integer;
FSorted: boolean;
@ -314,6 +315,7 @@ type
procedure LMMeasureItem(var TheMessage: TLMMeasureItem); message LM_MeasureItem;
procedure LMSelChange(var TheMessage); message LM_SelChange;
procedure CNCommand(var TheMessage: TLMCommand); message CN_Command;
procedure SetReadOnly(const AValue: Boolean);
procedure UpdateSorted;
procedure SetArrowKeysTraverseList(Value: Boolean);
procedure WMChar(var Message: TLMChar); message LM_CHAR;
@ -411,6 +413,7 @@ type
property DropDownCount: Integer read FDropDownCount write SetDropDownCount default 8;
property Items: TStrings read FItems write SetItems;
property ItemIndex: integer read GetItemIndex write SetItemIndex default -1;
property ReadOnly: Boolean read FReadOnly write SetReadOnly default False;
property SelLength: integer read GetSelLength write SetSelLength;// UTF-8 length
property SelStart: integer read GetSelStart write SetSelStart;// UTF-8 position
property SelText: String read GetSelText write SetSelText;
@ -486,6 +489,7 @@ type
property ParentFont;
property ParentShowHint;
property PopupMenu;
property ReadOnly;
property ShowHint;
property Sorted;
property Style;

6
lcl/widgetset/wsstdctrls.pp
View File

@ -86,6 +86,7 @@ type
class procedure SetItemIndex(const ACustomComboBox: TCustomComboBox; NewIndex: integer); virtual;
class procedure SetMaxLength(const ACustomComboBox: TCustomComboBox; NewLength: integer); virtual;
class procedure SetStyle(const ACustomComboBox: TCustomComboBox; NewStyle: TComboBoxStyle); virtual;
class procedure SetReadOnly(const ACustomComboBox: TCustomComboBox; NewReadOnly: boolean); virtual;
class function GetItems(const ACustomComboBox: TCustomComboBox): TStrings; virtual;
class procedure FreeItems(var AItems: TStrings); virtual;
@ -470,6 +471,11 @@ class procedure TWSCustomComboBox.SetStyle(const ACustomComboBox: TCustomComboBo
begin
end;
class procedure TWSCustomComboBox.SetReadOnly(const ACustomComboBox: TCustomComboBox;
NewReadOnly: boolean);
begin
end;
class function TWSCustomComboBox.GetItems(const ACustomComboBox: TCustomComboBox
): TStrings;
begin