paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-08-29 11:30:28 +02:00
Code Issues Packages Projects Releases Wiki Activity

* Start of colored messages by Graeme Geldenhuys

Browse Source 
git-svn-id: trunk@8374 -
This commit is contained in:
marc 2005-12-26 17:58:04 +00:00
parent 7bc376c87b
commit b79a3c34cb
1 changed files with 40 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

40
ide/msgview.pp
View File

@ -94,6 +94,8 @@ type
procedure MessageViewClicked(Sender: TObject); procedure MessageViewClicked(Sender: TObject);
procedure MessagesViewKeyDown(Sender: TObject; var Key: word; procedure MessagesViewKeyDown(Sender: TObject; var Key: word;
Shift: TShiftState); Shift: TShiftState);
procedure MessageViewDrawItem(Control: TWinControl; Index: Integer;
ARect: TRect; State: TOwnerDrawState);
procedure SaveAllToFileMenuItemClick(Sender: TObject); procedure SaveAllToFileMenuItemClick(Sender: TObject);
private private
FItems: TList; // list of TMessageLine FItems: TList; // list of TMessageLine
@ -159,6 +161,10 @@ procedure RegisterStandardMessagesViewMenuItems;
implementation implementation
uses
Graphics, // used for TColor
LCLType; // used for TOwnerDrawState
const const
SeparatorLine = '---------------------------------------------'; SeparatorLine = '---------------------------------------------';
@ -191,6 +197,8 @@ begin
FLastSelectedIndex := -1; FLastSelectedIndex := -1;
Caption := lisMenuViewMessages; Caption := lisMenuViewMessages;
MessageView.Style := lbOwnerDrawFixed;
MessageView.OnDrawItem := @MessageViewDrawItem;
// assign the root TMenuItem to the registered menu root. // assign the root TMenuItem to the registered menu root.
// This will automatically create all registered items // This will automatically create all registered items
@ -480,6 +488,38 @@ begin
ExecuteIDEShortCut(Self, Key, Shift); ExecuteIDEShortCut(Self, Key, Shift);
end; end;
//------------------------------------------------------------------------------
procedure TMessagesView.MessageViewDrawItem(Control: TWinControl;
Index: Integer; ARect: TRect; State: TOwnerDrawState);
var
TheText: string;
cl: TColor;
const
cHint = 'Hint: User defined:';
cNote = 'Note: User defined:';
clMsgHint = clBlue;
clMsgNote = clGreen;
cLeftSpacer = 3;
begin
MessageView.Canvas.FillRect(ARect);
TheText := MessageView.Items[Index];
cl := MessageView.Canvas.Font.Color; // save original color
{ Only use custom colors if not selected, otherwise it is difficult to read }
if not (odSelected in State)
then begin
if Pos(cNote, TheText) > 0
then MessageView.Canvas.Font.Color := clMsgNote
else if Pos(cHint, TheText) > 0
then MessageView.Canvas.Font.Color := clMsgHint
end;
MessageView.Canvas.TextOut(ARect.Left + cLeftSpacer, ARect.Top + 1, TheText);
MessageView.Canvas.Font.Color := cl; // restore original color
end;
//------------------------------------------------------------------------------
procedure TMessagesView.SaveAllToFileMenuItemClick(Sender: TObject); procedure TMessagesView.SaveAllToFileMenuItemClick(Sender: TObject);
var var
SaveDialog: TSaveDialog; SaveDialog: TSaveDialog;