348 lines
8.2 KiB
ObjectPascal
348 lines
8.2 KiB
ObjectPascal
(* ***** BEGIN LICENSE BLOCK *****
|
|
* Version: MPL 1.1
|
|
*
|
|
* The contents of this file are subject to the Mozilla Public License Version
|
|
* 1.1 (the "License"); you may not use this file except in compliance with
|
|
* the License. You may obtain a copy of the License at
|
|
* http://www.mozilla.org/MPL/
|
|
*
|
|
* Software distributed under the License is distributed on an "AS IS" basis,
|
|
* WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License
|
|
* for the specific language governing rights and limitations under the
|
|
* License.
|
|
*
|
|
* The Original Code is TurboPower Abbrevia
|
|
*
|
|
* The Initial Developer of the Original Code is
|
|
* TurboPower Software
|
|
*
|
|
* Portions created by the Initial Developer are Copyright (C) 1997-2002
|
|
* the Initial Developer. All Rights Reserved.
|
|
*
|
|
* Contributor(s):
|
|
*
|
|
* ***** END LICENSE BLOCK ***** *)
|
|
|
|
{*********************************************************}
|
|
{* ABBREVIA: AbPeVer.pas *}
|
|
{*********************************************************}
|
|
{* ABBREVIA: Property Editor - Version *}
|
|
{* Use AbQPeVer.pas for CLX *}
|
|
{*********************************************************}
|
|
|
|
{$IFNDEF UsingCLX}
|
|
unit AbPeVer;
|
|
{$ENDIF}
|
|
|
|
{$I AbDefine.inc}
|
|
|
|
interface
|
|
|
|
uses
|
|
{$IFDEF MSWINDOWS}
|
|
Windows,
|
|
ShellAPI,
|
|
{$ENDIF}
|
|
{$IFDEF LibcAPI}
|
|
Libc,
|
|
{$ENDIF}
|
|
{$IFDEF UsingClx}
|
|
QGraphics,
|
|
QForms,
|
|
QControls,
|
|
QStdCtrls,
|
|
QButtons,
|
|
QExtCtrls,
|
|
QDialogs,
|
|
{$ELSE}
|
|
Graphics,
|
|
Forms,
|
|
Controls,
|
|
StdCtrls,
|
|
Buttons,
|
|
ExtCtrls,
|
|
Dialogs,
|
|
{$ENDIF}
|
|
DesignIntf,
|
|
DesignEditors,
|
|
SysUtils,
|
|
Classes;
|
|
|
|
type
|
|
TAbAboutBox = class(TForm)
|
|
lblVersion: TLabel;
|
|
Panel1: TPanel;
|
|
Image1: TImage;
|
|
btnOK: TButton;
|
|
Panel2: TPanel;
|
|
WebLbl: TLabel;
|
|
NewsLbl: TLabel;
|
|
Bevel1: TBevel;
|
|
Label1: TLabel;
|
|
Label2: TLabel;
|
|
Label3: TLabel;
|
|
Label5: TLabel;
|
|
Label6: TLabel;
|
|
Label7: TLabel;
|
|
Label10: TLabel;
|
|
Label11: TLabel;
|
|
procedure FormCreate(Sender: TObject);
|
|
procedure btnOKClick(Sender: TObject);
|
|
procedure WebLblClick(Sender: TObject);
|
|
procedure WebLblMouseMove(Sender: TObject; Shift: TShiftState; X,
|
|
Y: Integer);
|
|
procedure NewsLblClick(Sender: TObject);
|
|
procedure NewsLblMouseMove(Sender: TObject; Shift: TShiftState; X,
|
|
Y: Integer);
|
|
procedure Panel2MouseMove(Sender: TObject; Shift: TShiftState; X,
|
|
Y: Integer);
|
|
procedure FormMouseMove(Sender: TObject; Shift: TShiftState; X,
|
|
Y: Integer);
|
|
private
|
|
{ Private declarations }
|
|
public
|
|
{ Public declarations }
|
|
end;
|
|
|
|
|
|
TAbVersionProperty = class( TStringProperty )
|
|
public
|
|
function GetAttributes: TPropertyAttributes;
|
|
override;
|
|
procedure Edit;
|
|
override;
|
|
end;
|
|
|
|
var
|
|
AbAboutBox : TAbAboutBox;
|
|
|
|
implementation
|
|
|
|
{$IFNDEF UsingCLX}
|
|
{$R *.dfm}
|
|
{$ENDIF}
|
|
|
|
uses
|
|
AbArcTyp,
|
|
AbConst,
|
|
AbResString;
|
|
|
|
{$IFDEF LINUX}
|
|
const
|
|
{ String Constants }
|
|
sCannotStartBrowser = 'Unable to start web browser. Make sure you have it properly set-up on your system.';
|
|
|
|
const
|
|
MaxBrowsers = 1;
|
|
|
|
type
|
|
ECannotStartBrowser = class(Exception);
|
|
|
|
type
|
|
TBrowserStartCmd = record
|
|
Command : string [64];
|
|
Parameters : string [255];
|
|
XTerm : Boolean; { Start browser in an XTerm }
|
|
end;
|
|
|
|
const
|
|
{ The list of browsers we can launch. }
|
|
|
|
BrowserList : array [1..MaxBrowsers] of TBrowserStartCmd =
|
|
((Command : 'netscape'; Parameters : '<site>'; Xterm : False));
|
|
|
|
|
|
procedure GetCurrentPath (PathList : TStringList);
|
|
var
|
|
WorkPath : PChar;
|
|
StartPos : PChar;
|
|
CurrentPath : PChar;
|
|
State : (Scanning, GotColon);
|
|
begin
|
|
WorkPath := getenv ('PATH');
|
|
|
|
PathList.Clear;
|
|
|
|
StartPos := WorkPath;
|
|
State := Scanning;
|
|
while (WorkPath^ <> #0) do begin
|
|
case State of
|
|
Scanning :
|
|
begin
|
|
if (WorkPath^ = ':') then begin
|
|
State := GotColon;
|
|
if (WorkPath <> StartPos) then begin
|
|
CurrentPath := StrAlloc(WorkPath - StartPos + 1);
|
|
StrLCopy(CurrentPath, StartPos, WorkPath-StartPos);
|
|
PathList.Add (CurrentPath);
|
|
StrDispose(CurrentPath);
|
|
end;
|
|
end;
|
|
end;
|
|
GotColon :
|
|
begin
|
|
if (WorkPath^ <> ':') then begin
|
|
StartPos := WorkPath;
|
|
State := Scanning;
|
|
end;
|
|
end;
|
|
end;{case}
|
|
inc(WorkPath);
|
|
end;
|
|
if (State = Scanning) and (WorkPath <> StartPos) then begin
|
|
CurrentPath := StrAlloc(WorkPath - StartPos + 1);
|
|
StrLCopy(CurrentPath, StartPos, WorkPath-StartPos);
|
|
PathList.Add (CurrentPath);
|
|
StrDispose(CurrentPath);
|
|
end;
|
|
end;
|
|
|
|
|
|
function IsBrowserPresent (PathList : TStringList;
|
|
Browser : string) : Boolean;
|
|
var
|
|
i : integer;
|
|
begin
|
|
Result := False;
|
|
for i := 0 to PathList.Count - 1 do begin
|
|
if FileExists (PathList[i] + '/' + Browser) then begin
|
|
Result := True;
|
|
exit;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure CallBrowser (Browser : string;
|
|
Parameters : string;
|
|
Website : string;
|
|
XTerm : Boolean);
|
|
begin
|
|
if Pos ('<site>', Parameters) > 0 then begin
|
|
Parameters := Copy (Parameters, 1, Pos ('<site>', Parameters) - 1) +
|
|
Website +
|
|
Copy (Parameters, Pos ('<site>', Parameters) + 6, 255);
|
|
end else
|
|
Parameters := Parameters + ' ' + Website;
|
|
if XTerm then begin
|
|
Parameters := '-e ' + Browser + ' ' + Parameters;
|
|
Browser := 'xterm';
|
|
end;
|
|
Libc.system (PChar (Browser + ' ' + Parameters + ' &'));
|
|
end;
|
|
|
|
procedure StartBrowser (Website : string);
|
|
|
|
var
|
|
PathList : TStringList;
|
|
i : integer;
|
|
|
|
begin
|
|
PathList := TStringList.Create;
|
|
try
|
|
GetCurrentPath (PathList);
|
|
for i := 1 to MaxBrowsers do begin
|
|
if IsBrowserPresent (PathList, BrowserList[i].Command) then begin
|
|
CallBrowser (BrowserList[i].Command, BrowserList[i].Parameters,
|
|
Website, BrowserList[i].XTerm);
|
|
exit;
|
|
end;
|
|
end;
|
|
raise ECannotStartBrowser.Create(sCannotStartBrowser);
|
|
finally
|
|
PathList.Free;
|
|
end;
|
|
end;
|
|
{$ENDIF}
|
|
|
|
|
|
procedure TAbAboutBox.FormCreate(Sender: TObject);
|
|
begin
|
|
Top := (Screen.Height - Height ) div 3;
|
|
Left := (Screen.Width - Width ) div 2;
|
|
lblVersion.Caption := Format(AbVersionFormatS, [AbVersionS] );
|
|
end;
|
|
|
|
function TAbVersionProperty.GetAttributes: TPropertyAttributes;
|
|
begin
|
|
Result := [paDialog, paReadOnly];
|
|
end;
|
|
|
|
procedure TAbVersionProperty.Edit;
|
|
begin
|
|
with TAbAboutBox.Create( Application ) do
|
|
try
|
|
ShowModal;
|
|
finally
|
|
Free;
|
|
end;
|
|
end;
|
|
|
|
procedure TAbAboutBox.btnOKClick(Sender: TObject);
|
|
begin
|
|
Close;
|
|
end;
|
|
|
|
procedure TAbAboutBox.WebLblClick(Sender: TObject);
|
|
begin
|
|
{$IFDEF MSWINDOWS }
|
|
if ShellExecute(0, 'open', 'http://www.sourceforge.net/projects/tpabbrevia', '', '',
|
|
SW_SHOWNORMAL) <= 32 then
|
|
ShowMessage('Unable to start web browser');
|
|
{$ENDIF MSWINDOWS }
|
|
{$IFDEF LINUX }
|
|
try
|
|
StartBrowser('http://www.sourceforge.net/projects/tpabbrevia');
|
|
except
|
|
on ECannotStartBrowser do
|
|
ShowMessage('Unable to start web browser');
|
|
end;
|
|
{$ENDIF LINUX }
|
|
WebLbl.Font.Color := clNavy;
|
|
end;
|
|
|
|
procedure TAbAboutBox.WebLblMouseMove(Sender: TObject; Shift: TShiftState;
|
|
X, Y: Integer);
|
|
begin
|
|
WebLbl.Font.Color := clRed;
|
|
end;
|
|
|
|
procedure TAbAboutBox.NewsLblClick(Sender: TObject);
|
|
begin
|
|
{$IFDEF MSWINDOWS }
|
|
if ShellExecute(0, 'open', 'http://www.sourceforge.net/forum/forum.php?forum_id=241865', '', '',
|
|
SW_SHOWNORMAL) <= 32 then
|
|
ShowMessage('Unable to start web browser');
|
|
{$ENDIF MSWINDOWS }
|
|
{$IFDEF LINUX }
|
|
try
|
|
StartBrowser('http://www.sourceforge.net/forum/forum.php?forum_id=241865');
|
|
except
|
|
on ECannotStartBrowser do
|
|
ShowMessage('Unable to start web browser');
|
|
end;
|
|
{$ENDIF LINUX }
|
|
NewsLbl.Font.Color := clNavy;
|
|
end;
|
|
|
|
procedure TAbAboutBox.NewsLblMouseMove(Sender: TObject; Shift: TShiftState;
|
|
X, Y: Integer);
|
|
begin
|
|
NewsLbl.Font.Color := clRed;
|
|
end;
|
|
|
|
procedure TAbAboutBox.Panel2MouseMove(Sender: TObject; Shift: TShiftState;
|
|
X, Y: Integer);
|
|
begin
|
|
NewsLbl.Font.Color := clNavy;
|
|
end;
|
|
|
|
procedure TAbAboutBox.FormMouseMove(Sender: TObject; Shift: TShiftState; X,
|
|
Y: Integer);
|
|
begin
|
|
WebLbl.Font.Color := clNavy;
|
|
NewsLbl.Font.Color := clNavy;
|
|
end;
|
|
|
|
end.
|
|
|