mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-04-06 05:58:06 +02:00
examples: removed obsolete openbrowser
git-svn-id: trunk@54879 -
This commit is contained in:
mattias
parent
5377b0e786
commit
6cc8aeb697
10
.gitattributes
vendored
10
.gitattributes
vendored
@ -5873,16 +5873,6 @@ examples/objectinspector/mainunit.lfm svneol=native#text/plain
|
||||
examples/objectinspector/mainunit.pas svneol=native#text/pascal
|
||||
examples/objectinspector/oiexample.lpi svneol=native#text/plain
|
||||
examples/objectinspector/oiexample.lpr svneol=native#text/pascal
|
||||
examples/openbrowser/OpenURLInFirefox.sh svneol=native#text/plain
|
||||
examples/openbrowser/OpenURLInGaleon.sh svneol=native#text/plain
|
||||
examples/openbrowser/OpenURLInKonqueror.sh svneol=native#text/plain
|
||||
examples/openbrowser/OpenURLInMozilla.sh svneol=native#text/plain
|
||||
examples/openbrowser/OpenURLInNetscape.sh svneol=native#text/plain
|
||||
examples/openbrowser/OpenURLInOpera.sh svneol=native#text/plain
|
||||
examples/openbrowser/mainunit.lfm svneol=native#text/plain
|
||||
examples/openbrowser/mainunit.pas svneol=native#text/plain
|
||||
examples/openbrowser/testbrowserrmc.lpi svneol=native#text/plain
|
||||
examples/openbrowser/testbrowserrmc.lpr svneol=native#text/plain
|
||||
examples/openglcontrol/data/particle.png -text svneol=unset#image/png
|
||||
examples/openglcontrol/data/texture1.png -text svneol=unset#image/png
|
||||
examples/openglcontrol/data/texture2.png -text svneol=unset#image/png
|
||||
|
||||
2
.gitignore
vendored
2
.gitignore
vendored
@ -426,8 +426,6 @@ examples/multithreading/*.bak
|
||||
examples/multithreading/units
|
||||
examples/objectinspector/*.bak
|
||||
examples/objectinspector/units
|
||||
examples/openbrowser/*.bak
|
||||
examples/openbrowser/units
|
||||
examples/openglcontrol/*.bak
|
||||
examples/openglcontrol/data/*.bak
|
||||
examples/openglcontrol/data/units
|
||||
|
||||
@ -1,4 +0,0 @@
|
||||
#!/usr/bin/env bash
|
||||
|
||||
firefox -remote "openurl($1)" || firefox $1 &
|
||||
|
||||
@ -1,4 +0,0 @@
|
||||
#!/usr/bin/env bash
|
||||
|
||||
galeon -x $1 &
|
||||
|
||||
@ -1,4 +0,0 @@
|
||||
#!/usr/bin/env bash
|
||||
|
||||
kfmclient openURL $1 &
|
||||
|
||||
@ -1,4 +0,0 @@
|
||||
#!/usr/bin/env bash
|
||||
|
||||
mozilla -remote "openurl($1)" || mozilla $1 &
|
||||
|
||||
@ -1,4 +0,0 @@
|
||||
#!/usr/bin/env bash
|
||||
|
||||
netscape -remote "openurl($1)" || netscape $1 &
|
||||
|
||||
@ -1,4 +0,0 @@
|
||||
#!/usr/bin/env bash
|
||||
|
||||
opera -remote "openURL($1)" || opera $1 &
|
||||
|
||||
@ -1,50 +0,0 @@
|
||||
object Form1: TForm1
|
||||
Left = 302
|
||||
Height = 300
|
||||
Top = 168
|
||||
Width = 439
|
||||
Caption = 'Form1'
|
||||
ClientHeight = 300
|
||||
ClientWidth = 439
|
||||
OnCreate = FormCreate
|
||||
LCLVersion = '0.9.25'
|
||||
object OpenLazarusButton: TButton
|
||||
Left = 190
|
||||
Height = 29
|
||||
Top = 80
|
||||
Width = 221
|
||||
AutoSize = True
|
||||
Caption = 'Open www.lazarus.freepascal.org'
|
||||
OnClick = OpenLazarusButtonClick
|
||||
TabOrder = 0
|
||||
end
|
||||
object BrowserRadioGroup: TRadioGroup
|
||||
Left = 25
|
||||
Height = 267
|
||||
Top = 10
|
||||
Width = 150
|
||||
AutoFill = True
|
||||
Caption = 'Browser'
|
||||
ChildSizing.LeftRightSpacing = 6
|
||||
ChildSizing.TopBottomSpacing = 6
|
||||
ChildSizing.EnlargeHorizontal = crsHomogenousChildResize
|
||||
ChildSizing.EnlargeVertical = crsHomogenousChildResize
|
||||
ChildSizing.ShrinkHorizontal = crsScaleChilds
|
||||
ChildSizing.ShrinkVertical = crsScaleChilds
|
||||
ChildSizing.Layout = cclLeftToRightThenTopToBottom
|
||||
ChildSizing.ControlsPerLine = 1
|
||||
ClientHeight = 248
|
||||
ClientWidth = 146
|
||||
ItemIndex = 4
|
||||
Items.Strings = (
|
||||
'xdg-open'
|
||||
'Firefox'
|
||||
'Galeon'
|
||||
'Konqueror'
|
||||
'Mozilla'
|
||||
'Netscape'
|
||||
'Opera'
|
||||
)
|
||||
TabOrder = 1
|
||||
end
|
||||
end
|
||||
@ -1,123 +0,0 @@
|
||||
unit MainUnit;
|
||||
|
||||
{$mode objfpc}{$H+}
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
SysUtils, LCLProc, Forms, Dialogs,
|
||||
FileUtil, LazFileUtils, LazUTF8, UTF8Process, StdCtrls, Process, ExtCtrls;
|
||||
|
||||
type
|
||||
{ TForm1 }
|
||||
|
||||
TForm1 = class(TForm)
|
||||
OpenLazarusButton: TButton;
|
||||
BrowserRadioGroup: TRadioGroup;
|
||||
procedure FormCreate(Sender: TObject);
|
||||
procedure OpenLazarusButtonClick(Sender: TObject);
|
||||
private
|
||||
public
|
||||
procedure OpenURL(const URL: string);
|
||||
procedure GetBrowser(out BrowserName, BrowserFilename, StartScriptFilename: string);
|
||||
end;
|
||||
|
||||
var
|
||||
Form1: TForm1;
|
||||
|
||||
implementation
|
||||
|
||||
{$R mainunit.lfm}
|
||||
|
||||
function SearchExecutable(const ShortFilename: string; var Filename: string
|
||||
): boolean;
|
||||
begin
|
||||
Filename:=SearchFileInPath(ShortFilename,'',
|
||||
GetEnvironmentVariableUTF8('PATH'),PathSeparator,[]);
|
||||
Result:=Filename<>'';
|
||||
end;
|
||||
|
||||
{ TForm1 }
|
||||
|
||||
procedure TForm1.FormCreate(Sender: TObject);
|
||||
begin
|
||||
end;
|
||||
|
||||
procedure TForm1.OpenLazarusButtonClick(Sender: TObject);
|
||||
begin
|
||||
OpenURL('http://www.lazarus-ide.org/');
|
||||
end;
|
||||
|
||||
procedure TForm1.OpenURL(const URL: string);
|
||||
var
|
||||
TheProcess: TProcessUTF8;
|
||||
BrowserFilename: string;
|
||||
StartScriptFilename: string;
|
||||
BrowserName: string;
|
||||
begin
|
||||
GetBrowser(BrowserName,BrowserFilename,StartScriptFilename);
|
||||
if BrowserFilename='' then begin
|
||||
DebugLn('TForm1.OpenURL unable to find browser "',BrowserName,'"');
|
||||
MessageDlg('Invalid browser',
|
||||
'Unable to find browser executable "'+BrowserName+'"',
|
||||
mtError,[mbCancel],0);
|
||||
exit;
|
||||
end;
|
||||
|
||||
DebugLn('TForm1.OpenURL StartScriptFilename=',StartScriptFilename);
|
||||
if not FileExistsUTF8(StartScriptFilename) then begin
|
||||
DebugLn('TForm1.OpenURL unable to find program "',StartScriptFilename,'"');
|
||||
MessageDlg('Invalid browser',
|
||||
'Unable to find browser "'+StartScriptFilename+'"',
|
||||
mtError,[mbCancel],0);
|
||||
exit;
|
||||
end;
|
||||
if not FileIsExecutable(StartScriptFilename) then begin
|
||||
DebugLn('TForm1.OpenURL browserfile is not executable "',StartScriptFilename,'"');
|
||||
MessageDlg('Invalid browser',
|
||||
'Browserfilename "'+StartScriptFilename+'" is not executable',
|
||||
mtError,[mbCancel],0);
|
||||
exit;
|
||||
end;
|
||||
|
||||
|
||||
TheProcess:=TProcessUTF8.Create(nil);
|
||||
try
|
||||
TheProcess.InheritHandles := false;
|
||||
TheProcess.Options:= [poUsePipes, poNoConsole, poStdErrToOutput];
|
||||
TheProcess.ShowWindow := swoNone;
|
||||
TheProcess.CommandLine:=StartScriptFilename+' '+URL;
|
||||
try
|
||||
TheProcess.Execute;
|
||||
TheProcess.WaitOnExit;
|
||||
if TheProcess.ExitStatus<>0 then begin
|
||||
MessageDlg('Error',
|
||||
'Error executing browser script '+StartScriptFilename+#13
|
||||
+'Error code: '+IntToStr(TheProcess.ExitStatus),
|
||||
mtError,[mbCancel],0);
|
||||
end;
|
||||
finally
|
||||
TheProcess.Free;
|
||||
end;
|
||||
except
|
||||
on E: Exception do begin
|
||||
DebugLn('TForm1.OpenURL ERROR: ',E.Message);
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TForm1.GetBrowser(out BrowserName, BrowserFilename,
|
||||
StartScriptFilename: string);
|
||||
var
|
||||
i: LongInt;
|
||||
begin
|
||||
i:=BrowserRadioGroup.ItemIndex;
|
||||
if i<0 then i:=4;
|
||||
BrowserName:=BrowserRadioGroup.Items[i];
|
||||
StartScriptFilename:=ExtractFilePath(Application.ExeName)+'OpenURLIn'+BrowserName+'.sh';
|
||||
if not SearchExecutable(lowercase(BrowserName),BrowserFilename) then
|
||||
BrowserFilename:='';
|
||||
end;
|
||||
|
||||
end.
|
||||
|
||||
@ -1,61 +0,0 @@
|
||||
<?xml version="1.0"?>
|
||||
<CONFIG>
|
||||
<ProjectOptions>
|
||||
<Version Value="9"/>
|
||||
<General>
|
||||
<Flags>
|
||||
<LRSInOutputDirectory Value="False"/>
|
||||
</Flags>
|
||||
<SessionStorage Value="InProjectDir"/>
|
||||
<MainUnit Value="0"/>
|
||||
</General>
|
||||
<BuildModes Count="1">
|
||||
<Item1 Name="default" Default="True"/>
|
||||
</BuildModes>
|
||||
<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"/>
|
||||
</local>
|
||||
</RunParams>
|
||||
<RequiredPackages Count="1">
|
||||
<Item1>
|
||||
<PackageName Value="LCL"/>
|
||||
</Item1>
|
||||
</RequiredPackages>
|
||||
<Units Count="2">
|
||||
<Unit0>
|
||||
<Filename Value="testbrowserrmc.lpr"/>
|
||||
<IsPartOfProject Value="True"/>
|
||||
<UnitName Value="TestBrowserRMC"/>
|
||||
</Unit0>
|
||||
<Unit1>
|
||||
<Filename Value="mainunit.pas"/>
|
||||
<IsPartOfProject Value="True"/>
|
||||
<ComponentName Value="Form1"/>
|
||||
<UnitName Value="MainUnit"/>
|
||||
</Unit1>
|
||||
</Units>
|
||||
</ProjectOptions>
|
||||
<CompilerOptions>
|
||||
<Version Value="9"/>
|
||||
<SearchPaths>
|
||||
|
||||
</SearchPaths>
|
||||
<Linking>
|
||||
<Options>
|
||||
<Win32>
|
||||
<GraphicApplication Value="True"/>
|
||||
</Win32>
|
||||
</Options>
|
||||
</Linking>
|
||||
<Other>
|
||||
<CompilerPath Value="$(CompPath)"/>
|
||||
</Other>
|
||||
</CompilerOptions>
|
||||
</CONFIG>
|
||||
@ -1,15 +0,0 @@
|
||||
program TestBrowserRMC;
|
||||
|
||||
{$mode objfpc}{$H+}
|
||||
|
||||
uses
|
||||
Interfaces, // this includes the LCL widgetset
|
||||
Forms
|
||||
{ add your units here }, MainUnit;
|
||||
|
||||
begin
|
||||
Application.Initialize;
|
||||
Application.CreateForm(TForm1, Form1);
|
||||
Application.Run;
|
||||
end.
|
||||
|
||||
Loading…
Reference in New Issue
Block a user