frminstall.pas

East make Tray Icon in delphi

{-----------------------------------------------------------------------------
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,v 1.20 2004/12/31 13:45:44 ahuser Exp $

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;
    procedure Init;
  protected
    property Installer: TInstaller read FInstaller;
  private
    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 Aborted: Boolean);
    procedure EvIdle(Sender: TObject);
  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;

{$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 * ProjectMax;
        ProgressBarTarget.Position := (FPositionTarget * ProjectMax);
        FormCompile.Init('JVCL - ' + Text, not FInstaller.Data.IgnoreMakeErrors);
      end;

    pkProject:
      begin
        FPositionProject := Position;
        ProgressBarTarget.Position := FPositionProject + (FPositionTarget * ProjectMax);
        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;
          FormCompile.Init(Trim(Copy(Text, 1, ps - 1)), False);
        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 Aborted: 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
  Aborted := FAborted;
  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;

    RichEditLog.Lines.Add(Line);
    if Text <> '' then
    begin
      if Text[1] = #1 then
        SetFont([fsBold], clGray)
      else
      if (Text[1] = #9) and not StartsWith(Text, #9'Loaded ') then
        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, 'Copyright ', True) then // do not localize
          begin
            SetFont([fsItalic], clGray);
          end
        end;

        if Pos('Turbo Incremental Link', Line) <> 0 then
        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
    SetWindowLong(FormCompile.Handle, GWL_HWNDPARENT, Integer(Handle));
    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 := TJVCLCompiler.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.