summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--examples/gui/gridtest/gridtest.lpr11
-rw-r--r--src/corelib/render/software/Agg2D.pas3
-rw-r--r--src/corelib/render/software/agg_blur.pas2
-rw-r--r--src/gui/fpg_basegrid.pas108
-rw-r--r--src/gui/fpg_grid.pas3
-rw-r--r--src/gui/fpg_scrollbar.pas2
-rw-r--r--uidesigner/vfddesigner.pas34
7 files changed, 152 insertions, 11 deletions
diff --git a/examples/gui/gridtest/gridtest.lpr b/examples/gui/gridtest/gridtest.lpr
index 173806e9..4b53f260 100644
--- a/examples/gui/gridtest/gridtest.lpr
+++ b/examples/gui/gridtest/gridtest.lpr
@@ -17,7 +17,8 @@ uses
fpg_checkbox,
fpg_tab,
fpg_edit,
- fpg_dialogs;
+ fpg_dialogs,
+ fpg_scrollbar;
type
@@ -256,6 +257,14 @@ begin
OnDrawCell := @StringGridDrawCell;
OnDoubleClick := @StringGridDoubleClicked;
OnHeaderClick := @StringGridHeaderClicked;
+ // Testing various scrollbar styles
+// ScrollBarStyle:= ssNone;
+// ScrollBarStyle:= ssHorizontal;
+// ScrollBarStyle:= ssVertical;
+ ScrollBarStyle:= ssAutoBoth;
+// ScrollBarStyle:= ssHorizVisible;
+// ScrollBarStyle:= ssVertiVisible;
+// ScrollBarStyle:= ssBothVisible;
end;
chkShowHeader := TfpgCheckBox.Create(self);
diff --git a/src/corelib/render/software/Agg2D.pas b/src/corelib/render/software/Agg2D.pas
index 333e37ea..b77b9ce9 100644
--- a/src/corelib/render/software/Agg2D.pas
+++ b/src/corelib/render/software/Agg2D.pas
@@ -2653,9 +2653,10 @@ procedure TAgg2D.Font(
italic : boolean = false;
cache : TAggFontCacheType = AGG_VectorFontCache;
angle : double = 0.0 );
+{$IFDEF AGG2D_USE_WINFONTS}
var
b : int;
-
+{$ENDIF}
begin
m_textAngle :=angle;
m_fontHeight :=height;
diff --git a/src/corelib/render/software/agg_blur.pas b/src/corelib/render/software/agg_blur.pas
index 5ddda2bc..78e6df72 100644
--- a/src/corelib/render/software/agg_blur.pas
+++ b/src/corelib/render/software/agg_blur.pas
@@ -25,7 +25,7 @@
// http://incubator.quasimondo.com/processing/fast_blur_deluxe.php
// (search phrase "Stackblur: Fast But Goodlooking").
// The major improvement is that there's no more division table
-// that was very expensive to create for large blur radii. Insted,
+// that was very expensive to create for large blur radii. Instead,
// for 8-bit per channel and radius not exceeding 254 the division is
// replaced by multiplication and shift.
//
diff --git a/src/gui/fpg_basegrid.pas b/src/gui/fpg_basegrid.pas
index 6bd90cfd..2df7b414 100644
--- a/src/gui/fpg_basegrid.pas
+++ b/src/gui/fpg_basegrid.pas
@@ -79,6 +79,7 @@ type
FScrollBarStyle: TfpgScrollStyle;
FShowGrid: boolean;
FShowHeader: boolean;
+ FAutoHeight: boolean;
FTemp: integer;
FVScrollBar: TfpgScrollBar;
FHScrollBar: TfpgScrollBar;
@@ -89,6 +90,7 @@ type
FBorderStyle: TfpgEditBorderStyle;
function GetFontDesc: string;
function GetHeaderFontDesc: string;
+ function GetScrollBarWidth: Integer;
function GetTotalColumnWidth: integer;
function GetAdjustedBorderSizes: TRect;
procedure HScrollBarMove(Sender: TObject; position: integer);
@@ -98,6 +100,9 @@ type
procedure SetHeaderStyle(const AValue: TfpgGridHeaderStyle);
procedure SetRowSelect(const AValue: boolean);
procedure SetScrollBarStyle(const AValue: TfpgScrollStyle);
+ function GetScrollBarPage: integer;
+ procedure SetScrollBarPage(const AValue: integer);
+ procedure SetScrollBarWidth(const AValue: integer);
procedure VScrollBarMove(Sender: TObject; position: integer);
procedure SetDefaultColWidth(const AValue: integer);
procedure SetDefaultRowHeight(const AValue: integer);
@@ -106,10 +111,12 @@ type
procedure CheckFocusChange;
procedure SetShowGrid(const AValue: boolean);
procedure SetShowHeader(const AValue: boolean);
+ procedure SetAutoHeight(const AValue: boolean);
function VisibleLines: Integer;
procedure SetFirstRow(const AValue: Integer);
procedure SetAlternativeBGColor(const AValue: TfpgColor);
procedure SetBorderStyle(AValue: TfpgEditBorderStyle);
+ function AdjustHeight: Integer;
protected
property UpdateCount: integer read FUpdateCount;
procedure UpdateScrollBars; virtual;
@@ -158,7 +165,10 @@ type
property RowCount: Integer read GetRowCount;
property ShowHeader: boolean read FShowHeader write SetShowHeader default True;
property ShowGrid: boolean read FShowGrid write SetShowGrid default True;
+ property AutoHeight: boolean read FAutoHeight write SetAutoHeight default False;
property ScrollBarStyle: TfpgScrollStyle read FScrollBarStyle write SetScrollBarStyle default ssAutoBoth;
+ property ScrollBarPage: Integer read GetScrollBarPage write SetScrollBarPage;
+ property ScrollBarWidth: Integer read GetScrollBarWidth write SetScrollBarWidth;
property HeaderHeight: integer read FHeaderHeight write SetHeaderHeight;
property TotalColumnWidth: integer read GetTotalColumnWidth;
// property ColResizing: boolean read FColResizing write FColResizing;
@@ -225,6 +235,11 @@ begin
Result := FHeaderFont.FontDesc;
end;
+function TfpgBaseGrid.GetScrollBarWidth: Integer;
+begin
+ Result := FVScrollBar.Width;
+end;
+
function TfpgBaseGrid.GetTotalColumnWidth: integer;
var
i: integer;
@@ -308,6 +323,28 @@ begin
FScrollBarStyle := AValue;
end;
+function TfpgBaseGrid.GetScrollBarPage: integer;
+begin
+ Result:= FVScrollBar.PageSize;
+end;
+
+procedure TfpgBaseGrid.SetScrollBarPage(const AValue: integer);
+begin
+ if AValue= FVScrollBar.PageSize then
+ Exit; //==>
+ FVScrollBar.PageSize:= AValue;
+end;
+
+procedure TfpgBaseGrid.SetScrollBarWidth(const AValue: integer);
+begin
+ if FVScrollBar.Width = AValue then
+ Exit; //==>
+ FVScrollBar.Width := AValue;
+ FHScrollBar.Height:= AValue;
+ if FAutoHeight then
+ Height := AdjustHeight;
+end;
+
procedure TfpgBaseGrid.VScrollBarMove(Sender: TObject; position: integer);
begin
if FFirstRow <> position then
@@ -558,6 +595,15 @@ begin
RePaint;
end;
+procedure TfpgBaseGrid.SetAutoHeight(const AValue: boolean);
+begin
+ if FAutoHeight= AValue then
+ Exit; //==>
+ FAutoHeight := AValue;
+ if FAutoHeight then
+ Height := AdjustHeight;
+end;
+
// Return the fully visible lines only. Partial lines not counted
function TfpgBaseGrid.VisibleLines: Integer;
var
@@ -620,6 +666,28 @@ begin
Repaint;
end;
+function TfpgBaseGrid.AdjustHeight: Integer;
+var
+ r: TRect;
+begin
+ if FAutoHeight then
+ begin
+ r := GetAdjustedBorderSizes;
+ if FShowHeader then
+ if (FScrollBarStyle = ssHorizontal) or (FScrollBarStyle = ssAutoBoth) then
+ Result := Succ(((Height - r.Bottom * 2 - HeaderHeight - FHScrollBar.Height) div DefaultRowHeight) * DefaultRowHeight + HeaderHeight + FHScrollBar.Height + r.Bottom * 2)
+ else
+ Result := Succ(((Height - r.Bottom * 2 - HeaderHeight) div DefaultRowHeight) * DefaultRowHeight + HeaderHeight + r.Bottom * 2)
+ else
+ if (FScrollBarStyle = ssHorizontal) or (FScrollBarStyle = ssAutoBoth) then
+ Result := Succ(((Height - r.Bottom * 2 - FHScrollBar.Height) div DefaultRowHeight) * DefaultRowHeight + FHScrollBar.Height + r.Bottom * 2)
+ else
+ Result := Succ(((Height - r.Bottom * 2) div DefaultRowHeight) * DefaultRowHeight + r.Bottom * 2);
+ if Align = alBottom then
+ Top := Top + Height - result;
+ end;
+end;
+
procedure TfpgBaseGrid.UpdateScrollBars;
var
HWidth: integer;
@@ -668,6 +736,22 @@ var
Vfits := vl >= RowCount;
end;
+ function ColMax: integer;
+ var
+ i: integer;
+ w: integer;
+ begin
+ w := 0;
+ Result := 0;
+ for i := 0 to ColumnCount-1 do
+ begin
+ w := w + ColumnWidth[i];
+ if w > Width then
+ inc(Result);
+ end;
+ inc(Result);
+ end;
+
begin
// if we don't want any scrollbars, hide them and exit
if FScrollBarStyle = ssNone then
@@ -733,6 +817,25 @@ begin
getVisLines;
end;
end;
+ ssHorizVisible:
+ begin
+ hideScrollbar (FVScrollBar);
+ showH := true;
+ getVisLines;
+ end;
+ ssVertiVisible:
+ begin
+ hideScrollbar (FHScrollBar);
+ showV := true;
+ getVisWidth;
+ end;
+ ssBothVisible:
+ begin
+ showV := true;
+ showH := true;
+ getVisLines;
+ getVisWidth;
+ end;
end;
// set the scrollbar width/height space
@@ -780,16 +883,15 @@ begin
if FXOffset>hmax then
FXOffset:=hmax;
FHScrollBar.Position := FXOffset;
- FHScrollBar.SliderSize := HWidth / TotalColumnWidth;
FHScrollBar.PageSize := 5;
end
else
begin
- FHScrollBar.Max := ColumnCount-1;
+ FHScrollBar.Max := ColMax;
FHScrollBar.Position := FFirstCol;
- FHScrollBar.SliderSize := 1 / ColumnCount;
FHScrollBar.PageSize := 1;
end;
+ FHScrollBar.SliderSize := HWidth / TotalColumnWidth;
FHScrollBar.RepaintSlider;
FHScrollBar.Top := Height - FHScrollBar.Height - borders.Bottom;
FHScrollBar.Left := borders.Left;
diff --git a/src/gui/fpg_grid.pas b/src/gui/fpg_grid.pas
index 3f8b52fb..1f7e0f54 100644
--- a/src/gui/fpg_grid.pas
+++ b/src/gui/fpg_grid.pas
@@ -136,6 +136,7 @@ type
published
property Align;
property AlternateBGColor;
+ property AutoHeight;
property BackgroundColor;
property BorderStyle;
// property ColResizing;
@@ -158,6 +159,8 @@ type
property RowCount;
property RowSelect;
property ScrollBarStyle;
+ property ScrollBarPage;
+ property ScrollBarWidth;
property ShowGrid;
property ShowHeader;
property ShowHint;
diff --git a/src/gui/fpg_scrollbar.pas b/src/gui/fpg_scrollbar.pas
index 1ec78952..fbe20006 100644
--- a/src/gui/fpg_scrollbar.pas
+++ b/src/gui/fpg_scrollbar.pas
@@ -36,7 +36,7 @@ uses
type
TScrollNotifyEvent = procedure(Sender: TObject; position: integer) of object;
- TfpgScrollStyle = (ssNone, ssHorizontal, ssVertical, ssAutoBoth, ssBothVisible);
+ TfpgScrollStyle = (ssNone, ssHorizontal, ssVertical, ssAutoBoth, ssHorizVisible, ssVertiVisible, ssBothVisible);
TfpgScrollBarPart = (sbpNone, sbpUpBack, sbpPageUpBack, sbpSlider, sbpDownForward, sbpPageDownForward);
diff --git a/uidesigner/vfddesigner.pas b/uidesigner/vfddesigner.pas
index 0de305cb..42fef1a2 100644
--- a/uidesigner/vfddesigner.pas
+++ b/uidesigner/vfddesigner.pas
@@ -81,11 +81,12 @@ type
FSelected: boolean;
resizer: array[1..8] of TwgResizer;
other: TStringList;
+ MarkForDeletion: Boolean;
constructor Create(AFormDesigner: TFormDesigner; wg: TfpgWidget; wgc: TVFDWidgetClass);
destructor Destroy; override;
+ procedure UpdateResizerPositions;
property Selected: boolean read FSelected write SetSelected;
property Widget: TfpgWidget read FWidget;
- procedure UpdateResizerPositions;
property FormDesigner: TFormDesigner read FFormDesigner;
end;
@@ -205,6 +206,7 @@ begin
FSelected := False;
wg.MouseCursor := mcDefault;
other := TStringList.Create;
+ MarkForDeletion := False;
end;
destructor TWidgetDesigner.Destroy;
@@ -630,20 +632,44 @@ procedure TFormDesigner.DeleteWidgets;
var
n: integer;
cd: TWidgetDesigner;
+
+ procedure DeleteChildWidget(ADesignWidget: TWidgetDesigner);
+ var
+ i: integer;
+ begin
+ if not Assigned(ADesignWidget.Widget) then // safety check
+ Exit;
+ if ADesignWidget.Widget.IsContainer and (ADesignWidget.Widget.ComponentCount > 0) then
+ begin
+ for i := ADesignWidget.Widget.ComponentCount - 1 downto 0 do
+ DeleteChildWidget(WidgetDesigner(TfpgWidget(ADesignWidget.Widget.Components[i])));
+ end;
+ ADesignWidget.MarkForDeletion := True;
+ end;
+
begin
n := 0;
+ // Pass 1: Mark widgets and children than need deletion
while n < FWidgets.Count do
begin
cd := TWidgetDesigner(FWidgets.Items[n]);
if cd.Selected then
+ DeleteChildWidget(cd);
+ Inc(n);
+ end;
+
+ // Pass 2: free TWidgetDesigner instances that have no more Widget instances
+ for n := FWidgets.Count-1 downto 0 do
+ begin
+ cd := TWidgetDesigner(FWidgets.Items[n]);
+ if cd.MarkForDeletion then
begin
cd.Widget.Free;
cd.Free;
FWidgets.Delete(n);
- end
- else
- Inc(n);
+ end;
end;
+
UpdatePropWin;
end;
generated by cgit v1.2.3-70-g09d2 (git 2.47.0) at 2024-10-17 23:51:36 +0000