messages, added option fastDisplay

- when true do not refresh the list for each item
- faster when a lot of messages have to be output
This commit is contained in:
Basile Burg 2015-06-03 15:01:58 +02:00
parent a1672f7187
commit 280ddd6c98
1 changed files with 26 additions and 5 deletions

View File

@ -23,12 +23,14 @@ type
TCEMessagesOptions = class(TWritableLfmTextComponent) TCEMessagesOptions = class(TWritableLfmTextComponent)
private private
fFastDisplay: boolean;
fMaxCount: Integer; fMaxCount: Integer;
fAutoSelect: boolean; fAutoSelect: boolean;
fSingleClick: boolean; fSingleClick: boolean;
fFont: TFont; fFont: TFont;
procedure setFont(aValue: TFont); procedure setFont(aValue: TFont);
published published
property fastDisplay: boolean read fFastDisplay write fFastDisplay;
property maxMessageCount: integer read fMaxCount write fMaxCount; property maxMessageCount: integer read fMaxCount write fMaxCount;
property autoSelect: boolean read fAutoSelect write fAutoSelect; property autoSelect: boolean read fAutoSelect write fAutoSelect;
property singleMessageClick: boolean read fSingleClick write fSingleClick; property singleMessageClick: boolean read fSingleClick write fSingleClick;
@ -73,6 +75,7 @@ type
fCtxt: TCEAppMessageCtxt; fCtxt: TCEAppMessageCtxt;
fAutoSelect: boolean; fAutoSelect: boolean;
fSingleClick: boolean; fSingleClick: boolean;
fastDisplay: boolean;
fOptions: TCEMessagesOptions; fOptions: TCEMessagesOptions;
fOptionsBackup: TCEMessagesOptions; fOptionsBackup: TCEMessagesOptions;
fBtns: array[TCEAppMessageCtxt] of TToolButton; fBtns: array[TCEAppMessageCtxt] of TToolButton;
@ -114,6 +117,7 @@ type
procedure clearbyContext(aCtxt: TCEAppMessageCtxt); procedure clearbyContext(aCtxt: TCEAppMessageCtxt);
procedure clearbyData(aData: Pointer); procedure clearbyData(aData: Pointer);
protected protected
procedure updateLoop; override;
// //
function contextName: string; override; function contextName: string; override;
function contextActionCount: integer; override; function contextActionCount: integer; override;
@ -170,6 +174,7 @@ begin
fMaxCount := opts.fMaxCount; fMaxCount := opts.fMaxCount;
fAutoSelect := opts.fAutoSelect; fAutoSelect := opts.fAutoSelect;
fSingleClick := opts.fSingleClick; fSingleClick := opts.fSingleClick;
fFastDisplay := opts.fFastDisplay;
fFont.EndUpdate; fFont.EndUpdate;
end end
else if Source is TCEMessagesWidget then else if Source is TCEMessagesWidget then
@ -179,6 +184,7 @@ begin
fMaxCount := widg.fMaxMessCnt; fMaxCount := widg.fMaxMessCnt;
fAutoSelect := widg.fAutoSelect; fAutoSelect := widg.fAutoSelect;
fSingleClick := widg.fSingleClick; fSingleClick := widg.fSingleClick;
fFastDisplay := widg.fastDisplay;
end end
else inherited; else inherited;
end; end;
@ -194,6 +200,7 @@ begin
widg.maxMessageCount := fMaxCount; widg.maxMessageCount := fMaxCount;
widg.autoSelectCategory := fAutoSelect; widg.autoSelectCategory := fAutoSelect;
widg.singleMessageClick := fSingleClick; widg.singleMessageClick := fSingleClick;
widg.fastDisplay:= fFastDisplay;
end end
else inherited; else inherited;
end; end;
@ -230,6 +237,7 @@ begin
// //
inherited; inherited;
// //
updaterByLoopInterval := 12;
fOptions := TCEMessagesOptions.Create(Self); fOptions := TCEMessagesOptions.Create(Self);
fOptions.assign(self); fOptions.assign(self);
fOptions.Name:= 'messageOptions'; fOptions.Name:= 'messageOptions';
@ -569,15 +577,20 @@ begin
dt^.ctxt := aCtxt; dt^.ctxt := aCtxt;
if fAutoSelect then if fCtxt <> aCtxt then if fAutoSelect then if fCtxt <> aCtxt then
fBtns[aCtxt].Click; fBtns[aCtxt].Click;
if fastDisplay then
IncLoopUpdate;
item := List.Items.Add(nil, aValue); item := List.Items.Add(nil, aValue);
item.Data := dt; item.Data := dt;
item.ImageIndex := iconIndex(aKind); item.ImageIndex := iconIndex(aKind);
item.SelectedIndex := item.ImageIndex; item.SelectedIndex := item.ImageIndex;
clearOutOfRangeMessg; if not fastDisplay then
//TODO-cfeature: reset horz scroll bar to the left begin
scrollToBack; //TODO-cfeature: reset horz scroll bar to the left
Application.ProcessMessages; clearOutOfRangeMessg;
filterMessages(fCtxt); scrollToBack;
Application.ProcessMessages;
filterMessages(fCtxt);
end;
end; end;
procedure TCEMessagesWidget.clearByContext(aCtxt: TCEAppMessageCtxt); procedure TCEMessagesWidget.clearByContext(aCtxt: TCEAppMessageCtxt);
@ -616,6 +629,14 @@ end;
{$ENDREGION} {$ENDREGION}
{$REGION Messages --------------------------------------------------------------} {$REGION Messages --------------------------------------------------------------}
procedure TCEMessagesWidget.updateLoop;
begin
clearOutOfRangeMessg;
scrollToBack;
Application.ProcessMessages;
filterMessages(fCtxt);
end;
function TCEMessagesWidget.iconIndex(aKind: TCEAppMessageKind): Integer; function TCEMessagesWidget.iconIndex(aKind: TCEAppMessageKind): Integer;
begin begin
case aKind of case aKind of