You've already forked lazarus-ccr
fpspreadsheet: Complete hyperlink form. In examples/visual/fpsctrls, open hyperlink URI when hyperlink cell is activated.
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@4062 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
@ -538,12 +538,6 @@ object MainForm: TMainForm
|
||||
Caption = 'ToolButton52'
|
||||
Style = tbsDivider
|
||||
end
|
||||
object ToolButton4: TToolButton
|
||||
Left = 504
|
||||
Top = 0
|
||||
Caption = 'ToolButton4'
|
||||
OnClick = ToolButton4Click
|
||||
end
|
||||
object ToolButton50: TToolButton
|
||||
Left = 403
|
||||
Top = 0
|
||||
@ -1480,7 +1474,7 @@ object MainForm: TMainForm
|
||||
Category = 'FPSpreadsheet'
|
||||
WorkbookSource = WorkbookSource
|
||||
Mode = chmNew
|
||||
OnHyperlink = AcHyperlinkNewHyperlink
|
||||
OnHyperlink = HyperlinkHandler
|
||||
Caption = 'New hyperlink...'
|
||||
Hint = 'Add hyperlink to active cell'
|
||||
ImageIndex = 57
|
||||
@ -1489,7 +1483,7 @@ object MainForm: TMainForm
|
||||
Category = 'FPSpreadsheet'
|
||||
WorkbookSource = WorkbookSource
|
||||
Mode = chmEdit
|
||||
OnHyperlink = AcHyperlinkEditHyperlink
|
||||
OnHyperlink = HyperlinkHandler
|
||||
Caption = 'Edit hyperlink...'
|
||||
Hint = 'Edit hyperlink of selected cell'
|
||||
ImageIndex = 59
|
||||
|
||||
@ -272,7 +272,6 @@ type
|
||||
ToolButton38: TToolButton;
|
||||
ToolButton39: TToolButton;
|
||||
TbCommentAdd: TToolButton;
|
||||
ToolButton4: TToolButton;
|
||||
ToolButton40: TToolButton;
|
||||
ToolButton41: TToolButton;
|
||||
ToolButton42: TToolButton;
|
||||
@ -302,10 +301,6 @@ type
|
||||
procedure AcColDeleteExecute(Sender: TObject);
|
||||
procedure AcFileOpenAccept(Sender: TObject);
|
||||
procedure AcFileSaveAsAccept(Sender: TObject);
|
||||
procedure AcHyperlinkEditHyperlink(Sender: TObject; ACaption: String;
|
||||
var AHyperlink: TsHyperlink);
|
||||
procedure AcHyperlinkNewHyperlink(Sender: TObject; ACaption: String;
|
||||
var AHyperlink: TsHyperlink);
|
||||
procedure AcRowAddExecute(Sender: TObject);
|
||||
procedure AcRowDeleteExecute(Sender: TObject);
|
||||
procedure AcSettingsCSVParamsExecute(Sender: TObject);
|
||||
@ -315,7 +310,6 @@ type
|
||||
procedure HyperlinkHandler(Sender: TObject; ACaption: String;
|
||||
var AHyperlink: TsHyperlink);
|
||||
procedure InspectorTabControlChange(Sender: TObject);
|
||||
procedure ToolButton4Click(Sender: TObject);
|
||||
procedure WorksheetGridClickHyperlink(Sender: TObject;
|
||||
const AHyperlink: TsHyperlink);
|
||||
private
|
||||
@ -334,6 +328,7 @@ implementation
|
||||
{$R *.lfm}
|
||||
|
||||
uses
|
||||
LCLIntf, uriparser,
|
||||
fpsUtils, fpsCSV,
|
||||
sCSVParamsForm, sCurrencyForm, sFormatSettingsForm, sSortParamsForm,
|
||||
sHyperlinkForm;
|
||||
@ -399,19 +394,6 @@ begin
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TMainForm.AcHyperlinkEditHyperlink(Sender: TObject; ACaption: String;
|
||||
var AHyperlink: TsHyperlink);
|
||||
begin
|
||||
HyperlinkHandler(Sender, ACaption, AHyperlink);
|
||||
end;
|
||||
|
||||
procedure TMainForm.AcHyperlinkNewHyperlink(Sender: TObject; ACaption: String;
|
||||
var AHyperlink: TsHyperlink);
|
||||
begin
|
||||
HyperlinkHandler(Sender, ACaption, AHyperlink);
|
||||
end;
|
||||
|
||||
|
||||
{ Adds a row before the active cell }
|
||||
procedure TMainForm.AcRowAddExecute(Sender: TObject);
|
||||
begin
|
||||
@ -480,10 +462,17 @@ procedure TMainForm.AcViewInspectorExecute(Sender: TObject);
|
||||
begin
|
||||
InspectorTabControl.Visible := AcViewInspector.Checked;
|
||||
InspectorSplitter.Visible := AcViewInspector.Checked;
|
||||
InspectorSplitter.Left := 0;
|
||||
InspectorSplitter.Left := 0; // Make sure that the splitter is always at the left of the inspector
|
||||
end;
|
||||
|
||||
{ Event handler for hyperlinks }
|
||||
{ Event handler for hyperlinks: it only has to provide the hyperlink data
|
||||
which are applied to the active cell by the TsCellHyperlinkAction.
|
||||
Is called by the "new hyperlink" and "edit hyperlink" actions.
|
||||
Here we open the HyperlinkForm which is similar to the one used by
|
||||
Open/LibreOffice.
|
||||
|
||||
Caption .... Caption of the form in which the hyperlink can be specified
|
||||
Hyperlink .. Data record (target, tooltip) for/from the the hyperlink form. }
|
||||
procedure TMainForm.HyperlinkHandler(Sender: TObject; ACaption: String;
|
||||
var AHyperlink: TsHyperlink);
|
||||
begin
|
||||
@ -502,15 +491,20 @@ begin
|
||||
Inspector.Mode := TsInspectorMode(InspectorTabControl.TabIndex);
|
||||
end;
|
||||
|
||||
procedure TMainForm.ToolButton4Click(Sender: TObject);
|
||||
begin
|
||||
WorkbookSource.Worksheet.WriteHyperlink(0, 0, '#Sheet2!B5', 'Go to B5');
|
||||
end;
|
||||
|
||||
{ Event handler if an external hyperlink in a cell is activated. Usually the
|
||||
linked documents/web sites etc. are opened. }
|
||||
procedure TMainForm.WorksheetGridClickHyperlink(Sender: TObject;
|
||||
const AHyperlink: TsHyperlink);
|
||||
var
|
||||
u: TUri;
|
||||
begin
|
||||
ShowMessage('Hyperlink ' + AHyperlink.Target + ' clicked');
|
||||
u := ParseURI(AHyperlink.Target);
|
||||
case Lowercase(u.Protocol) of
|
||||
'http', 'https', 'ftp', 'mailto', 'file':
|
||||
OpenUrl(AHyperlink.Target);
|
||||
else
|
||||
ShowMessage('Hyperlink ' + AHyperlink.Target + ' clicked');
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TMainForm.UpdateCaption;
|
||||
|
||||
@ -1,17 +1,18 @@
|
||||
object HyperlinkForm: THyperlinkForm
|
||||
Left = 327
|
||||
Height = 347
|
||||
Height = 386
|
||||
Top = 259
|
||||
Width = 498
|
||||
Caption = 'Hyperlink'
|
||||
ClientHeight = 347
|
||||
ClientHeight = 386
|
||||
ClientWidth = 498
|
||||
OnCreate = FormCreate
|
||||
ShowHint = True
|
||||
LCLVersion = '1.5'
|
||||
object ButtonPanel1: TButtonPanel
|
||||
Left = 6
|
||||
Height = 34
|
||||
Top = 307
|
||||
Top = 346
|
||||
Width = 486
|
||||
OKButton.Name = 'OKButton'
|
||||
OKButton.DefaultCaption = True
|
||||
@ -27,20 +28,20 @@ object HyperlinkForm: THyperlinkForm
|
||||
end
|
||||
object Panel2: TPanel
|
||||
Left = 75
|
||||
Height = 301
|
||||
Height = 340
|
||||
Top = 0
|
||||
Width = 423
|
||||
Align = alClient
|
||||
BevelOuter = bvNone
|
||||
ClientHeight = 301
|
||||
ClientHeight = 340
|
||||
ClientWidth = 423
|
||||
TabOrder = 1
|
||||
object Notebook: TNotebook
|
||||
Left = 4
|
||||
Height = 263
|
||||
Height = 246
|
||||
Top = 4
|
||||
Width = 415
|
||||
PageIndex = 0
|
||||
PageIndex = 2
|
||||
Align = alClient
|
||||
BorderSpacing.Around = 4
|
||||
TabOrder = 0
|
||||
@ -62,7 +63,8 @@ object HyperlinkForm: THyperlinkForm
|
||||
Left = 8
|
||||
Height = 23
|
||||
Top = 24
|
||||
Width = 208
|
||||
Width = 210
|
||||
Anchors = [akTop, akLeft, akRight]
|
||||
ItemHeight = 15
|
||||
OnChange = UpdateHyperlinkInfo
|
||||
ParentFont = False
|
||||
@ -79,20 +81,21 @@ object HyperlinkForm: THyperlinkForm
|
||||
ParentFont = False
|
||||
end
|
||||
object Label6: TLabel
|
||||
Left = 224
|
||||
Left = 226
|
||||
Height = 15
|
||||
Top = 8
|
||||
Width = 66
|
||||
Anchors = [akTop, akRight]
|
||||
Caption = 'Cell address:'
|
||||
ParentColor = False
|
||||
ParentFont = False
|
||||
end
|
||||
object CbCellAddress: TComboBox
|
||||
Left = 224
|
||||
Left = 226
|
||||
Height = 23
|
||||
Top = 24
|
||||
Width = 178
|
||||
Anchors = [akTop, akLeft, akRight]
|
||||
Width = 176
|
||||
Anchors = [akTop, akRight]
|
||||
ItemHeight = 15
|
||||
OnChange = UpdateHyperlinkInfo
|
||||
OnEditingDone = CbCellAddressEditingDone
|
||||
@ -101,33 +104,35 @@ object HyperlinkForm: THyperlinkForm
|
||||
end
|
||||
end
|
||||
end
|
||||
object Page2: TPage
|
||||
object GroupBox3: TGroupBox
|
||||
object PgFile: TPage
|
||||
object GbFileName: TGroupBox
|
||||
Left = 0
|
||||
Height = 88
|
||||
Height = 64
|
||||
Top = 0
|
||||
Width = 417
|
||||
Width = 407
|
||||
Align = alTop
|
||||
BorderSpacing.Right = 8
|
||||
BorderSpacing.Bottom = 8
|
||||
Caption = 'File'
|
||||
ClientHeight = 68
|
||||
ClientWidth = 413
|
||||
Caption = 'File / Document'
|
||||
ClientHeight = 44
|
||||
ClientWidth = 403
|
||||
Font.Style = [fsBold]
|
||||
ParentFont = False
|
||||
TabOrder = 0
|
||||
object CbFileName: TComboBox
|
||||
Left = 16
|
||||
Left = 8
|
||||
Height = 23
|
||||
Top = 8
|
||||
Width = 306
|
||||
Width = 307
|
||||
Anchors = [akTop, akLeft, akRight]
|
||||
ItemHeight = 15
|
||||
OnChange = UpdateHyperlinkInfo
|
||||
OnEditingDone = CbFileNameEditingDone
|
||||
ParentFont = False
|
||||
TabOrder = 0
|
||||
end
|
||||
object BtnBrowseFile: TButton
|
||||
Left = 330
|
||||
Left = 320
|
||||
Height = 23
|
||||
Top = 8
|
||||
Width = 75
|
||||
@ -137,102 +142,215 @@ object HyperlinkForm: THyperlinkForm
|
||||
ParentFont = False
|
||||
TabOrder = 1
|
||||
end
|
||||
object RadioButton1: TRadioButton
|
||||
Left = 19
|
||||
Height = 19
|
||||
Top = 41
|
||||
Width = 92
|
||||
Caption = 'absolute path'
|
||||
Checked = True
|
||||
ParentFont = False
|
||||
TabOrder = 3
|
||||
TabStop = True
|
||||
end
|
||||
object RadioButton2: TRadioButton
|
||||
Left = 137
|
||||
Height = 19
|
||||
Top = 41
|
||||
Width = 85
|
||||
Caption = 'relative path'
|
||||
ParentFont = False
|
||||
TabOrder = 2
|
||||
end
|
||||
end
|
||||
end
|
||||
object Page3: TPage
|
||||
object GroupBox4: TGroupBox
|
||||
object GbFileBookmark: TGroupBox
|
||||
Left = 0
|
||||
Height = 64
|
||||
Top = 72
|
||||
Width = 407
|
||||
Align = alTop
|
||||
BorderSpacing.Top = 8
|
||||
BorderSpacing.Right = 8
|
||||
Caption = 'URL'
|
||||
BorderSpacing.Bottom = 8
|
||||
Caption = 'Bookmark within document'
|
||||
ClientHeight = 44
|
||||
ClientWidth = 403
|
||||
TabOrder = 0
|
||||
object CbFileName1: TComboBox
|
||||
Left = 16
|
||||
Font.Style = [fsBold]
|
||||
ParentFont = False
|
||||
TabOrder = 1
|
||||
object CbFileBookmark: TComboBox
|
||||
Left = 8
|
||||
Height = 23
|
||||
Top = 8
|
||||
Width = 395
|
||||
Width = 387
|
||||
Anchors = [akTop, akLeft, akRight]
|
||||
ItemHeight = 15
|
||||
OnChange = UpdateHyperlinkInfo
|
||||
OnDropDown = CbFileBookmarkDropDown
|
||||
ParentFont = False
|
||||
TabOrder = 0
|
||||
Text = 'ComboBox1'
|
||||
end
|
||||
end
|
||||
object GroupBox5: TGroupBox
|
||||
end
|
||||
object PgInternet: TPage
|
||||
object GbInternetLinkType: TGroupBox
|
||||
Left = 0
|
||||
Height = 64
|
||||
Top = 0
|
||||
Width = 407
|
||||
Align = alTop
|
||||
BorderSpacing.Right = 8
|
||||
Caption = 'Link'
|
||||
Caption = 'Type of link'
|
||||
ClientHeight = 44
|
||||
ClientWidth = 403
|
||||
TabOrder = 1
|
||||
object CbFileName2: TComboBox
|
||||
Left = 16
|
||||
Height = 23
|
||||
Top = 8
|
||||
Width = 80
|
||||
ItemHeight = 15
|
||||
ItemIndex = 0
|
||||
Items.Strings = (
|
||||
'http'
|
||||
'ftp'
|
||||
)
|
||||
Font.Style = [fsBold]
|
||||
ParentFont = False
|
||||
TabOrder = 0
|
||||
object RbHTTP: TRadioButton
|
||||
Left = 11
|
||||
Height = 19
|
||||
Top = 7
|
||||
Width = 42
|
||||
Caption = 'http'
|
||||
Checked = True
|
||||
OnChange = HTTP_FTP_Change
|
||||
ParentFont = False
|
||||
TabOrder = 1
|
||||
TabStop = True
|
||||
end
|
||||
object RbFTP: TRadioButton
|
||||
Left = 77
|
||||
Height = 19
|
||||
Top = 7
|
||||
Width = 35
|
||||
Caption = 'ftp'
|
||||
OnChange = HTTP_FTP_Change
|
||||
ParentFont = False
|
||||
TabOrder = 0
|
||||
Text = 'http'
|
||||
end
|
||||
end
|
||||
object GroupBox6: TGroupBox
|
||||
object InternetNotebook: TNotebook
|
||||
Left = 0
|
||||
Height = 64
|
||||
Top = 144
|
||||
Width = 407
|
||||
Align = alTop
|
||||
BorderSpacing.Top = 8
|
||||
BorderSpacing.Right = 8
|
||||
Caption = 'URL'
|
||||
ClientHeight = 44
|
||||
ClientWidth = 403
|
||||
TabOrder = 2
|
||||
object CbFileName3: TComboBox
|
||||
Left = 16
|
||||
Height = 23
|
||||
Top = 8
|
||||
Width = 381
|
||||
Anchors = [akTop, akLeft, akRight]
|
||||
ItemHeight = 15
|
||||
TabOrder = 0
|
||||
Text = 'ComboBox1'
|
||||
Height = 182
|
||||
Top = 64
|
||||
Width = 415
|
||||
PageIndex = 1
|
||||
Align = alClient
|
||||
TabOrder = 1
|
||||
TabStop = True
|
||||
object PgHTTP: TPage
|
||||
object GbHttp: TGroupBox
|
||||
Left = 0
|
||||
Height = 144
|
||||
Top = 8
|
||||
Width = 407
|
||||
Align = alTop
|
||||
BorderSpacing.Top = 8
|
||||
BorderSpacing.Right = 8
|
||||
Caption = 'Bookmark within document'
|
||||
ClientHeight = 124
|
||||
ClientWidth = 403
|
||||
Font.Style = [fsBold]
|
||||
ParentFont = False
|
||||
TabOrder = 0
|
||||
object CbHttpAddress: TComboBox
|
||||
Left = 8
|
||||
Height = 23
|
||||
Top = 32
|
||||
Width = 384
|
||||
Anchors = [akTop, akLeft, akRight]
|
||||
ItemHeight = 15
|
||||
OnEditingDone = CbHttpAddressEditingDone
|
||||
ParentFont = False
|
||||
TabOrder = 0
|
||||
end
|
||||
object EdHttpBookmark: TEdit
|
||||
Left = 8
|
||||
Height = 23
|
||||
Top = 86
|
||||
Width = 384
|
||||
ParentFont = False
|
||||
TabOrder = 1
|
||||
end
|
||||
object LblHttpAddress: TLabel
|
||||
Left = 8
|
||||
Height = 15
|
||||
Top = 8
|
||||
Width = 121
|
||||
Caption = 'URL of web document;'
|
||||
FocusControl = CbHttpAddress
|
||||
ParentColor = False
|
||||
ParentFont = False
|
||||
end
|
||||
object LblHttpBookmark: TLabel
|
||||
Left = 8
|
||||
Height = 15
|
||||
Top = 64
|
||||
Width = 151
|
||||
Caption = 'Bookmark within document:'
|
||||
FocusControl = EdHttpBookmark
|
||||
ParentColor = False
|
||||
ParentFont = False
|
||||
end
|
||||
end
|
||||
end
|
||||
object PfFTP: TPage
|
||||
object GbFtp: TGroupBox
|
||||
Left = 0
|
||||
Height = 144
|
||||
Top = 8
|
||||
Width = 407
|
||||
Align = alTop
|
||||
BorderSpacing.Top = 8
|
||||
BorderSpacing.Right = 8
|
||||
Caption = 'ftp server'
|
||||
ClientHeight = 124
|
||||
ClientWidth = 403
|
||||
Font.Style = [fsBold]
|
||||
ParentFont = False
|
||||
TabOrder = 0
|
||||
object CbFtpServer: TComboBox
|
||||
Left = 8
|
||||
Height = 23
|
||||
Top = 32
|
||||
Width = 384
|
||||
Anchors = [akTop, akLeft, akRight]
|
||||
ItemHeight = 15
|
||||
OnEditingDone = CbFtpServerEditingDone
|
||||
ParentFont = False
|
||||
TabOrder = 0
|
||||
end
|
||||
object Label1: TLabel
|
||||
Left = 8
|
||||
Height = 15
|
||||
Top = 10
|
||||
Width = 35
|
||||
Caption = 'Server:'
|
||||
ParentColor = False
|
||||
ParentFont = False
|
||||
end
|
||||
object LblFtpUserName: TLabel
|
||||
Left = 8
|
||||
Height = 15
|
||||
Top = 64
|
||||
Width = 59
|
||||
Caption = 'User name:'
|
||||
FocusControl = CbFtpUsername
|
||||
ParentColor = False
|
||||
ParentFont = False
|
||||
end
|
||||
object CbFtpUsername: TComboBox
|
||||
Left = 8
|
||||
Height = 23
|
||||
Top = 86
|
||||
Width = 190
|
||||
ItemHeight = 15
|
||||
ParentFont = False
|
||||
TabOrder = 1
|
||||
end
|
||||
object LblFtpPassword: TLabel
|
||||
Left = 208
|
||||
Height = 15
|
||||
Top = 64
|
||||
Width = 53
|
||||
Caption = 'Password:'
|
||||
FocusControl = CbFtpPassword
|
||||
ParentColor = False
|
||||
ParentFont = False
|
||||
end
|
||||
object CbFtpPassword: TComboBox
|
||||
Left = 208
|
||||
Height = 23
|
||||
Top = 86
|
||||
Width = 182
|
||||
ItemHeight = 15
|
||||
ParentFont = False
|
||||
TabOrder = 2
|
||||
end
|
||||
end
|
||||
end
|
||||
end
|
||||
end
|
||||
object Page4: TPage
|
||||
object PgMail: TPage
|
||||
object GbMailRecipient: TGroupBox
|
||||
Left = 0
|
||||
Height = 60
|
||||
@ -251,6 +369,7 @@ object HyperlinkForm: THyperlinkForm
|
||||
Height = 23
|
||||
Top = 6
|
||||
Width = 397
|
||||
Anchors = [akTop, akLeft, akRight]
|
||||
ItemHeight = 15
|
||||
OnEditingDone = CbMailRecipientEditingDone
|
||||
ParentFont = False
|
||||
@ -286,7 +405,7 @@ object HyperlinkForm: THyperlinkForm
|
||||
object HyperlinkInfo: TLabel
|
||||
Left = 8
|
||||
Height = 15
|
||||
Top = 282
|
||||
Top = 321
|
||||
Width = 407
|
||||
Align = alBottom
|
||||
BorderSpacing.Left = 8
|
||||
@ -300,17 +419,41 @@ object HyperlinkForm: THyperlinkForm
|
||||
object Bevel1: TBevel
|
||||
Left = 4
|
||||
Height = 3
|
||||
Top = 271
|
||||
Top = 310
|
||||
Width = 415
|
||||
Align = alBottom
|
||||
BorderSpacing.Left = 4
|
||||
BorderSpacing.Right = 4
|
||||
Shape = bsBottomLine
|
||||
end
|
||||
object GroupBox6: TGroupBox
|
||||
Left = 0
|
||||
Height = 56
|
||||
Top = 254
|
||||
Width = 415
|
||||
Align = alBottom
|
||||
BorderSpacing.Right = 8
|
||||
Caption = 'Cell tooltip'
|
||||
ClientHeight = 36
|
||||
ClientWidth = 411
|
||||
Font.Style = [fsBold]
|
||||
ParentFont = False
|
||||
TabOrder = 1
|
||||
object EdTooltip: TEdit
|
||||
Left = 8
|
||||
Height = 23
|
||||
Top = 3
|
||||
Width = 392
|
||||
Anchors = [akTop, akLeft, akRight]
|
||||
ParentFont = False
|
||||
TabOrder = 0
|
||||
Text = 'EdTooltip'
|
||||
end
|
||||
end
|
||||
end
|
||||
object ToolBar: TToolBar
|
||||
Left = 4
|
||||
Height = 297
|
||||
Height = 336
|
||||
Top = 4
|
||||
Width = 67
|
||||
Align = alLeft
|
||||
|
||||
@ -17,34 +17,48 @@ type
|
||||
Bevel1: TBevel;
|
||||
BtnBrowseFile: TButton;
|
||||
ButtonPanel1: TButtonPanel;
|
||||
CbFileName1: TComboBox;
|
||||
CbFileName2: TComboBox;
|
||||
CbFileName3: TComboBox;
|
||||
CbFtpServer: TComboBox;
|
||||
CbFtpUsername: TComboBox;
|
||||
CbFtpPassword: TComboBox;
|
||||
CbHttpAddress: TComboBox;
|
||||
CbFileBookmark: TComboBox;
|
||||
CbWorksheets: TComboBox;
|
||||
CbCellAddress: TComboBox;
|
||||
CbFileName: TComboBox;
|
||||
CbMailRecipient: TComboBox;
|
||||
EdHttpBookmark: TEdit;
|
||||
EdTooltip: TEdit;
|
||||
EdMailSubject: TEdit;
|
||||
GroupBox2: TGroupBox;
|
||||
GroupBox3: TGroupBox;
|
||||
GroupBox4: TGroupBox;
|
||||
GroupBox5: TGroupBox;
|
||||
GroupBox6: TGroupBox;
|
||||
GbFileName: TGroupBox;
|
||||
GbInternetLinkType: TGroupBox;
|
||||
GbHttp: TGroupBox;
|
||||
GbMailRecipient: TGroupBox;
|
||||
GroupBox6: TGroupBox;
|
||||
GbFileBookmark: TGroupBox;
|
||||
GroupBox8: TGroupBox;
|
||||
GbFtp: TGroupBox;
|
||||
Images: TImageList;
|
||||
HyperlinkInfo: TLabel;
|
||||
Label1: TLabel;
|
||||
LblFtpUserName: TLabel;
|
||||
LblFtpPassword: TLabel;
|
||||
LblHttpAddress: TLabel;
|
||||
Label5: TLabel;
|
||||
Label6: TLabel;
|
||||
LblHttpBookmark: TLabel;
|
||||
Notebook: TNotebook;
|
||||
InternetNotebook: TNotebook;
|
||||
OpenDialog: TOpenDialog;
|
||||
PgHTTP: TPage;
|
||||
PfFTP: TPage;
|
||||
PgInternal: TPage;
|
||||
Page2: TPage;
|
||||
Page3: TPage;
|
||||
Page4: TPage;
|
||||
PgFile: TPage;
|
||||
PgInternet: TPage;
|
||||
PgMail: TPage;
|
||||
Panel2: TPanel;
|
||||
RadioButton1: TRadioButton;
|
||||
RadioButton2: TRadioButton;
|
||||
RbFTP: TRadioButton;
|
||||
RbHTTP: TRadioButton;
|
||||
ToolBar: TToolBar;
|
||||
TbInternal: TToolButton;
|
||||
TbFile: TToolButton;
|
||||
@ -52,8 +66,14 @@ type
|
||||
TbMail: TToolButton;
|
||||
procedure BtnBrowseFileClick(Sender: TObject);
|
||||
procedure CbCellAddressEditingDone(Sender: TObject);
|
||||
procedure CbFileBookmarkDropDown(Sender: TObject);
|
||||
procedure CbFileNameEditingDone(Sender: TObject);
|
||||
procedure CbFtpServerEditingDone(Sender: TObject);
|
||||
procedure CbHttpAddressEditingDone(Sender: TObject);
|
||||
procedure CbMailRecipientEditingDone(Sender: TObject);
|
||||
procedure FormCreate(Sender: TObject);
|
||||
procedure OKButtonClick(Sender: TObject);
|
||||
procedure HTTP_FTP_Change(Sender: TObject);
|
||||
procedure ToolButtonClick(Sender: TObject);
|
||||
procedure UpdateHyperlinkInfo(Sender: TObject);
|
||||
private
|
||||
@ -65,6 +85,7 @@ type
|
||||
procedure SetHyperlinkKind(AValue: Integer);
|
||||
procedure SetHyperlinkTarget(const AValue: String);
|
||||
procedure SetHyperlinkTooltip(const AValue: String);
|
||||
procedure SetInternetLinkKind(AValue: Integer);
|
||||
procedure SetWorksheet(AWorksheet: TsWorksheet);
|
||||
protected
|
||||
function GetHyperlinkKind: Integer;
|
||||
@ -92,6 +113,9 @@ const
|
||||
TAG_INTERNET = 2;
|
||||
TAG_MAIL = 3;
|
||||
|
||||
TAG_HTTP = 0;
|
||||
TAG_FTP = 1;
|
||||
|
||||
{ THyperlinkForm }
|
||||
|
||||
procedure THyperlinkForm.BtnBrowseFileClick(Sender: TObject);
|
||||
@ -99,9 +123,10 @@ begin
|
||||
with OpenDialog do begin
|
||||
Filename := CbFileName.Text;
|
||||
if Execute then begin
|
||||
InitialDir := ExtractFileDir(FileName);
|
||||
CbFileName.Text := FileName;
|
||||
if CbFileName.Items.IndexOf(FileName) = -1 then
|
||||
CbFilename.Items.Add(FileName);
|
||||
if (CbFileName.Text <> '') and (CbFileName.Items.IndexOf(FileName) = -1) then
|
||||
CbFilename.Items.Insert(0, FileName);
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
@ -111,6 +136,56 @@ begin
|
||||
CbCellAddress.Text := Uppercase(CbCellAddress.Text);
|
||||
end;
|
||||
|
||||
procedure THyperlinkForm.CbFileBookmarkDropDown(Sender: TObject);
|
||||
var
|
||||
ext: String;
|
||||
wb: TsWorkbook;
|
||||
ws: TsWorksheet;
|
||||
i: Integer;
|
||||
begin
|
||||
CbFileBookmark.Items.Clear;
|
||||
if FileExists(CbFilename.Text) then begin
|
||||
ext := Lowercase(ExtractFileExt(CbFileName.Text));
|
||||
if (ext = '.xls') or (ext = '.xlsx') or (ext = '.ods') then begin
|
||||
wb := TsWorkbook.Create;
|
||||
try
|
||||
wb.ReadFromFile(CbFileName.Text);
|
||||
for i:=0 to wb.GetWorksheetCount-1 do
|
||||
begin
|
||||
ws := wb.GetWorksheetByIndex(i);
|
||||
CbFileBookmark.Items.Add(ws.Name);
|
||||
end;
|
||||
finally
|
||||
wb.Free;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure THyperlinkForm.CbFileNameEditingDone(Sender: TObject);
|
||||
begin
|
||||
if (CbFilename.Text <> '') and
|
||||
(CbFilename.Items.IndexOf(CbFilename.Text) = -1)
|
||||
then
|
||||
CbFileName.Items.Insert(0, CbFileName.Text);
|
||||
end;
|
||||
|
||||
procedure THyperlinkForm.CbFtpServerEditingDone(Sender: TObject);
|
||||
begin
|
||||
if (CbFtpServer.Text <> '') and
|
||||
(CbFtpServer.Items.IndexOf(CbFtpServer.Text) = -1)
|
||||
then
|
||||
CbFtpServer.Items.Insert(0, CbFtpServer.Text);
|
||||
end;
|
||||
|
||||
procedure THyperlinkForm.CbHttpAddressEditingDone(Sender: TObject);
|
||||
begin
|
||||
if (CbHttpAddress.Text <> '') and
|
||||
(CbHttpAddress.Items.Indexof(CbHttpAddress.Text) = -1)
|
||||
then
|
||||
CbHttpAddress.Items.Insert(0, CbHttpAddress.Text);
|
||||
end;
|
||||
|
||||
procedure THyperlinkForm.CbMailRecipientEditingDone(Sender: TObject);
|
||||
begin
|
||||
if (CbMailRecipient.Text <> '') and
|
||||
@ -119,6 +194,11 @@ begin
|
||||
CbMailRecipient.Items.Insert(0, CbMailRecipient.Text);
|
||||
end;
|
||||
|
||||
procedure THyperlinkForm.FormCreate(Sender: TObject);
|
||||
begin
|
||||
HTTP_FTP_Change(nil);
|
||||
end;
|
||||
|
||||
procedure THyperlinkForm.GetHyperlink(out AHyperlink: TsHyperlink);
|
||||
begin
|
||||
AHyperlink.Target := GetHyperlinkTarget;
|
||||
@ -135,6 +215,7 @@ end;
|
||||
|
||||
function THyperlinkForm.GetHyperlinkTarget: String;
|
||||
begin
|
||||
Result := '';
|
||||
case GetHyperlinkKind of
|
||||
TAG_INTERNAL:
|
||||
begin //internal
|
||||
@ -143,19 +224,42 @@ begin
|
||||
else if (CbWorksheets.ItemIndex > 0) then
|
||||
Result := '#' + CbWorksheets.Text + '!'
|
||||
else if (CbCellAddress.Text <> '') then
|
||||
Result := '#' + Uppercase(CbCellAddress.Text)
|
||||
else
|
||||
Result := '';
|
||||
Result := '#' + Uppercase(CbCellAddress.Text);
|
||||
end;
|
||||
|
||||
TAG_FILE:
|
||||
begin // File
|
||||
if (FWorkbook = nil) or (FWorkbook.FileName = '') then
|
||||
if FileNameIsAbsolute(CbFilename.Text) then
|
||||
Result := FilenameToURI(CbFilename.Text)
|
||||
else
|
||||
Result := '';
|
||||
Result := CbFilename.Text;
|
||||
if CbFileBookmark.Text <> '' then
|
||||
Result := Result + '#' + CbFileBookmark.Text;
|
||||
end;
|
||||
|
||||
TAG_INTERNET:
|
||||
;
|
||||
begin // Internet link
|
||||
if RbHttp.Checked and (CbHttpAddress.Text <> '') then
|
||||
begin
|
||||
if pos('http', Lowercase(CbHttpAddress.Text)) = 1 then
|
||||
Result := CbHttpAddress.Text
|
||||
else
|
||||
Result := 'http://' + CbHttpAddress.Text;
|
||||
if EdHttpBookmark.Text <> '' then
|
||||
Result := Result + '#' + EdHttpBookmark.Text;
|
||||
end else
|
||||
if RbFtp.Checked and (CbFtpServer.Text <> '') then
|
||||
begin
|
||||
if (CbFtpUsername.Text <> '') and (CbFtpPassword.Text <> '') then
|
||||
Result := Format('ftp://%s:%s@%s', [CbFtpUsername.Text, CbFtpPassword.Text, CbFtpServer.Text])
|
||||
else
|
||||
if (CbFtpUsername.Text <> '') and (CbFtpPassword.Text = '') then
|
||||
Result := Format('ftp://%s@%s', [CbFtpUsername.Text , CbFtpServer.Text])
|
||||
else
|
||||
Result := 'ftp://anonymous@' + CbFtpServer.Text;
|
||||
end;
|
||||
end;
|
||||
|
||||
TAG_MAIL:
|
||||
begin // Mail
|
||||
if EdMailSubject.Text <> '' then
|
||||
@ -168,7 +272,7 @@ end;
|
||||
|
||||
function THyperlinkForm.GetHyperlinkTooltip: String;
|
||||
begin
|
||||
//
|
||||
Result := EdTooltip.Text;
|
||||
end;
|
||||
|
||||
procedure THyperlinkForm.OKButtonClick(Sender: TObject);
|
||||
@ -183,6 +287,15 @@ begin
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure THyperlinkForm.HTTP_FTP_Change(Sender: TObject);
|
||||
begin
|
||||
if RbHTTP.Checked then
|
||||
InternetNotebook.PageIndex := 0;
|
||||
if RbFTP.Checked then
|
||||
InternetNotebook.PageIndex := 1;
|
||||
UpdateHyperlinkInfo(nil);
|
||||
end;
|
||||
|
||||
procedure THyperlinkForm.SetHyperlink(AWorksheet: TsWorksheet;
|
||||
const AHyperlink: TsHyperlink);
|
||||
begin
|
||||
@ -207,6 +320,7 @@ var
|
||||
c,r: Cardinal;
|
||||
i, idx: Integer;
|
||||
p: Integer;
|
||||
fn, bm: String;
|
||||
begin
|
||||
if AValue = '' then
|
||||
begin
|
||||
@ -251,6 +365,17 @@ begin
|
||||
// external links
|
||||
u := ParseURI(AValue);
|
||||
|
||||
// File with absolute path
|
||||
if SameText(u.Protocol, 'file') then
|
||||
begin
|
||||
SetHyperlinkKind(TAG_FILE);
|
||||
UriToFilename(AValue, fn);
|
||||
CbFilename.Text := fn;
|
||||
CbFileBookmark.Text := u.Bookmark;
|
||||
UpdateHyperlinkInfo(nil);
|
||||
exit;
|
||||
end;
|
||||
|
||||
// Mail
|
||||
if SameText(u.Protocol, 'mailto') then
|
||||
begin
|
||||
@ -267,11 +392,48 @@ begin
|
||||
UpdateHyperlinkInfo(nil);
|
||||
exit;
|
||||
end;
|
||||
|
||||
// http
|
||||
if SameText(u.Protocol, 'http') or SameText(u.Protocol, 'https') then
|
||||
begin
|
||||
SetHyperlinkKind(TAG_INTERNET);
|
||||
SetInternetLinkKind(TAG_HTTP);
|
||||
CbHttpAddress.Text := u.Host;
|
||||
EdHttpBookmark.Text := u.Bookmark;
|
||||
UpdateHyperlinkInfo(nil);
|
||||
exit;
|
||||
end;
|
||||
|
||||
// ftp
|
||||
if SameText(u.Protocol, 'ftp') then
|
||||
begin
|
||||
SetHyperlinkKind(TAG_INTERNET);
|
||||
SetInternetLinkKind(TAG_FTP);
|
||||
CbFtpServer.Text := u.Host;
|
||||
CbFtpUserName.text := u.UserName;
|
||||
CbFtpPassword.Text := u.Password;
|
||||
UpdateHyperlinkInfo(nil);
|
||||
exit;
|
||||
end;
|
||||
|
||||
// If we get there it must be a local file with relative path
|
||||
SetHyperlinkKind(TAG_FILE);
|
||||
SplitHyperlink(AValue, fn, bm);
|
||||
CbFileName.Text := fn;
|
||||
CbFileBookmark.Text := bm;
|
||||
UpdateHyperlinkInfo(nil);
|
||||
end;
|
||||
|
||||
procedure THyperlinkForm.SetHyperlinkTooltip(const AValue: String);
|
||||
begin
|
||||
//
|
||||
EdTooltip.Text := AValue;
|
||||
end;
|
||||
|
||||
procedure THyperlinkForm.SetInternetLinkKind(AValue: Integer);
|
||||
begin
|
||||
RbHttp.Checked := AValue = TAG_HTTP;
|
||||
RbFtp.Checked := AValue = TAG_FTP;
|
||||
InternetNotebook.PageIndex := AValue;
|
||||
end;
|
||||
|
||||
procedure THyperlinkForm.SetWorksheet(AWorksheet: TsWorksheet);
|
||||
@ -300,8 +462,12 @@ begin
|
||||
end;
|
||||
|
||||
procedure THyperlinkForm.UpdateHyperlinkInfo(Sender: TObject);
|
||||
var
|
||||
s: String;
|
||||
begin
|
||||
HyperlinkInfo.Caption := GetHyperlinkTarget;
|
||||
s := GetHyperlinkTarget;
|
||||
if s = '' then s := #32;
|
||||
HyperlinkInfo.Caption := s;
|
||||
end;
|
||||
|
||||
function THyperlinkForm.ValidData(out AControl: TWinControl;
|
||||
@ -336,6 +502,36 @@ begin
|
||||
end;
|
||||
end;
|
||||
|
||||
TAG_FILE:
|
||||
begin
|
||||
if CbFilename.Text = '' then
|
||||
begin
|
||||
AMsg := 'No filename specified.';
|
||||
AControl := CbFileName;
|
||||
exit;
|
||||
end;
|
||||
end;
|
||||
|
||||
TAG_INTERNET:
|
||||
if RbHttp.Checked then
|
||||
begin
|
||||
if CbHttpAddress.Text = '' then
|
||||
begin
|
||||
AMsg := 'URL of web site not specified.';
|
||||
AControl := CbHttpAddress;
|
||||
exit;
|
||||
end;
|
||||
end else
|
||||
if RbFtp.Checked then
|
||||
begin
|
||||
if CbFtpServer.Text = '' then
|
||||
begin
|
||||
AMsg := 'Ftp server not specified.';
|
||||
AControl := CbFtpServer;
|
||||
exit;
|
||||
end;
|
||||
end;
|
||||
|
||||
TAG_MAIL:
|
||||
begin
|
||||
if CbMailRecipient.Text = '' then
|
||||
|
||||
@ -1342,7 +1342,6 @@ var
|
||||
cellStr: String;
|
||||
hyperlink: TsHyperlink;
|
||||
displayText: String;
|
||||
// noCellText: Boolean;
|
||||
cell: PCell;
|
||||
begin
|
||||
Unused(Target);
|
||||
@ -1365,9 +1364,7 @@ begin
|
||||
end;
|
||||
chmEdit:
|
||||
begin
|
||||
displayText := Worksheet.ReadAsUTF8Text(ActiveCell);
|
||||
hyperlink := Worksheet.ReadHyperlink(ActiveCell);
|
||||
// noCellText := displayText = hyperlink.Target;
|
||||
txt := Format('Edit hyperlink for cell %s', [cellStr]);
|
||||
if EditHyperlink(txt, hyperlink) then
|
||||
begin
|
||||
@ -1375,10 +1372,6 @@ begin
|
||||
Worksheet.ActiveCellRow, Worksheet.ActiveCellCol,
|
||||
hyperlink.Target, hyperlink.ToolTip
|
||||
);
|
||||
{
|
||||
if noCellText then
|
||||
Worksheet.WriteBlank(Worksheet.ActiveCellRow, Worksheet.ActiveCellCol);
|
||||
}
|
||||
end;
|
||||
end;
|
||||
chmDelete:
|
||||
|
||||
@ -4216,6 +4216,7 @@ begin
|
||||
GetCellString(ARow, ACol)
|
||||
]);
|
||||
|
||||
// Hyperlink?
|
||||
if FWorksheet.HasHyperlink(ACell) then
|
||||
begin
|
||||
hyperlink := FWorksheet.FindHyperlink(ACell);
|
||||
@ -4240,6 +4241,7 @@ begin
|
||||
'</text:p>', [target, txt]);
|
||||
|
||||
end else
|
||||
// No hyperlink, normal text only
|
||||
textp := '<text:p>' + txt + '</text:p>';
|
||||
|
||||
// Write it ...
|
||||
|
||||
Reference in New Issue
Block a user