www.pudn.com > tp60src.zip > CALSTKWN.PAS

unit CalStkWn; 
 
{$O+,F+,S-,X+} 
 
interface 
 
uses Objects, Drivers, Views; 
 
const 
 
  CCallStackViewer = #6#6#7#6#6; 
 
type 
 
  PCallStackViewer = ^TCallStackViewer; 
  TCallStackViewer = object(TListViewer) 
    constructor Init(var Bounds: TRect; AHScrollBar, AVScrollBar: PScrollBar); 
    function GetPalette: PPalette; virtual; 
    function GetText(Item: Integer; MaxLen: Integer): string; virtual; 
    procedure HandleEvent(var Event: TEvent); virtual; 
    procedure SelectItem(Item: Integer); virtual; 
    function Valid(Command: Word): Boolean; virtual; 
  end; 
 
const 
 
  RCallStackViewer: TStreamRec = ( 
    ObjType: 9001; 
    VmtLink: Ofs(TypeOf(TCallStackViewer)^); 
    Load:    @TCallStackViewer.Load; 
    Store:@TCallStackViewer.Store 
  ); 
 
function CallStackWindow: PWindow; 
 
implementation 
 
uses TVars, TWindows, Compiler, Editor, Context; 
 
constructor TCallStackViewer.Init(var Bounds: TRect; 
  AHScrollBar, AVScrollBar: PScrollBar); 
begin 
  TListViewer.Init(Bounds, 1, AHScrollBar, AVScrollBar); 
  GrowMode := gfGrowHiX + gfGrowHiY; 
  EventMask:=EventMask or evDebugger; 
  HScrollBar^.SetRange(1, 128); 
end; 
 
function TCallStackViewer.GetPalette: PPalette; 
const 
  P: string[Length(CCallStackViewer)] = CCallStackViewer; 
begin 
  GetPalette := @P; 
end; 
 
function TCallStackViewer.GetText(Item: Integer; MaxLen: Integer): string; 
var 
  S: string; 
begin 
  GetCallStackEntry(Item + 1, S); 
  GetText := S; 
end; 
 
procedure TCallStackViewer.HandleEvent(var Event: TEvent); 
begin 
  TListViewer.HandleEvent(Event); 
  if Event.What and evMessage <> 0 then 
    case Event.Command of 
      cmFindCallStackWindow: 
        ClearEvent(Event); 
      cmRefreshInfo: 
        begin 
          SetRange(GetCallStackSize); 
          DrawView; 
        end; 
      cmOK: 
        begin 
          Event.What := evCommand; 
          Event.Command := cmViewSource; 
          Event.InfoInt := Focused; 
          PutEvent(Event); 
        end; 
      cmViewSource: 
        begin 
          if Focused < Range then 
            SelectItem(Focused); 
          ClearEvent(Event); 
        end; 
    end; 
end; 
 
procedure TCallStackViewer.SelectItem(Item: Integer); 
var 
  T: TPoint; 
begin 
  Longint(T) := GetCallStackPos(Item + 1); 
  GoFileLine(GetSourceName(T.X)^, T.Y, gfAlways + gfProgram); 
end; 
 
function TCallStackViewer.Valid(Command: Word): Boolean; 
begin 
  SetRange(GetCallStackSize); 
  Valid := True; 
end; 
 
function CallStackWindow: PWindow; 
var 
  R: TRect; 
  Window: PWindow; 
begin 
  R.Assign(0, 16, 80, 23); 
  Window := New(PTurboWindow, Init(R, 'Call stack', wnNoNumber, wpCallStackWindow)); 
  with Window^ do 
  begin 
    HelpCtx := hcCallStackWindow; 
    Flags := Flags or (wfPutOnBottom + wfSaveable); 
    GetExtent(R); 
    R.Grow(-1, -1); 
    Insert(New(PCallStackViewer, Init(R, StandardScrollBar(sbHorizontal), 
      StandardScrollBar(sbVertical)))); 
  end; 
  CallStackWindow := Window; 
end; 
 
end.