summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--examples/gui/gridtest/gridtest.lpi107
-rw-r--r--examples/gui/gridtest/gridtest.lpr4
-rw-r--r--examples/gui/listviewtest/listviewtest.lpr2
-rw-r--r--prototypes/fpgui2/tests/drawtest.lpi7
-rw-r--r--prototypes/fpgui2/tests/edittest.lpi7
-rw-r--r--src/gui/gui_grid.pas207
-rw-r--r--src/gui/gui_listbox.pas6
-rw-r--r--src/gui/gui_memo.pas9
-rw-r--r--src/gui/gui_scrollbar.pas20
9 files changed, 274 insertions, 95 deletions
diff --git a/examples/gui/gridtest/gridtest.lpi b/examples/gui/gridtest/gridtest.lpi
index ff9c418c..9b698ffe 100644
--- a/examples/gui/gridtest/gridtest.lpi
+++ b/examples/gui/gridtest/gridtest.lpi
@@ -1,54 +1,53 @@
-<?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=""/>
- </General>
- <VersionInfo>
- <ProjectVersion Value=""/>
- </VersionInfo>
- <PublishOptions>
- <Version Value="2"/>
- <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_package"/>
- <MinVersion Minor="5" Valid="True"/>
- </Item1>
- </RequiredPackages>
- <Units Count="1">
- <Unit0>
- <Filename Value="gridtest.lpr"/>
- <IsPartOfProject Value="True"/>
- <UnitName Value="gridtest"/>
- </Unit0>
- </Units>
- </ProjectOptions>
- <CompilerOptions>
- <Version Value="5"/>
- <PathDelim Value="\"/>
- <CodeGeneration>
- <Generate Value="Faster"/>
- </CodeGeneration>
- <Other>
- <CustomOptions Value="-FUunits"/>
- <CompilerPath Value="$(CompPath)"/>
- </Other>
- </CompilerOptions>
-</CONFIG>
+<?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=""/>
+ </General>
+ <VersionInfo>
+ <ProjectVersion Value=""/>
+ </VersionInfo>
+ <PublishOptions>
+ <Version Value="2"/>
+ <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_package"/>
+ <MinVersion Minor="5" Valid="True"/>
+ </Item1>
+ </RequiredPackages>
+ <Units Count="1">
+ <Unit0>
+ <Filename Value="gridtest.lpr"/>
+ <IsPartOfProject Value="True"/>
+ <UnitName Value="gridtest"/>
+ </Unit0>
+ </Units>
+ </ProjectOptions>
+ <CompilerOptions>
+ <Version Value="5"/>
+ <CodeGeneration>
+ <Generate Value="Faster"/>
+ </CodeGeneration>
+ <Other>
+ <CustomOptions Value="-FUunits"/>
+ <CompilerPath Value="$(CompPath)"/>
+ </Other>
+ </CompilerOptions>
+</CONFIG>
diff --git a/examples/gui/gridtest/gridtest.lpr b/examples/gui/gridtest/gridtest.lpr
index dac0e79a..40c91bec 100644
--- a/examples/gui/gridtest/gridtest.lpr
+++ b/examples/gui/gridtest/gridtest.lpr
@@ -67,12 +67,12 @@ begin
chkShowHeader := CreateCheckBox(self, 10, 320, 'Show Header');
chkShowHeader.Checked := True;
chkShowHeader.OnChange := @chkShowHeaderChange;
- chkShowHeader.Anchors := [anLeft, anBottom];
+ chkShowHeader.Anchors := [anLeft, anBottom];
chkShowGrid := CreateCheckBox(self, chkShowHeader.Right+10, 320, 'Show Grid');
chkShowGrid.Checked := True;
chkShowGrid.OnChange := @chkShowGridChange;
- chkShowGrid.Anchors := [anLeft, anBottom];
+ chkShowGrid.Anchors := [anLeft, anBottom];
end;
diff --git a/examples/gui/listviewtest/listviewtest.lpr b/examples/gui/listviewtest/listviewtest.lpr
index 7f551a2e..a0d80e0b 100644
--- a/examples/gui/listviewtest/listviewtest.lpr
+++ b/examples/gui/listviewtest/listviewtest.lpr
@@ -92,7 +92,7 @@ begin
OnPaintItem := @PaintItem;
MultiSelect := True;
end;
-
+
FTmpListView := TfpgListView.Create(Self);
with FTmpListView do begin
Parent := Self;
diff --git a/prototypes/fpgui2/tests/drawtest.lpi b/prototypes/fpgui2/tests/drawtest.lpi
index 72c37002..463c580b 100644
--- a/prototypes/fpgui2/tests/drawtest.lpi
+++ b/prototypes/fpgui2/tests/drawtest.lpi
@@ -1,7 +1,7 @@
<?xml version="1.0"?>
<CONFIG>
<ProjectOptions>
- <PathDelim Value="\"/>
+ <PathDelim Value="/"/>
<Version Value="5"/>
<General>
<Flags>
@@ -9,7 +9,7 @@
</Flags>
<SessionStorage Value="InProjectDir"/>
<MainUnit Value="0"/>
- <IconPath Value=".\"/>
+ <IconPath Value="./"/>
<TargetFileExt Value=""/>
</General>
<VersionInfo>
@@ -23,7 +23,7 @@
<RunParams>
<local>
<FormatVersion Value="1"/>
- <LaunchingApplication PathPlusParams="\usr\X11R6\bin\xterm -T 'Lazarus Run Output' -e $(LazarusDir)\tools\runwait.sh $(TargetCmdLine)"/>
+ <LaunchingApplication PathPlusParams="/usr/X11R6/bin/xterm -T 'Lazarus Run Output' -e $(LazarusDir)/tools/runwait.sh $(TargetCmdLine)"/>
</local>
</RunParams>
<RequiredPackages Count="1">
@@ -41,7 +41,6 @@
</ProjectOptions>
<CompilerOptions>
<Version Value="5"/>
- <PathDelim Value="\"/>
<CodeGeneration>
<Generate Value="Faster"/>
</CodeGeneration>
diff --git a/prototypes/fpgui2/tests/edittest.lpi b/prototypes/fpgui2/tests/edittest.lpi
index b609d403..1ecb384f 100644
--- a/prototypes/fpgui2/tests/edittest.lpi
+++ b/prototypes/fpgui2/tests/edittest.lpi
@@ -1,7 +1,7 @@
<?xml version="1.0"?>
<CONFIG>
<ProjectOptions>
- <PathDelim Value="\"/>
+ <PathDelim Value="/"/>
<Version Value="5"/>
<General>
<Flags>
@@ -9,7 +9,7 @@
</Flags>
<SessionStorage Value="InProjectDir"/>
<MainUnit Value="0"/>
- <IconPath Value=".\"/>
+ <IconPath Value="./"/>
<TargetFileExt Value=""/>
</General>
<VersionInfo>
@@ -23,7 +23,7 @@
<RunParams>
<local>
<FormatVersion Value="1"/>
- <LaunchingApplication PathPlusParams="\usr\X11R6\bin\xterm -T 'Lazarus Run Output' -e $(LazarusDir)\tools\runwait.sh $(TargetCmdLine)"/>
+ <LaunchingApplication PathPlusParams="/usr/X11R6/bin/xterm -T 'Lazarus Run Output' -e $(LazarusDir)/tools/runwait.sh $(TargetCmdLine)"/>
</local>
</RunParams>
<RequiredPackages Count="1">
@@ -42,7 +42,6 @@
</ProjectOptions>
<CompilerOptions>
<Version Value="5"/>
- <PathDelim Value="\"/>
<CodeGeneration>
<Generate Value="Faster"/>
</CodeGeneration>
diff --git a/src/gui/gui_grid.pas b/src/gui/gui_grid.pas
index 9249667c..6b34c7cb 100644
--- a/src/gui/gui_grid.pas
+++ b/src/gui/gui_grid.pas
@@ -61,7 +61,7 @@ type
procedure SetShowHeader(const AValue: boolean);
function VisibleLines: integer;
function VisibleWidth: integer;
- procedure UpdateScrollBar;
+ procedure UpdateScrollBars;
protected
function GetColumnWidth(ACol: integer): integer; virtual;
procedure SetColumnWidth(ACol: integer; const AValue: integer); virtual;
@@ -72,6 +72,8 @@ type
procedure DrawGrid(ARow, ACol: integer; ARect: TfpgRect; AFlags: integer); virtual;
procedure HandlePaint; override;
procedure HandleShow; override;
+ procedure HandleKeyPress(var keycode: word; var shiftstate: TShiftState; var consumed: boolean); override;
+ procedure FollowFocus; virtual;
property DefaultColWidth: integer read FDefaultColWidth write SetDefaultColWidth default 64;
property DefaultRowHeight: integer read FDefaultRowHeight write SetDefaultRowHeight;
public
@@ -157,7 +159,7 @@ begin
if (ACol = 2) and (AValue <> FTemp) then
begin
FTemp := AValue;
- UpdateScrollBar;
+ UpdateScrollBars;
Repaint;
end;
end;
@@ -221,6 +223,16 @@ begin
if FFocusCol = AValue then
Exit; //==>
FFocusCol := AValue;
+
+ // apply min/max limit
+ if FFocusCol < 1 then
+ FFocusCol := 1;
+ if FFocusCol > ColumnCount then
+ FFocusCol := ColumnCount;
+
+ FollowFocus;
+ CheckFocusChange;
+ UpdateScrollBars;
end;
procedure TfpgBaseGrid.SetFocusRow(const AValue: integer);
@@ -228,6 +240,16 @@ begin
if FFocusRow = AValue then
Exit; //==>
FFocusRow := AValue;
+
+ // apply min/max limit
+ if FFocusRow < 1 then
+ FFocusRow := 1;
+ if FFocusRow > RowCount then
+ FFocusRow := RowCount;
+
+ FollowFocus;
+ CheckFocusChange;
+ UpdateScrollBars;
end;
procedure TfpgBaseGrid.CheckFocusChange;
@@ -284,7 +306,7 @@ begin
Result := Width - FMargin*2 - sw;
end;
-procedure TfpgBaseGrid.UpdateScrollBar;
+procedure TfpgBaseGrid.UpdateScrollBars;
var
HWidth: integer;
VHeight: integer;
@@ -301,28 +323,27 @@ begin
cw := cw + ColumnWidth[i];
FHScrollBar.Visible := cw > vw;
-// writeln('RowCount:', RowCount, ' VisibleLines:', VisibleLines);
FVScrollBar.Visible := (RowCount > VisibleLines);
if FVScrollBar.Visible then
begin
Dec(HWidth, FVScrollBar.Width);
- FVScrollBar.Min := 1;
+ FVScrollBar.Min := 1;
if RowCount > 0 then
FVScrollBar.SliderSize := VisibleLines / RowCount
else
FVScrollBar.SliderSize := 0;
- FVScrollBar.Max := RowCount-VisibleLines+1;
- FVScrollBar.Position := FFirstRow;
+ FVScrollBar.Max := RowCount-VisibleLines+1;
+ FVScrollBar.Position := FFirstRow;
end;
if FHScrollBar.Visible then
begin
Dec(VHeight, FHScrollBar.Height);
- FHScrollBar.Min := 1;
- FHScrollBar.SliderSize := 0.2;
- FHScrollBar.Max := ColumnCount;
- FHScrollBar.Position := FFocusCol;
+ FHScrollBar.Min := 1;
+ FHScrollBar.SliderSize := 0.2;
+ FHScrollBar.Max := ColumnCount;
+ FHScrollBar.Position := FFocusCol;
end;
FHScrollBar.Top := Height -FHScrollBar.Height - 2;
@@ -469,7 +490,169 @@ end;
procedure TfpgBaseGrid.HandleShow;
begin
inherited HandleShow;
- UpdateScrollBar;
+ UpdateScrollBars;
+end;
+
+procedure TfpgBaseGrid.HandleKeyPress(var keycode: word;
+ var shiftstate: TShiftState; var consumed: boolean);
+var
+ w: integer;
+begin
+ consumed := True;
+ case keycode of
+ keyRight:
+ begin
+ if RowSelect then
+ begin
+ w := 0;
+ FFocusCol := FFirstCol;
+ while FFocusCol < ColumnCount do
+ begin
+ inc(w, ColumnWidth[FFocusCol]+1);
+ if w + ColumnWidth[FFocusCol+1]+1 > VisibleWidth then
+ Break;
+ inc(FFocusCol);
+ end;
+ end;
+
+ if FFocusCol < ColumnCount then
+ begin
+ inc(FFocusCol);
+ FollowFocus;
+ RePaint;
+ //DoChange;
+ end;
+ end;
+
+ keyLeft:
+ begin
+ if RowSelect then
+ FFocusCol := FFirstCol;
+ if FFocusCol > 1 then
+ begin
+ dec(FFocusCol);
+ FollowFocus;
+ RePaint;
+ //DoChange;
+ end;
+ end;
+
+ keyUp:
+ begin
+ if FFocusRow > 1 then
+ begin
+ dec(FFocusRow);
+ FollowFocus;
+ RePaint;
+ //DoChange;
+ end;
+ end;
+
+ keyDown:
+ begin
+ if FFocusRow < RowCount then
+ begin
+ inc(FFocusRow);
+ FollowFocus;
+ RePaint;
+ //DoChange;
+ end;
+ end;
+
+ keyPageUp:
+ begin
+ dec(FFocusRow,VisibleLines);
+ if FFocusRow < 1 then
+ FFocusRow := 1;
+ FollowFocus;
+ RePaint;
+ //DoChange;
+ end;
+
+ keyPageDown:
+ begin
+ inc(FFocusRow,VisibleLines);
+ if FFocusRow > RowCount then
+ FFocusRow := RowCount;
+ FollowFocus;
+ RePaint;
+ //DoChange;
+ end;
+
+ keyHome:
+ begin
+ FFocusCol := 1;
+ FollowFocus;
+ RePaint;
+ //DoChange;
+ end;
+
+ keyEnd:
+ begin
+ FFocusCol := ColumnCount;
+ FollowFocus;
+ RePaint;
+ //DoChange;
+ end;
+
+ else
+ consumed := False;
+ end;
+
+ if consumed then
+ CheckFocusChange;
+
+ inherited HandleKeyPress(keycode, shiftstate, consumed);
+end;
+
+procedure TfpgBaseGrid.FollowFocus;
+var
+ n: integer;
+ w: TfpgCoord;
+begin
+ if (RowCount > 0) and (FFocusRow < 1) then
+ FFocusRow := 1;
+ if FFocusRow > RowCount then
+ FFocusRow := RowCount;
+
+ if (ColumnCount > 0) and (FFocusCol < 1) then
+ FFocusCol := 1;
+ if FFocusCol > ColumnCount then
+ FFocusCol := ColumnCount;
+
+ if FFirstRow < 1 then
+ FFirstRow := 1;
+ if FFirstCol < 1 then
+ FFirstCol := 1;
+
+ if FFocusRow < FFirstRow then
+ FFirstRow := FFocusRow
+ else
+ begin
+ if (FFirstRow + VisibleLines - 1) < FFocusRow then
+ FFirstRow := FFocusRow - VisibleLines + 1;
+ end; { if/else }
+
+ if FFocusCol < FFirstCol then
+ FFirstCol := FFocusCol
+ else
+ begin
+ w := 0;
+ for n := FFocusCol downto FFirstCol do
+ begin
+ w := w + ColumnWidth[n]+1;
+ if w > VisibleWidth then
+ begin
+ if n = FFocusCol then
+ FFirstCol := n
+ else
+ FFirstCol := n+1;
+ break;
+ end;
+ end; { for }
+ end; { if/else }
+
+ UpdateScrollBars;
end;
constructor TfpgBaseGrid.Create(AOwner: TComponent);
diff --git a/src/gui/gui_listbox.pas b/src/gui/gui_listbox.pas
index 07ac9899..ad05fbc8 100644
--- a/src/gui/gui_listbox.pas
+++ b/src/gui/gui_listbox.pas
@@ -105,10 +105,6 @@ type
implementation
type
- // used to access protected properties
- TfpgScrollbarFriend = class(TfpgScrollbar)
- end;
-
// custom stringlist that will notify listbox of item changes
TfpgListBoxStrings = class(TStringList)
protected
@@ -218,8 +214,6 @@ begin
FScrollBar.SliderSize := 1;
FScrollBar.Max := ItemCount-pn+1;
FScrollBar.Position := FFirstItem;
- if FScrollBar.WinHandle > 0 then
- TfpgScrollbarFriend(FScrollBar).RePaint;
end;
end;
diff --git a/src/gui/gui_memo.pas b/src/gui/gui_memo.pas
index f00b388a..a6c737f1 100644
--- a/src/gui/gui_memo.pas
+++ b/src/gui/gui_memo.pas
@@ -147,8 +147,10 @@ begin
VHeight := Height - 4;
HWidth := Width - 4;
- if FVScrollBar.Visible then Dec(HWidth, FVScrollBar.Width);
- if FHScrollBar.Visible then Dec(VHeight, FHScrollBar.Height);
+ if FVScrollBar.Visible then
+ Dec(HWidth, FVScrollBar.Width);
+ if FHScrollBar.Visible then
+ Dec(VHeight, FHScrollBar.Height);
FHScrollBar.Top := Height -FHScrollBar.Height - 2;
FHScrollBar.Left := 2;
@@ -478,7 +480,6 @@ begin
else
FHScrollBar.SliderSize := VisibleWidth / FLongestLineWidth;
FHScrollBar.Position := FDrawOffset;
- FHScrollBar.RepaintSlider;
end;
if FVScrollBar.Visible then
@@ -487,8 +488,6 @@ begin
FVScrollBar.SliderSize := VisibleLines / LineCount;
FVScrollBar.Max := LineCount - VisibleLines + 1;
FVScrollBar.Position := FFirstLine;
-
- FVScrollBar.RePaintSlider;
end;
if (hsbwas <> FHScrollBar.Visible) or (vsbwas <> FVScrollBar.Visible) then
diff --git a/src/gui/gui_scrollbar.pas b/src/gui/gui_scrollbar.pas
index ce236fef..00295356 100644
--- a/src/gui/gui_scrollbar.pas
+++ b/src/gui/gui_scrollbar.pas
@@ -154,6 +154,8 @@ begin
FPosition := FMax
else
FPosition := AValue;
+
+ RepaintSlider;
end;
procedure TfpgScrollBar.ScrollTimer(Sender: TObject);
@@ -317,10 +319,11 @@ begin
inherited;
WasPressed := FStartBtnPressed or FEndBtnPressed;
FScrollTimer.Enabled := False;
- FStartBtnPressed := False;
- FEndBtnPressed := False;
- FSliderDragging := False;
- if WasPressed then HandlePaint;
+ FStartBtnPressed := False;
+ FEndBtnPressed := False;
+ FSliderDragging := False;
+ if WasPressed then
+ HandlePaint;
end;
procedure TfpgScrollBar.HandleMouseMove(x, y: integer; btnstate: word; shiftstate: TShiftState);
@@ -380,8 +383,10 @@ procedure TfpgScrollBar.HandleMouseScroll(x, y: integer; shiftstate: TShiftState
delta: smallint);
begin
inherited HandleMouseScroll(x, y, shiftstate, delta);
- if delta < 0 then PositionChange(-FScrollStep);
- if delta > 0 then PositionChange( FScrollStep);
+ if delta < 0 then
+ PositionChange(-FScrollStep);
+ if delta > 0 then
+ PositionChange( FScrollStep);
end;
procedure TfpgScrollBar.PositionChange(d: integer);
@@ -392,7 +397,8 @@ begin
if FPosition > FMax then
FPosition := FMax;
- if Visible then DrawSlider(True);
+ if Visible then
+ DrawSlider(True);
if Assigned(FOnScroll) then
FOnScroll(self, FPosition);
generated by cgit v1.2.3-70-g09d2 (git 2.47.1) at 2024-12-26 19:34:12 +0000