summaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
authorgraemeg <graemeg@ae50a9b5-8222-0410-bf8d-8a13f76226bf>2008-06-28 23:01:25 +0000
committergraemeg <graemeg@ae50a9b5-8222-0410-bf8d-8a13f76226bf>2008-06-28 23:01:25 +0000
commite6a9cae10aad4d803c8a371cb97f3b711e536dc9 (patch)
tree068cb8f4ab1c8dfe645fd0065e7cc17c7a801023 /src
parent4f159b5e41a57663f20fb25aa6352ec7b60df3ca (diff)
downloadfpGUI-e6a9cae10aad4d803c8a371cb97f3b711e536dc9.tar.xz
* Forgot to add the actual gui_splitter unit.
* Updated the fpgui_toolkit.lpk package for X11.
Diffstat (limited to 'src')
-rw-r--r--src/corelib/x11/fpgui_toolkit.lpk5
-rw-r--r--src/corelib/x11/fpgui_toolkit.pas3
-rw-r--r--src/gui/gui_splitter.pas324
3 files changed, 330 insertions, 2 deletions
diff --git a/src/corelib/x11/fpgui_toolkit.lpk b/src/corelib/x11/fpgui_toolkit.lpk
index 243f958f..bebb13cd 100644
--- a/src/corelib/x11/fpgui_toolkit.lpk
+++ b/src/corelib/x11/fpgui_toolkit.lpk
@@ -28,7 +28,7 @@
<License Value="Modified LGPL
"/>
<Version Minor="6" Release="2"/>
- <Files Count="70">
+ <Files Count="71">
<Item1>
<Filename Value="../stdimages.inc"/>
<Type Value="Include"/>
@@ -309,6 +309,9 @@
<Filename Value="../../gui/db/fpgui_db.pas"/>
<UnitName Value="fpgui_db"/>
</Item70>
+ <Item71>
+ <Filename Value="../../gui/gui_splitter.pas"/>
+ </Item71>
</Files>
<LazDoc Paths="../../../docs/xml/corelib/;../../../docs/xml/corelib/x11/;../../../docs/xml/corelib/gdi/;../../../docs/xml/gui/"/>
<RequiredPkgs Count="1">
diff --git a/src/corelib/x11/fpgui_toolkit.pas b/src/corelib/x11/fpgui_toolkit.pas
index 85c6b743..65e87ec6 100644
--- a/src/corelib/x11/fpgui_toolkit.pas
+++ b/src/corelib/x11/fpgui_toolkit.pas
@@ -16,7 +16,8 @@ uses
gui_editcombo, gui_edit, gui_form, gui_gauge, gui_grid, gui_hyperlink,
gui_iniutils, gui_label, gui_listbox, gui_listview, gui_memo, gui_menu,
gui_mru, gui_panel, gui_popupcalendar, gui_progressbar, gui_radiobutton,
- gui_scrollbar, gui_style, gui_tab, gui_trackbar, gui_tree, fpgui_db;
+ gui_scrollbar, gui_style, gui_tab, gui_trackbar, gui_tree, fpgui_db,
+ gui_splitter;
implementation
diff --git a/src/gui/gui_splitter.pas b/src/gui/gui_splitter.pas
new file mode 100644
index 00000000..b3635353
--- /dev/null
+++ b/src/gui/gui_splitter.pas
@@ -0,0 +1,324 @@
+{
+ fpGUI - Free Pascal GUI Toolkit
+
+ Copyright (C) 2006 - 2008 See the file AUTHORS.txt, included in this
+ distribution, for details of the copyright.
+
+ See the file COPYING.modifiedLGPL, included in this distribution,
+ for details about redistributing fpGUI.
+
+ 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.
+
+ Description:
+ Defines a Splitter control.
+}
+
+unit gui_splitter;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+ Classes,
+ SysUtils,
+ fpgfx,
+ gfxbase,
+ gfx_widget;
+
+type
+
+ NaturalNumber = 1..High(Integer);
+
+ { TfpgSplitter }
+
+ TfpgSplitter = class(TfpgWidget)
+ private
+ FAutoSnap: Boolean;
+ FControl: TfpgWidget;
+ FDownPos: TPoint;
+ FMinSize: NaturalNumber;
+ FMaxSize: Integer;
+ FNewSize: Integer;
+ FOldSize: Integer;
+ FSplit: Integer;
+ procedure CalcSplitSize(X, Y: Integer; var NewSize, Split: Integer);
+ function FindControl: TfpgWidget;
+ procedure UpdateControlSize;
+ procedure UpdateSize(X, Y: Integer);
+ protected
+ function DoCanResize(var NewSize: Integer): Boolean; virtual;
+ procedure HandleLMouseDown(x, y: integer; shiftstate: TShiftState); override;
+ procedure HandleLMouseUp(x, y: integer; shiftstate: TShiftState); override;
+ procedure HandleMouseMove(x, y: integer; btnstate: word; shiftstate: TShiftState); override;
+ procedure HandleMouseEnter; override;
+ procedure HandleMouseExit; override;
+ procedure HandlePaint; override;
+ procedure StopSizing; dynamic;
+ public
+ constructor Create(AOwner: TComponent); override;
+ destructor Destroy; override;
+ end;
+
+function CreateSplitter(AOwner: TComponent; ALeft, ATop, AWidth, AHeight: TfpgCoord;
+ AnAlign: TAlign): TfpgSplitter;
+
+implementation
+
+function CreateSplitter(AOwner: TComponent; ALeft, ATop, AWidth, AHeight: TfpgCoord;
+ AnAlign: TAlign): TfpgSplitter;
+begin
+ Result := TfpgSplitter.Create(AOwner);
+ Result.Left := ALeft;
+ Result.Top := ATop;
+ Result.Width := AWidth;
+ Result.Height := AHeight;
+ Result.Align := AnAlign;
+end;
+
+{ TfpgSplitter }
+
+procedure TfpgSplitter.CalcSplitSize(X, Y: Integer; var NewSize, Split: Integer);
+var
+ S: Integer;
+begin
+ if Align in [alLeft, alRight] then
+ Split := X - FDownPos.X
+ else
+ Split := Y - FDownPos.Y;
+ S := 0;
+ case Align of
+ alLeft: S := FControl.Width + Split;
+ alRight: S := FControl.Width - Split;
+ alTop: S := FControl.Height + Split;
+ alBottom: S := FControl.Height - Split;
+ end;
+ NewSize := S;
+ if S < FMinSize then
+ NewSize := FMinSize
+ else if S > FMaxSize then
+ NewSize := FMaxSize;
+ if S <> NewSize then
+ begin
+ if Align in [alRight, alBottom] then
+ S := S - NewSize
+ else
+ S := NewSize - S;
+ Inc(Split, S);
+ end;
+end;
+
+function TfpgSplitter.FindControl: TfpgWidget;
+var
+ i: Integer;
+ wg: TfpgWidget;
+ p: TPoint;
+ r: TfpgRect;
+begin
+ Result := nil;
+ p := Point(Left, Top);
+ case Align of
+ alLeft: Dec(p.X);
+ alRight: Inc(p.X, Width);
+ alTop: Dec(p.Y);
+ alBottom: Inc(p.Y, Height);
+ else
+ Exit;
+ end;
+
+ for i := 0 to Parent.ComponentCount-1 do
+ begin
+ wg := TfpgWidget(Parent.Components[i]);
+ if (wg <> nil) and wg.Visible and wg.Enabled then
+ begin
+ Result := wg;
+ r := Result.GetBoundsRect;
+ if (r.Width = 0) then
+ if Align in [alTop, alLeft] then
+ Dec(r.Left)
+ else
+ Inc(r.Width);
+ if (r.Height = 0) then
+ if Align in [alTop, alLeft] then
+ Dec(r.Top)
+ else
+ Inc(r.Height);
+ if PtInRect(r, p) then Exit;
+ end;
+ end;
+ Result := nil;
+end;
+
+procedure TfpgSplitter.UpdateControlSize;
+begin
+ if FNewSize <> FOldSize then
+ begin
+ case Align of
+ alLeft, alRight: // FControl.Width := FNewSize; // (1)
+ FControl.MoveAndResize(FControl.Left, FControl.Top, FNewSize, FControl.Height); // (2)
+ alTop, alBottom: // FControl.Height := FNewSize; // (1)
+ FControl.MoveAndResize(FControl.Left, FControl.Top, FControl.Width, FNewSize); // (2)
+ end;
+ // FControl.UpdateWindowPosition; // (1)
+ // vvzh:
+ // Lines marked with (1) work wrong under Linux (e.g. folding/unfolding Memo1)
+ // Lines marked with (2) work OK under both platforms. Why?
+ Parent.Realign;
+ // if Assigned(FOnMoved) then FOnMoved(Self);
+ FOldSize := FNewSize;
+ end;
+end;
+
+procedure TfpgSplitter.UpdateSize(X, Y: Integer);
+begin
+ CalcSplitSize(X, Y, FNewSize, FSplit);
+end;
+
+function TfpgSplitter.DoCanResize(var NewSize: Integer): Boolean;
+begin
+ // Result := CanResize(NewSize); // omit onCanResize call
+ Result := True;
+ if Result and (NewSize <= FMinSize) and FAutoSnap then
+ NewSize := 0;
+end;
+
+procedure TfpgSplitter.HandleLMouseDown(x, y: integer; shiftstate: TShiftState);
+var
+ i: integer;
+ wg: TfpgWidget;
+begin
+ inherited HandleLMouseDown(x, y, shiftstate);
+
+ FControl := FindControl;
+ FDownPos := Point(X, Y);
+
+ if Assigned(FControl) then
+ begin
+ if Align in [alLeft, alRight] then
+ begin
+ FMaxSize := Parent.Width - FMinSize;
+ for i := 0 to Parent.ComponentCount-1 do
+ begin
+ wg := TfpgWidget(Parent.Components[i]);
+ if wg.Visible and (wg.Align in [alLeft, alRight]) then
+ Dec(FMaxSize, Width);
+ end;
+ Inc(FMaxSize, FControl.Width);
+ end
+ else
+ begin
+ FMaxSize := Parent.Height - FMinSize;
+ for i := 0 to Parent.ComponentCount-1 do
+ begin
+ wg := TfpgWidget(Parent.Components[i]);
+ if (wg.Align in [alTop, alBottom]) then
+ Dec(FMaxSize, Height);
+ end;
+ Inc(FMaxSize, FControl.Height);
+ end;
+ UpdateSize(X, Y);
+ CaptureMouse;
+ {AllocateLineDC;
+ with ValidParentForm(Self) do
+ if ActiveControl <> nil then
+ begin
+ FActiveControl := ActiveControl;
+ FOldKeyDown := TWinControlAccess(FActiveControl).OnKeyDown;
+ TWinControlAccess(FActiveControl).OnKeyDown := FocusKeyDown;
+ end;
+ if ResizeStyle in [rsLine, rsPattern] then DrawLine;}
+ end;
+end;
+
+procedure TfpgSplitter.HandleLMouseUp(x, y: integer; shiftstate: TShiftState);
+begin
+ inherited HandleLMouseUp(x, y, shiftstate);
+ if Assigned(FControl) then
+ begin
+ ReleaseMouse;
+ // if ResizeStyle in [rsLine, rsPattern] then DrawLine;
+ UpdateControlSize;
+ {writeln('LT: ', FControl.Left, ':', FControl.Width, ' ', Self.Left, ':', Self.Width);
+ writeln('RB: ', FControl.Top, ':', FControl.Height, ' ', Self.Top, ':', Self.Height);}
+ StopSizing;
+ end;
+end;
+
+procedure TfpgSplitter.HandleMouseMove(x, y: integer; btnstate: word;
+ shiftstate: TShiftState);
+var
+ NewSize, Split: Integer;
+begin
+ inherited HandleMouseMove(x, y, btnstate, shiftstate);
+ if (ssLeft in shiftstate) and Assigned(FControl) then
+ begin
+ CalcSplitSize(X, Y, NewSize, Split);
+ if DoCanResize(NewSize) then
+ begin
+ // if ResizeStyle in [rsLine, rsPattern] then DrawLine;
+ FNewSize := NewSize;
+ FSplit := Split;
+ // if ResizeStyle = rsUpdate then
+ UpdateControlSize;
+ // if ResizeStyle in [rsLine, rsPattern] then DrawLine;
+ end;
+ end;
+end;
+
+procedure TfpgSplitter.HandleMouseEnter;
+begin
+ if Align in [alBottom, alTop] then
+ MouseCursor := mcSizeNS
+ else
+ MouseCursor := mcSizeEW;
+end;
+
+procedure TfpgSplitter.HandleMouseExit;
+begin
+ if FControl = nil then
+ MouseCursor := mcDefault;
+end;
+
+procedure TfpgSplitter.HandlePaint;
+begin
+ Canvas.SetColor(clWindowBackground);
+ Canvas.FillRectangle(GetClientBounds);
+end;
+
+procedure TfpgSplitter.StopSizing;
+begin
+ if Assigned(FControl) then
+ begin
+ // if FLineVisible then DrawLine;
+ FControl := nil;
+ {ReleaseLineDC;
+ if Assigned(FActiveControl) then
+ begin
+ TWinControlAccess(FActiveControl).OnKeyDown := FOldKeyDown;
+ FActiveControl := nil;
+ end;}
+ end;
+ {if Assigned(FOnMoved) then
+ FOnMoved(Self);}
+end;
+
+constructor TfpgSplitter.Create(AOwner: TComponent);
+begin
+ inherited Create(AOwner);
+ FAutoSnap := True;
+ Height := 100;
+ Align := alLeft;
+ Width := 2;
+ FMinSize := 30;
+ // FResizeStyle := rsPattern;
+ FOldSize := -1;
+end;
+
+destructor TfpgSplitter.Destroy;
+begin
+ inherited Destroy;
+end;
+
+end.