mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-06-02 19:18:14 +02:00
expand and implement ReadOnly for win32
git-svn-id: trunk@8200 -
This commit is contained in:
parent
fb9ab660a7
commit
84afc58a43
@ -2159,6 +2159,7 @@ var
|
||||
IsFocused: Boolean;
|
||||
begin
|
||||
if csDestroying in AWinControl.ComponentState then Exit;
|
||||
if wcfCreatingHandle in AWinControl.FWinControlFlags then exit;
|
||||
|
||||
if not AWinControl.HandleAllocated
|
||||
then begin
|
||||
|
@ -26,12 +26,11 @@
|
||||
|
||||
Create the underlying interface-object.
|
||||
------------------------------------------------------------------------------}
|
||||
procedure TCustomComboBox.CreateWnd;
|
||||
procedure TCustomComboBox.InitializeWnd;
|
||||
var
|
||||
NewStrings: TStrings;
|
||||
ASelStart, ASelLength : integer;
|
||||
begin
|
||||
inherited CreateWnd;
|
||||
|
||||
// get the interface based item list
|
||||
NewStrings:= TWSCustomComboBoxClass(WidgetSetClass).GetItems(Self);
|
||||
// then delete internal list
|
||||
@ -47,6 +46,13 @@ begin
|
||||
TWSCustomComboBoxClass(WidgetSetClass).SetStyle(Self, FStyle);
|
||||
TWSCustomComboBoxClass(WidgetSetClass).SetArrowKeysTraverseList(Self, FArrowKeysTraverseList);
|
||||
TWSCustomComboBoxClass(WidgetSetClass).SetReadOnly(Self, FReadOnly);
|
||||
|
||||
if FSelStart <> FSelLength then begin
|
||||
ASelStart:= FSelStart;
|
||||
ASelLength:= FSelLength;
|
||||
SelStart:= ASelStart;
|
||||
SelLength:= ASelLength;
|
||||
end;
|
||||
end;
|
||||
|
||||
{------------------------------------------------------------------------------
|
||||
@ -93,26 +99,6 @@ begin
|
||||
end;
|
||||
end;
|
||||
|
||||
{------------------------------------------------------------------------------
|
||||
Method: TCustomComboBox.InitializeWnd
|
||||
Params: ---
|
||||
Returns: Nothing
|
||||
|
||||
Initialize window after it has been created.
|
||||
------------------------------------------------------------------------------}
|
||||
|
||||
procedure TCustomComboBox.InitializeWnd;
|
||||
var ASelStart, ASelLength : integer;
|
||||
begin
|
||||
inherited InitializeWnd;
|
||||
if FSelStart <> FSelLength then begin
|
||||
ASelStart:= FSelStart;
|
||||
ASelLength:= FSelLength;
|
||||
SelStart:= ASelStart;
|
||||
SelLength:= ASelLength;
|
||||
end;
|
||||
end;
|
||||
|
||||
{------------------------------------------------------------------------------
|
||||
Method: TCustomComboBox.SetSorted
|
||||
Params: val - true means "sort" the combo
|
||||
@ -359,6 +345,10 @@ procedure TCustomComboBox.SetStyle(Val : TComboBoxStyle);
|
||||
begin
|
||||
if Val <> FStyle then begin
|
||||
FStyle:= Val;
|
||||
case FStyle of
|
||||
csDropDown, csSimple: FReadOnly := false;
|
||||
csDropDownList: FReadOnly := true;
|
||||
end;
|
||||
if HandleAllocated and ([csLoading,csDestroying]*ComponentState=[]) then
|
||||
TWSCustomComboBoxClass(WidgetSetClass).SetStyle(Self, Val);
|
||||
end;
|
||||
@ -724,9 +714,6 @@ begin
|
||||
ItemIndex := I
|
||||
else if (not (csLoading in ComponentState)) then
|
||||
begin
|
||||
{$message warn TCustomComboBox.Editable to be implemented soon!}
|
||||
if Style in [csOwnerDrawFixed, csOwnerDrawVariable] then
|
||||
raise Exception.Create('Setting .Text on owner drawn TComboBox does not make sense!');
|
||||
FItemIndex := -1;
|
||||
inherited;
|
||||
end;
|
||||
@ -830,9 +817,19 @@ begin
|
||||
end;
|
||||
end;
|
||||
|
||||
function TCustomComboBox.IsReadOnlyStored: boolean;
|
||||
begin
|
||||
case FStyle of
|
||||
csSimple, csDropDown, csDropDownList: Result := false;
|
||||
else
|
||||
Result := FReadOnly <> false;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TCustomComboBox.SetReadOnly(const AValue: Boolean);
|
||||
begin
|
||||
if FReadOnly=AValue then exit;
|
||||
if FStyle in [csSimple, csDropDown, csDropDownList] then exit;
|
||||
FReadOnly:=AValue;
|
||||
if HandleAllocated then
|
||||
TWSCustomComboBoxClass(WidgetSetClass).SetReadOnly(Self, AValue);
|
||||
|
@ -569,12 +569,21 @@ end;
|
||||
{ TWin32WSCustomComboBox }
|
||||
|
||||
const
|
||||
ComboBoxStyles: array[TComboBoxStyle] of Integer = (
|
||||
CBS_DROPDOWN, CBS_SIMPLE, CBS_DROPDOWNLIST,
|
||||
CBS_DROPDOWNLIST or CBS_OWNERDRAWFIXED,
|
||||
CBS_DROPDOWNLIST or CBS_OWNERDRAWVARIABLE);
|
||||
ComboBoxStylesMask = CBS_DROPDOWN or CBS_DROPDOWN or CBS_DROPDOWNLIST or
|
||||
CBS_OWNERDRAWFIXED or CBS_OWNERDRAWVARIABLE;
|
||||
|
||||
function CalcComboBoxWinFlags(AComboBox: TCustomComboBox): dword;
|
||||
const
|
||||
ComboBoxStyles: array[TComboBoxStyle] of dword = (
|
||||
CBS_DROPDOWN, CBS_SIMPLE, CBS_DROPDOWNLIST,
|
||||
CBS_OWNERDRAWFIXED, CBS_OWNERDRAWVARIABLE);
|
||||
ComboBoxReadOnlyStyles: array[boolean] of dword = (
|
||||
CBS_DROPDOWN, CBS_DROPDOWNLIST);
|
||||
begin
|
||||
Result := ComboBoxStyles[AComboBox.Style];
|
||||
if AComboBox.Style in [csOwnerDrawFixed, csOwnerDrawVariable] then
|
||||
Result := Result or ComboBoxReadOnlyStyles[AComboBox.ReadOnly];
|
||||
end;
|
||||
|
||||
function TWin32WSCustomComboBox.CreateHandle(const AWinControl: TWinControl;
|
||||
const AParams: TCreateParams): HWND;
|
||||
@ -586,11 +595,11 @@ begin
|
||||
// customization of Params
|
||||
with Params do
|
||||
begin
|
||||
Flags := Flags or ComboBoxStyles[TCustomComboBox(AWinControl).Style];
|
||||
Flags := Flags or CalcComboBoxWinFlags(TCustomComboBox(AWinControl));
|
||||
If TComboBox(AWinControl).Sorted Then
|
||||
Flags:= Flags or CBS_SORT;
|
||||
pClassName := 'COMBOBOX';
|
||||
Flags := Flags or WS_VSCROLL or CBS_AUTOHSCROLL or CBS_HASSTRINGS;
|
||||
Flags := Flags or (WS_VSCROLL or CBS_AUTOHSCROLL or CBS_HASSTRINGS);
|
||||
SubClassWndProc := @ComboBoxWindowProc;
|
||||
end;
|
||||
// create window
|
||||
@ -641,11 +650,12 @@ end;
|
||||
|
||||
procedure TWin32WSCustomComboBox.SetStyle(const ACustomComboBox: TCustomComboBox; NewStyle: TComboBoxStyle);
|
||||
var
|
||||
CurrentStyle: Integer;
|
||||
CurrentStyle: dword;
|
||||
begin
|
||||
CurrentStyle := GetWindowLong(ACustomComboBox.Handle, GWL_STYLE);
|
||||
if (CurrentStyle and ComboBoxStylesMask)=
|
||||
ComboBoxStyles[TCustomComboBox(ACustomComboBox).Style] then exit;
|
||||
if (CurrentStyle and ComboBoxStylesMask) =
|
||||
CalcComboBoxWinFlags(ACustomComboBox) then
|
||||
exit;
|
||||
|
||||
RecreateWnd(ACustomComboBox);
|
||||
end;
|
||||
@ -716,7 +726,7 @@ var
|
||||
begin
|
||||
Assert(False, Format('Trace:TWin32WSCustomComboBox.SetText --> %S', [AText]));
|
||||
Handle := AWinControl.Handle;
|
||||
if TCustomComboBox(AWinControl).Style = csDropDownList then
|
||||
if TCustomComboBox(AWinControl).ReadOnly then
|
||||
Windows.SendMessage(Handle, CB_SELECTSTRING, -1, LPARAM(PChar(AText)))
|
||||
else
|
||||
Windows.SendMessage(Handle, WM_SETTEXT, 0, LPARAM(PChar(AText)));
|
||||
|
@ -261,7 +261,7 @@ type
|
||||
procedure SetArrowKeysTraverseList(Value: Boolean);
|
||||
procedure WMChar(var Message: TLMChar); message LM_CHAR;
|
||||
protected
|
||||
procedure CreateWnd; override;
|
||||
procedure InitializeWnd; override;
|
||||
procedure DestroyWnd; override;
|
||||
procedure DrawItem(Index: Integer; ARect: TRect;
|
||||
State: TOwnerDrawState); virtual;
|
||||
@ -279,8 +279,7 @@ type
|
||||
function GetSelText: string; virtual;
|
||||
function GetItemIndex: integer; virtual;
|
||||
function GetMaxLength: integer; virtual;
|
||||
procedure InitializeWnd; override;
|
||||
function SelectItem(const AnItem: String): Boolean;
|
||||
function IsReadOnlyStored: boolean;
|
||||
procedure SetDropDownCount(const AValue: Integer); virtual;
|
||||
procedure SetDroppedDown(const AValue: Boolean); virtual;
|
||||
procedure SetItemHeight(const AValue: Integer); virtual;
|
||||
@ -293,6 +292,7 @@ type
|
||||
procedure SetStyle(Val: TComboBoxStyle); virtual;
|
||||
procedure RealSetText(const AValue: TCaption); override;
|
||||
procedure KeyDown(var Key: Word; Shift: TShiftState); override;
|
||||
function SelectItem(const AnItem: String): Boolean;
|
||||
|
||||
property DropDownCount: Integer read FDropDownCount write SetDropDownCount default 8;
|
||||
property ItemHeight: Integer read GetItemHeight write SetItemHeight;
|
||||
@ -327,7 +327,7 @@ type
|
||||
property Canvas: TCanvas read FCanvas;
|
||||
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 ReadOnly: Boolean read FReadOnly write SetReadOnly stored IsReadOnlyStored;
|
||||
property SelLength: integer read GetSelLength write SetSelLength;
|
||||
property SelStart: integer read GetSelStart write SetSelStart;
|
||||
property SelText: String read GetSelText write SetSelText;
|
||||
|
Loading…
Reference in New Issue
Block a user