mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-04-18 13:09:35 +02:00
splitter and pairsplitter improvements:
1. ability to control pairsplitter cursor for gtk 2. ability to control pairsplitter internal splitter cursor for others 3. default values for pairsplitter cursor (crHSplit/crVSplit) 4. painting splitter through themes for win32/xp/gtk2 (disabled through -dUseThemes) 5. Clean up git-svn-id: trunk@11214 -
This commit is contained in:
paul
parent
469c195b08
commit
8eefc8e23f
lcl
@ -810,7 +810,6 @@ type
|
||||
FControlHandlers: array[TControlHandlerType] of TMethodList;
|
||||
FControlStyle: TControlStyle;
|
||||
FCtl3D: Boolean;
|
||||
FCursor: TCursor;
|
||||
FDockOrientation: TDockOrientation;
|
||||
FDragCursor: TCursor;
|
||||
FDragKind: TDragKind;
|
||||
@ -914,7 +913,6 @@ type
|
||||
procedure SetClientSize(const Value: TPoint);
|
||||
procedure SetClientWidth(Value: Integer);
|
||||
procedure SetConstraints(const Value: TSizeConstraints);
|
||||
procedure SetCursor(Value: TCursor);
|
||||
procedure SetDragCursor(const AValue: TCursor);
|
||||
procedure SetFont(Value: TFont);
|
||||
procedure SetHeight(Value: Integer);
|
||||
@ -934,6 +932,9 @@ type
|
||||
procedure SetWidth(Value: Integer);
|
||||
protected
|
||||
FControlState: TControlState;
|
||||
FCursor: TCursor;
|
||||
function GetCursor: TCursor; virtual;
|
||||
procedure SetCursor(Value: TCursor); virtual;
|
||||
protected
|
||||
// sizing/aligning
|
||||
AutoSizing: Boolean;
|
||||
@ -1303,7 +1304,7 @@ type
|
||||
property AnchorSideTop: TAnchorSide index 1 read GetAnchorSideIndex write SetAnchorSideIndex;
|
||||
property AnchorSideRight: TAnchorSide index 2 read GetAnchorSideIndex write SetAnchorSideIndex;
|
||||
property AnchorSideBottom: TAnchorSide index 3 read GetAnchorSideIndex write SetAnchorSideIndex;
|
||||
property Cursor: TCursor read FCursor write SetCursor default crDefault;
|
||||
property Cursor: TCursor read GetCursor write SetCursor default crDefault;
|
||||
property Left: Integer read FLeft write SetLeft;
|
||||
property Height: Integer read FHeight write SetHeight;
|
||||
property Hint: TTranslateString read FHint write SetHint;
|
||||
|
||||
@ -34,7 +34,7 @@ interface
|
||||
|
||||
uses
|
||||
SysUtils, Classes, LCLStrConsts, LCLType, LCLProc, LResources, Controls,
|
||||
Forms, StdCtrls, lMessages, GraphType, Graphics, LCLIntf, CustomTimer;
|
||||
Forms, StdCtrls, lMessages, GraphType, Graphics, LCLIntf, CustomTimer, Themes;
|
||||
|
||||
type
|
||||
{ workaround problem with fcl }
|
||||
@ -409,6 +409,7 @@ type
|
||||
FAutoSnap: boolean;
|
||||
FBeveled: boolean;
|
||||
FMinSize: integer;
|
||||
FMouseInControl: Boolean;
|
||||
FOnCanResize: TCanResizeEvent;
|
||||
FOnMoved: TNotifyEvent;
|
||||
FResizeAnchor: TAnchorKind;
|
||||
@ -424,17 +425,21 @@ type
|
||||
procedure SetResizeControl(const AValue: TControl);
|
||||
procedure SetResizeStyle(const AValue: TResizeStyle);
|
||||
protected
|
||||
procedure StartSplitterMove(const MouseXY: TPoint);
|
||||
procedure MouseDown(Button: TMouseButton; Shift:TShiftState; X,Y:Integer); override;
|
||||
procedure MouseMove(Shift: TShiftState; X,Y: Integer); override;
|
||||
procedure MouseUp(Button: TMouseButton; Shift:TShiftState; X,Y:Integer); override;
|
||||
function FindAlignControl: TControl;
|
||||
function FindAlignOtherControl: TControl;
|
||||
procedure SetAlign(Value: TAlign); override;
|
||||
procedure SetAnchors(const AValue: TAnchors); override;
|
||||
procedure CheckAlignment;
|
||||
function CheckNewSize(var NewSize: integer): boolean; virtual;
|
||||
function FindAlignControl: TControl;
|
||||
function FindAlignOtherControl: TControl;
|
||||
|
||||
procedure MouseDown(Button: TMouseButton; Shift:TShiftState; X,Y:Integer); override;
|
||||
procedure MouseEnter; override;
|
||||
procedure MouseLeave; override;
|
||||
procedure MouseMove(Shift: TShiftState; X,Y: Integer); override;
|
||||
procedure MouseUp(Button: TMouseButton; Shift:TShiftState; X,Y:Integer); override;
|
||||
|
||||
procedure Paint; override;
|
||||
procedure SetAlign(Value: TAlign); override;
|
||||
procedure SetAnchors(const AValue: TAnchors); override;
|
||||
procedure StartSplitterMove(const MouseXY: TPoint);
|
||||
public
|
||||
constructor Create(TheOwner: TComponent); override;
|
||||
procedure AnchorSplitter(Kind: TAnchorKind; AControl: TControl);
|
||||
|
||||
@ -2941,6 +2941,11 @@ begin
|
||||
SetBounds(FLeft, FTop, Max(0,Value), FHeight);
|
||||
end;
|
||||
|
||||
function TControl.GetCursor: TCursor;
|
||||
begin
|
||||
Result := FCursor;
|
||||
end;
|
||||
|
||||
{------------------------------------------------------------------------------
|
||||
TControl SetHeight
|
||||
------------------------------------------------------------------------------}
|
||||
|
||||
@ -677,23 +677,102 @@ begin
|
||||
end;
|
||||
|
||||
procedure TCustomSplitter.Paint;
|
||||
{$ifdef UseThemes}
|
||||
const
|
||||
GripperSize = 30; // todo: look at gtk size
|
||||
GripperDetailsPart: array[Boolean] of TThemedRebar =
|
||||
(
|
||||
trGripperVert,
|
||||
trGripper
|
||||
);
|
||||
var
|
||||
ARect, GripperRect: TRect;
|
||||
BgPart: TThemedRebar;
|
||||
BgDetails, GripperDetails: TThemedElementDetails;
|
||||
{$endif}
|
||||
begin
|
||||
inherited Paint;
|
||||
|
||||
{$ifdef UseThemes}
|
||||
ARect := ClientRect;
|
||||
GripperDetails := ThemeServices.GetElementDetails(GripperDetailsPart[ResizeAnchor in [akLeft,akRight]]);
|
||||
|
||||
if not Enabled then
|
||||
BgPart := trBandDisabled
|
||||
else
|
||||
if FMouseInControl then
|
||||
BgPart := trBandHot
|
||||
else
|
||||
BgPart := trBandNormal;
|
||||
|
||||
BgDetails := ThemeServices.GetElementDetails(BgPart);
|
||||
ThemeServices.DrawElement(Canvas.Handle, BgDetails, Arect, nil);
|
||||
|
||||
if Beveled then
|
||||
ThemeServices.DrawEdge(Canvas.Handle, BgDetails, ARect, BDR_RAISEDOUTER,
|
||||
BF_ADJUST or BF_RECT, @ARect);
|
||||
|
||||
GripperRect := ARect;
|
||||
|
||||
if ResizeAnchor in [akLeft,akRight] then
|
||||
begin
|
||||
if (GripperRect.Bottom - GripperRect.Top) > GripperSize then
|
||||
begin
|
||||
GripperRect.Top := (GripperRect.Top + GripperRect.Bottom - GripperSize) shr 1;
|
||||
GripperRect.Bottom := GripperRect.Top + GripperSize;
|
||||
end;
|
||||
end
|
||||
else
|
||||
begin
|
||||
if (GripperRect.Right - GripperRect.Left) > GripperSize then
|
||||
begin
|
||||
GripperRect.Left := (GripperRect.Left + GripperRect.Right - GripperSize) shr 1;
|
||||
GripperRect.Right := GripperRect.Left + GripperSize;
|
||||
end;
|
||||
end;
|
||||
|
||||
ThemeServices.DrawElement(Canvas.Handle, GripperDetails, GripperRect, nil);
|
||||
{$else}
|
||||
TWSCustomSplitterClass(WidgetSetClass).DrawSplitter(Self);
|
||||
//DrawSplitter(Canvas.Handle,Rect(0,0,Width,Height),
|
||||
// FResizeAnchor in [akTop,akBottom]);
|
||||
{$endif}
|
||||
end;
|
||||
|
||||
procedure TCustomSplitter.MouseEnter;
|
||||
begin
|
||||
inherited MouseEnter;
|
||||
if csDesigning in ComponentState then exit;
|
||||
|
||||
if not FMouseInControl and Enabled and (GetCapture = 0) then
|
||||
begin
|
||||
FMouseInControl := True;
|
||||
invalidate;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TCustomSplitter.MouseLeave;
|
||||
begin
|
||||
inherited MouseLeave;
|
||||
if csDesigning in ComponentState then exit;
|
||||
|
||||
if FMouseInControl then
|
||||
begin
|
||||
FMouseInControl := False;
|
||||
invalidate;
|
||||
end;
|
||||
end;
|
||||
|
||||
constructor TCustomSplitter.Create(TheOwner: TComponent);
|
||||
begin
|
||||
inherited Create(TheOwner);
|
||||
FResizeStyle:=rsUpdate;
|
||||
fAutoSnap:=true;
|
||||
FBeveled:=false;
|
||||
FMinSize:=30;
|
||||
FResizeAnchor:=akLeft;
|
||||
FResizeStyle := rsUpdate;
|
||||
fAutoSnap := True;
|
||||
FBeveled := False;
|
||||
FMinSize := 30;
|
||||
FMouseInControl := False;
|
||||
FResizeAnchor := akLeft;
|
||||
|
||||
Align:=alLeft;
|
||||
Width:=5;
|
||||
Align := alLeft;
|
||||
Width := 5;
|
||||
end;
|
||||
|
||||
procedure TCustomSplitter.AnchorSplitter(Kind: TAnchorKind; AControl: TControl
|
||||
|
||||
@ -561,15 +561,6 @@ procedure TWidgetSet.SendCachedLCLMessages;
|
||||
begin
|
||||
end;
|
||||
|
||||
function TWidgetSet.DrawSplitter(DC: HDC; const ARect: TRect;
|
||||
Horizontal: boolean): boolean;
|
||||
var
|
||||
DrawingRect: TRect;
|
||||
begin
|
||||
DrawingRect:=ARect;
|
||||
Result := Frame3D(DC,DrawingRect,1,bvRaised);
|
||||
end;
|
||||
|
||||
function TWidgetSet.SetCaretRespondToFocus(Handle: HWnd;
|
||||
ShowHideOnFocus: Boolean): Boolean;
|
||||
begin
|
||||
|
||||
@ -426,11 +426,6 @@ procedure SendCachedLCLMessages;
|
||||
begin
|
||||
end;
|
||||
|
||||
function DrawSplitter(DC: HDC; const ARect: TRect; Horizontal: boolean): boolean;
|
||||
begin
|
||||
Result := WidgetSet.DrawSplitter(DC,ARect,Horizontal);
|
||||
end;
|
||||
|
||||
function SetCaretRespondToFocus(Handle: hWnd; ShowHideOnFocus: boolean):Boolean;
|
||||
begin
|
||||
Result := WidgetSet.SetCaretRespondToFocus(Handle,ShowHideOnFocus);
|
||||
|
||||
@ -114,7 +114,6 @@ function ReplaceBitmapMask(var Image, Mask: HBitmap; NewMask: HBitmap): boolean;
|
||||
function RequestInput(const InputCaption, InputPrompt : String; MaskInput : Boolean; var Value : String) : Boolean; {$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF}
|
||||
|
||||
procedure SendCachedLCLMessages; {$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF}
|
||||
function DrawSplitter(DC: HDC; const ARect: TRect; Horizontal: boolean): boolean; {$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF}
|
||||
function SetCaretRespondToFocus(handle: HWND; ShowHideOnFocus: boolean): Boolean; {$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF}
|
||||
function SetComboMinDropDownSize(Handle: HWND; MinItemsWidth, MinItemsHeight, MinItemCount: integer): boolean; {$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF}
|
||||
procedure SetEventHandlerFlags(AHandler: PEventHandler; NewFlags: dword); {$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF}
|
||||
|
||||
@ -56,31 +56,6 @@ begin
|
||||
{$ENDIF}
|
||||
end;
|
||||
|
||||
{------------------------------------------------------------------------------
|
||||
Method: DrawSplitter
|
||||
Params: DC - Handle to device context
|
||||
ARect - Bounding rectangle
|
||||
Horizontal - If the splitter is horizontal or vertical
|
||||
|
||||
Draws a splitter
|
||||
------------------------------------------------------------------------------}
|
||||
function TCarbonWidgetSet.DrawSplitter(DC: HDC; const ARect: TRect;
|
||||
Horizontal: boolean): boolean;
|
||||
begin
|
||||
Result := False;
|
||||
|
||||
{$IFDEF VerboseLCLIntf}
|
||||
DebugLn('TCarbonWidgetSet.DrawSplitter DC: ' + DbgS(DC) + ' R: ' +
|
||||
DbgS(ARect) + ' Horizontal: ' + DbgS(Horizontal);
|
||||
{$ENDIF}
|
||||
|
||||
if not CheckDC(DC, 'DrawSplitter') then Exit;
|
||||
|
||||
TCarbonDeviceContext(DC).DrawSplitter(ARect);
|
||||
|
||||
Result := True;
|
||||
end;
|
||||
|
||||
function TCarbonWidgetSet.ExtUTF8Out(DC: HDC; X, Y: Integer; Options: Longint;
|
||||
Rect: PRect; Str: PChar; Count: Longint; Dx: PInteger): Boolean;
|
||||
begin
|
||||
|
||||
@ -28,7 +28,6 @@
|
||||
//##apiwiz##sps## // Do not remove
|
||||
|
||||
function CreateStandardCursor(ACursor: SmallInt): hCursor; override;
|
||||
function DrawSplitter(DC: HDC; const ARect: TRect; Horizontal: boolean): boolean; override;
|
||||
|
||||
function ExtUTF8Out(DC: HDC; X, Y: Integer; Options: Longint; Rect: PRect;
|
||||
Str: PChar; Count: Longint; Dx: PInteger): Boolean; override;
|
||||
|
||||
@ -188,53 +188,6 @@ begin
|
||||
end;
|
||||
{$endif}
|
||||
|
||||
{------------------------------------------------------------------------------
|
||||
function TGtkWidgetSet.DrawSplitter(DC: HDC; const ARect: TRect;
|
||||
Horizontal: boolean): Integer;
|
||||
|
||||
------------------------------------------------------------------------------}
|
||||
function TGtkWidgetSet.DrawSplitter(DC: HDC; const ARect: TRect;
|
||||
Horizontal: boolean): boolean;
|
||||
var
|
||||
Widget: PGtkWidget;
|
||||
ClientWidget: Pointer;
|
||||
DCOrigin: TPoint;
|
||||
Detail: PChar;
|
||||
Area: TGdkRectangle;
|
||||
Style: PGtkStyle;
|
||||
AWindow: PGdkWindow;
|
||||
begin
|
||||
Result := False;
|
||||
if not IsValidDC(DC) then exit;
|
||||
|
||||
Widget:=TDeviceContext(DC).DCWidget;
|
||||
ClientWidget:=GetFixedWidget(Widget);
|
||||
if ClientWidget<>nil then
|
||||
Widget:=ClientWidget;
|
||||
AWindow:=TDeviceContext(DC).Drawable;
|
||||
|
||||
Style:=GetStyle(lgsButton);
|
||||
if Horizontal then begin
|
||||
Detail:='vpaned';
|
||||
end else begin
|
||||
Detail:='hpaned';
|
||||
end;
|
||||
|
||||
DCOrigin:=GetDCOffset(TDeviceContext(DC));
|
||||
Area.X:=ARect.Left+DCOrigin.X;
|
||||
Area.Y:=ARect.Top+DCOrigin.Y;
|
||||
Area.Width:=ARect.Right-ARect.Left;
|
||||
Area.Height:=ARect.Bottom-ARect.Top;
|
||||
|
||||
gtk_paint_box(Style, AWindow,
|
||||
GTK_WIDGET_STATE(Widget),
|
||||
GTK_SHADOW_OUT,
|
||||
@Area, Widget, Detail,
|
||||
Area.X,Area.Y,Area.Width,Area.Height);
|
||||
|
||||
Result:=true;
|
||||
end;
|
||||
|
||||
{------------------------------------------------------------------------------
|
||||
function TGtkWidgetSet.ExtUTF8Out(DC: HDC; X, Y: Integer; Options: Longint;
|
||||
Rect: PRect; Str: PChar; Count: Longint; Dx: PInteger): Boolean;
|
||||
|
||||
@ -38,8 +38,6 @@ function AddProcessEventHandler(AHandle: THandle;
|
||||
|
||||
function CreateStandardCursor(ACursor: SmallInt): hCursor; override;
|
||||
|
||||
function DrawSplitter(DC: HDC; const ARect: TRect; Horizontal: boolean): boolean; override;
|
||||
|
||||
function ExtUTF8Out(DC: HDC; X, Y: Integer; Options: Longint; Rect: PRect;
|
||||
Str: PChar; Count: Longint; Dx: PInteger): Boolean; override;
|
||||
function TextUTF8Out(DC: HDC; X, Y: Integer; Str: PChar; Count: Longint): Boolean; override;
|
||||
|
||||
@ -52,3 +52,16 @@ begin
|
||||
end;
|
||||
end;
|
||||
|
||||
{ TGtkPrivatePaned }
|
||||
|
||||
class procedure TGtkPrivatePaned.UpdateCursor(AInfo: PWidgetInfo);
|
||||
var
|
||||
Widget: PGtkWidget;
|
||||
Window: PGdkWindow;
|
||||
begin
|
||||
Widget := AInfo^.CoreWidget;
|
||||
Window := PGTkPaned(Widget)^.handle;
|
||||
if Window = nil then Exit;
|
||||
SetWindowCursor(Window, AInfo^.ControlCursor, False);
|
||||
end;
|
||||
|
||||
|
||||
@ -32,7 +32,8 @@ uses
|
||||
{$ELSE}
|
||||
Gtk, //Glib, Gdk,
|
||||
{$ENDIF}
|
||||
PairSplitter,
|
||||
GtkWSPrivate,
|
||||
Controls, PairSplitter,
|
||||
WSPairSplitter, WSLCLClasses, WSProc;
|
||||
|
||||
type
|
||||
@ -53,6 +54,9 @@ type
|
||||
public
|
||||
class function AddSide(ASplitter: TCustomPairSplitter; ASide: TPairSplitterSide; Side: integer): Boolean; override;
|
||||
class function SetPosition(ASplitter: TCustomPairSplitter; var NewPosition: integer): Boolean; override;
|
||||
// special cursor handling
|
||||
class function GetSplitterCursor(ASplitter: TCustomPairSplitter; var ACursor: TCursor): Boolean; override;
|
||||
class function SetSplitterCursor(ASplitter: TCustomPairSplitter; ACursor: TCursor): Boolean; override;
|
||||
end;
|
||||
|
||||
{ TGtkWSPairSplitter }
|
||||
@ -99,6 +103,18 @@ begin
|
||||
Result:=true;
|
||||
end;
|
||||
|
||||
class function TGtkWSCustomPairSplitter.GetSplitterCursor(
|
||||
ASplitter: TCustomPairSplitter; var ACursor: TCursor): Boolean;
|
||||
begin
|
||||
Result := False;
|
||||
end;
|
||||
|
||||
class function TGtkWSCustomPairSplitter.SetSplitterCursor(
|
||||
ASplitter: TCustomPairSplitter; ACursor: TCursor): Boolean;
|
||||
begin
|
||||
Result := False;
|
||||
end;
|
||||
|
||||
initialization
|
||||
|
||||
////////////////////////////////////////////////////
|
||||
@ -108,7 +124,7 @@ initialization
|
||||
// which actually implement something
|
||||
////////////////////////////////////////////////////
|
||||
// RegisterWSComponent(TPairSplitterSide, TGtkWSPairSplitterSide);
|
||||
RegisterWSComponent(TCustomPairSplitter, TGtkWSCustomPairSplitter);
|
||||
RegisterWSComponent(TCustomPairSplitter, TGtkWSCustomPairSplitter, TGtkPrivatePaned);
|
||||
// RegisterWSComponent(TPairSplitter, TGtkWSPairSplitter);
|
||||
////////////////////////////////////////////////////
|
||||
end.
|
||||
|
||||
@ -154,6 +154,14 @@ type
|
||||
public
|
||||
end;
|
||||
|
||||
{ TGtkPrivatePaned }
|
||||
{ Private class for gtkpaned }
|
||||
TGtkPrivatePaned = class(TGtkPrivateContainer)
|
||||
private
|
||||
protected
|
||||
public
|
||||
class procedure UpdateCursor(AInfo: PWidgetInfo); override;
|
||||
end;
|
||||
|
||||
|
||||
function GetWidgetWithWindow(const AHandle: THandle): PGtkWidget;
|
||||
@ -291,8 +299,6 @@ begin
|
||||
end;
|
||||
end;
|
||||
|
||||
|
||||
|
||||
{$I gtkprivatewidget.inc}
|
||||
|
||||
end.
|
||||
|
||||
@ -15,10 +15,6 @@ uses
|
||||
gtkdef, gtk2int, gtkproc;
|
||||
|
||||
type
|
||||
// todo: more common painter
|
||||
TGtkPainter = procedure (style:PGtkStyle; window:PGdkWindow; state_type:TGtkStateType; shadow_type:TGtkShadowType;
|
||||
area:PGdkRectangle; widget:PGtkWidget; detail:Pgchar; x:gint; y:gint; width:gint; height:gint); cdecl;
|
||||
|
||||
TGtkPainterType =
|
||||
(
|
||||
gptNone,
|
||||
@ -30,23 +26,24 @@ type
|
||||
gptFlatBox,
|
||||
gptCheck,
|
||||
gptOption,
|
||||
gptTab
|
||||
gptTab,
|
||||
// gptSlider,
|
||||
// gptHandle,
|
||||
gptHandle
|
||||
// gptExpander,
|
||||
// gptResizeGrip
|
||||
);
|
||||
|
||||
TGtkStyleParams = record
|
||||
Style : PGtkStyle; // paint style
|
||||
Painter: TGtkPainterType; // type of paint handler
|
||||
Widget : PGtkWidget; // widget
|
||||
Window : PGdkWindow; // paint window
|
||||
Origin : TPoint; // offset
|
||||
State : TGtkStateType; // Style state
|
||||
Shadow : TGtkShadowType; // Shadow
|
||||
Detail : String; // Detail (button, checkbox, ...)
|
||||
IsHot : Boolean;
|
||||
Style : PGtkStyle; // paint style
|
||||
Painter : TGtkPainterType; // type of paint handler
|
||||
Widget : PGtkWidget; // widget
|
||||
Window : PGdkWindow; // paint window
|
||||
Origin : TPoint; // offset
|
||||
State : TGtkStateType; // Style state
|
||||
Shadow : TGtkShadowType; // Shadow
|
||||
Detail : String; // Detail (button, checkbox, ...)
|
||||
Orientation: TGtkOrientation; // Orientation (horizontal/vertical)
|
||||
IsHot : Boolean;
|
||||
end;
|
||||
|
||||
{ TGtk2ThemeServices }
|
||||
@ -63,9 +60,7 @@ type
|
||||
|
||||
procedure InternalDrawParentBackground(Window: HWND; Target: HDC; Bounds: PRect); override;
|
||||
public
|
||||
|
||||
procedure DrawElement(DC: HDC; Details: TThemedElementDetails; const R: TRect; ClipRect: PRect); override;
|
||||
procedure DrawEdge(DC: HDC; Details: TThemedElementDetails; const R: TRect; Edge, Flags: Cardinal; AContentRect: PRect); override;
|
||||
procedure DrawIcon(DC: HDC; Details: TThemedElementDetails; const R: TRect; himl: HIMAGELIST; Index: Integer); override;
|
||||
procedure DrawText(DC: HDC; Details: TThemedElementDetails; const S: WideString; R: TRect; Flags, Flags2: Cardinal); override;
|
||||
|
||||
@ -73,33 +68,9 @@ type
|
||||
function HasTransparentParts(Details: TThemedElementDetails): Boolean; override;
|
||||
end;
|
||||
|
||||
procedure wrap_gtk_paint_hline(style:PGtkStyle; window:PGdkWindow; state_type:TGtkStateType; shadow_type:TGtkShadowType;
|
||||
area:PGdkRectangle; widget:PGtkWidget; detail:Pgchar; x:gint; y:gint; width:gint; height:gint); cdecl;
|
||||
|
||||
procedure wrap_gtk_paint_vline(style:PGtkStyle; window:PGdkWindow; state_type:TGtkStateType; shadow_type:TGtkShadowType;
|
||||
area:PGdkRectangle; widget:PGtkWidget; detail:Pgchar; x:gint; y:gint; width:gint; height:gint); cdecl;
|
||||
|
||||
implementation
|
||||
|
||||
const
|
||||
GtkPainterMap: array[TGtkPainterType] of TGtkPainter =
|
||||
(
|
||||
{ gptNone } nil,
|
||||
{ gptDefault } @gtk_paint_box, // maybe smth else ??
|
||||
{ gptHLine } @wrap_gtk_paint_hline,
|
||||
{ gptVLine } @wrap_gtk_paint_vline,
|
||||
{ gptShadow } @gtk_paint_shadow,
|
||||
{ gptBox } @gtk_paint_box,
|
||||
{ gptFlatBox } @gtk_paint_flat_box,
|
||||
{ gptCheck } @gtk_paint_check,
|
||||
{ gptOption } @gtk_paint_option,
|
||||
{ gptTab, } @gtk_paint_tab
|
||||
// { gptSlider } @gtk_paint_slider,
|
||||
// { gptHandle } @gtk_paint_handle,
|
||||
// { gptExpander } @gtk_paint_expander,
|
||||
// { gptResizeGrip } @gtk_paint_resize_grip
|
||||
);
|
||||
|
||||
// most common maps
|
||||
GtkButtonMap: array[0..6] of TGtkStateType =
|
||||
(
|
||||
@ -112,18 +83,6 @@ const
|
||||
{ hot + checked } GTK_STATE_INSENSITIVE // PRELIGHT IS TOO LIGHT
|
||||
);
|
||||
|
||||
procedure wrap_gtk_paint_hline(style:PGtkStyle; window:PGdkWindow; state_type:TGtkStateType; shadow_type:TGtkShadowType;
|
||||
area:PGdkRectangle; widget:PGtkWidget; detail:Pgchar; x:gint; y:gint; width:gint; height:gint); cdecl;
|
||||
begin
|
||||
gtk_paint_hline(style, window, state_type, area, widget, detail, x, width, y);
|
||||
end;
|
||||
|
||||
procedure wrap_gtk_paint_vline(style:PGtkStyle; window:PGdkWindow; state_type:TGtkStateType; shadow_type:TGtkShadowType;
|
||||
area:PGdkRectangle; widget:PGtkWidget; detail:Pgchar; x:gint; y:gint; width:gint; height:gint); cdecl;
|
||||
begin
|
||||
gtk_paint_vline(style, window, state_type, area, widget, detail, y, height, x);
|
||||
end;
|
||||
|
||||
{ TGtk2ThemeServices }
|
||||
|
||||
function TGtk2ThemeServices.GdkRectFromRect(R: TRect): TGdkRectangle;
|
||||
@ -206,6 +165,29 @@ begin
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
teRebar:
|
||||
begin
|
||||
case Details.Part of
|
||||
RP_GRIPPER, RP_GRIPPERVERT:
|
||||
begin
|
||||
Result.State := GTK_STATE_NORMAL;
|
||||
Result.Shadow := GTK_SHADOW_NONE;
|
||||
Result.Detail := 'paned';
|
||||
Result.Painter := gptHandle;
|
||||
if Details.Part = RP_GRIPPER then
|
||||
Result.Orientation := GTK_ORIENTATION_VERTICAL
|
||||
else
|
||||
Result.Orientation := GTK_ORIENTATION_HORIZONTAL;
|
||||
end;
|
||||
RP_BAND:
|
||||
begin
|
||||
Result.State := GtkButtonMap[Details.State];
|
||||
Result.Shadow := GTK_SHADOW_NONE;
|
||||
Result.Detail := 'paned';
|
||||
Result.Painter := gptFlatBox;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
@ -238,13 +220,6 @@ begin
|
||||
-StyleParams.Style^.ythickness);
|
||||
end;
|
||||
|
||||
procedure TGtk2ThemeServices.DrawEdge(DC: HDC;
|
||||
Details: TThemedElementDetails; const R: TRect; Edge, Flags: Cardinal;
|
||||
AContentRect: PRect);
|
||||
begin
|
||||
|
||||
end;
|
||||
|
||||
procedure TGtk2ThemeServices.DrawElement(DC: HDC;
|
||||
Details: TThemedElementDetails; const R: TRect; ClipRect: PRect);
|
||||
var
|
||||
@ -282,13 +257,62 @@ begin
|
||||
}
|
||||
end;
|
||||
|
||||
if Painter <> gptNone then
|
||||
GtkPainterMap[Painter](
|
||||
case Painter of
|
||||
gptBox,
|
||||
gptDefault: gtk_paint_box(
|
||||
Style, Window,
|
||||
State, Shadow,
|
||||
p_ClipArea, Widget, PChar(Detail),
|
||||
R1.Left + Origin.x, R1.Top + Origin.y,
|
||||
R1.Right - R1.Left, R1.Bottom - R1.Top);
|
||||
gptHLine : gtk_paint_hline(
|
||||
Style, Window,
|
||||
State, p_ClipArea,
|
||||
Widget, PChar(Detail),
|
||||
R1.Left + Origin.x, R1.Right + Origin.x, R1.Top + Origin.y);
|
||||
gptVLine : gtk_paint_vline(
|
||||
Style, Window,
|
||||
State, p_ClipArea,
|
||||
Widget, PChar(Detail),
|
||||
R1.Top + Origin.y, R1.Bottom + Origin.y, R1.Left + Origin.x);
|
||||
gptShadow : gtk_paint_shadow(
|
||||
Style, Window,
|
||||
State, Shadow,
|
||||
p_ClipArea, Widget, PChar(Detail),
|
||||
R1.Left + Origin.x, R1.Top + Origin.y,
|
||||
R1.Right - R1.Left, R1.Bottom - R1.Top);
|
||||
gptFlatBox: gtk_paint_flat_box(
|
||||
Style, Window,
|
||||
State, Shadow,
|
||||
p_ClipArea, Widget, PChar(Detail),
|
||||
R1.Left + Origin.x, R1.Top + Origin.y,
|
||||
R1.Right - R1.Left, R1.Bottom - R1.Top);
|
||||
gptCheck : gtk_paint_check(
|
||||
Style, Window,
|
||||
State, Shadow,
|
||||
p_ClipArea, Widget, PChar(Detail),
|
||||
R1.Left + Origin.x, R1.Top + Origin.y,
|
||||
R1.Right - R1.Left, R1.Bottom - R1.Top);
|
||||
gptOption : gtk_paint_option(
|
||||
Style, Window,
|
||||
State, Shadow,
|
||||
p_ClipArea, Widget, PChar(Detail),
|
||||
R1.Left + Origin.x, R1.Top + Origin.y,
|
||||
R1.Right - R1.Left, R1.Bottom - R1.Top);
|
||||
gptTab : gtk_paint_tab(
|
||||
Style, Window,
|
||||
State, Shadow,
|
||||
p_ClipArea, Widget, PChar(Detail),
|
||||
R1.Left + Origin.x, R1.Top + Origin.y,
|
||||
R1.Right - R1.Left, R1.Bottom - R1.Top);
|
||||
gptHandle : gtk_paint_handle(
|
||||
Style, Window,
|
||||
State, Shadow,
|
||||
p_ClipArea, Widget, PChar(Detail),
|
||||
R1.Left + Origin.x, R1.Top + Origin.y,
|
||||
R1.Right - R1.Left, R1.Bottom - R1.Top,
|
||||
Orientation);
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
@ -108,9 +108,18 @@ type
|
||||
public
|
||||
class procedure UpdateCursor(AInfo: PWidgetInfo); override;
|
||||
end;
|
||||
|
||||
{ TGtk2PrivatePaned }
|
||||
|
||||
TGtk2PrivatePaned = class(TGtkPrivatePaned)
|
||||
private
|
||||
protected
|
||||
public
|
||||
end;
|
||||
|
||||
|
||||
implementation
|
||||
{$I Gtk2PrivateWidget.inc}
|
||||
|
||||
end.
|
||||
|
||||
|
||||
@ -707,6 +707,8 @@ Var
|
||||
if ACursor = crDefault then
|
||||
begin
|
||||
// statictext controls do not get WM_SETCURSOR messages...
|
||||
if lWinControl.ClassName = 'TPairSplitter' then
|
||||
P := P;
|
||||
lControl := lWinControl.ControlAtPos(P, [capfOnlyClientAreas,
|
||||
capfAllowWinControls, capfHasScrollOffset]);
|
||||
if lControl = nil then
|
||||
|
||||
@ -587,14 +587,14 @@ end;
|
||||
|
||||
{ TWin32WSCustomSplitter }
|
||||
|
||||
class procedure TWin32WSCustomSplitter.DrawSplitter(const ASplitter: TCustomSplitter
|
||||
);
|
||||
class procedure TWin32WSCustomSplitter.DrawSplitter(const ASplitter: TCustomSplitter);
|
||||
var
|
||||
ARect: TRect;
|
||||
begin
|
||||
|
||||
if ASplitter.Beveled then begin
|
||||
LCLIntf.DrawSplitter(ASplitter.Canvas.Handle,
|
||||
Rect(0,0,ASplitter.Width,ASplitter.Height),
|
||||
ASplitter.ResizeAnchor in [akTop,akBottom]);
|
||||
if ASplitter.Beveled then
|
||||
begin
|
||||
ARect := Rect(0, 0, ASplitter.Width, ASplitter.Height);
|
||||
Frame3D(ASplitter.Canvas.Handle, ARect, 1, bvRaised);
|
||||
end;
|
||||
end;
|
||||
|
||||
|
||||
@ -67,6 +67,7 @@ type
|
||||
property ChildSizing;
|
||||
property ClientWidth;
|
||||
property ClientHeight;
|
||||
property Cursor;
|
||||
property Enabled;
|
||||
property OnMouseDown;
|
||||
property OnMouseMove;
|
||||
@ -77,7 +78,6 @@ type
|
||||
property PopupMenu;
|
||||
end;
|
||||
|
||||
|
||||
{ TCustomPairSplitter }
|
||||
|
||||
TPairSplitterType = (
|
||||
@ -90,13 +90,17 @@ type
|
||||
FPosition: integer;
|
||||
FSides: array[0..1] of TPairSplitterSide;
|
||||
FSplitterType: TPairSplitterType;
|
||||
fDoNotCreateSides: boolean;
|
||||
FDoNotCreateSides: boolean;
|
||||
FLoadCursor: TCursor;
|
||||
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);
|
||||
protected
|
||||
function GetCursor: TCursor; override;
|
||||
procedure SetCursor(Value: TCursor); override;
|
||||
public
|
||||
constructor Create(TheOwner: TComponent); override;
|
||||
destructor Destroy; override;
|
||||
@ -106,6 +110,7 @@ type
|
||||
procedure Loaded; override;
|
||||
function ChildClassAllowed(ChildClass: TClass): boolean; override;
|
||||
public
|
||||
property Cursor default crHSplit;
|
||||
property Sides[Index: integer]: TPairSplitterSide read GetSides;
|
||||
property SplitterType: TPairSplitterType read FSplitterType
|
||||
write SetSplitterType default pstHorizontal;
|
||||
@ -120,17 +125,18 @@ type
|
||||
property Align;
|
||||
property Anchors;
|
||||
property BorderSpacing;
|
||||
property Cursor;
|
||||
property Enabled;
|
||||
property OnMouseDown;
|
||||
property OnMouseMove;
|
||||
property OnMouseUp;
|
||||
property OnResize;
|
||||
property OnChangeBounds;
|
||||
property ShowHint;
|
||||
property SplitterType;
|
||||
property ParentShowHint;
|
||||
property PopupMenu;
|
||||
property Position;
|
||||
property ShowHint;
|
||||
property SplitterType;
|
||||
property Visible;
|
||||
end;
|
||||
|
||||
@ -138,7 +144,7 @@ procedure Register;
|
||||
|
||||
implementation
|
||||
uses
|
||||
WSPairSplitter, extctrls;
|
||||
WSPairSplitter, ExtCtrls;
|
||||
|
||||
procedure Register;
|
||||
begin
|
||||
@ -162,23 +168,22 @@ var
|
||||
begin
|
||||
CheckNewParent(AParent);
|
||||
// remove from side list of old parent
|
||||
ASplitter:=Splitter;
|
||||
if ASplitter<>nil then begin
|
||||
ASplitter := Splitter;
|
||||
if ASplitter <> nil then
|
||||
ASplitter.RemoveSide(Self);
|
||||
end;
|
||||
|
||||
inherited SetParent(AParent);
|
||||
|
||||
// add to side list of new parent
|
||||
ASplitter:=Splitter;
|
||||
if ASplitter<>nil then begin
|
||||
if ASplitter <> nil then
|
||||
ASplitter.AddSide(Self);
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TPairSplitterSide.WMPaint(var PaintMessage: TLMPaint);
|
||||
begin
|
||||
if (csDestroying in ComponentState) or (not HandleAllocated) then exit;
|
||||
if (csDestroying in ComponentState) or (not HandleAllocated) then
|
||||
Exit;
|
||||
Include(FControlState, csCustomPaint);
|
||||
inherited WMPaint(PaintMessage);
|
||||
Paint;
|
||||
@ -189,9 +194,11 @@ procedure TPairSplitterSide.Paint;
|
||||
var
|
||||
ACanvas: TControlCanvas;
|
||||
begin
|
||||
if csDesigning in ComponentState then begin
|
||||
if csDesigning in ComponentState then
|
||||
begin
|
||||
ACanvas := TControlCanvas.Create;
|
||||
with ACanvas do begin
|
||||
with ACanvas do
|
||||
begin
|
||||
Control := Self;
|
||||
Pen.Style := psDash;
|
||||
Frame(0,0,Width-1,Height-1);
|
||||
@ -204,7 +211,7 @@ constructor TPairSplitterSide.Create(TheOwner: TComponent);
|
||||
begin
|
||||
inherited Create(TheOwner);
|
||||
FCompStyle := csPairSplitterSide;
|
||||
ControlStyle:=ControlStyle+[csAcceptsControls];
|
||||
ControlStyle := ControlStyle + [csAcceptsControls];
|
||||
end;
|
||||
|
||||
destructor TPairSplitterSide.Destroy;
|
||||
@ -216,78 +223,121 @@ end;
|
||||
|
||||
function TCustomPairSplitter.GetSides(Index: integer): TPairSplitterSide;
|
||||
begin
|
||||
if (Index<0) or (Index>1) then
|
||||
if (Index < 0) or (Index > 1) then
|
||||
RaiseGDBException('TCustomPairSplitter.GetSides: Index out of bounds');
|
||||
Result:=FSides[Index];
|
||||
Result := FSides[Index];
|
||||
end;
|
||||
|
||||
function TCustomPairSplitter.GetPosition: integer;
|
||||
begin
|
||||
if HandleAllocated and (not (csLoading in ComponentState)) then
|
||||
UpdatePosition;
|
||||
Result:=FPosition;
|
||||
Result := FPosition;
|
||||
end;
|
||||
|
||||
procedure TCustomPairSplitter.SetPosition(const AValue: integer);
|
||||
begin
|
||||
if FPosition=AValue then exit;
|
||||
FPosition:=AValue;
|
||||
if FPosition<0 then
|
||||
FPosition:=0;
|
||||
if FPosition = AValue then
|
||||
Exit;
|
||||
FPosition := AValue;
|
||||
if FPosition < 0 then
|
||||
FPosition := 0;
|
||||
if HandleAllocated and (not (csLoading in ComponentState)) then
|
||||
TWSCustomPairSplitterClass(WidgetSetClass).SetPosition(Self, FPosition);
|
||||
end;
|
||||
|
||||
procedure TCustomPairSplitter.SetSplitterType(const AValue: TPairSplitterType);
|
||||
const
|
||||
DefaultCursors: array[TPairSplitterType] of TCursor =
|
||||
(
|
||||
{ pstHorizontal } crHSplit,
|
||||
{ pstVertical } crVSplit
|
||||
);
|
||||
begin
|
||||
if FSplitterType=AValue then exit;
|
||||
FSplitterType:=AValue;
|
||||
if FSplitterType = AValue then
|
||||
Exit;
|
||||
|
||||
if Cursor = DefaultCursors[FSplitterType] then
|
||||
Cursor := DefaultCursors[AValue];
|
||||
FSplitterType := AValue;
|
||||
|
||||
// TODO: Remove RecreateWnd
|
||||
if HandleAllocated then RecreateWnd(Self);
|
||||
if HandleAllocated then
|
||||
RecreateWnd(Self);
|
||||
end;
|
||||
|
||||
procedure TCustomPairSplitter.AddSide(ASide: TPairSplitterSide);
|
||||
var
|
||||
i: Integer;
|
||||
begin
|
||||
if ASide=nil then exit;
|
||||
i:=Low(FSides);
|
||||
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 FSides[i] = ASide then
|
||||
Exit;
|
||||
if FSides[i] =nil then
|
||||
begin
|
||||
FSides[i] := ASide;
|
||||
if HandleAllocated then
|
||||
TWSCustomPairSplitterClass(WidgetSetClass).AddSide(Self, ASide, i);
|
||||
break;
|
||||
end;
|
||||
inc(i);
|
||||
if i>High(FSides) then
|
||||
if i > High(FSides) then
|
||||
RaiseGDBException('TCustomPairSplitter.AddSide no free side left');
|
||||
until false;
|
||||
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 ASide = nil then
|
||||
Exit;
|
||||
for i := Low(FSides) to High(FSides) do
|
||||
if FSides[i]=ASide then
|
||||
begin
|
||||
if HandleAllocated and ASide.HandleAllocated then
|
||||
TWSCustomPairSplitterClass(WidgetSetClass).RemoveSide(Self, ASide, i);
|
||||
FSides[i]:=nil;
|
||||
FSides[i] := nil;
|
||||
end;
|
||||
// if the user deletes a side at designtime, autocreate a new one
|
||||
if (csDesigning in ComponentState) then
|
||||
CreateSides;
|
||||
end;
|
||||
|
||||
function TCustomPairSplitter.GetCursor: TCursor;
|
||||
begin
|
||||
// Paul Ishenin: I dont know another method to tell internal splitter about
|
||||
// cursor changes
|
||||
|
||||
// if widgetset class dont want to get cursor (has no internal splitter) then
|
||||
// use default lcl handler
|
||||
if not TWSCustomPairSplitterClass(WidgetSetClass).GetSplitterCursor(Self, Result) then
|
||||
Result := inherited GetCursor;
|
||||
end;
|
||||
|
||||
procedure TCustomPairSplitter.SetCursor(Value: TCursor);
|
||||
begin
|
||||
if not HandleAllocated then
|
||||
begin
|
||||
FLoadCursor := Value;
|
||||
Exit;
|
||||
end;
|
||||
// if widgetset class dont want to set cursor (has no internal splitter) then
|
||||
// use default lcl handler
|
||||
if not TWSCustomPairSplitterClass(WidgetSetClass).SetSplitterCursor(Self, Value) then
|
||||
inherited SetCursor(Value);
|
||||
end;
|
||||
|
||||
constructor TCustomPairSplitter.Create(TheOwner: TComponent);
|
||||
begin
|
||||
inherited Create(TheOwner);
|
||||
FCompStyle := csPairSplitter;
|
||||
ControlStyle:=ControlStyle-[csAcceptsControls];
|
||||
FSplitterType:=pstHorizontal;
|
||||
ControlStyle := ControlStyle - [csAcceptsControls];
|
||||
FSplitterType := pstHorizontal;
|
||||
Cursor := crHSplit;
|
||||
SetInitialBounds(0, 0, 90, 90);
|
||||
FPosition:=45;
|
||||
CreateSides;
|
||||
@ -311,13 +361,14 @@ var
|
||||
APosition: Integer;
|
||||
begin
|
||||
inherited CreateWnd;
|
||||
for i:=Low(FSides) to High(FSides) do
|
||||
if FSides[i]<>nil then
|
||||
for i := Low(FSides) to High(FSides) do
|
||||
if FSides[i] <> nil then
|
||||
TWSCustomPairSplitterClass(WidgetSetClass).AddSide(Self, FSides[i], i);
|
||||
APosition:=FPosition;
|
||||
APosition := FPosition;
|
||||
TWSCustomPairSplitterClass(WidgetSetClass).SetPosition(Self, APosition);
|
||||
SetCursor(FLoadCursor);
|
||||
if not (csLoading in ComponentState) then
|
||||
FPosition:=APosition;
|
||||
FPosition := APosition;
|
||||
end;
|
||||
|
||||
procedure TCustomPairSplitter.UpdatePosition;
|
||||
@ -326,9 +377,9 @@ var
|
||||
begin
|
||||
if HandleAllocated then
|
||||
begin
|
||||
CurPosition:=-1;
|
||||
CurPosition := -1;
|
||||
TWSCustomPairSplitterClass(WidgetSetClass).SetPosition(Self, CurPosition);
|
||||
FPosition:=CurPosition;
|
||||
FPosition := CurPosition;
|
||||
end;
|
||||
end;
|
||||
|
||||
@ -341,8 +392,9 @@ begin
|
||||
or (csLoading in ComponentState)
|
||||
or ((Owner<>nil) and (csLoading in Owner.ComponentState)) then exit;
|
||||
// create the missing side controls
|
||||
for i:=Low(FSides) to High(FSides) do
|
||||
if FSides[i]=nil then begin
|
||||
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
|
||||
ASide:=TPairSplitterSide.Create(Owner);
|
||||
|
||||
@ -1751,8 +1751,14 @@ end;
|
||||
|
||||
procedure TThemeServices.DrawEdge(DC: HDC; Details: TThemedElementDetails; const R: TRect; Edge, Flags: Cardinal;
|
||||
AContentRect: PRect = nil);
|
||||
var
|
||||
ARect: TRect;
|
||||
begin
|
||||
// deafult painting
|
||||
ARect := R;
|
||||
WidgetSet.DrawEdge(DC, ARect, Edge, Flags);
|
||||
if (Flags and DFCS_ADJUSTRECT <> 0) and (AContentRect <> nil) then
|
||||
AContentRect^ := R;
|
||||
end;
|
||||
|
||||
//----------------------------------------------------------------------------------------------------------------------
|
||||
|
||||
@ -43,7 +43,7 @@ uses
|
||||
////////////////////////////////////////////////////
|
||||
// To get as little as posible circles,
|
||||
// uncomment only when needed for registration
|
||||
PairSplitter, WSLCLClasses, WSControls;
|
||||
Controls, ExtCtrls, PairSplitter, WSLCLClasses, WSControls;
|
||||
|
||||
type
|
||||
{ TWSPairSplitterSide }
|
||||
@ -57,6 +57,10 @@ type
|
||||
class function AddSide(ASplitter: TCustomPairSplitter; ASide: TPairSplitterSide; Side: integer): Boolean; virtual;
|
||||
class function RemoveSide(ASplitter: TCustomPairSplitter; ASide: TPairSplitterSide; Side: integer): Boolean; virtual;
|
||||
class function SetPosition(ASplitter: TCustomPairSplitter; var NewPosition: integer): Boolean; virtual;
|
||||
|
||||
// special cursor handling
|
||||
class function GetSplitterCursor(ASplitter: TCustomPairSplitter; var ACursor: TCursor): Boolean; virtual;
|
||||
class function SetSplitterCursor(ASplitter: TCustomPairSplitter; ACursor: TCursor): Boolean; virtual;
|
||||
end;
|
||||
TWSCustomPairSplitterClass = class of TWSCustomPairSplitter;
|
||||
|
||||
@ -68,7 +72,7 @@ type
|
||||
|
||||
implementation
|
||||
uses
|
||||
WSProc, Controls, ExtCtrls;
|
||||
WSProc;
|
||||
|
||||
function GetInternalSplitter(ASplitter: TCustomPairSplitter): TSplitter;
|
||||
var
|
||||
@ -103,7 +107,8 @@ begin
|
||||
if Side = 0 then
|
||||
begin
|
||||
if ASplitter.SplitterType = pstHorizontal then
|
||||
ASide.Align := alLeft else
|
||||
ASide.Align := alLeft
|
||||
else
|
||||
ASide.Align := alTop;
|
||||
end else
|
||||
begin
|
||||
@ -154,12 +159,39 @@ begin
|
||||
end;
|
||||
end;
|
||||
if ASplitter.SplitterType = pstHorizontal then
|
||||
NewPosition := ASplitter.Sides[0].Width else
|
||||
NewPosition := ASplitter.Sides[0].Width
|
||||
else
|
||||
NewPosition := ASplitter.Sides[0].Height;
|
||||
|
||||
Result := True;
|
||||
end;
|
||||
|
||||
class function TWSCustomPairSplitter.GetSplitterCursor(ASplitter: TCustomPairSplitter; var ACursor: TCursor): Boolean;
|
||||
var
|
||||
InternalSplitter: TSplitter;
|
||||
begin
|
||||
Result := True;
|
||||
InternalSplitter := GetInternalSplitter(ASplitter);
|
||||
if InternalSplitter <> nil then
|
||||
ACursor := InternalSplitter.Cursor
|
||||
else
|
||||
ACursor := crDefault;
|
||||
end;
|
||||
|
||||
class function TWSCustomPairSplitter.SetSplitterCursor(ASplitter: TCustomPairSplitter; ACursor: TCursor): Boolean;
|
||||
var
|
||||
InternalSplitter: TSplitter;
|
||||
begin
|
||||
Result := True;
|
||||
InternalSplitter := GetInternalSplitter(ASplitter);
|
||||
if InternalSplitter <> nil then
|
||||
begin
|
||||
InternalSplitter.Cursor := ACursor;
|
||||
ASplitter.Sides[0].Cursor := crArrow;
|
||||
ASplitter.Sides[1].Cursor := crArrow;
|
||||
end;
|
||||
end;
|
||||
|
||||
initialization
|
||||
|
||||
////////////////////////////////////////////////////
|
||||
|
||||
Loading…
Reference in New Issue
Block a user