paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-09-06 16:41:28 +02:00
Code Issues Packages Projects Releases Wiki Activity

IDE: started msg overview

Browse Source 
git-svn-id: trunk@45163 -
This commit is contained in:
mattias 2014-05-25 00:53:48 +00:00
parent 3d95b919cf
commit f85322d7c5
1 changed files with 126 additions and 18 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

144
ide/etmessageframe.pas
View File

@ -105,10 +105,16 @@ type
const
MCDefaultBackground = clWindow;
MCDefaultHeaderBackgroundRunning = TColor($F0F080);
MCDefaultHeaderBackgroundSuccess = TColor($A0F0A0);
MCDefaultHeaderBackgroundFailed = TColor($A0A0F0);
MCDefaultAutoHeaderBackground = TColor($FFC0A0);
MCDefaultHeaderBackgroundRunning = TColor($F0F080); // light aqua
MCDefaultHeaderBackgroundSuccess = TColor($A0F0A0); // light green
MCDefaultHeaderBackgroundFailed = TColor($A0A0F0); // light red
MCDefaultAutoHeaderBackground = TColor($FFC0A0); // light blue
MCODefaultWidth = 4;
MCODefaultBackgroundColor = TColor($C0C0C0);
MCODefaultBorderColor = TColor($404040);
MCODefaultVisibleColor = TColor($909090);
MCODefaultHeaderColor = TColor($FF0000);
MCODefaultErrorColor = TColor($0000FF);
type
TMessagesCtrl = class;
@ -182,6 +188,41 @@ type
property Color: TColor read FColor write SetColor default clDefault;
end;
type
{ TMsgCtrlOverview }
TMsgCtrlOverview = class(TPersistent)
private
FBackgroundColor: TColor;
FBorderColor: TColor;
FControl: TMessagesCtrl;
FErrorColor: TColor;
FHeaderColor: TColor;
//FPaintedActiveStart: integer;
//FPaintedActiveEnd: integer;
FVisibleColor: TColor;
FWidth: integer;
procedure SetBackgroundColor(AValue: TColor);
procedure SetBorderColor(AValue: TColor);
procedure SetErrorColor(AValue: TColor);
procedure SetHeaderColor(AValue: TColor);
procedure SetVisibleColor(AValue: TColor);
procedure SetWidth(AValue: integer);
public
constructor Create(aMsgControl: TMessagesCtrl);
destructor Destroy; override;
property Control: TMessagesCtrl read FControl;
published
property Width: integer read FWidth write SetWidth;
property BackgroundColor: TColor read FBackgroundColor write SetBackgroundColor; // default background
property BorderColor: TColor read FBorderColor write SetBorderColor; // vertical line separating messages and overview
property VisibleColor: TColor read FVisibleColor write SetVisibleColor; // background for visible messages
property HeaderColor: TColor read FHeaderColor write SetHeaderColor; // view headers
property ErrorColor: TColor read FErrorColor write SetErrorColor; // errors, fatals, panic
end;
TOnOpenMessageLine = function(Sender: TObject; Msg: TMessageLine): boolean of object;
TMsgCtrlState = (
@ -228,6 +269,7 @@ type
FOnAllViewsStopped: TNotifyEvent;
FOnOpenMessage: TOnOpenMessageLine;
FOptions: TMsgCtrlOptions;
FOverview: TMsgCtrlOverview;
FScrollLeft: integer;
FScrollTop: integer;
fScrollTopMax: integer;
@ -356,7 +398,8 @@ type
function ScrollLeftMax: integer;
function ScrollTopMax: integer;
procedure StoreSelectedAsSearchStart;
property AutoScrollToNewMessage: boolean read FAutoScrollToNewMessage write FAutoScrollToNewMessage;
property AutoScrollToNewMessage: boolean read FAutoScrollToNewMessage
write FAutoScrollToNewMessage; // activated when user scrolled to bottom, not an option
// file
function OpenSelection: boolean;
@ -364,23 +407,24 @@ type
function ApplySrcChanges(Changes: TETSrcChanges): boolean; // true if something changed
public
// properties
property ItemHeight: integer read FItemHeight write SetItemHeight;
property Color default clWindow;
property SelectedView: TLMsgWndView read FSelectedView write SetSelectedView;
property SelectedLine: integer read GetSelectedLine write SetSelectedLine; // -1=header line
property BackgroundColor: TColor read FBackgroundColor write SetBackgroundColor default MCDefaultBackground;
property HeaderBackground[aToolState: TLMVToolState]: TColor read GetHeaderBackground write SetHeaderBackground;
property AutoHeaderBackground: TColor read FAutoHeaderBackground write SetAutoHeaderBackground default MCDefaultAutoHeaderBackground;
property Images: TCustomImageList read FImages write SetImages;
property UrgencyStyles[Urgency: TMessageLineUrgency]: TMsgCtrlUrgencyStyle read GetUrgencyStyles write SetUrgencyStyles;
property SearchText: string read FSearchText write SetSearchText;
property IdleConnected: boolean read FIdleConnected write SetIdleConnected;
property Options: TMsgCtrlOptions read FOptions write SetOptions default MCDefaultOptions;
property BackgroundColor: TColor read FBackgroundColor write SetBackgroundColor default MCDefaultBackground;
property Color default clWindow;
property FilenameStyle: TMsgCtrlFileNameStyle read FFilenameStyle write SetFilenameStyle;
property SourceMarks: TETMarks read FSourceMarks write SetSourceMarks;
property ShowHint default true;
property HeaderBackground[aToolState: TLMVToolState]: TColor read GetHeaderBackground write SetHeaderBackground;
property IdleConnected: boolean read FIdleConnected write SetIdleConnected;
property Images: TCustomImageList read FImages write SetImages;
property ItemHeight: integer read FItemHeight write SetItemHeight;
property OnAllViewsStopped: TNotifyEvent read FOnAllViewsStopped write FOnAllViewsStopped;
property OnOpenMessage: TOnOpenMessageLine read FOnOpenMessage write FOnOpenMessage;
property Options: TMsgCtrlOptions read FOptions write SetOptions default MCDefaultOptions;
property Overview: TMsgCtrlOverview read FOverview;
property SearchText: string read FSearchText write SetSearchText;
property SelectedLine: integer read GetSelectedLine write SetSelectedLine; // -1=header line
property SelectedView: TLMsgWndView read FSelectedView write SetSelectedView;
property ShowHint default true;
property SourceMarks: TETMarks read FSourceMarks write SetSourceMarks;
property UrgencyStyles[Urgency: TMessageLineUrgency]: TMsgCtrlUrgencyStyle read GetUrgencyStyles write SetUrgencyStyles;
end;
{ TMessagesFrame }
@ -608,6 +652,67 @@ end;
{$R *.lfm}
{ TMsgCtrlOverview }
procedure TMsgCtrlOverview.SetBackgroundColor(AValue: TColor);
begin
if FBackgroundColor=AValue then Exit;
FBackgroundColor:=AValue;
Control.Invalidate;
end;
procedure TMsgCtrlOverview.SetBorderColor(AValue: TColor);
begin
if FBorderColor=AValue then Exit;
FBorderColor:=AValue;
Control.Invalidate;
end;
procedure TMsgCtrlOverview.SetErrorColor(AValue: TColor);
begin
if FErrorColor=AValue then Exit;
FErrorColor:=AValue;
Control.Invalidate;
end;
procedure TMsgCtrlOverview.SetHeaderColor(AValue: TColor);
begin
if FHeaderColor=AValue then Exit;
FHeaderColor:=AValue;
Control.Invalidate;
end;
procedure TMsgCtrlOverview.SetVisibleColor(AValue: TColor);
begin
if FVisibleColor=AValue then Exit;
FVisibleColor:=AValue;
Control.Invalidate;
end;
procedure TMsgCtrlOverview.SetWidth(AValue: integer);
begin
if FWidth=AValue then Exit;
FWidth:=AValue;
Control.Invalidate;
end;
constructor TMsgCtrlOverview.Create(aMsgControl: TMessagesCtrl);
begin
FControl:=aMsgControl;
FWidth:=MCODefaultWidth;
FBackgroundColor:=MCODefaultBackgroundColor;
FBorderColor:=MCODefaultBorderColor;
FVisibleColor:=MCODefaultVisibleColor;
FHeaderColor:=MCODefaultHeaderColor;
FErrorColor:=MCODefaultErrorColor;
end;
destructor TMsgCtrlOverview.Destroy;
begin
Control.fOverview:=nil;
inherited Destroy;
end;
{ TLMVFilterHideMsgType }
procedure TLMVFilterHideMsgType.SetMsgID(AValue: integer);
@ -2759,6 +2864,7 @@ begin
FImageChangeLink.OnChange := @ImageListChange;
for u:=Low(TMessageLineUrgency) to high(TMessageLineUrgency) do
fUrgencyStyles[u]:=TMsgCtrlUrgencyStyle.Create(Self,u);
FOverview:=TMsgCtrlOverview.Create(Self);
ShowHint:=true;
end;
@ -2771,6 +2877,8 @@ begin
Images:=nil;
ClearViews;
FreeAndNil(FOverview);
FActiveFilter:=nil;
for i:=0 to FFilters.Count-1 do
TObject(FFilters[i]).Free;