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

applied listbox/combobox patch from Karl

Browse Source 
git-svn-id: trunk@4524 -
This commit is contained in:
mattias 2003-08-26 08:12:33 +00:00
parent 5073d76b3e
commit c771afd96b
14 changed files with 380 additions and 258 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

67
designer/objectinspector.pp
View File

@ -40,7 +40,7 @@ interface
uses
Forms, SysUtils, Buttons, Classes, Graphics, GraphType, StdCtrls, LCLType,
LCLLinux, LMessages, Controls, ComCtrls, ExtCtrls, TypInfo, Messages,
LResources, Laz_XMLCfg, Menus, Dialogs, ObjInspStrConsts,
LResources, PairSplitter, Laz_XMLCfg, Menus, Dialogs, ObjInspStrConsts,
PropEdits, GraphPropEdits, ListViewPropEdit, ImageListEditor,
ComponentTreeView;
@ -316,6 +316,8 @@ type
TObjectInspector = class (TForm)
AvailCompsComboBox: TComboBox;
PairSplitter1: TPairSplitter;
ComponentTree: TComponentTreeView;
NoteBook: TNoteBook;
PropertyGrid: TOIPropertyGrid;
EventGrid: TOIPropertyGrid;
@ -326,7 +328,6 @@ type
ShowHintsPopupMenuItem: TMenuItem;
ShowComponentTreePopupMenuItem: TMenuItem;
ShowOptionsPopupMenuItem: TMenuItem;
ComponentTree: TComponentTreeView;
procedure AvailComboBoxCloseUp(Sender: TObject);
procedure ComponentTreeSelectionChanged(Sender: TObject);
procedure OnBackgroundColPopupMenuItemClick(Sender :TObject);
@ -361,6 +362,7 @@ type
procedure HookGetSelectedComponents(Selection: TComponentSelectionList);
procedure SetShowComponentTree(const AValue: boolean);
procedure SetUsePairSplitter(const AValue: boolean);
procedure CreatePairSplitter;
public
constructor Create(AnOwner: TComponent); override;
destructor Destroy; override;
@ -2154,6 +2156,7 @@ begin
FComponentTreeHeight:=100;
{$IFDEF CompTree}
FShowComponentTree:=true;
FUsePairSplitter:=TPairSplitter.IsSupportedByInterface;
{$ENDIF}
// StatusBar
@ -2206,13 +2209,21 @@ begin
Visible:=not FShowComponentTree;
end;
if FUsePairSplitter and ShowComponentTree then
CreatePairSplitter;
// Component Tree at top (filled with available components)
ComponentTree:=TComponentTreeView.Create(Self);
with ComponentTree do begin
Name:='ComponentTree';
Height:=ComponentTreeHeight;
Parent:=Self;
Align:=alTop;
if PairSplitter1<>nil then begin
Parent:=PairSplitter1.Sides[0];
Align:=alClient;
end else begin
Parent:=Self;
Align:=alTop;
end;
OnSelectionChanged:=@ComponentTreeSelectionChanged;
Visible:=FShowComponentTree;
end;
@ -2221,7 +2232,12 @@ begin
NoteBook:=TNoteBook.Create(Self);
with NoteBook do begin
Name:='NoteBook';
Parent:=Self;
if PairSplitter1<>nil then begin
Parent:=PairSplitter1.Sides[1];
end else begin
Parent:=Self;
end;
Align:= alClient;
if PageCount>0 then
Pages.Strings[0]:=oisProperties
else
@ -2229,7 +2245,6 @@ begin
Pages.Add(oisEvents);
PageIndex:=0;
PopupMenu:=MainPopupMenu;
Align:= alClient;
end;
// property grid
@ -2502,8 +2517,6 @@ begin
if Execute then begin
PropertyGrid.BackgroundColor:=Color;
EventGrid.BackgroundColor:=Color;
PropertyGrid.Invalidate;
EventGrid.Invalidate;
end;
end;
finally
@ -2540,9 +2553,32 @@ begin
{$ENDIF}
if FShowComponentTree=AValue then exit;
FShowComponentTree:=AValue;
BeginUpdate;
ShowComponentTreePopupMenuItem.Checked:=FShowComponentTree;
writeln('TObjectInspector.SetShowComponentTree A ',FShowComponentTree);
ComponentTree.Visible:=FShowComponentTree;
AvailCompsComboBox.Visible:=not FShowComponentTree;
if FUsePairSplitter and FShowComponentTree then begin
CreatePairSplitter;
ComponentTree.Parent:=PairSplitter1.Sides[0];
ComponentTree.Align:=alClient;
NoteBook.Parent:=PairSplitter1.Sides[1];
NoteBook.Align:=alClient;
writeln('TObjectInspector.SetShowComponentTree B ',NoteBook.Parent.Name,':',NoteBook.Parent.ClassName,' ',
NoteBook.Visible,' ',NoteBook.Height,' ',NoteBook.Parent.ClientHeight,' ',
NoteBook.Parent.Height,' ',
PairSplitter1.Height,' ',NoteBook.HandleAllocated);
end else begin
PairSplitter1.Visible:=false;
ComponentTree.Parent:=Self;
ComponentTree.Align:=alTop;
ComponentTree.Height:=ComponentTreeHeight;
NoteBook.Parent:=Self;
NoteBook.Align:=alClient;
PairSplitter1.Free;
PairSplitter1:=nil;
end;
EndUpdate;
end;
procedure TObjectInspector.SetUsePairSplitter(const AValue: boolean);
@ -2551,6 +2587,21 @@ begin
FUsePairSplitter:=AValue;
end;
procedure TObjectInspector.CreatePairSplitter;
begin
// pair splitter between component tree and notebook
PairSplitter1:=TPairSplitter.Create(Self);
with PairSplitter1 do begin
Name:='PairSplitter1';
Parent:=Self;
SplitterType:=pstVertical;
Align:=alClient;
Position:=ComponentTreeHeight;
Sides[0].Name:=Name+'Side1';
Sides[1].Name:=Name+'Side2';
end;
end;
procedure TObjectInspector.OnShowHintPopupMenuItemClick(Sender : TObject);
begin
PropertyGrid.ShowHint:=not PropertyGrid.ShowHint;

