Adds a OpenURL/OpenDocument test

git-svn-id: trunk@36744 -
This commit is contained in:
sekelsenmat 2012-04-13 12:45:54 +00:00
parent 89ba11a644
commit 5f2d225948
7 changed files with 266 additions and 0 deletions

6
.gitattributes vendored
View File

@ -4024,6 +4024,12 @@ examples/openglcontrol/data/texture3.png -text svneol=unset#image/png
examples/openglcontrol/exampleform.pp svneol=native#text/pascal
examples/openglcontrol/openglcontrol_demo.lpi svneol=native#text/plain
examples/openglcontrol/openglcontrol_demo.pas svneol=native#text/pascal
examples/openurltest/mainform.lfm svneol=native#text/plain
examples/openurltest/mainform.pas svneol=native#text/plain
examples/openurltest/openurltest.ico -text
examples/openurltest/openurltest.lpi svneol=native#text/plain
examples/openurltest/openurltest.lpr svneol=native#text/plain
examples/openurltest/openurltest.res -text
examples/pascalstream/PascalStream1.lpi svneol=native#text/plain
examples/pascalstream/PascalStream1.lpr svneol=native#text/plain
examples/pascalstream/componentstreampas.pas svneol=native#text/plain

View File

@ -0,0 +1,82 @@
object Form1: TForm1
Left = 257
Height = 248
Top = 177
Width = 320
Caption = 'Form1'
ClientHeight = 248
ClientWidth = 320
LCLVersion = '1.1'
object btnOpenURLHTTP: TButton
Left = 64
Height = 25
Top = 119
Width = 184
Caption = 'OpenURL with http://'
OnClick = btnOpenURLHTTPClick
TabOrder = 0
end
object editFileName: TFileNameEdit
Left = 8
Height = 21
Top = 32
Width = 280
FilterIndex = 0
HideDirectories = False
ButtonWidth = 23
NumGlyphs = 0
MaxLength = 0
TabOrder = 1
end
object Label1: TLabel
Left = 8
Height = 14
Top = 9
Width = 216
Caption = 'Please indicate a filename or URL for testing:'
ParentColor = False
end
object btnOpenURLFILE: TButton
Left = 64
Height = 25
Top = 151
Width = 184
Caption = 'OpenURL with file://'
OnClick = btnOpenURLFILEClick
TabOrder = 2
end
object btnOpenDocument: TButton
Left = 64
Height = 25
Top = 183
Width = 184
Caption = 'OpenDocument test'
OnClick = btnOpenDocumentClick
TabOrder = 3
end
object btnFindBrowser: TButton
Left = 64
Height = 25
Top = 215
Width = 182
Caption = 'Find Browser'
OnClick = btnFindBrowserClick
TabOrder = 4
end
object Label2: TLabel
Left = 9
Height = 14
Top = 58
Width = 35
Caption = 'Result:'
ParentColor = False
end
object editResult: TEdit
Left = 9
Height = 21
Top = 80
Width = 279
TabOrder = 5
Text = 'editResult'
end
end

View File

@ -0,0 +1,67 @@
unit mainform;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, StdCtrls,
EditBtn, LCLIntf, LCLProc;
type
{ TForm1 }
TForm1 = class(TForm)
btnOpenURLHTTP: TButton;
btnOpenURLFILE: TButton;
btnOpenDocument: TButton;
btnFindBrowser: TButton;
editResult: TEdit;
editFileName: TFileNameEdit;
Label1: TLabel;
Label2: TLabel;
procedure btnFindBrowserClick(Sender: TObject);
procedure btnOpenDocumentClick(Sender: TObject);
procedure btnOpenURLHTTPClick(Sender: TObject);
procedure btnOpenURLFILEClick(Sender: TObject);
private
{ private declarations }
public
{ public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.lfm}
{ TForm1 }
procedure TForm1.btnOpenURLHTTPClick(Sender: TObject);
begin
editResult.Text := BoolToStr(OpenURL('www.google.com'));
end;
procedure TForm1.btnOpenDocumentClick(Sender: TObject);
begin
editResult.Text := BoolToStr(OpenDocument(editFilename.Text));
end;
procedure TForm1.btnFindBrowserClick(Sender: TObject);
var
lStr, lParams: String;
begin
FindDefaultBrowser(lStr, lParams);
editResult.Text := lStr + ' ' + lParams;
end;
procedure TForm1.btnOpenURLFILEClick(Sender: TObject);
begin
editResult.Text := BoolToStr(OpenURL('file://'+editFilename.Text));
end;
end.

Binary file not shown.

After

Width:  |  Height:  |  Size: 134 KiB

View File

@ -0,0 +1,90 @@
<?xml version="1.0"?>
<CONFIG>
<ProjectOptions>
<Version Value="9"/>
<PathDelim Value="\"/>
<General>
<SessionStorage Value="InProjectDir"/>
<MainUnit Value="0"/>
<Title Value="openurltest"/>
<ResourceType Value="res"/>
<UseXPManifest Value="True"/>
<Icon Value="0"/>
</General>
<i18n>
<EnableI18N LFM="False"/>
</i18n>
<VersionInfo>
<StringTable ProductVersion=""/>
</VersionInfo>
<BuildModes Count="1">
<Item1 Name="Default" Default="True"/>
</BuildModes>
<PublishOptions>
<Version Value="2"/>
<IncludeFileFilter Value="*.(pas|pp|inc|lfm|lpr|lrs|lpi|lpk|sh|xml)"/>
<ExcludeFileFilter Value="*.(bak|ppu|o|so);*~;backup"/>
</PublishOptions>
<RunParams>
<local>
<FormatVersion Value="1"/>
</local>
</RunParams>
<RequiredPackages Count="1">
<Item1>
<PackageName Value="LCL"/>
</Item1>
</RequiredPackages>
<Units Count="2">
<Unit0>
<Filename Value="openurltest.lpr"/>
<IsPartOfProject Value="True"/>
<UnitName Value="openurltest"/>
</Unit0>
<Unit1>
<Filename Value="mainform.pas"/>
<IsPartOfProject Value="True"/>
<ComponentName Value="Form1"/>
<ResourceBaseClass Value="Form"/>
<UnitName Value="mainform"/>
</Unit1>
</Units>
</ProjectOptions>
<CompilerOptions>
<Version Value="11"/>
<PathDelim Value="\"/>
<Target>
<Filename Value="openurltest"/>
</Target>
<SearchPaths>
<IncludeFiles Value="$(ProjOutDir)"/>
<UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/>
</SearchPaths>
<Linking>
<Options>
<Win32>
<GraphicApplication Value="True"/>
</Win32>
</Options>
</Linking>
<Other>
<CompilerMessages>
<MsgFileName Value=""/>
</CompilerMessages>
<CompilerPath Value="$(CompPath)"/>
</Other>
</CompilerOptions>
<Debugging>
<Exceptions Count="3">
<Item1>
<Name Value="EAbort"/>
</Item1>
<Item2>
<Name Value="ECodetoolError"/>
</Item2>
<Item3>
<Name Value="EFOpenError"/>
</Item3>
</Exceptions>
</Debugging>
</CONFIG>

View File

@ -0,0 +1,21 @@
program openurltest;
{$mode objfpc}{$H+}
uses
{$IFDEF UNIX}{$IFDEF UseCThreads}
cthreads,
{$ENDIF}{$ENDIF}
Interfaces, // this includes the LCL widgetset
Forms, mainform
{ you can add units after this };
{$R *.res}
begin
RequireDerivedFormResource := True;
Application.Initialize;
Application.CreateForm(TForm1, Form1);
Application.Run;
end.

Binary file not shown.