425 lines
12 KiB
ObjectPascal
425 lines
12 KiB
ObjectPascal
{-----------------------------------------------------------------------------
|
|
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/MPL-1.1.html
|
|
|
|
Software distributed under the License is distributed on an "AS IS" basis,
|
|
WITHOUT WARRANTY OF ANY KIND, either expressed or implied. See the License for
|
|
the specific language governing rights and limitations under the License.
|
|
|
|
The Original Code is: FrmInstall.pas, released on 2004-04-06.
|
|
|
|
The Initial Developer of the Original Code is Andreas Hausladen
|
|
(Andreas dott Hausladen att gmx dott de)
|
|
Portions created by Andreas Hausladen are Copyright (C) 2004 Andreas Hausladen.
|
|
All Rights Reserved.
|
|
|
|
Contributor(s): -
|
|
|
|
You may retrieve the latest version of this file at the Project JEDI's JVCL
|
|
home page, located at http://jvcl.sourceforge.net
|
|
|
|
Known Issues:
|
|
-----------------------------------------------------------------------------}
|
|
// $Id: FrmInstall.pas 11265 2007-04-16 17:24:34Z ahuser $
|
|
|
|
unit FrmInstall;
|
|
|
|
{$I jvcl.inc}
|
|
{$I windowsonly.inc}
|
|
|
|
interface
|
|
|
|
uses
|
|
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
|
|
Dialogs, ComCtrls, StdCtrls,
|
|
ShellAPI,
|
|
{$IFDEF USE_DXGETTEXT}
|
|
JvGnugettext,
|
|
{$ENDIF USE_DXGETTEXT}
|
|
JVCL3Install, JVCLData, PackageUtils, Compile, Utils;
|
|
|
|
type
|
|
TFrameInstall = class(TFrame)
|
|
LblTarget: TLabel;
|
|
ProgressBarTarget: TProgressBar;
|
|
ProgressBarCompile: TProgressBar;
|
|
LblInfo: TLabel;
|
|
RichEditLog: TRichEdit;
|
|
LblOpenFile: TLabel;
|
|
BtnDetails: TButton;
|
|
procedure RichEditLogSelectionChange(Sender: TObject);
|
|
procedure BtnDetailsClick(Sender: TObject);
|
|
procedure LblOpenFileClick(Sender: TObject);
|
|
private
|
|
FInitializing: Boolean;
|
|
FInstaller: TInstaller;
|
|
FPositionTarget: Integer;
|
|
FPositionProject: Integer;
|
|
FFinished: Boolean;
|
|
FAborted: Boolean;
|
|
FLastCapLine: string;
|
|
procedure EvProgress(Sender: TObject; const Text: string;
|
|
Position, Max: Integer; Kind: TProgressKind);
|
|
procedure EvCaptureLine(const Text: string; var AAborted: Boolean);
|
|
procedure EvIdle(Sender: TObject);
|
|
procedure Init;
|
|
protected
|
|
property Installer: TInstaller read FInstaller;
|
|
public
|
|
class function Build(Installer: TInstaller; Client: TWinControl): TFrameInstall;
|
|
procedure Execute;
|
|
|
|
property Aborted: Boolean read FAborted write FAborted;
|
|
end;
|
|
|
|
implementation
|
|
|
|
uses
|
|
InstallerConsts, FileCtrl, FrmCompile, FrmCompileMessages, ComStrs;
|
|
|
|
{$R *.dfm}
|
|
|
|
{ TFrameInstall }
|
|
|
|
class function TFrameInstall.Build(Installer: TInstaller;
|
|
Client: TWinControl): TFrameInstall;
|
|
begin
|
|
Result := TFrameInstall.Create(Client);
|
|
Installer.PackageInstaller.Translate(Result);
|
|
Result.FInstaller := Installer;
|
|
Result.Parent := Client;
|
|
Result.Align := alClient;
|
|
Result.Init;
|
|
end;
|
|
|
|
procedure TFrameInstall.EvProgress(Sender: TObject; const Text: string;
|
|
Position, Max: Integer; Kind: TProgressKind);
|
|
var
|
|
ps: Integer;
|
|
begin
|
|
case Kind of
|
|
pkTarget:
|
|
begin
|
|
FPositionTarget := Position;
|
|
|
|
LblTarget.Caption := Text;
|
|
LblTarget.Hint := Text;
|
|
ProgressBarTarget.Max := Max * ProjectMaxProgress;
|
|
ProgressBarTarget.Position := (FPositionTarget * ProjectMaxProgress);
|
|
if Assigned(Compiler) then
|
|
FormCompile.Init('JVCL - ' + Text, not FInstaller.Data.IgnoreMakeErrors, Compiler.IsDcc32BugDangerous);
|
|
end;
|
|
|
|
pkProject:
|
|
begin
|
|
FPositionProject := Position;
|
|
ProgressBarTarget.Position := FPositionProject + (FPositionTarget * ProjectMaxProgress);
|
|
LblTarget.Caption := LblTarget.Hint + ' - ' + Text;
|
|
ProgressBarCompile.Position := 0;
|
|
end;
|
|
|
|
pkResource,
|
|
pkPackage:
|
|
begin
|
|
if Text <> '' then
|
|
begin
|
|
LblInfo.Caption := Format(RsCompiling, [Text]);
|
|
ps := Pos('(', Text);
|
|
if ps = 0 then
|
|
ps := Length(Text) + 1;
|
|
if Assigned(Compiler) then
|
|
FormCompile.Init(Trim(Copy(Text, 1, ps - 1)), False, Compiler.IsDcc32BugDangerous);
|
|
end
|
|
else
|
|
LblInfo.Caption := '';
|
|
ProgressBarCompile.Max := Max;
|
|
ProgressBarCompile.Position := Position;
|
|
end;
|
|
|
|
pkOther:
|
|
begin
|
|
LblInfo.Caption := Text;
|
|
ProgressBarCompile.Max := Max;
|
|
ProgressBarCompile.Position := Position;
|
|
end;
|
|
end;
|
|
|
|
Application.ProcessMessages;
|
|
end;
|
|
|
|
procedure TFrameInstall.EvCaptureLine(const Text: string;
|
|
var AAborted: Boolean);
|
|
var
|
|
Line: string;
|
|
|
|
procedure SetFont(Styles: TFontStyles; Color: TColor = clNone);
|
|
begin
|
|
RichEditLog.SelStart := RichEditLog.SelStart - Length(Line) - 2;
|
|
RichEditLog.SelLength := Length(Line);
|
|
if Color <> clNone then
|
|
RichEditLog.SelAttributes.Color := Color;
|
|
RichEditLog.SelAttributes.Style := Styles;
|
|
RichEditLog.SelLength := 0;
|
|
end;
|
|
|
|
var
|
|
LText: string;
|
|
CompileLine: TCompileLineType;
|
|
ps: Integer;
|
|
begin
|
|
AAborted := FAborted or FormCompile.Aborted;
|
|
Line := Text;
|
|
if (Text <> '') and (Text[1] = #1) then
|
|
Delete(Line, 1, 1);
|
|
|
|
CompileLine := FormCompile.HandleLine(Line);
|
|
if CompileLine <> clFileProgress then
|
|
begin
|
|
if (Line = '') and (FLastCapLine = '') then // reduce empty lines
|
|
Exit;
|
|
FLastCapLine := Line;
|
|
|
|
try
|
|
RichEditLog.Lines.Add(Line);
|
|
except
|
|
on E: EOutOfResources do
|
|
if E.Message <> sRichEditInsertError then // ignore this special EOutOfResources exception
|
|
raise;
|
|
end;
|
|
if Text <> '' then
|
|
begin
|
|
if Text[1] = #1 then
|
|
SetFont([fsBold], clGray)
|
|
else
|
|
if (Text[1] = #9) and not StartsWith(Text, #9'Loaded ') then // do not localize
|
|
SetFont([], clGray)
|
|
else if Text[1] = '[' then
|
|
SetFont([fsBold])
|
|
else if Text = RsPackagesAreUpToDate then
|
|
SetFont([], clTeal)
|
|
else
|
|
begin
|
|
case CompileLine of
|
|
clHint:
|
|
SetFont([], clGreen);
|
|
clWarning:
|
|
SetFont([], clMaroon);
|
|
clError:
|
|
SetFont([], clRed);
|
|
clFatal:
|
|
SetFont([fsBold], clRed);
|
|
else
|
|
LText := TrimLeft(Text);
|
|
if StartsWith(LText, 'MAKE version', True) or // do not localize
|
|
StartsWith(LText, 'Borland ', True) or // do not localize
|
|
StartsWith(LText, 'CodeGear ', True) or // do not localize
|
|
StartsWith(LText, 'Copyright ', True) or // do not localize
|
|
StartsWith(LText, 'Turbo Incremental Link', True) then // do not localize
|
|
begin
|
|
SetFont([fsItalic], clGray);
|
|
end
|
|
end;
|
|
|
|
if Pos('Turbo Incremental Link', Line) <> 0 then // do not localize
|
|
begin
|
|
ps := Pos(':', LblInfo.Caption);
|
|
if ps > 0 then
|
|
LText := Copy(LblInfo.Caption, ps + 1, MaxInt)
|
|
else
|
|
LText := LblInfo.Caption;
|
|
ps := Pos('(', LText);
|
|
if ps = 0 then
|
|
ps := Length(LText) + 1;
|
|
FormCompile.Linking(Trim(Copy(LText, 1, ps - 1)));
|
|
end;
|
|
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure TFrameInstall.EvIdle(Sender: TObject);
|
|
begin
|
|
Application.ProcessMessages;
|
|
end;
|
|
|
|
procedure TFrameInstall.RichEditLogSelectionChange(Sender: TObject);
|
|
var
|
|
S: string;
|
|
ps: Integer;
|
|
i: Integer;
|
|
ShowDirLbl: Boolean;
|
|
begin
|
|
if not FFinished then
|
|
Exit;
|
|
if (RichEditLog.CaretPos.Y > 0) and (RichEditLog.CaretPos.Y < RichEditLog.Lines.Count) then
|
|
begin
|
|
S := RichEditLog.Lines[RichEditLog.CaretPos.Y];
|
|
|
|
// find the directory
|
|
if StartsWith(S, Installer.JVCLDir + '\') then
|
|
ShowDirLbl := True
|
|
else
|
|
begin
|
|
ShowDirLbl := False;
|
|
for i := 0 to Installer.Data.Targets.Count - 1 do
|
|
if StartsWith(S, Installer.Data.TargetConfig[i].JCLDir + '\') then
|
|
begin
|
|
ShowDirLbl := True;
|
|
Break;
|
|
end;
|
|
end;
|
|
|
|
if ShowDirLbl then
|
|
begin
|
|
ps := Pos('(', S);
|
|
if ps > 0 then
|
|
begin
|
|
Delete(S, ps, MaxInt);
|
|
if FileExists(S) then
|
|
begin
|
|
LblOpenFile.Hint := S;
|
|
LblOpenFile.Caption := MinimizeName(LblOpenFile.Hint, LblOpenFile.Canvas, LblOpenFile.Width);
|
|
LblOpenFile.Visible := True;
|
|
end
|
|
else
|
|
LblOpenFile.Visible := False;
|
|
end;
|
|
end
|
|
else
|
|
LblOpenFile.Visible := False;
|
|
end;
|
|
end;
|
|
|
|
procedure TFrameInstall.Init;
|
|
begin
|
|
FInitializing := True;
|
|
try
|
|
RichEditLog.Visible := False;
|
|
LblOpenFile.Visible := False;
|
|
BtnDetails.Visible := True;
|
|
|
|
LblTarget.Caption := '';
|
|
LblTarget.Hint := '';
|
|
ProgressBarTarget.Max := 100;
|
|
ProgressBarTarget.Position := 0;
|
|
|
|
LblInfo.Caption := '';
|
|
ProgressBarCompile.Max := 100;
|
|
ProgressBarCompile.Position := 0;
|
|
finally
|
|
FInitializing := False;
|
|
end;
|
|
end;
|
|
|
|
procedure TFrameInstall.Execute;
|
|
var
|
|
Success: Boolean;
|
|
i: Integer;
|
|
AbortReason: string;
|
|
Pt: TPoint;
|
|
ParentForm: TWinControl;
|
|
begin
|
|
Aborted := False;
|
|
|
|
Installer.Data.SaveTargetConfigs;
|
|
FPositionTarget := 0;
|
|
FPositionProject := 0;
|
|
|
|
FFinished := False;
|
|
|
|
FormCompile := TFormCompile.Create(Self);
|
|
try
|
|
FormCompile.Position := poDesigned;
|
|
Pt := RichEditLog.ClientToScreen(Point((RichEditLog.Width - BtnDetails.Width) div 2, 0));
|
|
FormCompile.Top := Pt.Y;
|
|
FormCompile.Left := Pt.X - FormCompile.Width div 2;
|
|
|
|
FormCompileMessages.Clear;
|
|
ParentForm := Parent;
|
|
while (ParentForm <> nil) and not (ParentForm is TForm) do
|
|
ParentForm := ParentForm.Parent;
|
|
FormCompileMessages.Top := ParentForm.BoundsRect.Bottom;
|
|
FormCompileMessages.Left := ParentForm.Left + (ParentForm.Width - FormCompileMessages.Width) div 2;
|
|
|
|
FormCompile.CompileMessages := FormCompileMessages;
|
|
|
|
{$IFDEF USE_DXGETTEXT}
|
|
TranslateComponent(FormCompile, 'JVCLInstall');
|
|
TranslateComponent(FormCompileMessages, 'JVCLInstall');
|
|
{$ENDIF USE_DXGETTEXT}
|
|
|
|
Compiler := TCompiler.Create(Installer.Data);
|
|
try
|
|
Compiler.OnProgress := EvProgress;
|
|
Compiler.OnCaptureLine := EvCaptureLine;
|
|
Compiler.OnIdle := EvIdle;
|
|
Success := Compiler.Compile;
|
|
AbortReason := Compiler.AbortReason;
|
|
finally
|
|
Compiler.Free;
|
|
end;
|
|
SetWindowLong(FormCompile.Handle, GWL_HWNDPARENT, 0);
|
|
|
|
if Success and Installer.Data.IgnoreMakeErrors then
|
|
Success := FormCompileMessages.Count = 0;
|
|
|
|
if not Success then
|
|
begin
|
|
LblTarget.Caption := Format(RsError, [LblTarget.Hint]);
|
|
BtnDetails.Visible := False;
|
|
RichEditLog.Visible := True;
|
|
if FormCompileMessages.Count > 0 then
|
|
FormCompileMessages.Show;
|
|
FormCompile.Done(AbortReason);
|
|
end
|
|
else
|
|
begin
|
|
FormCompile.Done;
|
|
//FormCompileMessages.Clear;
|
|
Application.ProcessMessages;
|
|
LblTarget.Caption := RsComplete;
|
|
if FormCompileMessages.Count > 0 then
|
|
FormCompileMessages.Show;
|
|
end;
|
|
finally
|
|
FormCompile.Free;
|
|
end;
|
|
|
|
if Success then
|
|
begin
|
|
// register packages into IDE
|
|
with Installer do
|
|
for i := 0 to SelTargetCount - 1 do
|
|
if SelTargets[i].InstallJVCL and (not SelTargets[i].CompileOnly) then
|
|
begin
|
|
if SelTargets[i].CleanPalettes then
|
|
SelTargets[i].CleanJVCLPalette(False);
|
|
Success := SelTargets[i].RegisterToIDE;
|
|
if not Success then
|
|
Break;
|
|
end;
|
|
end;
|
|
|
|
FFinished := True;
|
|
if Success then
|
|
Installer.PackageInstaller.ForcedFinish; // this is the last page so we want the installer to show the finished state
|
|
end;
|
|
|
|
procedure TFrameInstall.BtnDetailsClick(Sender: TObject);
|
|
begin
|
|
BtnDetails.Visible := False;
|
|
RichEditLog.Visible := True;
|
|
RichEditLog.SetFocus;
|
|
end;
|
|
|
|
procedure TFrameInstall.LblOpenFileClick(Sender: TObject);
|
|
begin
|
|
if ShellExecute(Handle, 'open', PChar(LblOpenFile.Hint), nil, nil, SW_SHOW) < 32 then // do not localize
|
|
MessageDlg(RsErrorOpeningFile, mtError, [mbOk], 0);
|
|
end;
|
|
|
|
end.
|