summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--examples/gui/splitter/extrafpc.cfg5
-rw-r--r--examples/gui/splitter/splitter_test.lpi69
-rw-r--r--examples/gui/splitter/splitter_test.lpr151
-rw-r--r--src/corelib/gdi/fpgui_toolkit.lpk6
-rw-r--r--src/corelib/gdi/fpgui_toolkit.pas2
-rw-r--r--src/corelib/gdi/gfx_gdi.pas100
-rw-r--r--src/corelib/gfx_widget.pas18
7 files changed, 290 insertions, 61 deletions
diff --git a/examples/gui/splitter/extrafpc.cfg b/examples/gui/splitter/extrafpc.cfg
new file mode 100644
index 00000000..073dc4b6
--- /dev/null
+++ b/examples/gui/splitter/extrafpc.cfg
@@ -0,0 +1,5 @@
+-FUunits
+-Fu../../../lib
+-Xs
+-XX
+-CX
diff --git a/examples/gui/splitter/splitter_test.lpi b/examples/gui/splitter/splitter_test.lpi
new file mode 100644
index 00000000..1d0201aa
--- /dev/null
+++ b/examples/gui/splitter/splitter_test.lpi
@@ -0,0 +1,69 @@
+<?xml version="1.0"?>
+<CONFIG>
+ <ProjectOptions>
+ <PathDelim Value="\"/>
+ <Version Value="5"/>
+ <General>
+ <Flags>
+ <SaveOnlyProjectUnits Value="True"/>
+ </Flags>
+ <SessionStorage Value="InProjectDir"/>
+ <MainUnit Value="0"/>
+ <IconPath Value=".\"/>
+ <TargetFileExt Value=".exe"/>
+ </General>
+ <VersionInfo>
+ <ProjectVersion Value=""/>
+ </VersionInfo>
+ <PublishOptions>
+ <Version Value="2"/>
+ <DestinationDirectory Value="$(TestDir)\publishedproject\"/>
+ <IgnoreBinaries Value="False"/>
+ <IncludeFileFilter Value="*.(pas|pp|inc|lfm|lpr|lrs|lpi|lpk|sh|xml)"/>
+ <ExcludeFileFilter Value="*.(bak|ppu|ppw|o|so);*~;backup"/>
+ </PublishOptions>
+ <RunParams>
+ <local>
+ <FormatVersion Value="1"/>
+ <LaunchingApplication PathPlusParams="\usr\X11R6\bin\xterm -T 'Lazarus Run Output' -e $(LazarusDir)\tools\runwait.sh $(TargetCmdLine)"/>
+ </local>
+ </RunParams>
+ <RequiredPackages Count="1">
+ <Item1>
+ <PackageName Value="fpgui_toolkit"/>
+ </Item1>
+ </RequiredPackages>
+ <Units Count="1">
+ <Unit0>
+ <Filename Value="splitter_test.lpr"/>
+ <IsPartOfProject Value="True"/>
+ <UnitName Value="splitter_test"/>
+ </Unit0>
+ </Units>
+ </ProjectOptions>
+ <CompilerOptions>
+ <Version Value="5"/>
+ <PathDelim Value="\"/>
+ <CodeGeneration>
+ <SmartLinkUnit Value="True"/>
+ <Checks>
+ <IOChecks Value="True"/>
+ <RangeChecks Value="True"/>
+ <OverflowChecks Value="True"/>
+ <StackChecks Value="True"/>
+ </Checks>
+ <Generate Value="Faster"/>
+ </CodeGeneration>
+ <Linking>
+ <Debugging>
+ <UseLineInfoUnit Value="False"/>
+ <StripSymbols Value="True"/>
+ </Debugging>
+ <LinkSmart Value="True"/>
+ </Linking>
+ <Other>
+ <CustomOptions Value="-FUunits"/>
+ <CompilerPath Value="$(CompPath)"/>
+ </Other>
+ </CompilerOptions>
+</CONFIG>
diff --git a/examples/gui/splitter/splitter_test.lpr b/examples/gui/splitter/splitter_test.lpr
new file mode 100644
index 00000000..cc79b433
--- /dev/null
+++ b/examples/gui/splitter/splitter_test.lpr
@@ -0,0 +1,151 @@
+program splitter_test;
+
+{$mode objfpc}{$H+}
+
+uses
+ {$IFDEF UNIX}{$IFDEF UseCThreads}
+ cthreads,
+ {$ENDIF}{$ENDIF}
+ SysUtils, Classes, gfxbase, fpgfx,
+ gui_form, gui_memo, gui_listbox,
+ gui_panel, gui_progressbar, gui_splitter, fpgui_toolkit;
+
+type
+ { TfrmSplitterTest }
+
+ TfrmSplitterTest = class(TfpgForm)
+ public
+ {@VFD_HEAD_BEGIN: frmSplitterTest}
+ lstChoice: TfpgListBox;
+ spl1: TfpgSplitter;
+ mmSource: TfpgMemo;
+ spl2: TfpgSplitter;
+ mmDest: TfpgMemo;
+ pnlName1: TfpgPanel;
+ spl3: TfpgSplitter;
+ pbName1: TfpgProgressBar;
+ spl4: TfpgSplitter;
+ {@VFD_HEAD_END: frmSplitterTest}
+ procedure AfterCreate; override;
+ end;
+
+{@VFD_NEWFORM_DECL}
+
+{@VFD_NEWFORM_IMPL}
+
+procedure TfrmSplitterTest.AfterCreate;
+begin
+ {@VFD_BODY_BEGIN: frmSplitterTest}
+ Name := 'frmSplitterTest';
+ SetPosition(292, 184, 553, 290);
+ WindowTitle := 'Splitter Demo';
+
+ lstChoice := TfpgListBox.Create(self);
+ with lstChoice do
+ begin
+ Name := 'lstChoice';
+ SetPosition(-1, 0, 160, 211);
+ FontDesc := '#List';
+ Items.Add('List item #1');
+ Items.Add('List item #2');
+ TabOrder := 3;
+ Align := alLeft;
+ end;
+
+ spl1 := TfpgSplitter.Create(self);
+ with spl1 do
+ begin
+ Name := 'spl1';
+ SetPosition(159, 0, 2, 212);
+ Align := alLeft;
+ end;
+
+ mmSource := TfpgMemo.Create(self);
+ with mmSource do
+ begin
+ Name := 'mmSource';
+ SetPosition(164, 0, 257, 90);
+ Lines.Add('Memo1 Line #1');
+ Lines.Add('Memo1 Line #2');
+ FontDesc := '#Edit1';
+ TabOrder := 2;
+ Align := alTop;
+ end;
+
+ spl2 := TfpgSplitter.Create(self);
+ with spl2 do
+ begin
+ Name := 'spl2';
+ SetPosition(165, 90, 257, 2);
+ Align := alTop;
+ end;
+
+ mmDest := TfpgMemo.Create(self);
+ with mmDest do
+ begin
+ Name := 'mmDest';
+ SetPosition(165, 94, 256, 116);
+ Lines.Add('Memo2 Line #1');
+ Lines.Add('Memo2 Line #2');
+ FontDesc := '#Edit1';
+ TabOrder := 1;
+ Align := alClient;
+ end;
+
+ pnlName1 := TfpgPanel.Create(self);
+ with pnlName1 do
+ begin
+ Name := 'pnlName1';
+ SetPosition(425, 0, 128, 208);
+ Text := 'Panel';
+ Align := alRight;
+ end;
+
+ spl3 := TfpgSplitter.Create(self);
+ with spl3 do
+ begin
+ Name := 'spl3';
+ SetPosition(422, 0, 2, 208);
+ Align := alRight;
+ end;
+
+ pbName1 := TfpgProgressBar.Create(self);
+ with pbName1 do
+ begin
+ Name := 'pbName1';
+ SetPosition(0, 213, 554, 78);
+ Position := 100;
+ Align := alBottom;
+ end;
+
+ spl4 := TfpgSplitter.Create(self);
+ with spl4 do
+ begin
+ Name := 'spl4';
+ SetPosition(0, 211, 554, 2);
+ Align := alBottom;
+ end;
+
+ // vvzh: the form appears unaligned under Linux, so we have to add the following line:
+ Self.Realign;
+
+ {@VFD_BODY_END: frmSplitterTest}
+end;
+
+procedure MainProc;
+var
+ frmSplitterTest: TfrmSplitterTest;
+begin
+ fpgApplication.Initialize;
+ frmSplitterTest := TfrmSplitterTest.Create(nil);
+ try
+ frmSplitterTest.Show;
+ fpgApplication.Run;
+ finally
+ frmSplitterTest.Free;
+ end;
+end;
+
+begin
+ MainProc;
+end.
diff --git a/src/corelib/gdi/fpgui_toolkit.lpk b/src/corelib/gdi/fpgui_toolkit.lpk
index 3a2bdd58..6acbaacb 100644
--- a/src/corelib/gdi/fpgui_toolkit.lpk
+++ b/src/corelib/gdi/fpgui_toolkit.lpk
@@ -30,7 +30,7 @@
<License Value="Modified LGPL
"/>
<Version Minor="6" Release="2"/>
- <Files Count="68">
+ <Files Count="69">
<Item1>
<Filename Value="..\stdimages.inc"/>
<Type Value="Include"/>
@@ -303,6 +303,10 @@
<Filename Value="gdikeys.inc"/>
<Type Value="Include"/>
</Item68>
+ <Item69>
+ <Filename Value="..\..\gui\gui_splitter.pas"/>
+ <UnitName Value="gui_splitter"/>
+ </Item69>
</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/gdi/fpgui_toolkit.pas b/src/corelib/gdi/fpgui_toolkit.pas
index a503b1ac..f85bebf3 100644
--- a/src/corelib/gdi/fpgui_toolkit.pas
+++ b/src/corelib/gdi/fpgui_toolkit.pas
@@ -16,7 +16,7 @@ uses
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, gfx_gdi, gfx_impl;
+ gui_trackbar, gui_tree, fpgui_db, gfx_gdi, gfx_impl, gui_splitter;
implementation
diff --git a/src/corelib/gdi/gfx_gdi.pas b/src/corelib/gdi/gfx_gdi.pas
index 67d04de1..497f66b0 100644
--- a/src/corelib/gdi/gfx_gdi.pas
+++ b/src/corelib/gdi/gfx_gdi.pas
@@ -708,7 +708,7 @@ begin
msgp.mouse.shiftstate := GetKeyboardShiftState;
- if uMsg = WM_MouseMove then
+ if uMsg = WM_MOUSEMOVE then
w.DoMouseEnterLeaveCheck(w, uMsg, wParam, lParam);
if mcode <> 0 then
@@ -1030,74 +1030,60 @@ end;
{ TfpgWindowImpl }
var
- // these are required for Windows MouseEnter & MouseExit detection.
+ // this are required for Windows MouseEnter & MouseExit detection.
uLastWindowHndl: TfpgWinHandle;
- uLastWindow: TfpgWindowImpl;
function TfpgWindowImpl.DoMouseEnterLeaveCheck(AWindow: TfpgWindowImpl; uMsg, wParam, lParam: Cardinal): Boolean;
-
- //----------------------
- function CursorInDifferentWindow: Boolean;
- var
- pt: Windows.POINT;
- begin
- pt.x := LoWord(lParam);
- pt.y := HiWord(lParam);
-
- // only WM_MOUSEWHEEL uses screen coordinates!!!
- if uMsg <> WM_MOUSEWHEEL then
- Windows.ClientToScreen(FWinHandle, @pt);
-
- Result := WindowFromPoint(pt) <> uLastWindowHndl;
- end;
-
var
- pt: Windows.POINT;
+ pt, spt: Windows.POINT;
msgp: TfpgMessageParams;
- b: boolean;
-begin
- b := CursorInDifferentWindow;
- FillChar(msgp, sizeof(msgp), 0);
+ CursorInDifferentWindow: boolean;
+ CurrentWindowHndl: TfpgWinHandle;
+ LastWindow: TfpgWindowImpl;
+
+begin
+ // vvzh: this method currently cannot receive mouse events when mouse pointer
+ // is outside of the application window. We could try to play with
+ // TrackMouseEvent to catch such events and then
+ // - send FPGM_MOUSEEXIT/FPGM_MOUSEENTER
+ // - set uLastWindowHndl to 0
+ // An example:
+ // var tme: TTrackMouseEvent;
+ // tme.cbSize := SizeOf(tme);
+ // tme.hwndTrack := m_hWnd;
+ // tme.dwFlags := TME_LEAVE or TME_HOVER;
+ // tme.dwHoverTime := 1;
+ // TrackMouseEvent(tme);
+
pt.x := LoWord(lParam);
pt.y := HiWord(lParam);
- if (not b) and (not FMouseInWindow) then
- begin
- if not CursorInDifferentWindow then
- begin
- FMouseInWindow := True;
-// writeln('GFX: MouseEnter detected');
- fpgSendMessage(nil, AWindow, FPGM_MOUSEENTER, msgp);
- end;
- Result := uMsg <> WM_MOUSEMOVE;
- end
+ spt := pt;
+ // only WM_MOUSEWHEEL uses screen coordinates!!!
+ if uMsg = WM_MOUSEWHEEL then
+ Windows.ScreenToClient(FWinHandle, @pt)
else
+ Windows.ClientToScreen(FWinHandle, @spt);
+
+ CurrentWindowHndl := WindowFromPoint(spt);
+ CursorInDifferentWindow := (CurrentWindowHndl <> uLastWindowHndl);
+
+ if CursorInDifferentWindow then
begin
-// writeln('... in else part... (', pt.x, ',', pt.y, ')');
- if uMsg = WM_MOUSEWHEEL then
- Windows.ScreenToClient(FWinHandle, @pt);
- // we should change the Width and Height to ClientWidth, ClientHeight
- if (pt.x <= 0) or (pt.y <= 0) or (pt.x >= Width) or
- (pt.y >= Height) or CursorInDifferentWindow then
- FMouseInWindow := False;
-
- if not FMouseInWindow then
+ FillChar(msgp, sizeof(msgp), 0);
+ msgp.mouse.x := pt.x;
+ msgp.mouse.y := pt.y;
+ LastWindow := GetMyWidgetFromHandle(uLastWindowHndl);
+ // check if last window still exits. eg: Dialog window could be closed.
+ if LastWindow <> nil then
begin
- msgp.mouse.x := LoWord(lParam);
- msgp.mouse.y := HiWord(lParam);
// writeln('GFX: MouseExit detected');
- if uLastWindow <> nil then
- begin
- // check if last window still exits. eg: Dialog window could be closed.
- if GetMyWidgetFromHandle(uLastWindowHndl) <> nil then
- fpgSendMessage(nil, uLastWindow, FPGM_MOUSEEXIT, msgp);
- end;
- Result := False;
- end
- else
- Result := True;
+ fpgSendMessage(nil, LastWindow, FPGM_MOUSEEXIT, msgp);
+ end;
+// writeln('GFX: MouseEnter detected');
+ fpgSendMessage(nil, AWindow, FPGM_MOUSEENTER, msgp);
end;
- uLastWindowHndl := FWinHandle;
- uLastWindow := AWindow;
+
+ uLastWindowHndl := CurrentWindowHndl;
end;
procedure TfpgWindowImpl.DoAllocateWindowHandle(AParent: TfpgWindowBase);
diff --git a/src/corelib/gfx_widget.pas b/src/corelib/gfx_widget.pas
index d76e88cb..c6280e05 100644
--- a/src/corelib/gfx_widget.pas
+++ b/src/corelib/gfx_widget.pas
@@ -16,6 +16,8 @@ type
TFocusSearchDirection = (fsdFirst, fsdLast, fsdNext, fsdPrev);
+ { TfpgWidget }
+
TfpgWidget = class(TfpgWindow)
private
FAlignRect: TfpgRect;
@@ -63,7 +65,6 @@ type
FIsContainer: Boolean;
procedure SetBackgroundColor(const AValue: TfpgColor); virtual;
procedure SetTextColor(const AValue: TfpgColor); virtual;
- function GetClientBounds: TfpgRect; virtual;
function GetParent: TfpgWidget; reintroduce;
procedure SetParent(const AValue: TfpgWidget); reintroduce;
procedure SetEnabled(const AValue: boolean); virtual;
@@ -93,7 +94,6 @@ type
procedure HandleShow; virtual;
procedure InternalHandleShow; virtual;
procedure HandleHide; virtual;
- procedure MoveAndResize(ALeft, ATop, AWidth, AHeight: TfpgCoord);
procedure RePaint;
{ property events }
property OnClick: TNotifyEvent read FOnClick write FOnClick;
@@ -111,8 +111,12 @@ type
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
+ function GetClientBounds: TfpgRect; virtual;
+ function GetBoundsRect: TfpgRect; virtual;
+ procedure Realign;
procedure SetFocus;
procedure KillFocus;
+ procedure MoveAndResize(ALeft, ATop, AWidth, AHeight: TfpgCoord);
procedure MoveAndResizeBy(dx, dy, dw, dh: TfpgCoord);
procedure SetPosition(aleft, atop, awidth, aheight: TfpgCoord); virtual;
procedure Invalidate; // double check this works as developers expect????
@@ -245,6 +249,16 @@ begin
Result.SetRect(0, 0, Width, Height);
end;
+function TfpgWidget.GetBoundsRect: TfpgRect;
+begin
+ Result.SetRect(Left, Top, Width+1, Height+1);
+end;
+
+procedure TfpgWidget.Realign;
+begin
+ HandleAlignments(0, 0);
+end;
+
function TfpgWidget.GetParent: TfpgWidget;
begin
Result := TfpgWidget(inherited GetParent);
generated by cgit v1.2.3-70-g09d2 (git 2.47.1) at 2024-12-29 10:10:56 +0000