{ *************************************************************************** * * * This source is free software; you can redistribute it and/or modify * * it under the terms of the GNU General Public License as published by * * the Free Software Foundation; either version 2 of the License, or * * (at your option) any later version. * * * * This code is distributed in the hope that it will be useful, but * * WITHOUT ANY WARRANTY; without even the implied warranty of * * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU * * General Public License for more details. * * * * A copy of the GNU General Public License is available on the World * * Wide Web at . You can also * * obtain it by writing to the Free Software Foundation, * * Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. * * * *************************************************************************** Dialog box used during compile or build $Author$ Guadagnini David $Date$ Feb-28-2008 $Revision$ 2.1 } unit InfoBuild; {$mode objfpc}{$H+} interface uses Classes, SysUtils, LResources, Forms, Controls, Graphics, Dialogs, Buttons, LCLProc, ExtCtrls, StdCtrls, ExtDlgs, LazIDEIntf, LazarusIDEStrConsts; type { TFInfoCompile } TFInfoCompile = class ( TForm ) BClose : TBitBtn; LInfoError : TLabel; LInfoNote : TLabel; LInfoHint : TLabel; LInfoWarning : TLabel; LInfoLines : TLabel; LNError : TLabel; LNNote : TLabel; LNLines : TLabel; LNHint : TLabel; LNWarning : TLabel; Panel2 : TPanel; Panel4 : TPanel; PCurrentStatus : TLabel; Panel1 : TPanel; PInfo : TPanel; procedure BCloseClick ( Sender : TObject ) ; procedure FormCreate ( Sender : TObject ) ; private NHints : Integer; NWarnings : Integer; NErrors : Integer; NNotes : Integer; NLines : Integer; ToAbort : Boolean; public Procedure SetProjectName(Const Sname : String); Procedure SetStatus(Const SStatus : String); Procedure SetCanClose; Procedure MakeBold; end; var FInfoCompile : TFInfoCompile; ShowCompileDialog: Boolean = false; Procedure CreateInfoBuilder(Owner: TComponent); Procedure DestroyInfoBuilder; Procedure PutInfoBuilderStatus(Const Info : String); Procedure PutInfoBuilderProject(Const Info : String); Procedure AbleInfoBuilderExit; Procedure PutExitInfoBuilder(Const Info : String); implementation { TFInfoCompile } procedure TFInfoCompile.BCloseClick ( Sender : TObject ) ; begin If ToAbort then begin LazarusIDE.AbortBuild; SetStatus('Aborted...!'); MakeBold; SetCanClose; end else Close; end; procedure TFInfoCompile.FormCreate ( Sender : TObject ) ; begin NHints := 0; NWarnings := 0; NErrors := 0; NNotes := 0; NLines := 0; LInfoLines.Caption := lisInfoBuildLines; LInfoError.Caption := lisInfoBuildErrors; LInfoHint.Caption := lisInfoBuildHint; LInfoWarning.Caption := lisInfoBuildWarning; LInfoNote.Caption := lisInfoBuildNote; BClose.Kind := bkNoToAll; BClose.Caption := lisInfoBuildMakeAbort; Caption := lisInfoBuildCaption; ToAbort := True; SetProjectName(''); SetStatus(''); end; Procedure TFInfoCompile.SetProjectName(Const Sname : String); begin PInfo.Caption := lisInfoBuildBuild + ' '+Sname; end; Procedure TFInfoCompile.SetStatus(Const SStatus : String); Var S : String; Ok : Boolean; NL : Integer; begin S := LowerCase(SStatus); if (pos('warning(s)', s) > 0) or (pos('hint(s)', s) > 0) or (pos('note(s)', s) > 0) then exit; Ok := True; if (Pos('hint:', s) > 0) then begin Inc(NHints); LNHint.Caption := IntToStr(NHints); Ok := False; end; If Pos('warning:', s) > 0 then begin Inc(NWarnings); LNWarning.Caption := IntToStr(NWarnings); Ok := False; end; If (Pos('fatal:', s) > 0) Or (Pos('error:', s) > 0) then begin Inc(NErrors); LNError.Caption := IntToStr(NErrors); Ok := False; end; If (Pos('note:', s) > 0) then begin Inc(NNotes); LNNote.Caption := IntToStr(NNotes); Ok := False; end; If (Pos('lines compiled', s) > 0) then begin s := copy(s, 1, pos('lines compiled', s)-1); while copy(s, 1, 1) = ' ' do delete(s, 1, 1); while copy(s, length(s), 1) = ' ' do delete(s, length(s), 1); try NL := strtoint(s) except NL := 0; end; NLines := NLines + NL; LNLines.Caption := IntToStr(NLines); Ok := false; end; If Ok then PCurrentStatus.Caption := SStatus; end; Procedure TFInfoCompile.SetCanClose; begin ToAbort := False; BClose.Kind := bkOk; BClose.Caption := lisMenuClose; end; Procedure TFInfoCompile.MakeBold; begin PCurrentStatus.Font.Style:= PCurrentStatus.Font.Style + [fsBold]; end; Procedure PutInfoBuilderStatus(Const Info : String); begin if Assigned(FInfoCompile) then FInfoCompile.SetStatus(Info); end; Procedure DestroyInfoBuilder; begin if Assigned(FInfoCompile) then begin FInfoCompile.Free; FinfoCompile := Nil; end; end; Procedure CreateInfoBuilder(Owner: TComponent); begin //DebugLn(['CreateInfoBuilder ',ShowCompileDialog]); DestroyInfoBuilder; if ShowCompileDialog then begin FInfoCompile := TFInfoCompile.Create(Owner); FInfoCompile.Show; end; end; Procedure PutInfoBuilderProject(Const Info : String); begin if Assigned(FInfoCompile) then FInfoCompile.SetProjectName(Info); end; Procedure AbleInfoBuilderExit; begin if Assigned(FInfoCompile) then FInfoCompile.SetCanClose; end; Procedure PutExitInfoBuilder(Const Info : String); begin PutInfoBuilderStatus(Info); if Assigned(FInfoCompile) then FInfoCompile.MakeBold; AbleInfoBuilderExit; end; initialization {$I infobuild.lrs} end.