paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-12-16 00:40:43 +01:00
Code Issues Packages Projects Releases Wiki Activity

implemented TPairSplitter

Browse Source 
git-svn-id: trunk@3225 -
This commit is contained in:
mattias 2002-08-19 15:15:24 +00:00
parent b027a05a07
commit 907efa7e6e
15 changed files with 542 additions and 38 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
.gitattributes vendored
View File

@ -730,6 +730,7 @@ lcl/lresources.pp svneol=native#text/pascal
lcl/maskedit.pp svneol=native#text/pascal
lcl/menus.pp svneol=native#text/pascal
lcl/messages.pp svneol=native#text/pascal
lcl/pairsplitter.pas svneol=native#text/pascal
lcl/postscriptprinter.pas svneol=native#text/pascal
lcl/printers.pas svneol=native#text/pascal
lcl/registry.pp svneol=native#text/pascal

5
lcl/allunits.pp
View File

@ -38,7 +38,7 @@ uses
Buttons, Extctrls, Registry, Calendar, Clipbrd, Forms, LCLLinux, Spin,
Comctrls, Graphics, StdCtrls, Arrow, Controls, ImgList, Menus, Toolwin,
Dialogs, Messages, Clistbox, ActnList, Grids, MaskEdit,
Printers, PostScriptPrinter, CheckLst;
Printers, PostScriptPrinter, CheckLst, PairSplitter;
implementation
@ -47,6 +47,9 @@ end.
{ =============================================================================
$Log$
Revision 1.23 2002/08/19 15:15:23 mattias
implemented TPairSplitter
Revision 1.22 2003/06/20 01:37:47 marc
+ Added TCheckListBox component

5
lcl/controls.pp
View File

@ -565,7 +565,7 @@ type
procedure DoDragMsg(var Dragmsg : TCMDrag);
procedure DoMouseDown(var Message: TLMMouse; Button: TMouseButton; Shift:TShiftState);
procedure DoMouseUp(var Message: TLMMouse; Button: TMouseButton);
procedure SetAlign(Value : TAlign);
procedure SetAlign(Value: TAlign);
procedure SetBoundsRect(const ARect : TRect);
procedure SetClientHeight(Value: Integer);
procedure SetClientSize(Value: TPoint);
@ -1536,6 +1536,9 @@ end.
{ =============================================================================
$Log$
Revision 1.131 2002/08/19 15:15:23 mattias
implemented TPairSplitter
Revision 1.130 2002/08/17 23:41:34 mattias
many clipping fixes

4
lcl/extctrls.pp
View File

@ -72,7 +72,6 @@ type
procedure SetParent(AParent : TWinControl); override;
property Flags: TPageFlags read FFlags write FFlags;
public
procedure AddControl; override;
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
procedure AdjustClientRect(var ARect: TRect); override;
@ -754,6 +753,9 @@ end.
{
$Log$
Revision 1.66 2002/08/19 15:15:23 mattias
implemented TPairSplitter
Revision 1.65 2003/06/19 22:38:21 mattias
fixed update on changing package usage options

21
lcl/include/interfacebase.inc
View File

@ -1235,6 +1235,24 @@ Begin
Result:=SetWindowOrgEx(dc, P.x-dX, P.y-dY, @P);
end;
function TInterfaceBase.PairSplitterAddSide(SplitterHandle, SideHandle: hWnd;
Side: integer): Boolean;
begin
Result:=false;
end;
function TInterfaceBase.PairSplitterRemoveSide(SplitterHandle, SideHandle: hWnd;
Side: integer): Boolean;
begin
Result:=false;
end;
function TInterfaceBase.PairSplitterSetPosition(SplitterHandle: hWnd;
var NewPosition: integer): Boolean;
begin
Result:=false;
end;
function TInterfaceBase.PeekMessage(var lpMsg : TMsg; Handle : HWND;
wMsgFilterMin, wMsgFilterMax,wRemoveMsg : UINT): Boolean;
Begin
@ -1715,6 +1733,9 @@ end;
{ =============================================================================
$Log$
Revision 1.90 2002/08/19 15:15:23 mattias
implemented TPairSplitter
Revision 1.89 2002/08/18 00:03:45 mattias
fixed bitbtn image for NoToAll

19
lcl/include/page.inc
View File

@ -16,14 +16,6 @@
* *
*****************************************************************************
}
{------------------------------------------------------------------------------
TPage AddControl
------------------------------------------------------------------------------}
procedure TPage.AddControl;
begin
// nothing yet
end;
{------------------------------------------------------------------------------
TPage Constructor
------------------------------------------------------------------------------}
@ -42,7 +34,6 @@ begin
SetInitialBounds(0,0,120,100);
end;
{create the control}
fCompStyle := csPage;
Visible := False;
@ -67,13 +58,6 @@ begin
CNSendMessage(LM_NB_UpdateTab, Self, nil);
end;
{------------------------------------------------------------------------------
TPage Paint
------------------------------------------------------------------------------}
{procedure TPage.Paint;
begin
end;}
{------------------------------------------------------------------------------
TPage WMPaint
Params: a TLMPaint message
@ -157,6 +141,9 @@ end;
// included by extctrls.pp
{
$Log$
Revision 1.15 2002/08/19 15:15:23 mattias
implemented TPairSplitter
Revision 1.14 2003/06/11 22:29:42 mattias
fixed realizing bounds after loading form

28
lcl/include/winapi.inc
View File

@ -647,9 +647,30 @@ begin
Result := InterfaceObject.MoveWindowOrgEx(DC, dX, dY);
end;
function PeekMessage(var lpMsg : TMsg; Handle : HWND; wMsgFilterMin, wMsgFilterMax,wRemoveMsg : UINT): Boolean;
function PairSplitterAddSide(SplitterHandle, SideHandle: hWnd;
Side: integer): Boolean;
begin
Result := InterfaceObject.PeekMessage(lpMsg,Handle,wMsgFilterMin,wMsgFilterMax,wRemoveMsg);
Result:=InterfaceObject.PairSplitterAddSide(SplitterHandle,SideHandle,Side);
end;
function PairSplitterRemoveSide(SplitterHandle, SideHandle: hWnd;
Side: integer): Boolean;
begin
Result:=InterfaceObject.PairSplitterRemoveSide(SplitterHandle,SideHandle,
Side);
end;
function PairSplitterSetPosition(SplitterHandle: hWnd;
var NewPosition: integer): Boolean;
begin
Result:=InterfaceObject.PairSplitterSetPosition(SplitterHandle,NewPosition);
end;
function PeekMessage(var lpMsg : TMsg; Handle : HWND;
wMsgFilterMin, wMsgFilterMax,wRemoveMsg : UINT): Boolean;
begin
Result := InterfaceObject.PeekMessage(lpMsg,Handle,
wMsgFilterMin,wMsgFilterMax,wRemoveMsg);
end;
function Pie(DC: HDC; x,y,width,height,angle1,angle2 : Integer): Boolean;
@ -1594,6 +1615,9 @@ end;
{ =============================================================================
$Log$
Revision 1.83 2002/08/19 15:15:23 mattias
implemented TPairSplitter
Revision 1.82 2002/08/17 23:41:34 mattias
many clipping fixes

6
lcl/include/winapih.inc
View File

@ -186,6 +186,9 @@ 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 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}
function Pie(DC: HDC; x,y,width,height,angle1,angle2 : Integer): Boolean; {$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF}
function PolyBezier(DC: HDC; Points: PPoint; NumPts: Integer; Filled, Continuous: boolean): boolean; {$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF}
@ -380,6 +383,9 @@ procedure RaiseLastOSError;
{ =============================================================================
$Log$
Revision 1.76 2002/08/19 15:15:24 mattias
implemented TPairSplitter
Revision 1.75 2002/08/17 23:41:34 mattias
many clipping fixes

9
lcl/interfaces/gtk/gtkdef.pp
View File

@ -192,6 +192,11 @@ type
procedure Clear;
end;
TWinWidgetInfoFlag = (
wwiNotOnParentsClientArea
);
TWinWidgetInfoFlags = set of TWinWidgetInfoFlag;
// Info needed by the API of a HWND (=Widget)
PWinWidgetInfo = ^TWinWidgetInfo;
@ -203,6 +208,7 @@ type
ExStyle: Integer;
UserData: Integer;
EventMask: TGdkEventMask;
Flags: TWinWidgetInfoFlags;
end;
// clipboard
@ -443,6 +449,9 @@ end.
{ =============================================================================
$Log$
Revision 1.40 2002/08/19 15:15:24 mattias
implemented TPairSplitter
Revision 1.39 2002/08/17 23:41:34 mattias
many clipping fixes

9
lcl/interfaces/gtk/gtkint.pp
View File

@ -109,6 +109,8 @@ type
function CreateAPIWidget(AWinControl: TWinControl): PGtkWidget;
function CreateForm(ACustomForm: TCustomForm): PGtkWidget;
function CreateListView(ListViewObject: TObject): PGtkWidget;
function CreatePairSplitter(PairSplitterObject: TObject): PGtkWidget;
function CreateSimpleClientAreaWidget(Sender: TObject): PGtkWidget;
procedure CreateComponent(Sender : TObject);virtual;
procedure DestroyEmptySubmenu(Sender: TObject);virtual;
procedure DestroyLCLComponent(Sender: TObject);virtual;
@ -248,8 +250,8 @@ implementation
uses
Graphics, Buttons, Menus, GTKWinApiWindow, StdCtrls, ComCtrls, CListBox,
KeyMap, Calendar, Arrow, Spin, CommCtrl, ExtCtrls, Dialogs, FileCtrl,
LResources, Math, gtkglobals, gtkproc;
KeyMap, Calendar, Arrow, Spin, PairSplitter, CommCtrl, ExtCtrls, Dialogs,
FileCtrl, LResources, Math, gtkglobals, gtkproc;
{$I gtklistsl.inc}
@ -343,6 +345,9 @@ end.
{ =============================================================================
$Log$
Revision 1.131 2002/08/19 15:15:24 mattias
implemented TPairSplitter
Revision 1.130 2002/08/17 23:41:34 mattias
many clipping fixes

72
lcl/interfaces/gtk/gtkobject.inc
View File

@ -594,6 +594,7 @@ procedure TgtkObject.SendCachedLCLMessages;
IsTopLevelWidget: boolean;
TopologicalList: TList; // list of PGtkWidget;
i, LCLWidth, LCLHeight: integer;
WinWidgetInfo: PWinWidgetInfo;
procedure WriteBigWarning;
begin
@ -661,8 +662,11 @@ procedure TgtkObject.SendCachedLCLMessages;
or GtkWidgetIsA(ParentFixed,GTK_LAYOUT_GET_TYPE) then begin
FixedMoveControl(ParentFixed, Widget,
LCLControl.Left, LCLControl.Top);
end else if not (LCLControl.Parent is TNoteBook) then begin
WriteWarningParentWidgetNotFound;
end else begin
WinWidgetInfo:=GetWidgetInfo(Widget,false);
if (WinWidgetInfo=nil)
or (not (wwiNotOnParentsClientArea in WinWidgetInfo^.Flags)) then
WriteWarningParentWidgetNotFound;
end;
end
else begin
@ -4666,6 +4670,48 @@ begin
Result:=MainWidget;
end;
{------------------------------------------------------------------------------
function TgtkObject.CreatePairSplitter(PairSplitterObject: TObject
): PGtkWidget;
Create a TCustomPairSplitter widget set
------------------------------------------------------------------------------}
function TgtkObject.CreatePairSplitter(PairSplitterObject: TObject
): PGtkWidget;
var
APairSplitter: TCustomPairSplitter;
PanedWidget: PGtkWidget;
begin
APairSplitter:=TCustomPairSplitter(PairSplitterObject);
// create the paned
if APairSplitter.SplitterType=pstHorizontal then
PanedWidget:=gtk_hpaned_new
else
PanedWidget:=gtk_vpaned_new;
Result:=PanedWidget;
end;
{------------------------------------------------------------------------------
function TgtkObject.CreateSimpleClientAreaWidget(Sender: TObject): PGtkWidget;
Create a fixed widget in a horizontal box
------------------------------------------------------------------------------}
function TgtkObject.CreateSimpleClientAreaWidget(Sender: TObject): PGtkWidget;
var
TempWidget: PGtkWidget;
WinWidgetInfo: PWinWidgetInfo;
begin
Result := gtk_hbox_new(false, 0);
TempWidget := gtk_fixed_new();
gtk_container_add(GTK_CONTAINER(Result), TempWidget);
gtk_widget_show(TempWidget);
WinWidgetInfo:=GetWidgetInfo(Result,true);
Include(WinWidgetInfo^.Flags,wwiNotOnParentsClientArea);
SetFixedWidget(Result, TempWidget);
SetMainWidget(Result, TempWidget);
gtk_widget_show(Result);
end;
{------------------------------------------------------------------------------
Function: TGTKObject.CreateComponent
Params: sender - object for which to create visual representation
@ -4678,7 +4724,7 @@ var
Caption : ansistring; // the caption of "Sender"
StrTemp : PChar; // same as "caption" but as PChar
TempWidget,
TempWidget2 : PGTKWidget; // pointer to gtk-widget (local use when neccessary)
TempWidget2 : PGTKWidget; // pointer to gtk-widget (local use when neccessary)
p : pointer; // ptr to the newly created GtkWidget
CompStyle, // componentstyle (type) of GtkWidget which will be created
TempInt : Integer; // local use when neccessary
@ -4972,16 +5018,13 @@ begin
end;
csPage: // TPage - Notebook page
begin
// create a fixed widget in a horizontal box
P := gtk_hbox_new(false, 0);
TempWidget := gtk_fixed_new();
gtk_container_add(GTK_CONTAINER(P), TempWidget);
gtk_widget_show(TempWidget);
SetFixedWidget(p, TempWidget);
SetMainWidget(p, TempWidget);
gtk_widget_show(P);
end;
P:=CreateSimpleClientAreaWidget(Sender);
csPairSplitter:
p:=CreatePairSplitter(Sender);
csPairSplitterSide:
P:=CreateSimpleClientAreaWidget(Sender);
csPanel:
begin
@ -7420,6 +7463,9 @@ end;
{ =============================================================================
$Log$
Revision 1.381 2002/08/19 15:15:24 mattias
implemented TPairSplitter
Revision 1.380 2002/08/18 16:50:09 mattias
fixes for debugging

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

@ -5562,6 +5562,51 @@ begin
end;
end;
{------------------------------------------------------------------------------
function TgtkObject.PairSplitterAddSide(SplitterHandle, SideHandle: hWnd;
Side: integer): Boolean;
------------------------------------------------------------------------------}
function TgtkObject.PairSplitterAddSide(SplitterHandle, SideHandle: hWnd;
Side: integer): Boolean;
begin
Result:=false;
if (SplitterHandle=0) or (SideHandle=0) or (Side<0) or (Side>1) then exit;
if Side=0 then
gtk_paned_add1(PGtkPaned(SplitterHandle),PGtkWidget(SideHandle))
else
gtk_paned_add2(PGtkPaned(SplitterHandle),PGtkWidget(SideHandle));
Result:=true;
end;
{------------------------------------------------------------------------------
function TgtkObject.PairSplitterRemoveSide(SplitterHandle, SideHandle: hWnd;
Side: integer): Boolean;
------------------------------------------------------------------------------}
function TgtkObject.PairSplitterRemoveSide(SplitterHandle, SideHandle: hWnd;
Side: integer): Boolean;
begin
Result:=false;
writeln('WARNING: TgtkObject.PairSplitterRemoveSide not implemented');
end;
{------------------------------------------------------------------------------
function TgtkObject.PairSplitterSetPosition(SplitterHandle: hWnd;
var NewPosition: integer): Boolean;
Negative values for NewPosition will only read the value
------------------------------------------------------------------------------}
function TgtkObject.PairSplitterSetPosition(SplitterHandle: hWnd;
var NewPosition: integer): Boolean;
begin
Result:=false;
if (SplitterHandle=0) then exit;
if NewPosition>=0 then
gtk_paned_set_position(PGtkPaned(SplitterHandle),NewPosition);
NewPosition:=PGtkPaned(SplitterHandle)^.child1_size;
Result:=true;
end;
{------------------------------------------------------------------------------
Function: PeekMessage
Params: lpMsg - Where it should put the message
@ -8436,6 +8481,9 @@ end;
{ =============================================================================
$Log$
Revision 1.250 2002/08/19 15:15:24 mattias
implemented TPairSplitter
Revision 1.249 2002/08/18 16:50:09 mattias
fixes for debugging

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

@ -132,6 +132,9 @@ function MessageBox(hWnd: HWND; lpText, lpCaption: PChar; uType: Cardinal): inte
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 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;
function Pie(DC: HDC; x,y,width,height,angle1,angle2 : Integer): Boolean; override;
function PolyBezier(DC: HDC; Points: PPoint; NumPts: Integer; Filled, Continuous: boolean): boolean; override;
@ -202,6 +205,9 @@ Procedure DeleteCriticalSection(var CritSection: TCriticalSection); Override;
{ =============================================================================
$Log$
Revision 1.69 2002/08/19 15:15:24 mattias
implemented TPairSplitter
Revision 1.68 2002/08/17 23:41:35 mattias
many clipping fixes

340
lcl/pairsplitter.pas Normal file
View File

@ -0,0 +1,340 @@
{ $Id$ }
{
/***************************************************************************
pairsplitter.pas
----------------
Component Library Controls
***************************************************************************/
*****************************************************************************
* *
* This file is part of the Lazarus Component Library (LCL) *
* *
* See the file COPYING.LCL, included in this distribution, *
* for details about the copyright. *
* *
* This program is distributed in the hope that it will be useful, *
* but WITHOUT ANY WARRANTY; without even the implied warranty of *
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. *
* *
*****************************************************************************
Author: Mattias Gaertner
Abstract:
TPairSplitter component. A component with two TPairSplitterSide childs.
Both child components can contain other components and the childs are
divided by a splitter which can be dragged by the user.
}
unit PairSplitter;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, LCLProc, LMessages, VCLGlobals, Graphics, LCLLinux,
Controls;
type
TCustomPairSplitter = class;
{ TPairSplitterSide }
TPairSplitterSide = class(TWinControl)
private
fCreatedBySplitter: boolean;
function GetSplitter: TCustomPairSplitter;
protected
procedure SetParent(AParent: TWinControl); override;
procedure WMPaint(var PaintMessage: TLMPaint); message LM_PAINT;
procedure Paint; virtual;
property Align;
property Anchors;
public
constructor Create(TheOwner: TComponent); override;
destructor Destroy; override;
public
property Splitter: TCustomPairSplitter read GetSplitter;
property Visible;
published
property Enabled;
property OnMouseDown;
property OnMouseMove;
property OnMouseUp;
property OnResize;
property ShowHint;
property ParentShowHint;
property PopupMenu;
end;
{ TCustomPairSplitter }
TPairSplitterType = (
pstHorizontal,
pstVertical
);
TCustomPairSplitter = class(TWinControl)
private
FPosition: integer;
FSides: array[0..1] of TPairSplitterSide;
FSplitterType: TPairSplitterType;
fDoNotCreateSides: boolean;
function GetPosition: integer;
function GetSides(Index: integer): TPairSplitterSide;
procedure SetPosition(const AValue: integer);
procedure SetSplitterType(const AValue: TPairSplitterType);
procedure AddSide(ASide: TPairSplitterSide);
procedure RemoveSide(ASide: TPairSplitterSide);
public
constructor Create(TheOwner: TComponent); override;
destructor Destroy; override;
procedure CreateWnd; override;
procedure UpdatePosition;
procedure CreateSides;
procedure Loaded; override;
public
property Sides[Index: integer]: TPairSplitterSide read GetSides;
property SplitterType: TPairSplitterType read FSplitterType
write SetSplitterType default pstHorizontal;
property Position: integer read GetPosition write SetPosition;
end;
{ TPairSplitter }
TPairSplitter = class(TCustomPairSplitter)
published
property Align;
property Anchors;
property Enabled;
property OnMouseDown;
property OnMouseMove;
property OnMouseUp;
property OnResize;
property OnChangeBounds;
property ShowHint;
property SplitterType;
property ParentShowHint;
property PopupMenu;
property Position;
property Visible;
end;
implementation
{ TPairSplitterSide }
function TPairSplitterSide.GetSplitter: TCustomPairSplitter;
begin
if (Parent<>nil) and (Parent is TCustomPairSplitter) then
Result:=TCustomPairSplitter(Parent)
else
Result:=nil;
end;
procedure TPairSplitterSide.SetParent(AParent: TWinControl);
var
ASplitter: TCustomPairSplitter;
begin
if (AParent<>nil) and (not (AParent is TCustomPairSplitter)) then
RaiseGDBException(
'TPairSplitterSide.SetParent Parent not TCustomPairSplitter');
// remove from side list of old parent
ASplitter:=Splitter;
if ASplitter<>nil then begin
ASplitter.RemoveSide(Self);
end;
inherited SetParent(AParent);
// add to side list of new parent
ASplitter:=Splitter;
if ASplitter<>nil then begin
ASplitter.AddSide(Self);
end;
end;
procedure TPairSplitterSide.WMPaint(var PaintMessage: TLMPaint);
begin
if (csDestroying in ComponentState) or (not HandleAllocated) then exit;
Include(FControlState, csCustomPaint);
inherited WMPaint(PaintMessage);
Paint;
Exclude(FControlState, csCustomPaint);
end;
procedure TPairSplitterSide.Paint;
var
ACanvas: TControlCanvas;
begin
if csDesigning in ComponentState then begin
ACanvas := TControlCanvas.Create;
with ACanvas do begin
Control := Self;
Pen.Color:=clRed;
Frame(0,0,Width-1,Height-1);
Free;
end;
end;
end;
constructor TPairSplitterSide.Create(TheOwner: TComponent);
begin
inherited Create(TheOwner);
FCompStyle := csPairSplitterSide;
ControlStyle:=ControlStyle+[csAcceptsControls];
end;
destructor TPairSplitterSide.Destroy;
begin
inherited Destroy;
end;
{ TCustomPairSplitter }
function TCustomPairSplitter.GetSides(Index: integer): TPairSplitterSide;
begin
if (Index<0) or (Index>1) then
RaiseGDBException('TCustomPairSplitter.GetSides: Index out of bounds');
Result:=FSides[Index];
end;
function TCustomPairSplitter.GetPosition: integer;
begin
if HandleAllocated and (not (csLoading in ComponentState)) then
UpdatePosition;
Result:=FPosition;
end;
procedure TCustomPairSplitter.SetPosition(const AValue: integer);
begin
if FPosition=AValue then exit;
FPosition:=AValue;
if FPosition<0 then
FPosition:=0;
if HandleAllocated and (not (csLoading in ComponentState)) then
PairSplitterSetPosition(Handle,FPosition);
end;
procedure TCustomPairSplitter.SetSplitterType(const AValue: TPairSplitterType);
begin
if FSplitterType=AValue then exit;
FSplitterType:=AValue;
RecreateWnd;
end;
procedure TCustomPairSplitter.AddSide(ASide: TPairSplitterSide);
var
i: Integer;
begin
if ASide=nil then exit;
i:=Low(FSides);
repeat
if FSides[i]=ASide then exit;
if FSides[i]=nil then begin
FSides[i]:=ASide;
if HandleAllocated then
PairSplitterAddSide(Handle,ASide.Handle,i);
break;
end;
inc(i);
if i>High(FSides) then
RaiseGDBException('TCustomPairSplitter.AddSide no free side left');
until false;
end;
procedure TCustomPairSplitter.RemoveSide(ASide: TPairSplitterSide);
var
i: Integer;
begin
if ASide=nil then exit;
for i:=Low(FSides) to High(FSides) do
if FSides[i]=ASide then begin
if HandleAllocated and ASide.HandleAllocated then
PairSplitterRemoveSide(Handle,ASide.Handle,i);
FSides[i]:=nil;
end;
// if the user deletes a side at designtime, autocreate a new one
if (csDesigning in ComponentState) and (not (csDestroying in ComponentState))
then
CreateSides;
end;
constructor TCustomPairSplitter.Create(TheOwner: TComponent);
begin
inherited Create(TheOwner);
FCompStyle := csPairSplitter;
ControlStyle:=ControlStyle-[csAcceptsControls];
FSplitterType:=pstHorizontal;
SetInitialBounds(0, 0, 50, 50);
if not (csLoading in ComponentState) then
CreateSides;
end;
destructor TCustomPairSplitter.Destroy;
var
i: Integer;
begin
// destroy the sides
fDoNotCreateSides:=true;
for i:=Low(FSides) to High(FSides) do
if (FSides[i]<>nil) and (FSides[i].fCreatedBySplitter) then
FSides[i].Free;
inherited Destroy;
end;
procedure TCustomPairSplitter.CreateWnd;
var
i: Integer;
begin
inherited CreateWnd;
for i:=Low(FSides) to High(FSides) do
if FSides[i]<>nil then
PairSplitterAddSide(Handle,FSides[i].Handle,i);
PairSplitterSetPosition(Handle,FPosition);
end;
procedure TCustomPairSplitter.UpdatePosition;
var
CurPosition: Integer;
begin
if HandleAllocated then begin
CurPosition:=-1;
PairSplitterSetPosition(Handle,CurPosition);
FPosition:=CurPosition;
end;
end;
procedure TCustomPairSplitter.CreateSides;
var
ASide: TPairSplitterSide;
i: Integer;
begin
if fDoNotCreateSides then exit;
// create the missing side controls
for i:=Low(FSides) to High(FSides) do
if FSides[i]=nil then begin
// For streaming it is important that the side controls are owned by
// the owner of the splitter
if (Owner<>nil) then
ASide:=TPairSplitterSide.Create(Owner)
else
ASide:=TPairSplitterSide.Create(Self);
ASide.fCreatedBySplitter:=true;
ASide.Parent:=Self;
end;
end;
procedure TCustomPairSplitter.Loaded;
begin
inherited Loaded;
CreateSides;
end;
end.

7
lcl/vclglobals.pp
View File

@ -95,9 +95,12 @@ const
csPanel = 51;
csScrollBox = 52;
csNonLCL = 53; // for non LCL controls, that create their own handles
csCheckListBox = 53;
csPairSplitter = 54;
csPairSplitterSide = 55;
csNonLCL = 56; // for non LCL controls, that create their own handles
csCheckListBox = 54;
const
{Mouse message key states}