summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--examples/gui/gridtest/gridtest.lpi53
-rw-r--r--examples/gui/gridtest/gridtest.lpr68
-rw-r--r--src/corelib/fpgfx.pas10
-rw-r--r--src/gui/fpgui_package.lpk6
-rw-r--r--src/gui/fpgui_package.pas2
-rw-r--r--src/gui/gui_grid.pas418
6 files changed, 550 insertions, 7 deletions
diff --git a/examples/gui/gridtest/gridtest.lpi b/examples/gui/gridtest/gridtest.lpi
new file mode 100644
index 00000000..fe5fc9a6
--- /dev/null
+++ b/examples/gui/gridtest/gridtest.lpi
@@ -0,0 +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"/>
+ <TargetFileExt Value=""/>
+ </General>
+ <VersionInfo>
+ <ProjectVersion Value=""/>
+ </VersionInfo>
+ <PublishOptions>
+ <Version Value="2"/>
+ <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_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
new file mode 100644
index 00000000..2bf0c7a2
--- /dev/null
+++ b/examples/gui/gridtest/gridtest.lpr
@@ -0,0 +1,68 @@
+program gridtest;
+
+{$mode objfpc}{$H+}
+
+uses
+ {$IFDEF UNIX}{$IFDEF UseCThreads}
+ cthreads,
+ {$ENDIF}{$ENDIF}
+ Classes,
+ fpgfx,
+ gui_form,
+ gui_grid,
+ gui_button;
+
+
+type
+
+ TMainForm = class(TfpgForm)
+ private
+ btnQuit: TfpgButton;
+ grdMain: TfpgBaseGrid;
+ procedure btnQuitClick(Sender: TObject);
+ public
+ constructor Create(AOwner: TComponent); override;
+ end;
+
+{ TMainForm }
+
+procedure TMainForm.btnQuitClick(Sender: TObject);
+begin
+ Close;
+end;
+
+constructor TMainForm.Create(AOwner: TComponent);
+begin
+ inherited Create(AOwner);
+ WindowTitle := 'Grid control test';
+ SetPosition(100, 100, 566, 350);
+
+ btnQuit := CreateButton(self, 476, 320, 80, 'Quit', @btnQuitClick);
+ btnQuit.ImageName := 'stdimg.Quit';
+ btnQuit.ShowImage := True;
+ btnQuit.Anchors := [anRight, anBottom];
+
+ grdMain := TfpgBaseGrid.Create(self);
+ grdMain.Top := 10;
+ grdMain.Left := 10;
+ grdMain.Width := Width - 20;
+ grdMain.Height := 300;
+ grdMain.Anchors := [anLeft, anTop, anRight, anBottom];
+
+end;
+
+
+procedure MainProc;
+var
+ frm: TMainForm;
+begin
+ fpgApplication.Initialize;
+ frm := TMainForm.Create(nil);
+ frm.Show;
+ fpgApplication.Run;
+end;
+
+begin
+ MainProc;
+end.
+
diff --git a/src/corelib/fpgfx.pas b/src/corelib/fpgfx.pas
index 6410afde..cce070ca 100644
--- a/src/corelib/fpgfx.pas
+++ b/src/corelib/fpgfx.pas
@@ -496,7 +496,6 @@ begin
if n < fpgNamedFonts.Count then
TNamedFontItem(fpgNamedFonts[n]).FontDesc := afontdesc// already defined
-
else
fpgNamedFonts.Add(TNamedFontItem.Create(afontid, afontdesc));
end;
@@ -552,7 +551,7 @@ var
begin
fdesc := afontdesc;
- if copy(fdesc, 1, 1) = '#' then
+ if copy(fdesc, 1, 1) = '#' then // A # (hash) denotes a named font
fdesc := fpgGetNamedFontDesc(copy(afontdesc, 2, length(afontdesc)));
Result := nil;
@@ -776,13 +775,14 @@ begin
fpgSetNamedFont('Edit1', 'Arial-10');
fpgSetNamedFont('Edit2', 'Courier New-10');
fpgSetNamedFont('List', 'Arial-10');
- fpgSetNamedFont('Grid', 'Arial-9:antialias=false');
- fpgSetNamedFont('GridHeader', 'Arial-9:bold:antialias=false');
+ fpgSetNamedFont('Grid', 'Arial-9');
+ fpgSetNamedFont('GridHeader', 'Arial-9:bold');
fpgSetNamedFont('Menu', 'Arial-10');
fpgSetNamedFont('MenuAccel', 'Arial-10:bold');
fpgSetNamedFont('MenuDisabled', 'Arial-10:italic');
- {$Note Refactor this so under Windows it can detect the system colors instead.}
+ {$Note Refactor this so under Windows it can detect the system colors instead.
+ Also under Linux (KDE and Gnome) we should be able to detect the system colors.}
fpgSetNamedColor(clWindowBackground, $D4D0C8);
fpgSetNamedColor(clBoxColor, $FFFFFF);
fpgSetNamedColor(clShadow1, $808080);
diff --git a/src/gui/fpgui_package.lpk b/src/gui/fpgui_package.lpk
index 5cc884cf..216e136b 100644
--- a/src/gui/fpgui_package.lpk
+++ b/src/gui/fpgui_package.lpk
@@ -18,7 +18,7 @@
<Description Value="fpGUI - multi-handle redesign"/>
<License Value="Modified LGPL"/>
<Version Minor="5"/>
- <Files Count="15">
+ <Files Count="16">
<Item1>
<Filename Value="gui_button.pas"/>
<UnitName Value="gui_button"/>
@@ -79,6 +79,10 @@
<Filename Value="gui_tab.pas"/>
<UnitName Value="gui_tab"/>
</Item15>
+ <Item16>
+ <Filename Value="gui_grid.pas"/>
+ <UnitName Value="gui_grid"/>
+ </Item16>
</Files>
<RequiredPkgs Count="2">
<Item1>
diff --git a/src/gui/fpgui_package.pas b/src/gui/fpgui_package.pas
index 5c32dc40..98749904 100644
--- a/src/gui/fpgui_package.pas
+++ b/src/gui/fpgui_package.pas
@@ -9,7 +9,7 @@ interface
uses
gui_button, gui_combobox, gui_dialogs, gui_edit, gui_form, gui_label,
gui_listbox, gui_memo, gui_popupwindow, gui_scrollbar, gui_bevel,
- gui_checkbox, gui_radiobutton, gui_trackbar, gui_tab;
+ gui_checkbox, gui_radiobutton, gui_trackbar, gui_tab, gui_grid;
implementation
diff --git a/src/gui/gui_grid.pas b/src/gui/gui_grid.pas
new file mode 100644
index 00000000..82f351c9
--- /dev/null
+++ b/src/gui/gui_grid.pas
@@ -0,0 +1,418 @@
+unit gui_grid;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+ Classes,
+ SysUtils,
+ gfxbase,
+ fpgfx,
+ gfx_widget,
+ gui_scrollbar;
+
+type
+
+ TFocusChangeNotify = procedure(Sender: TObject; ARow, ACol: integer) of object;
+ TRowChangeNotify = procedure(Sender: TObject; ARow: integer) of object;
+
+
+ TfpgBaseGrid = class(TfpgWidget)
+ private
+ FBackgroundColor: TfpgColor;
+ FColResizing: boolean;
+ FFocusCol: integer;
+ FFocusRow: integer;
+ FHeaderHeight: integer;
+ FOnFocusChange: TFocusChangeNotify;
+ FOnRowChange: TRowChangeNotify;
+ FPrevCol: integer;
+ FPrevRow: integer;
+ FFirstRow: integer;
+ FFirstCol: integer;
+ FMargin: integer;
+ FFont: TfpgFont;
+ FHeaderFont: TfpgFont;
+ FRowHeight: integer;
+ FRowSelect: boolean;
+ FShowGrid: boolean;
+ FShowHeader: boolean;
+ FTemp: integer;
+ FVScrollBar: TfpgScrollBar;
+ FHScrollBar: TfpgScrollBar;
+ procedure SetBackgroundColor(const AValue: TfpgColor);
+ procedure SetFocusCol(const AValue: integer);
+ procedure SetFocusRow(const AValue: integer);
+ procedure CheckFocusChange;
+ procedure SetShowGrid(const AValue: boolean);
+ procedure SetShowHeader(const AValue: boolean);
+ function VisibleLines: integer;
+ function VisibleWidth: integer;
+ procedure UpdateScrollBar;
+ protected
+ function GetColumnWidth(ACol: integer): integer; virtual;
+ procedure SetColumnWidth(ACol: integer; const AValue: integer); virtual;
+ function GetColumnCount: integer; virtual;
+ function GetRowCount: integer; virtual;
+ procedure DrawCell(ARow, ACol: integer; ARect: TRect; AFlags: integer); virtual;
+ procedure DrawHeader(ACol: integer; ARect: TRect; AFlags: integer); virtual;
+ procedure HandlePaint; override;
+ public
+ constructor Create(AOwner: TComponent); override;
+ destructor Destroy; override;
+ property Font: TfpgFont read FFont;
+ property HeaderFont: TfpgFont read FHeaderFont;
+ property BackgroundColor: TfpgColor read FBackgroundColor write SetBackgroundColor;
+ property FocusCol: integer read FFocusCol write SetFocusCol;
+ property FocusRow: integer read FFocusRow write SetFocusRow;
+ property RowSelect: boolean read FRowSelect write FRowSelect;
+ property ColumnCount: integer read GetColumnCount;
+ property RowCount: integer read GetRowCount;
+ property ShowHeader: boolean read FShowHeader write SetShowHeader;
+ property ShowGrid: boolean read FShowGrid write SetShowGrid;
+ property RowHeight: integer read FRowHeight;
+ property HeaderHeight: integer read FHeaderHeight;
+ property ColResizing: boolean read FColResizing write FColResizing;
+ property ColumnWidth[ACol: integer]: integer read GetColumnWidth write SetColumnWidth;
+ property OnFocusChange: TFocusChangeNotify read FOnFocusChange write FOnFocusChange;
+ property OnRowChange: TRowChangeNotify read FOnRowChange write FOnRowChange;
+ end;
+
+implementation
+
+{ TfpgBaseGrid }
+
+procedure TfpgBaseGrid.SetBackgroundColor(const AValue: TfpgColor);
+begin
+ if FBackgroundColor = AValue then
+ Exit; //==>
+ FBackgroundColor := AValue;
+ RePaint;
+end;
+
+function TfpgBaseGrid.GetColumnWidth(ACol: integer): integer;
+begin
+ if ACol = 2 then
+ Result := FTemp
+ else
+ Result := 60+(ACol*16);
+end;
+
+procedure TfpgBaseGrid.SetColumnWidth(ACol: integer; const AValue: integer);
+begin
+ if (ACol = 2) and (AValue <> FTemp) then
+ begin
+ FTemp := AValue;
+ UpdateScrollBar;
+ Repaint;
+ end;
+end;
+
+function TfpgBaseGrid.GetColumnCount: integer;
+begin
+ Result := 7;
+end;
+
+function TfpgBaseGrid.GetRowCount: integer;
+begin
+ Result := 24;
+end;
+
+procedure TfpgBaseGrid.DrawCell(ARow, ACol: integer; ARect: TRect; AFlags: integer);
+var
+ s: string;
+begin
+ s := 'Cellg(' + IntToStr(ARow) + ',' + IntToStr(ACol) + ')';
+ Canvas.DrawString(ARect.left+1, ARect.top+1, s);
+end;
+
+procedure TfpgBaseGrid.DrawHeader(ACol: integer; ARect: TRect; AFlags: integer);
+var
+ s: string;
+begin
+ s := 'Head ' + IntToStr(ACol);
+ Canvas.DrawString(ARect.left + (ARect.Right div 2) - (FHeaderFont.TextWidth(s) div 2),
+ ARect.top+1, s);
+end;
+
+procedure TfpgBaseGrid.SetFocusCol(const AValue: integer);
+begin
+ if FFocusCol = AValue then
+ Exit; //==>
+ FFocusCol := AValue;
+end;
+
+procedure TfpgBaseGrid.SetFocusRow(const AValue: integer);
+begin
+ if FFocusRow = AValue then
+ Exit; //==>
+ FFocusRow := AValue;
+end;
+
+procedure TfpgBaseGrid.CheckFocusChange;
+begin
+ if ((FPrevCol <> FFocusCol) and not RowSelect) or (FPrevRow <> FFocusRow) then
+ if Assigned(FOnFocusChange) then
+ FOnFocusChange(self, FFocusRow, FFocusCol);
+
+ if (FPrevRow <> FFocusRow) then
+ if Assigned(FOnRowChange) then
+ FOnRowChange(self, FFocusRow);
+
+ FPrevCol := FFocusCol;
+ FPrevRow := FFocusRow;
+end;
+
+procedure TfpgBaseGrid.SetShowGrid(const AValue: boolean);
+begin
+ if FShowGrid=AValue then exit;
+ FShowGrid:=AValue;
+end;
+
+procedure TfpgBaseGrid.SetShowHeader(const AValue: boolean);
+begin
+ if FShowHeader = AValue then
+ Exit; //==>
+ FShowHeader := AValue;
+ RePaint;
+end;
+
+function TfpgBaseGrid.VisibleLines: integer;
+var
+ hh: integer;
+begin
+ if FHScrollBar.Visible then
+ hh := FHScrollbar.Height
+ else
+ hh := 0;
+ if ShowHeader then
+ hh := hh + FHeaderHeight+1;
+ result := (Height - 2*FMargin - hh) div (FRowHeight+1)
+end;
+
+function TfpgBaseGrid.VisibleWidth: integer;
+var
+ sw: integer;
+begin
+ if FVScrollBar.Visible then
+ sw := FVScrollBar.Width-1
+ else
+ sw := 0;
+ Result := Width - FMargin*2 - sw;
+end;
+
+procedure TfpgBaseGrid.UpdateScrollBar;
+var
+ HWidth: integer;
+ VHeight: integer;
+begin
+ VHeight := Height - 4;
+ HWidth := Width - 4;
+
+ 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;
+ FHScrollBar.Width := HWidth;
+
+ FVScrollBar.Top := 2;
+ FVScrollBar.Left := Width - FVScrollBar.Width - 2;
+ FVScrollBar.Height := VHeight;
+
+ FVScrollBar.UpdateWindowPosition;
+ FHScrollBar.UpdateWindowPosition;
+end;
+
+procedure TfpgBaseGrid.HandlePaint;
+var
+ r: TRect;
+ r2: TRect;
+ col: integer;
+ row: integer;
+ clr: TRect;
+begin
+ Canvas.BeginDraw;
+// inherited HandlePaint;
+ Canvas.ClearClipRect;
+ r := Rect(0, 0, Width-1, Height-1);
+
+ Canvas.DrawControlFrame(0, 0, Width, Height);
+ InflateRect(r, -2, -2);
+ Canvas.SetClipRect(r);
+ Canvas.SetColor(FBackgroundColor);
+ Canvas.FillRectangle(r);
+
+ clr := Rect(FMargin, FMargin, VisibleWidth, Height-2*FMargin);
+ r := clr;
+
+ if (ColumnCount > 0) and ShowHeader then
+ begin
+ // Drawing headers
+ r.Bottom := FHeaderHeight;
+
+ Canvas.SetFont(FHeaderFont);
+ for col := FFirstCol to ColumnCount do
+ begin
+ r.Right := ColumnWidth[col];
+ Canvas.SetClipRect(clr);
+
+ // drawing grid lines
+ Canvas.SetColor(clGridLines);
+ Canvas.DrawLine(r.Left, r.Bottom+1, r.Right+1, r.Bottom+1);
+ Canvas.DrawLine(r.Right+1, r.Top, r.Right+1, r.Bottom+1);
+
+ Canvas.AddClipRect(r);
+ Canvas.SetColor(clGridHeader);
+ Canvas.FillRectangle(r);
+
+ Canvas.SetTextColor(clText1);
+ DrawHeader(col, r, 0);
+
+ r.Left := r.Left + r.Right + 1;
+
+ if r.Left >= clr.Right then
+ Break;
+ end;
+
+ r.Top := r.Top + r.Bottom + 1;
+ end;
+
+
+ if (RowCount > 0) and (ColumnCount > 0) then
+ begin
+ // Drawing items
+ Canvas.SetFont(FFont);
+
+ r.Bottom := RowHeight;
+
+ for row := FFirstRow to RowCount do
+ begin
+ r.Left := FMargin;
+ for col := FFirstCol to ColumnCount do
+ begin
+ r.Right := ColumnWidth[col];
+
+ canvas.SetClipRect(clr);
+
+ // drawing grid lines
+ if FShowGrid then
+ Canvas.SetColor(clGridLines)
+ else
+ Canvas.SetColor(FBackgroundColor);
+
+ canvas.DrawLine(r.Left, r.Bottom+1, r.Right+1, r.Bottom+1);
+ canvas.DrawLine(r.Right+1, r.Top, r.Right+1, r.Bottom+1);
+
+ canvas.AddClipRect(r);
+
+ if (row = FFocusRow) and (RowSelect or (col = FFocusCol)) then
+ begin
+ if FFocused then
+ begin
+ canvas.SetColor(clSelection);
+ canvas.SetTextColor(clSelectionText);
+ end
+ else
+ begin
+ canvas.SetColor(clInactiveSel);
+ canvas.SetTextColor(clInactiveSelText);
+ end;
+ end
+ else
+ begin
+ canvas.SetColor(BackgroundColor);
+ canvas.SetTextColor(clText1);
+ end;
+
+ canvas.FillRectangle(r);
+
+ DrawCell(row, col, r, 0);
+
+ r.Left := r.Left + r.Right + 1;
+
+ if r.Left >= clr.Right then
+ Break;
+ end;
+
+ r.Top := r.Top + r.Bottom + 1;
+
+ if r.Top >= clr.Bottom then break;
+
+ end;
+ end; // item drawing
+
+ canvas.SetClipRect(clr);
+ canvas.SetColor(FBackgroundColor);
+
+ // clearing after the last column
+ if r.Left <= clr.Right then
+ begin
+ r2.Left := r.Left;
+ r2.Top := clr.Top;
+ r2.Right := clr.Right;
+ r2.Bottom := clr.Bottom;
+ Canvas.FillRectangle(r2);
+ end;
+
+ // clearing after the last row
+ if r.Top <= clr.Bottom then
+ begin
+ r.Left := clr.Left;
+ r.Right := clr.Right;
+ r.Bottom := clr.Bottom;
+ Canvas.FillRectangle(r);
+ end;
+
+ Canvas.EndDraw;
+end;
+
+constructor TfpgBaseGrid.Create(AOwner: TComponent);
+begin
+ inherited Create(AOwner);
+ Focusable := True;
+ FWidth := 120;
+ FHeight := 80;
+ FFocusCol := 1;
+ FPrevCol := 0;
+ FFocusRow := 1;
+ FPrevRow := 0;
+ FFirstRow := 1;
+ FFirstCol := 1;
+ FMargin := 2;
+ FShowHeader := True;
+ FShowGrid := True;
+
+ FBackgroundColor := clBoxColor;
+ FColResizing := False;
+
+ FFont := fpgGetFont('#Grid');
+ FHeaderFont := fpgGetFont('#GridHeader');
+
+ FRowHeight := FFont.Height + 2;
+ FHeaderHeight := FHeaderFont.Height + 2;
+
+ FVScrollBar := TfpgScrollBar.Create(self);
+ FVScrollBar.Orientation := orVertical;
+ FVScrollBar.Visible := False;
+// FVScrollBar.OnScroll := @VScrollBarMove;
+
+ FHScrollBar := TfpgScrollBar.Create(self);
+ FHScrollBar.Orientation := orHorizontal;
+ FHScrollBar.Visible := False;
+// FHScrollBar.OnScroll := @HScrollBarMove;
+// FHScrollBar.ScrollStep := 5;
+
+ FTemp := 50; // a bit of a hack for now (default column width)
+end;
+
+destructor TfpgBaseGrid.Destroy;
+begin
+ FFont.Free;
+ FHeaderFont.Free;
+ inherited Destroy;
+end;
+
+end.
+
generated by cgit v1.2.3-70-g09d2 (git 2.47.1) at 2024-12-26 20:58:05 +0000