1
designer/propedits.pp
View File

@ -3250,6 +3250,7 @@ end;
procedure TMethodPropertyEditor.GetValues(Proc: TGetStringProc);
begin
RaiseGDBException('TMethodPropertyEditor.GetValues');
writeln('### TMethodPropertyEditor.GetValues');
Proc('(None)');
PropertyHook.GetMethods(GetTypeData(GetPropType), Proc);

8
lcl/include/interfacebase.inc
View File

@ -1320,6 +1320,11 @@ begin
Result:=false;
end;
function TInterfaceBase.PairSplitterGetInterfaceInfo: boolean;
begin
Result:=false;
end;
function TInterfaceBase.PairSplitterRemoveSide(SplitterHandle, SideHandle: hWnd;
Side: integer): Boolean;
begin
@ -1822,6 +1827,9 @@ end;
{ =============================================================================
$Log$
Revision 1.102 2003/08/26 08:12:33 mattias
applied listbox/combobox patch from Karl
Revision 1.101 2003/08/25 16:43:32 mattias
moved many graphics types form graphtype.pp to graphics.pp

8
lcl/include/winapi.inc
View File

@ -731,6 +731,11 @@ begin
Result:=InterfaceObject.PairSplitterAddSide(SplitterHandle,SideHandle,Side);
end;
function PairSplitterGetInterfaceInfo: boolean;
begin
Result:=InterfaceObject.PairSplitterGetInterfaceInfo;
end;
function PairSplitterRemoveSide(SplitterHandle, SideHandle: hWnd;
Side: integer): Boolean;
begin
@ -1671,6 +1676,9 @@ end;
{ =============================================================================
$Log$
Revision 1.97 2003/08/26 08:12:33 mattias
applied listbox/combobox patch from Karl
Revision 1.96 2003/08/25 16:43:32 mattias
moved many graphics types form graphtype.pp to graphics.pp

4
lcl/include/winapih.inc
View File

@ -201,6 +201,7 @@ Procedure NotifyUserAtXY(const DialogCaption, DialogMessage : String; DialogType
//function OffsetRect --> independent
function PairSplitterAddSide(SplitterHandle, SideHandle: hWnd; Side: integer): Boolean; {$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF}
function PairSplitterGetInterfaceInfo: boolean; {$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF}
function PairSplitterRemoveSide(SplitterHandle, SideHandle: hWnd; Side: integer): Boolean; {$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF}
function PairSplitterSetPosition(SplitterHandle: hWnd; var NewPosition: integer): Boolean; {$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF}
function PeekMessage(var lpMsg : TMsg; Handle : HWND; wMsgFilterMin, wMsgFilterMax,wRemoveMsg : UINT): Boolean; {$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF}
@ -396,6 +397,9 @@ procedure RaiseLastOSError;
{ =============================================================================
$Log$
Revision 1.87 2003/08/26 08:12:33 mattias
applied listbox/combobox patch from Karl
Revision 1.86 2003/08/25 16:43:32 mattias
moved many graphics types form graphtype.pp to graphics.pp

11
lcl/interfaces/gtk/gtkwinapi.inc
View File

@ -5747,6 +5747,14 @@ begin
Result:=true;
end;
{------------------------------------------------------------------------------
function TgtkObject.PairSplitterGetInterfaceInfo: Boolean;
------------------------------------------------------------------------------}
function TgtkObject.PairSplitterGetInterfaceInfo: Boolean;
begin
Result:=true;
end;
{------------------------------------------------------------------------------
function TgtkObject.PairSplitterRemoveSide(SplitterHandle, SideHandle: hWnd;
Side: integer): Boolean;
@ -8701,6 +8709,9 @@ end;
{ =============================================================================
$Log$
Revision 1.270 2003/08/26 08:12:33 mattias
applied listbox/combobox patch from Karl
Revision 1.269 2003/08/18 19:24:18 mattias
fixed TCanvas.Pie

4
lcl/interfaces/gtk/gtkwinapih.inc
View File

@ -140,6 +140,7 @@ function MoveToEx(DC: HDC; X, Y: Integer; OldPoint: PPoint): Boolean; override;
function MoveWindowOrgEx(DC: HDC; dX, dY: Integer): Boolean; override;
function PairSplitterAddSide(SplitterHandle, SideHandle: hWnd; Side: integer): Boolean; override;
function PairSplitterGetInterfaceInfo: Boolean; override;
function PairSplitterRemoveSide(SplitterHandle, SideHandle: hWnd; Side: integer): Boolean; override;
function PairSplitterSetPosition(SplitterHandle: hWnd; var NewPosition: integer): Boolean; override;
function PeekMessage(var lpMsg : TMsg; Handle : HWND; wMsgFilterMin, wMsgFilterMax,wRemoveMsg : UINT): Boolean; override;
@ -211,6 +212,9 @@ Procedure DeleteCriticalSection(var CritSection: TCriticalSection); Override;
{ =============================================================================
$Log$
Revision 1.76 2003/08/26 08:12:33 mattias
applied listbox/combobox patch from Karl
Revision 1.75 2003/08/18 19:24:18 mattias
fixed TCanvas.Pie

6
lcl/interfaces/win32/win32int.pp
View File

@ -95,7 +95,8 @@ Type
Procedure GetPixel(Sender: TObject; Data: Pointer);
Function GetValue (Sender: TObject; Data: Pointer): Integer;
Function SetValue (Sender: TObject; Data: Pointer): Integer;
Function SetProperties (Sender: TObject): Integer;
Function SetProperties(Sender: TObject): Integer;
procedure SetSelectionMode(Sender: TObject);
Procedure AttachMenu(Sender: TObject);
Function WinRegister: Boolean;
@ -190,6 +191,9 @@ End.
{ =============================================================================
$Log$
Revision 1.35 2003/08/26 08:12:33 mattias
applied listbox/combobox patch from Karl
Revision 1.34 2003/08/26 07:04:04 mattias
fixed win32int

24
lcl/interfaces/win32/win32listsl.inc
View File

@ -41,7 +41,7 @@ Begin
end;
Procedure SetComboHeight(Sender: TObject;
ALeft, ATop, AWidth, AHeight, AEditHeight:Integer);
ALeft, ATop, AWidth, AHeight:Integer);
var
ComboHandle: HWnd;
begin
@ -50,6 +50,7 @@ begin
MoveWindow(ComboHandle,ALeft,ATop,AWidth,AHeight,true);
LCLControlSizeNeedsUpdate(Sender,true);
end;
{*************************************************************}
{ TWin32ListStringList methods }
{*************************************************************}
@ -86,8 +87,8 @@ Begin
Windows.GetClientRect(FWin32List,@R);
FEditHeight:= R.Bottom;
FItemHeight:= SendMessage(FWin32List,CB_GETITEMHEIGHT,0,0);
FDropDownCount:= TComboBox(TheOwner).DropDownCount;
If FDropDownCount = 0 then FDropDownCount:= 8;
FDDownCount:= TComboBox(FSender).DropDownCount;
If FDDownCount = 0 then FDDownCount:= 8;
end;
csListBox:begin
FFlagSort:=LBS_SORT;
@ -128,7 +129,7 @@ End;
------------------------------------------------------------------------------}
Procedure TWin32ListStringList.Sort;
Begin
RecreateListControl(FWin32List,FSender,FSorted);
//RecreateListControl(FWin32List,FSender,FSorted);
End;
{------------------------------------------------------------------------------
@ -150,9 +151,9 @@ Begin
if FSender.FCompStyle=csComboBox Then
begin
if Count = 0 then
SetComboHeight(FSender,FSender.Left,FSender.Top,FSender.Width,FEditHeight + FItemHeight + 2,FEditHeight)
SetComboHeight(FSender,FSender.Left,FSender.Top,FSender.Width,FEditHeight + FItemHeight + 2)
else
SetComboHeight(FSender,FSender.Left,FSender.Top,FSender.Width,FEditHeight + FDropDownCount*FItemHeight + 2,FEditHeight);
SetComboHeight(FSender,FSender.Left,FSender.Top,FSender.Width,FEditHeight + FDDownCount*FItemHeight + 2);
end;
End
Else
@ -201,7 +202,7 @@ Procedure TWin32ListStringList.Clear;
Begin
if FSender.FCompStyle=csComboBox Then
SetComboHeight(FSender,FSender.Left,FSender.Top,FSender.Width,
FEditHeight + FItemHeight + 2,FEditHeight);
FEditHeight + FItemHeight + 2);
SendMessage(FWin32List,FFlagResetContent, 0, 0);
End;
@ -216,7 +217,7 @@ Begin
If (FSender.FCompStyle = csComboBox)
and (GetCount <= 1) Then
SetComboHeight(FSender,FSender.Left,FSender.Top,FSender.Width,
FEditHeight + FItemHeight + 2,FEditHeight);
FEditHeight + FItemHeight + 2);
SendMessage(FWin32List,FFlagDeleteString, Index, 0);
End;
@ -231,7 +232,7 @@ Begin
If (FSender.FCompStyle = csComboBox)
and (GetCount = 0) Then
SetComboHeight(FSender,FSender.Left,FSender.Top,FSender.Width,
FEditHeight + FItemHeight + 2,FEditHeight);
FEditHeight + FDDownCount*FItemHeight + 2);
If FSorted Then
SendMessage(FWin32List,FFlagAddString, 0, LPARAM(PChar(S)))
Else
@ -282,7 +283,7 @@ End;
Procedure TWin32CListStringList.Sort;
Begin
// The win api doesn't allow to change the sort on the fly, so is needed to recreate the window
RecreateListControl(FWin32CList,FSender,FSorted);
//RecreateListControl(FWin32CList,FSender,FSorted);
End;
{------------------------------------------------------------------------------
@ -405,6 +406,9 @@ End;
{ =============================================================================
$Log$
Revision 1.16 2003/08/26 08:12:33 mattias
applied listbox/combobox patch from Karl
Revision 1.15 2003/08/23 21:17:09 mattias
several fixes for the win32 intf, added pending OnResize events

5
lcl/interfaces/win32/win32listslh.inc
View File

@ -32,7 +32,7 @@ Type
FSender: TControl;
FEditHeight: Integer;
FItemHeight: Integer;
FDropDownCount: Integer;
FDDownCount: Integer;
//Win32 Flags
FFlagSort: Cardinal;
FFlagGetText:Cardinal;
@ -86,6 +86,9 @@ Type
{ =============================================================================
$Log$
Revision 1.9 2003/08/26 08:12:33 mattias
applied listbox/combobox patch from Karl
Revision 1.8 2003/08/13 21:23:10 mattias
fixed log

290
lcl/interfaces/win32/win32object.inc
View File

@ -983,17 +983,7 @@ activate_time : the time at which the activation event occurred.
End;
End;
LM_SETSELMODE:
If (Sender is TCustomListBox) And Assigned(data) Then
Begin
//The win32 api doesn't change the selection mode on the fly: it needs recreate the window
//RecreateWnd(Sender); -> cause endless loop
//Recreates the window step by step
If TCustomListBox(Sender).FCompStyle = csListBox Then
RecreateListControl(Handle,TControl(Sender),TListBox(Sender).Sorted)
Else
RecreateListControl(Handle,TControl(Sender),TCListBox(Sender).Sorted);
End;
SetSelectionMode(Sender);
LM_SETBORDER:
Begin
@ -2592,141 +2582,146 @@ begin
Assert (False, 'Trace:WARNING: [TWin32Object.SetProperties] --> got nil pointer');
Case TControl(Sender).FCompStyle Of
csEdit:
With (TCustomEdit(Sender)) Do
Begin
SendMessage(Handle, EM_SETREADONLY, WPARAM(ReadOnly), 0);
SendMessage(Handle, EM_LIMITTEXT, MaxLength, 0);
End;
csListView:
Begin
With TCustomListView(Sender) Do
Begin
If ViewStyle = vsReport Then
Begin
For I := 0 To Columns.Count - 1 Do
Begin
With LVC Do
Begin
Mask := LVCF_FMT Or LVCF_TEXT Or LVCF_WIDTH;
Fmt := Integer(Columns.Items[I].Alignment);
CX := Columns.Items[I].Width;
PSzText := PChar(Columns.Items[I].Caption);
End;
ListView_SetColumn(Handle, I, LVC);
End;
End;
//If Sorted Then
//ListView_SortItems(Handle, @CompareFunc, 0);
If MultiSelect Then
SetWindowLong(Handle, GWL_STYLE, GetWindowLong(Handle, GWL_STYLE) And Not LVS_SINGLESEL);
If SmallImages <> Nil Then
ListView_SetImageList(Handle, SmallImages.Handle, LVSIL_NORMAL);
End;
End;
csProgressBar:
With (TProgressBar(Sender)) Do
Begin
{ smooth and vertical need window recreation }
if ((GetWindowLong(Handle, GWL_STYLE) and PBS_SMOOTH ) <>
Integer(Smooth) * PBS_SMOOTH) or
((GetWindowLong(Handle, GWL_STYLE) and PBS_VERTICAL) <>
Integer((Orientation = pbVertical) or (Orientation = pbTopDown)) * PBS_VERTICAL) then
Self.RecreateWnd(Sender);
SendMessage(Handle, PBM_SETRANGE, 0, MakeLParam(Min, Max));
SendMessage(Handle, PBM_SETPOS, Position, 0);
csEdit:
With (TCustomEdit(Sender)) Do
Begin
SendMessage(Handle, EM_SETREADONLY, WPARAM(ReadOnly), 0);
SendMessage(Handle, EM_LIMITTEXT, MaxLength, 0);
End;
csListView:
With TCustomListView(Sender) Do
Begin
If ViewStyle = vsReport Then
Begin
For I := 0 To Columns.Count - 1 Do
Begin
With LVC Do
Begin
Mask := LVCF_FMT Or LVCF_TEXT Or LVCF_WIDTH;
Fmt := Integer(Columns.Items[I].Alignment);
CX := Columns.Items[I].Width;
PSzText := PChar(Columns.Items[I].Caption);
End;
ListView_SetColumn(Handle, I, LVC);
End;
End;
//If Sorted Then
//ListView_SortItems(Handle, @CompareFunc, 0);
If MultiSelect Then
SetWindowLong(Handle, GWL_STYLE, GetWindowLong(Handle, GWL_STYLE) And Not LVS_SINGLESEL);
If SmallImages <> Nil Then
ListView_SetImageList(Handle, SmallImages.Handle, LVSIL_NORMAL);
End;
csProgressBar:
With (TProgressBar(Sender)) Do
Begin
{ smooth and vertical need window recreation }
if ((GetWindowLong(Handle, GWL_STYLE) and PBS_SMOOTH ) <>
Integer(Smooth) * PBS_SMOOTH) or
((GetWindowLong(Handle, GWL_STYLE) and PBS_VERTICAL) <>
Integer((Orientation = pbVertical) or (Orientation = pbTopDown)) * PBS_VERTICAL) then
Self.RecreateWnd(Sender);
SendMessage(Handle, PBM_SETRANGE, 0, MakeLParam(Min, Max));
SendMessage(Handle, PBM_SETPOS, Position, 0);
{ TODO: Implementable?
If BarShowText Then
Begin
SetWindowText(Handle, StrToPChar((Sender As TControl).Caption));
End
Else
SetWindowText(Handle, Nil);
If BarShowText Then
Begin
SetWindowText(Handle, StrToPChar((Sender As TControl).Caption));
End
Else
SetWindowText(Handle, Nil);
}
End;
csScrollBar:
With (TScrollBar(Sender)) Do
Begin
SendMessage(Handle, SBM_SETRANGE, Min, Max);
SendMessage(Handle, SBM_SETPOS, Position, LPARAM(True));
Case Kind Of
sbHorizontal:
SetWindowLong(Handle, GWL_STYLE, GetWindowLong(Handle, GWL_STYLE) Or SBS_HORZ);
sbVertical:
SetWindowLong(Handle, GWL_STYLE, GetWindowLong(Handle, GWL_STYLE) Or SBS_VERT);
End;
Assert(False, 'Trace:TODO: [TWin32Object.SetProperties] Set up step and page increments for csScrollBar');
csScrollBar:
With (TScrollBar(Sender)) Do
Begin
SendMessage(Handle, SBM_SETRANGE, Min, Max);
SendMessage(Handle, SBM_SETPOS, Position, LPARAM(True));
Case Kind Of
sbHorizontal:
SetWindowLong(Handle, GWL_STYLE, GetWindowLong(Handle, GWL_STYLE) Or SBS_HORZ);
sbVertical:
SetWindowLong(Handle, GWL_STYLE, GetWindowLong(Handle, GWL_STYLE) Or SBS_VERT);
End;
csSpinEdit:
Assert(False, 'Trace:TODO: [TWin32Object.SetProperties] Set up step and page increments for csScrollBar');
End;
csSpinEdit:
Begin
SendMessage(Handle, UDM_SETPOS, 0, MakeLong(Trunc(TSpinEdit(Sender).Value), 0));
End;
csTrackbar:
With(TTrackBar(Sender)) Do
Begin
SendMessage(Handle, TBM_SETRANGEMAX, WPARAM(True), Max);
SendMessage(Handle, TBM_SETRANGEMIN, WPARAM(True), Min);
SendMessage(Handle, TBM_SETPOS, WPARAM(True), Position);
SendMessage(Handle, TBM_SETLINESIZE, 0, LineSize);
SendMessage(Handle, TBM_SETPAGESIZE, 0, PageSize);
Case Orientation Of
trVertical:
SetWindowLong(Handle, GWL_STYLE, GetWindowLong(Handle, GWL_STYLE) Or TBS_VERT);
trHorizontal:
SetWindowLong(Handle, GWL_STYLE, GetWindowLong(Handle, GWL_STYLE) Or TBS_HORZ);
End;
If ShowScale Then
Begin
Case ScalePos of
trLeft:
SetWindowLong(Handle, GWL_STYLE, GetWindowLong(Handle, GWL_STYLE) Or TBS_LEFT Or TBS_VERT);
trRight:
SetWindowLong(Handle, GWL_STYLE, GetWindowLong(Handle, GWL_STYLE) Or TBS_RIGHT Or TBS_VERT);
trTop:
SetWindowLong(Handle, GWL_STYLE, GetWindowLong(Handle, GWL_STYLE) Or TBS_TOP Or TBS_HORZ);
trBottom:
SetWindowLong(Handle, GWL_STYLE, GetWindowLong(Handle, GWL_STYLE) Or TBS_BOTTOM Or TBS_HORZ);
End;
End;
//Not here (Delphi compatibility)
End;
csLabel:
With TLabel(Sender) Do
Begin
Case Alignment of
taLeftJustify:
Style := Style Or SS_LEFT;
taCenter:
Style := Style Or SS_CENTER;
taRightJustify:
Style := Style Or SS_CENTER;
Else
Style := STYLE Or SS_LEFT; // default, shouldn't happen
End;
Case Layout of
tlTop:
Style := Style Or BS_TOP;
tlCenter:
Style := Style Or BS_VCENTER;
tlBottom:
Style := Style Or BS_BOTTOM;
Else
Style := Style Or BS_BOTTOM; //default, shouldn't happen
End;
// Experimental wordwrapping support
If Wordwrap Then
Style := Style And Not SS_LEFTNOWORDWRAP
Else
Style := Style Or SS_LEFTNOWORDWRAP;
SetWindowLong(Handle, GWL_STYLE, GetWindowLong(Handle, GWL_STYLE) Or Style);
Assert(False, 'TRACE:Wordwrapping of labels is not currently implemented');
Assert(False, 'Trace:TODO: Code wordwrapping labels');
csTrackbar:
With(TTrackBar(Sender)) Do
Begin
SendMessage(Handle, TBM_SETRANGEMAX, WPARAM(True), Max);
SendMessage(Handle, TBM_SETRANGEMIN, WPARAM(True), Min);
SendMessage(Handle, TBM_SETPOS, WPARAM(True), Position);
SendMessage(Handle, TBM_SETLINESIZE, 0, LineSize);
SendMessage(Handle, TBM_SETPAGESIZE, 0, PageSize);
Case Orientation Of
trVertical:
SetWindowLong(Handle, GWL_STYLE, GetWindowLong(Handle, GWL_STYLE) Or TBS_VERT);
trHorizontal:
SetWindowLong(Handle, GWL_STYLE, GetWindowLong(Handle, GWL_STYLE) Or TBS_HORZ);
End;
Else
Assert (True, Format('WARNING: [TWin32Object.SetProperties] failed for %S', [Sender.ClassName]));
If ShowScale Then
Begin
Case ScalePos of
trLeft:
SetWindowLong(Handle, GWL_STYLE, GetWindowLong(Handle, GWL_STYLE) Or TBS_LEFT Or TBS_VERT);
trRight:
SetWindowLong(Handle, GWL_STYLE, GetWindowLong(Handle, GWL_STYLE) Or TBS_RIGHT Or TBS_VERT);
trTop:
SetWindowLong(Handle, GWL_STYLE, GetWindowLong(Handle, GWL_STYLE) Or TBS_TOP Or TBS_HORZ);
trBottom:
SetWindowLong(Handle, GWL_STYLE, GetWindowLong(Handle, GWL_STYLE) Or TBS_BOTTOM Or TBS_HORZ);
End;
End;
//Not here (Delphi compatibility)
End;
csLabel:
With TLabel(Sender) Do
Begin
Case Alignment of
taLeftJustify:
Style := Style Or SS_LEFT;
taCenter:
Style := Style Or SS_CENTER;
taRightJustify:
Style := Style Or SS_CENTER;
Else
Style := STYLE Or SS_LEFT; // default, shouldn't happen
End;
Case Layout of
tlTop:
Style := Style Or BS_TOP;
tlCenter:
Style := Style Or BS_VCENTER;
tlBottom:
Style := Style Or BS_BOTTOM;
Else
Style := Style Or BS_BOTTOM; //default, shouldn't happen
End;
// Experimental wordwrapping support
If Wordwrap Then
Style := Style And Not SS_LEFTNOWORDWRAP
Else
Style := Style Or SS_LEFTNOWORDWRAP;
SetWindowLong(Handle, GWL_STYLE, GetWindowLong(Handle, GWL_STYLE) Or Style);
Assert(False, 'TRACE:Wordwrapping of labels is not currently implemented');
Assert(False, 'Trace:TODO: Code wordwrapping labels');
End;
Else
Assert (True, Format('WARNING: [TWin32Object.SetProperties] failed for %S', [Sender.ClassName]));
End;
End;
@ -2795,6 +2790,28 @@ Begin
else SetLabel(Sender, LPSTR((Sender as TMenuItem).Caption));
End;
{------------------------------------------------------------------------------
Method: TWin32Object.SetSelectionMode
Params: Sender - a LCL control
Returns: Nothing
Sets multiselect.
------------------------------------------------------------------------------}
procedure TWin32Object.SetSelectionMode(Sender: TObject);
begin
If (Sender is TCustomListBox) then begin
//The win32 api doesn't change the selection mode on the fly: it needs recreate the window
//RecreateWnd(Sender); -> cause endless loop
//Recreates the window step by step
//If TCustomListBox(Sender).FCompStyle = csListBox Then
// RecreateListControl(Handle,TControl(Sender),TListBox(Sender).Sorted)
//Else
// RecreateListControl(Handle,TControl(Sender),TCListBox(Sender).Sorted);
End;
end;
{------------------------------------------------------------------------------
Method: TWin32Object.SetName
Params: Window - The window to which to assign a name
@ -2829,6 +2846,9 @@ End;
{
$Log$
Revision 1.96 2003/08/26 08:12:33 mattias
applied listbox/combobox patch from Karl
Revision 1.95 2003/08/25 16:18:16 mattias
fixed background color of TPanel and clicks of TSpeedButton from Micha

195
lcl/interfaces/win32/win32proc.inc
View File

@ -515,108 +515,100 @@ End;
Returns: nothing
------------------------------------------------------------------------------}
Procedure RecreateListControl(const ListHandle:HWND;const ListControl:TControl; ToSort:Boolean);
var List:TListBox;
CList:TCListBox;
Combo:TComboBox;
TempStrList:TStringList;
ParentHandle,NewHandle:HWND;
ListFlags: DWORD;
var
List:TCustomListBox; //TLocalCustomListBox;
Combo:TCustomComboBox; //TLocalCustomComboBox;
TempStrList:TStringList;
CurrentList:TStrings;
ParentHandle,NewHandle,Main_WndProc:HWND;
ListFlags: DWORD;
begin
TempStrList:=TStringList.Create;
ParentHandle:=ListControl.Parent.Handle;
// Remove Prop before destroy the window
RemoveProp(ListHandle,'Lazarus');
// Get current flags
ListFlags:=GetWindowLong(ListHandle, GWL_STYLE);
case ListControl.FCompStyle of
csListBox:
with List do
begin
List:=TListBox(ListControl);
TempStrList.Assign(Items);
If MultiSelect Then
begin
if ExtendedSelect then
ListFlags:=ListFlags or LBS_EXTENDEDSEL
else
ListFlags:=(ListFlags or LBS_MULTIPLESEL) and (not LBS_EXTENDEDSEL);
end
else ListFlags:=ListFlags and (not (LBS_MULTIPLESEL or LBS_EXTENDEDSEL));
If ToSort Then
ListFlags:=ListFlags or LBS_SORT
Else
ListFlags:=ListFlags and (not LBS_SORT);
DestroyWindow(ListHandle);
If BorderStyle = TBorderStyle(bsSingle) Then
NewHandle:= CreateWindowEx(WS_EX_CLIENTEDGE,'LISTBOX', Nil, ListFlags or WS_VSCROLL, Left, Top, Width, Height, ParentHandle, HMENU(Nil), HInstance, Nil)
Else
NewHandle:= CreateWindow('LISTBOX', Nil, ListFlags or WS_VSCROLL, Left, Top, Width, Height, ParentHandle, HMENU(Nil), HInstance, Nil);
Handle:=NewHandle;
SendMessage(NewHandle, WM_SETFONT, GetStockObject(DEFAULT_GUI_FONT), 0);
Items.Free;
Items:= TWin32ListStringList.Create(NewHandle,List);
Items.Assign(TempStrList);
end;
csCListBox:
with CList do
begin
CList:=TCListBox(ListControl);
TempStrList.Assign(Items);
If MultiSelect Then
begin
if ExtendedSelect then
ListFlags:=ListFlags or LBS_EXTENDEDSEL
else
ListFlags:=(ListFlags or LBS_MULTIPLESEL) and (not LBS_EXTENDEDSEL);
end
else ListFlags:=ListFlags and (not (LBS_MULTIPLESEL or LBS_EXTENDEDSEL));
If ToSort Then
ListFlags:=ListFlags or LBS_SORT
Else
ListFlags:=ListFlags and (not LBS_SORT);
DestroyWindow(ListHandle);
If BorderStyle = TBorderStyle(bsSingle) Then
NewHandle := CreateWindowEx(WS_EX_CLIENTEDGE,'LISTBOX', Nil, ListFlags Or LBS_MULTICOLUMN or WS_HSCROLL, Left, Top, Width, Height, ParentHandle, HMENU(Nil), HInstance, Nil)
Else
NewHandle:= CreateWindow('LISTBOX', Nil, ListFlags Or LBS_MULTICOLUMN or WS_HSCROLL, Left, Top, Width, Height, ParentHandle, HMENU(Nil), HInstance, Nil);
Handle:=NewHandle;
SendMessage(NewHandle, WM_SETFONT, GetStockObject(DEFAULT_GUI_FONT), 0);
Items.Free;
Items:= TWin32CListStringList.Create(NewHandle,CList);
Items.Assign(TempStrList);
end;
csComboBox:with Combo do
begin
Combo:=TComboBox(ListControl);
TempStrList.Assign(Items);
If ToSort Then
ListFlags:=ListFlags or CBS_SORT
Else
ListFlags:=ListFlags and (not CBS_SORT);
DestroyWindow(ListHandle);
NewHandle:= CreateWindow('COMBOBOX', Nil, ListFlags or WS_VSCROLL, Left, Top, Width, Height, ParentHandle, HMENU(Nil), HInstance, Nil);
Handle:=NewHandle;
SendMessage(NewHandle, WM_SETFONT, GetStockObject(DEFAULT_GUI_FONT), 0);
Items.Free;
Items:= TWin32ListStringList.Create(NewHandle,Combo);
Items.Assign(TempStrList);
end;
end;
TempStrList.Free;
// Set the new window properties
SetProp(NewHandle,'Lazarus',ListControl);
TempStrList:=TStringList.Create;
ParentHandle:=ListControl.Parent.Handle;
// Get current flags
ListFlags:=GetWindowLong(ListHandle, GWL_STYLE);
// Stores WindowProc and reset to default to avoid LM_DESTROY
Main_WndProc:=SetWindowLong(ListHandle, GWL_WNDPROC,Integer(GetProp(ListHandle,'DefWndProc')));
Writeln(CS_TO_STRING(ListControl.FCompStyle),' being recreated');
WriteLn('DefWndProc : ',Integer(GetProp(ListHandle, 'DefWndProc')));
WriteLn('MainWindow proc: ',Main_WndProc);
// Remove Prop before destroy the window
RemoveProp(ListHandle,'Lazarus');
RemoveProp(ListHandle,'DefWndProc');
RemoveProp(ListHandle,'Sender');
If ListControl.FCompStyle = csComboBox then begin
Combo:=TCustomComboBox(ListControl);
with Combo do
begin
CurrentList:=Items;
TempStrList.Assign(Items);
If ToSort Then
ListFlags:=ListFlags or CBS_SORT
Else
ListFlags:=ListFlags and (not CBS_SORT);
DestroyWindow(ListHandle);
NewHandle:= CreateWindow('COMBOBOX', Nil, ListFlags or WS_VSCROLL, Left, Top, Width, Height, ParentHandle, HMENU(Nil), HInstance, Nil);
end;
end
Else Begin {csListBox or csCListBox}
List:=TCustomListBox(ListControl);
with List do
begin
CurrentList:=Items;
TempStrList.Assign(Items);
If MultiSelect Then begin
if ExtendedSelect then
ListFlags:=ListFlags or LBS_EXTENDEDSEL
else
ListFlags:=(ListFlags or LBS_MULTIPLESEL) and (not LBS_EXTENDEDSEL);
end
else
ListFlags:=ListFlags and (not (LBS_MULTIPLESEL or LBS_EXTENDEDSEL));
If ToSort Then
ListFlags:=ListFlags or LBS_SORT
Else
ListFlags:=ListFlags and (not LBS_SORT);
DestroyWindow(ListHandle);
If FCompStyle = csListBox then
ListFlags:= ListFlags or WS_VSCROLL or WS_HSCROLL
Else
ListFlags:= ListFlags Or LBS_MULTICOLUMN or WS_HSCROLL;
If BorderStyle = TBorderStyle(bsSingle) Then
NewHandle:= CreateWindowEx(WS_EX_CLIENTEDGE,'LISTBOX', Nil, ListFlags, Left, Top, Width, Height, ParentHandle, HMENU(Nil), HInstance, Nil)
Else
NewHandle:= CreateWindowEx(WS_EX_CLIENTEDGE,'LISTBOX', Nil, ListFlags, Left, Top, Width, Height, ParentHandle, HMENU(Nil), HInstance, Nil);
end;
end;
// Set the properties in the same order as in CreateComponent
SetProp(NewHandle,'Lazarus',ListControl);
TWinControl(ListControl).Handle:=NewHandle;
SetProp(NewHandle,'Sender',@ListControl);
Windows.SetProp(NewHandle, 'DefWndProc',SetWindowLong (NewHandle, GWL_WNDPROC, Main_WndProc));
SendMessage(NewHandle, WM_SETFONT, GetStockObject(DEFAULT_GUI_FONT), 0);
//Change Window handle at TWin32ListStringList
If ListControl.FCompStyle = csListBox then begin
TWin32ListStringList(CurrentList).FWin32List:=NewHandle;
TWin32ListStringList(CurrentList).Assign(TempStrList);
end
Else begin
TWin32CListStringList(CurrentList).FWin32CList:=NewHandle;
TWin32CListStringList(CurrentList).Assign(TempStrList);
end;
WriteLn('Values after handle Recreation');
WriteLn('DefWndProc: ',Integer(GetProp(NewHandle, 'DefWndProc')));
WriteLn('New WNDPROC Style: ',GetWindowLong(NewHandle, GWL_WNDPROC));
TempStrList.Free;
end;
(***********************************************************************
Widget member Functions
************************************************************************)
@ -795,6 +787,9 @@ End;
{ =============================================================================
$Log$
Revision 1.22 2003/08/26 08:12:33 mattias
applied listbox/combobox patch from Karl
Revision 1.21 2003/08/23 21:17:09 mattias
several fixes for the win32 intf, added pending OnResize events

6
lcl/pairsplitter.pas
View File

@ -103,6 +103,7 @@ type
procedure UpdatePosition;
procedure CreateSides;
procedure Loaded; override;
class function IsSupportedByInterface: boolean;
public
property Sides[Index: integer]: TPairSplitterSide read GetSides;
property SplitterType: TPairSplitterType read FSplitterType
@ -354,5 +355,10 @@ begin
PairSplitterSetPosition(Handle,FPosition);
end;
function TCustomPairSplitter.IsSupportedByInterface: boolean;
begin
Result:=PairSplitterGetInterfaceInfo;
end;
end.

9
lcl/stdctrls.pp
View File

@ -376,8 +376,8 @@ type
State: TOwnerDrawState); virtual;
protected
property ExtendedSelect : boolean read FExtendedSelect write SetExtendedSelect;
property Sorted : boolean read FSorted write SetSorted;
property Style : TListBoxStyle read FStyle write SetStyle;
property Sorted: boolean read FSorted write SetSorted;
property Style: TListBoxStyle read FStyle write SetStyle;
property ItemHeight: Integer read GetItemHeight write SetItemHeight;
property OnDrawItem: TDrawItemEvent read FOnDrawItem write FOnDrawItem;
public
@ -389,7 +389,7 @@ type
property Canvas: TCanvas read FCanvas;
property ItemIndex : integer read GetItemIndex write SetItemIndex;
property Items : TStrings read FItems write SetItems;
property MultiSelect : boolean read FMultiSelect write SetMultiSelect;
property MultiSelect: boolean read FMultiSelect write SetMultiSelect;
property SelCount : integer read GetSelCount;
property Selected[Index: integer]: boolean read GetSelected write SetSelected;
property TopIndex: Integer read GetTopIndex write SetTopIndex;
@ -1464,6 +1464,9 @@ end.
{ =============================================================================
$Log$
Revision 1.102 2003/08/26 08:12:33 mattias
applied listbox/combobox patch from Karl
Revision 1.101 2003/07/30 13:03:44 mattias
replaced label with memo