mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-04-08 02:19:57 +02:00
fixed message jumping
git-svn-id: trunk@4963 -
This commit is contained in:
parent
79edaaaf23
commit
642d5809ae
@ -31,9 +31,9 @@ unit DebugOptionsFrm;
|
||||
interface
|
||||
|
||||
uses
|
||||
Classes, SysUtils, LResources, Forms, Controls, Graphics, Dialogs, ExtCtrls,
|
||||
StdCtrls, Buttons, ComCtrls, Menus, Spin, CheckLst,
|
||||
ObjectInspector, LazarusIDEStrConsts, FileProcs, InputHistory,
|
||||
Classes, SysUtils, TypInfo, LResources, Forms, Controls, Graphics, Dialogs,
|
||||
ExtCtrls, StdCtrls, Buttons, ComCtrls, Menus, Spin, CheckLst,
|
||||
PropEdits, ObjectInspector, LazarusIDEStrConsts, FileProcs, InputHistory,
|
||||
EnvironmentOpts, BaseDebugManager, Debugger, DBGUtils;
|
||||
|
||||
type
|
||||
@ -80,6 +80,7 @@ type
|
||||
pgEventLog: TPAGE;
|
||||
pgGeneral: TPAGE;
|
||||
popSignal: TPOPUPMENU;
|
||||
PropertyGrid: TOIPropertyGrid;
|
||||
procedure DebuggerOptionsFormCREATE(Sender: TObject);
|
||||
procedure DebuggerOptionsFormDESTROY(Sender: TObject);
|
||||
procedure clbExceptionsCLICK (Sender: TObject );
|
||||
@ -89,10 +90,12 @@ type
|
||||
procedure cmdOKCLICK (Sender: TObject );
|
||||
procedure cmdOpenDebuggerPathCLICK(Sender: TObject);
|
||||
private
|
||||
ThePropertyEditorHook: TPropertyEditorHook;
|
||||
FExceptionDeleteList: TStringList;
|
||||
FOldDebuggerPathAndParams: string;
|
||||
FDebuggerSpecificComponents: TList;
|
||||
FCurDebuggerClass: TDebuggerClass; // currently shown debugger class
|
||||
FCurDebuggerObject: TDebugger; // currently shown debugger object
|
||||
procedure AddExceptionLine(const AException: TIDEException; AName: String);
|
||||
procedure AddSignalLine(const ASignal: TIDESignal);
|
||||
procedure FetchDebuggerClass;
|
||||
@ -188,7 +191,16 @@ procedure TDebuggerOptionsForm.FetchDebuggerSpecificOptions;
|
||||
var
|
||||
i: Integer;
|
||||
AMemo: TMemo;
|
||||
//var
|
||||
// Selection: TComponentSelectionList;
|
||||
begin
|
||||
{ThePropertyEditorHook.LookupRoot:=FCurDebuggerObject;
|
||||
Selection:=TComponentSelectionList.Create;
|
||||
if FCurDebuggerObject<>nil then
|
||||
Selection.Add(AComponent);
|
||||
PropertyGrid.Selections:=Selection;
|
||||
Selection.Free;}
|
||||
|
||||
// clear debugger specific options components
|
||||
if FDebuggerSpecificComponents=nil then
|
||||
FDebuggerSpecificComponents:=TList.Create;
|
||||
@ -239,6 +251,14 @@ begin
|
||||
if FCurDebuggerClass = AClass then Exit;
|
||||
FCurDebuggerClass := AClass;
|
||||
FetchDebuggerSpecificOptions;
|
||||
// destroy, replace or destroy Debugger instance
|
||||
if (FCurDebuggerObject<>nil)
|
||||
and ((FCurDebuggerClass=nil)
|
||||
or (not (FCurDebuggerObject is FCurDebuggerClass)))
|
||||
then
|
||||
FreeAndNil(FCurDebuggerObject);
|
||||
if (FCurDebuggerObject=nil) and (FCurDebuggerClass<>nil) then
|
||||
FCurDebuggerObject:=FCurDebuggerClass.Create('');
|
||||
end;
|
||||
|
||||
procedure TDebuggerOptionsForm.clbExceptionsCLICK (Sender: TObject );
|
||||
@ -371,6 +391,22 @@ begin
|
||||
AddSignalLine(DebugBoss.Signals[n]);
|
||||
end;
|
||||
|
||||
// create the PropertyEditorHook (the interface to the properties)
|
||||
ThePropertyEditorHook:=TPropertyEditorHook.Create;
|
||||
// create the PropertyGrid
|
||||
PropertyGrid:=TOIPropertyGrid.CreateWithParams(Self,ThePropertyEditorHook
|
||||
,[tkUnknown, tkInteger, tkChar, tkEnumeration, tkFloat, tkSet{, tkMethod}
|
||||
, tkSString, tkLString, tkAString, tkWString, tkVariant
|
||||
{, tkArray, tkRecord, tkInterface}, tkClass, tkObject, tkWChar, tkBool
|
||||
, tkInt64, tkQWord],
|
||||
25);
|
||||
with PropertyGrid do begin
|
||||
Name:='PropertyGrid';
|
||||
Parent:=gbDebuggerSpecific;
|
||||
Align:=alClient;
|
||||
SplitterX:=120;
|
||||
end;
|
||||
|
||||
FetchDebuggerClass;
|
||||
|
||||
// Fix designtime changes
|
||||
@ -381,6 +417,7 @@ procedure TDebuggerOptionsForm.DebuggerOptionsFormDESTROY(Sender: TObject);
|
||||
begin
|
||||
FreeAndNil(FDebuggerSpecificComponents);
|
||||
FreeAndNil(FExceptionDeleteList);
|
||||
FreeAndNil(FCurDebuggerObject);
|
||||
end;
|
||||
|
||||
|
||||
|
@ -7436,9 +7436,9 @@ begin
|
||||
// search relevant message (first error, first fatal)
|
||||
Index:=0;
|
||||
while (Index<MaxMessages) do begin
|
||||
CurMsg:=MessagesView.VisibleItems[Index].Msg;
|
||||
if (TheOutputFilter.GetSourcePosition(
|
||||
MessagesView.VisibleItems[Index].Msg,
|
||||
Filename,CaretXY,MsgType)) then
|
||||
CurMsg,Filename,CaretXY,MsgType)) then
|
||||
begin
|
||||
if MsgType in [etError,etFatal,etPanic] then break;
|
||||
end;
|
||||
@ -10235,6 +10235,9 @@ end.
|
||||
|
||||
{ =============================================================================
|
||||
$Log$
|
||||
Revision 1.688 2003/12/26 15:55:38 mattias
|
||||
fixed message jumping
|
||||
|
||||
Revision 1.687 2003/12/26 12:36:31 mattias
|
||||
started a posteriori message filtering
|
||||
|
||||
|
@ -319,8 +319,8 @@ begin
|
||||
RaiseException('TMessagesView.GetVisibleMessageAt');
|
||||
if (FItems.Count<=Index) then
|
||||
RaiseException('TMessagesView.GetVisibleMessageAt');
|
||||
Msg:=Items[Index].Msg;
|
||||
MsgDirectory:=Items[Index].Directory;
|
||||
Msg:=VisibleItems[Index].Msg;
|
||||
MsgDirectory:=VisibleItems[Index].Directory;
|
||||
end;
|
||||
|
||||
procedure TMessagesView.BeginBlock;
|
||||
|
@ -298,8 +298,8 @@ type
|
||||
procedure SetBounds(aLeft,aTop,aWidth,aHeight:integer); override;
|
||||
procedure Paint; override;
|
||||
procedure Clear;
|
||||
constructor CreateWithParams(AnOwner:TComponent;
|
||||
APropertyEditorHook:TPropertyEditorHook; TypeFilter:TTypeKinds;
|
||||
constructor CreateWithParams(AnOwner: TComponent;
|
||||
APropertyEditorHook: TPropertyEditorHook; TypeFilter: TTypeKinds;
|
||||
DefItemHeight: integer);
|
||||
destructor Destroy; override;
|
||||
function ConsistencyCheck: integer;
|
||||
|
Loading…
Reference in New Issue
Block a user