pascal/lazarus-ccr
1
0
Fork 0
Code Issues Releases Activity

fpspreadsheet: Improved user interface in TsSpreadsheetGrid for clicks on hyperlink cells.

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@3956 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
2015-02-23 18:50:29 +00:00
parent 4f6184f243
commit 70b859530f
5 changed files with 123 additions and 42 deletions
Download Patch File Download Diff File Expand all files Collapse all files

2
components/fpspreadsheet/examples/fpsctrls/main.pas
View File

@ -401,7 +401,7 @@ end;
procedure TMainForm.ToolButton4Click(Sender: TObject);
begin
WorkbookSource.Worksheet.WriteHyperlink(0, 0, hkURL, 'http://www.chip.de', 'Link to chip.de', 'chip.de');
WorkbookSource.Worksheet.WriteHyperlink(0, 0, hkCell, 'B5', 'Go to B5');
end;
procedure TMainForm.WorksheetGridClickHyperlink(Sender: TObject;

1
components/fpspreadsheet/fpspreadsheet.pas
View File

@ -5209,6 +5209,7 @@ begin
finally
parser.Free;
end;
Include(fmt.UsedFormattingFields, uffNumberFormat);
ACell^.FormatIndex := Workbook.AddCellFormat(fmt);
ChangedCell(ACell^.Row, ACell^.Col);
end;

138
components/fpspreadsheet/fpspreadsheetgrid.pas
View File

@ -23,13 +23,14 @@ unit fpspreadsheetgrid;
interface
uses
Classes, SysUtils, LResources, Forms, Controls, Graphics, Dialogs, Grids,
Classes, SysUtils, LResources,
Forms, Controls, Graphics, Dialogs, Grids, ExtCtrls,
LCLVersion,
fpstypes, fpspreadsheet, fpspreadsheetctrls;
const
{$IF (lcl_fullversion >= 1030000)}
ENABLE_MULTI_SELECT = 1; // requires Laz trunk after r46767
ENABLE_MULTI_SELECT = 1; // requires Laz 1.4+ or trunk after r46767
{$ELSE}
ENABLE_MULTI_SELECT = 0;
{$ENDIF}
@ -66,6 +67,8 @@ type
FDrawingCell: PCell;
FTextOverflowing: Boolean;
FEnhEditMode: Boolean;
FHyperlinkTimer: TTimer;
FHyperlinkCell: PCell;
FOnClickHyperlink: TsHyperlinkClickEvent;
function CalcAutoRowHeight(ARow: Integer): Integer;
function CalcColWidth(AWidth: Single): Integer;
@ -137,6 +140,8 @@ type
procedure SetWordwrap(ACol, ARow: Integer; AValue: boolean);
procedure SetWordwraps(ARect: TGridRect; AValue: boolean);
procedure HyperlinkTimerElapsed(Sender: TObject);
protected
{ Protected declarations }
procedure AutoAdjustColumn(ACol: Integer); override;
@ -158,6 +163,7 @@ type
procedure DrawRow(aRow: Integer); override;
procedure DrawSelection;
procedure DrawTextInCell(ACol, ARow: Integer; ARect: TRect; AState: TGridDrawState); override;
procedure ExecuteHyperlink;
function GetCellHeight(ACol, ARow: Integer): Integer;
function GetCellHintText(ACol, ARow: Integer): String; override;
function GetCellText(ACol, ARow: Integer): String;
@ -173,6 +179,7 @@ type
procedure LoadFromWorksheet(AWorksheet: TsWorksheet);
procedure MouseDown(Button: TMouseButton; Shift:TShiftState; X,Y:Integer); override;
procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;
procedure MouseUp(Button: TMouseButton; Shift:TShiftState; X,Y:Integer); override;
procedure MoveSelection; override;
procedure Notification(AComponent: TComponent; Operation: TOperation); override;
// function SelectCell(AGridCol, AGridRow: Integer): Boolean; override;
@ -210,6 +217,7 @@ type
{ public methods }
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
procedure BeginUpdate;
procedure DefaultDrawCell(ACol, ARow: Integer; var ARect: TRect; AState: TGridDrawState); override;
procedure DeleteCol(AGridCol: Integer); reintroduce;
@ -583,7 +591,7 @@ implementation
uses
Types, LCLType, LCLIntf, Math,
fpCanvas, fpsUtils, fpsVisualUtils;
fpCanvas, fpsStrings, fpsUtils, fpsVisualUtils;
const
{@@ Translation of the fpspreadsheet type of horizontal text alignment to that
@ -597,6 +605,13 @@ const
tlBottom, tlTop, tlCenter, tlBottom
);
{@@ Default number of columns prepared for a new empty worksheet }
DEFAULT_COL_COUNT = 26;
{@@ Default number of rows prepared for a new empty worksheet }
DEFAULT_ROW_COUNT = 100;
{@@ Interval how long the mouse buttons has to be held down on a
hyperlink cell until the associated hyperlink is executed. }
HYPERLINK_TIMER_INTERVAL = 500;
var
{@@ Auxiliary bitmap containing the previously used non-trivial fill pattern }
@ -842,12 +857,15 @@ begin
AutoAdvance := aaDown;
ExtendedSelect := true;
FHeaderCount := 1;
FInitColCount := 26;
FInitRowCount := 100;
FInitColCount := DEFAULT_COL_COUNT;
FInitRowCount := DEFAULT_ROW_COUNT;
FCellFont := TFont.Create;
FHyperlinkTimer := TTimer.Create(self);
FHyperlinkTimer.Interval := HYPERLINK_TIMER_INTERVAL;
FHyperlinkTimer.OnTimer := @HyperlinkTimerElapsed;
FOwnsWorkbook := true;
{$IF (ENABLE_MULTI_SELECT=1)}
//RangeSelectMode := rsmMulti;
RangeSelectMode := rsmMulti;
{$ENDIF}
end;
@ -2137,6 +2155,44 @@ begin
if FLockCount = 0 then Invalidate;
end;
{@@ ----------------------------------------------------------------------------
Executes a hyperlink stored in the FHyperlinkCell
-------------------------------------------------------------------------------}
procedure TsCustomWorksheetGrid.ExecuteHyperlink;
var
hyperlink: TsHyperlink;
sheetname: String;
sheet: TsWorksheet;
r, c: Cardinal;
begin
if FHyperlinkCell = nil then
exit;
hyperlink := Worksheet.ReadHyperlink(FHyperlinkCell);
case hyperlink.Kind of
hkNone:
; // nothing to do
hkCell:
// Goes to a cell
if ParseSheetCellString(hyperlink.Destination, sheetname, r, c) then
begin
if sheetname <> '' then
begin
sheet := Workbook.GetWorksheetByName(sheetname);
if sheet = nil then
raise Exception.CreateFmt(rsWorksheetNotFound, [sheetname]);
Workbook.SelectWorksheet(sheet);
end;
Worksheet.SelectCell(r, c);
end else
raise Exception.CreateFmt('"%s" is not a valid cell string.', [hyperlink.Destination]);
else
// Fires the OnClickHyperlink event which should open a file or a URL
if Assigned(FOnClickHyperlink) then FOnClickHyperlink(self, hyperlink);
end;
end;
{@@ ----------------------------------------------------------------------------
Copies the borders of a cell to its neighbors. This avoids the nightmare of
changing borders due to border conflicts of adjacent cells.
@ -2889,6 +2945,26 @@ begin
end;
end;
{@@ ----------------------------------------------------------------------------
Clicking into cells with hyperlinks poses a user-interface problem:
normally the cell should go into edit mode. But with hyperlinks a click should
also execute the hyperlink. How to distinguish both cases?
In order to keep both features for hyperlinks we follow a strategy similar to
Excel: a short click selects the cell for editing as usual; a longer click
opens the hyperlink by means of a timer ("FHyperlinkTimer") (in Excel, in
fact, the behavior is opposite, but this one here is easier to implement.)
-------------------------------------------------------------------------------}
procedure TsCustomWorksheetGrid.HyperlinkTimerElapsed(Sender: TObject);
begin
if FHyperlinkTimer.Enabled then begin
FHyperlinkTimer.Enabled := false;
FGridState := gsNormal; // this prevents selecting a cell block
EditorMode := false; // this prevents editing the clicked cell
ExecuteHyperlink; // Execute the hyperlink
FHyperlinkCell := nil;
end;
end;
{@@ ----------------------------------------------------------------------------
Inserts an empty column before the column specified
-------------------------------------------------------------------------------}
@ -3339,47 +3415,35 @@ end;
-------------------------------------------------------------------------------}
procedure TsCustomWorksheetGrid.MouseDown(Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
{todo: extend such the hyperlink is handled only when the text is clicked }
{todo: extend such that the hyperlink is handled only when the text is clicked (tough because of overflow cells!) }
var
hyperlink: TsHyperlink;
sheetname: String;
sheet: TsWorksheet;
r, c: Cardinal;
mouseCell: TPoint;
cell: PCell;
r, c: Cardinal;
begin
inherited;
if (ssLeft in Shift) and ([ssCtrl, ssSuper] * Shift <> []) then
{ Prepare processing of the hyperlink: triggers a timer, the hyperlink is
executed when the timer has expired (see HyperlinkTimerElapsed). }
if (ssLeft in Shift) then
begin
mouseCell := MouseToCell(Point(X, Y));
r := GetWorksheetRow(mouseCell.Y);
c := GetWorksheetCol(mouseCell.X);
cell := Worksheet.FindCell(r, c);
if Worksheet.IsMerged(cell) then
cell := Worksheet.FindMergeBase(cell);
if Worksheet.IsHyperlink(cell) then
begin
hyperlink := Worksheet.ReadHyperlink(cell);
case hyperlink.Kind of
hkNone:
; // nothing to do
hkCell:
if ParseSheetCellString(hyperlink.Destination, sheetname, r, c) then
begin
sheet := Workbook.GetWorksheetByName(sheetname);
Workbook.SelectWorksheet(sheet);
Worksheet.SelectCell(r, c);
FHyperlinkCell := cell;
FHyperlinkTimer.Enabled := true;
end else
raise Exception.CreateFmt('"%s" is not a valid cell string.', [hyperlink.Destination]);
else
if Assigned(FOnClickHyperlink) then FOnClickHyperlink(self, hyperlink);
end;
exit;
begin
FHyperlinkCell := nil;
FHyperlinkTimer.Enabled := false;
end;
end;
//inherited;
FEnhEditMode := true;
end;
@ -3398,6 +3462,20 @@ begin
((prevMouseCell.X <> GCache.MouseCell.X) or (prevMouseCell.Y <> GCache.MouseCell.Y))
then
InvalidateGrid;
if FHyperlinkTimer.Enabled and (ssLeft in Shift) then
FHyperlinkTimer.Enabled := false;
end;
procedure TsCustomWorksheetGrid.MouseUp(Button: TMouseButton;
Shift:TShiftState; X,Y:Integer);
begin
if FHyperlinkTimer.Enabled then begin
FHyperlinkTimer.Enabled := false;
FHyperlinkCell := nil;
end;
inherited;
end;
{@@ ----------------------------------------------------------------------------

1
components/fpspreadsheet/fpsstrings.pas
View File

@ -38,6 +38,7 @@ resourcestring
rsIncorrectParamCount = 'Funtion %s requires at least %d and at most %d parameters.';
rsCircularReference = 'Circular reference found when calculating worksheet formulas';
rsFileNotFound = 'File "%s" not found.';
rsWorksheetNotFound = 'Worksheet "%s" not found.';
rsInvalidWorksheetName = '"%s" is not a valid worksheet name.';
rsDefectiveInternalStructure = 'Defective internal structure of %s file.';
rsUnknownDataType = 'Unknown data type.';

5
components/fpspreadsheet/fpstypes.pas
View File

@ -678,8 +678,10 @@ begin
if (uffVertAlign in AItem.UsedFormattingFields) then
if (P^.VertAlignment <> AItem.VertAlignment) then continue;
if (uffBorder in AItem.UsedFormattingFields) then begin
if (uffBorder in AItem.UsedFormattingFields) then
if (P^.Border <> AItem.Border) then continue;
// Border styles can be set even if borders are not used --> don't check uffBorder!
equ := true;
for b in AItem.Border do begin
if (P^.BorderStyles[b].LineStyle <> AItem.BorderStyles[b].LineStyle) or
@ -690,7 +692,6 @@ begin
end;
end;
if not equ then continue;
end;
if (uffBackground in AItem.UsedFormattingFields) then begin
if (P^.Background.Style <> AItem.Background.Style) then continue;