[JVCL-Checkins] CVS: dev/JVCL3/examples/JvDiagramShape/3. DependencyWalker DepWalk.dof,NONE,1.1 DepWalk.dpr,NONE,1.1 DepWalk.ico,NONE,1.1 DepWalk.res,NONE,1.1 DepWalk2.ico,NONE,1.1 DepWalkConsts.pas,NONE,1.1 DepWalkUtils.pas,NONE,1.1 DependencyWalker.css,NONE,1.1 Images.bmp,NONE,1.1 JclParseUses.pas,NONE,1.1 MainFrm.dfm,NONE,1.1 MainFrm.pas,NONE,1.1 OptionsFrm.dfm,NONE,1.1 OptionsFrm.pas,NONE,1.1 PersistForm.dfm,NONE,1.1 PersistForm.pas,NONE,1.1 PersistSettings.pas,NONE,1.1 PrintFrm.dfm,NONE,1.1 PrintFrm.pas,NONE,1.1 SkipList.txt,NONE,1.1 StatsFrm.dfm,NONE,1.1 StatsFrm.pas,NONE,1.1 readme.txt,NONE,1.1

[Peter T. <pe...@us...>]

Update of /cvsroot/jvcl/dev/JVCL3/examples/JvDiagramShape/3. DependencyWalker
In directory sc8-pr-cvs1:/tmp/cvs-serv4702/JVCL3/examples/JvDiagramShape/3. DependencyWalker

Added Files:
	DepWalk.dof DepWalk.dpr DepWalk.ico DepWalk.res DepWalk2.ico 
	DepWalkConsts.pas DepWalkUtils.pas DependencyWalker.css 
	Images.bmp JclParseUses.pas MainFrm.dfm MainFrm.pas 
	OptionsFrm.dfm OptionsFrm.pas PersistForm.dfm PersistForm.pas 
	PersistSettings.pas PrintFrm.dfm PrintFrm.pas SkipList.txt 
	StatsFrm.dfm StatsFrm.pas readme.txt 
Log Message:
- Copied jvcl/devtools and jvcl/examples dev/JVCL3
- Copied JVCLConvert *.dat files to dev/JVCL3/converter

--- NEW FILE: DependencyWalker DepWalk.dof ---
[Directories]
OutputDir=..\..\Bin
UnitOutputDir=..\..\Dcu
SearchPath=..\..\Source;..\..\Common

--- NEW FILE: DepWalk.dpr ---
program DepWalk;

uses
  Forms,
  MainFrm in 'MainFrm.pas' {frmMain},
  StatsFrm in 'StatsFrm.pas' {frmUnitStats},
  PrintFrm in 'PrintFrm.pas' {frmPrint},
  DepWalkConsts in 'DepWalkConsts.pas',
  OptionsFrm in 'OptionsFrm.pas' {frmOptions},
  PersistForm in 'PersistForm.pas' {frmPersistable},
  DepWalkUtils in 'DepWalkUtils.pas';

{$R *.res}

begin
  Application.Initialize;
  Application.Title := 'Dependency Walker';
  Application.CreateForm(TfrmMain, frmMain);
  Application.Run;
end.

--- NEW FILE: DepWalk.ico ---
(This appears to be a binary file; contents omitted.)

--- NEW FILE: DepWalk.res ---
(This appears to be a binary file; contents omitted.)

--- NEW FILE: DepWalk2.ico ---
(This appears to be a binary file; contents omitted.)

--- NEW FILE: DepWalkConsts.pas ---
unit DepWalkConsts;

interface
uses
  Graphics;
  
type
  TPrintFormat = (pfText,pfHTML,pfXML);
const
  cUnitParsedImageIndex = 0;
  cUnitUsedImageIndex   = 1;
  cPascalExt = '.pas';
  cIniFileExt = '.ini';
// icon offsets
  cStartX = 50;
  cStartY = 50;


resourcestring
  SParsedStatusFmt = '  Done (%d units parsed, %d units in diagram)';
  SStatusReady     = '  Ready';
  SParseErrorsFmt  = 'Errors were encountered:'#13#10#13#10'%s';

  SUsesColon = 'uses:';
  SNone      = '(none)';
  SUsedByColon = 'used by:';
  SDependencyWalkerTitle = 'Dependency Walker';
  SAddSkipListTitle = 'Add unit to skiplist';
  SAddSkipListCaption =  'Unit name:';
  SConfirmDelete = 'Confirm delete';
  SConfirmClear  = 'Confirm clear';
  
  SDelSelItemsPrompt = 'Delete selected items?';
  SDelSelItemFmt = 'Remove "%s" from diagram?';
  SCheckPaths    = 'Check your paths in the options dialog and try again.';

  SAboutText = 'Dependency Walker Demo - part of JVCL (http://jvcl.sourceforge.net)';
  SClearDiagramPrompt = 'Clear and create new diagram?';

  SFindTitle = 'Find';
  SFindNameColon = 'Name:';
  SFindNotFoundFmt = '"%s" not found.';
  SRestartForNewOptions = 'The new settings will not take effect until you create a new diagram (Ctrl+N).';
  SFileNotFoundFmt      = 'Unit %s not found.';
  SUnitNotFound = 'Unit not found.';


implementation

end.

--- NEW FILE: DepWalkUtils.pas ---
unit DepWalkUtils;

interface
uses
  Classes, SysUtils, Controls;

function WaitCursor: IUnknown;
function ChangeCursor(NewCursor: TCursor): IUnknown;
procedure SuspendRedraw(AControl: TWinControl; Suspend: boolean);
function YesNo(const ACaption, AMsg: string): boolean;

procedure strTokenize(const S: string; Delims: TSysCharSet; Results: TStrings);
function GetBorlandLibPath(Version: integer; ForDelphi: boolean): string;
function GetExpandedLibRoot(Version: integer; ForDelphi: boolean): string;
procedure GetPathList(Version: integer; ForDelphi: boolean; Strings: TStrings);
procedure GetSystemPaths(Strings: TStrings);
procedure MakeEditNumeric(EditHandle: integer);


implementation
uses
  Windows, Forms, Messages, Registry, JclSysInfo; 

type
  // (p3) class that changes and restores the screen cursor automatically
  TChangeCursor = class(TInterfacedObject)
  private
    FOldCursor: TCursor;
  public
    constructor Create(NewCursor: TCursor);
    destructor Destroy; override;
  end;

{ TChangeCursor }

constructor TChangeCursor.Create(NewCursor: TCursor);
begin
  inherited Create;
  FOldCursor := Screen.Cursor;
  Screen.Cursor := NewCursor;
end;

destructor TChangeCursor.Destroy;
begin
  Screen.Cursor := FOldCursor;
  inherited;
end;

function WaitCursor: IUnknown;
begin
  Result := TChangeCursor.Create(crHourGlass);
end;

function ChangeCursor(NewCursor: TCursor): IUnknown;
begin
  Result := TChangeCursor.Create(NewCursor);
end;

// (3) shows a message box with Yes and No buttons

function YesNo(const ACaption, AMsg: string): boolean;
begin
  Result := MessageBox(GetFocus, PChar(AMsg), PChar(ACaption),
    MB_YESNO or MB_ICONQUESTION or MB_TASKMODAL) = IDYES;
end;

// suspend/resumes the drawing of a TWinControl

procedure SuspendRedraw(AControl: TWinControl; Suspend: boolean);
begin
  AControl.Perform(WM_SETREDRAW, Ord(not Suspend), 0);
  if not Suspend then
    RedrawWindow(AControl.Handle, nil, 0, RDW_ERASE or RDW_FRAME or RDW_INTERNALPAINT or RDW_INVALIDATE or RDW_UPDATENOW or RDW_ALLCHILDREN);
end;

procedure strTokenize(const S: string; Delims: TSysCharSet; Results: TStrings);
var I, J: integer; tmp: string;
begin
  I := 1;
  J := 1;
  while true do
  begin
    while (I <= Length(S)) and not (S[i] in Delims) do
      Inc(I);
    tmp := trim(Copy(S, J, I - J));
    if tmp <> '' then
      Results.Add(tmp);
    if (I <= Length(S)) and (S[I] in Delims) then
      Inc(I); // skip the delimiter
    J := I;
    if i > Length(S) then
      Break;
  end;
end;

function GetBorlandLibPath(Version: integer; ForDelphi: boolean): string;
const
  cLibPath: array[boolean] of PChar = ('\Software\Borland\C++Builder\%d.0\Library',
    '\Software\Borland\Delphi\%d.0\Library');
var ALibPath: string;
begin
  ALibPath := Format(cLibPath[ForDelphi], [Version]);
  with TRegistry.Create do // defaults to HKCU - just what we want
  try
    if OpenKeyReadOnly(ALibPath) and ValueExists('Search Path') then
      Result := ReadString('Search Path')
    else
      Result := '';
  finally
    Free;
  end;
end;

function GetExpandedLibRoot(Version: integer; ForDelphi: boolean): string;
const
  cLibPath: array[boolean] of PChar = ('\Software\Borland\C++Builder\%d.0',
    '\Software\Borland\Delphi\%d.0');
var ALibPath: string;
begin
  ALibPath := Format(cLibPath[ForDelphi], [Version]);
  with TRegistry.Create do
  try
    RootKey := HKEY_LOCAL_MACHINE;
    if OpenKeyReadOnly(ALibPath) and ValueExists('RootDir') then
      Result := ReadString('RootDir')
    else
      Result := '';
  finally
    Free;
  end;
end;

procedure GetPathList(Version: integer; ForDelphi: boolean; Strings: TStrings);
const
  cRootDirMacro: array[boolean] of PChar = ('$(BCB)', '$(DELPHI)');
var S, T: string;
begin
  S := GetBorlandLibPath(Version, ForDelphi);
  T := GetExpandedLibRoot(Version, ForDelphi);
  S := StringReplace(S, cRootDirMacro[ForDelphi], T, [rfReplaceAll, rfIgnoreCase]);
  StrTokenize(S, [';'], Strings);
end;

procedure GetSystemPaths(Strings: TStrings);
var S: string;
begin
  JclSysInfo.GetEnvironmentVar('PATH', S, true);
  strTokenize(S, [';'], Strings);
end;

procedure MakeEditNumeric(EditHandle: integer);
begin
  SetWindowLong(EditHandle, GWL_STYLE, GetWindowLong(EditHandle, GWL_STYLE) or ES_NUMBER);
end;

function GetFullNamePath(AComponent:TComponent):string;
begin
  Result := AComponent.GetNamePath;
  while AComponent.Owner <> nil do
  begin
    AComponent := AComponent.Owner;
    Result := AComponent.GetNamePath + '.' + Result;
  end;
  if (Length(Result) > 1) and (Result[1] = '.') then
  begin
    Move(Result[2],Result[1],Length(Result));
    SetLength(Result,Length(Result)-1);
  end;
end;

end.


--- NEW FILE: DependencyWalker.css ---
body{font-family: Verdana, Arial, Helvetica, sans-serif;font-size: 70%;}

--- NEW FILE: Images.bmp ---
(This appears to be a binary file; contents omitted.)

--- NEW FILE: JclParseUses.pas ---
{$I JVCL.INC}
unit JclParseUses;

interface

uses
  Classes, SysUtils;

type
  EUsesListError = class(Exception);

  TUsesList = class
  private
    FText: string;
    function GetCount: Integer;
    function GetItems(Index: Integer): string;
  public
    constructor Create(const AText: PChar);
    function Add(const UnitName: string): Integer;
    function IndexOf(const UnitName: string): Integer;
    procedure Insert(Index: Integer; const UnitName: string);
    procedure Remove(Index: Integer);
    property Text: string read FText;
    property Count: Integer read GetCount;
    property Items[Index: Integer]: string read GetItems; default;
  end;

  TCustomGoal = class
  public
    constructor Create(Text: PChar); virtual; abstract;
  end;

  TProgramGoal = class(TCustomGoal)
  private
    FTextAfterUses: string;
    FTextBeforeUses: string;
    FUsesList: TUsesList;
  public
    constructor Create(Text: PChar); override;
    destructor Destroy; override;
    property TextAfterUses: string read FTextAfterUses;
    property TextBeforeUses: string read FTextBeforeUses;
    property UsesList: TUsesList read FUsesList;
  end;

  TLibraryGoal = class(TCustomGoal)
  private
    FTextAfterUses: string;
    FTextBeforeUses: string;
    FUsesList: TUsesList;
  public
    constructor Create(Text: PChar); override;
    destructor Destroy; override;
    property TextAfterUses: string read FTextAfterUses;
    property TextBeforeUses: string read FTextBeforeUses;
    property UsesList: TUsesList read FUsesList;
  end;

  TUnitGoal = class(TCustomGoal)
  private
    FTextAfterImpl: string;
    FTextAfterIntf: string;
    FTextBeforeIntf: string;
    FUsesImpl: TUsesList;
    FUsesIntf: TUsesList;
  public
    constructor Create(Text: PChar); override;
    destructor Destroy; override;
    property TextAfterImpl: string read FTextAfterImpl;
    property TextAfterIntf: string read FTextAfterIntf;
    property TextBeforeIntf: string read FTextBeforeIntf;
    property UsesImpl: TUsesList read FUsesImpl;
    property UsesIntf: TUsesList read FUsesIntf;
  end;

function CreateGoal(Text: PChar): TCustomGoal;

implementation

uses
{$IFDEF COMPILER6_UP}
  RtlConsts;
{$ELSE}
  Consts;
{$ENDIF}

const
  Blanks: TSysCharSet = [#9, #10, #13, ' '];
  SLibrary = 'library';
  SProgram = 'program';
  SUnit = 'unit';
  SUses = 'uses';

resourcestring
  SDuplicateUnit = 'Duplicate unit ''%s''';
  SInvalidLibrary = 'Invalid library';
  SInvalidProgram = 'Invalid program';
  SInvalidUnit = 'Invalid unit';
  SInvalidUses = 'Invalid uses clause';

function PeekIdentifier(var P:PChar):boolean;forward;

function PeekKeyword(var P: PChar; Keyword: PChar): Boolean; forward;
function ReadIdentifier(var P: PChar): string; forward;
procedure SkipCommentsAndBlanks(var P: PChar); forward;

//----------------------------------------------------------------------------

function CheckIdentifier(var P: PChar): Boolean;
begin
  Result := P^ in ['A'..'Z', '_', 'a'..'z'];
  if Result then
  begin
    Inc(P);
    while P^ in ['0'..'9', 'A'..'Z', '_', 'a'..'z'] do
      Inc(P);
  end;
end;

//----------------------------------------------------------------------------

function CheckKeyword(var P: PChar; Keyword: PChar): Boolean;
var
  KeywordLen: Integer;
begin
  KeywordLen := StrLen(Keyword);
  Result := StrLIComp(P, Keyword, KeywordLen) = 0;
  if Result then
    Inc(P, KeywordLen);
end;

//----------------------------------------------------------------------------

function CreateGoal(Text: PChar): TCustomGoal;
var
  P: PChar;
begin
  Result := nil;
  P := Text;

  SkipCommentsAndBlanks(P);
  if PeekKeyword(P, SProgram) then
    Result := TProgramGoal.Create(Text)
  else
  if PeekKeyword(P, SLibrary) then
    Result := TLibraryGoal.Create(Text)
  else
  if PeekKeyword(P, SUnit) then
    Result := TUnitGoal.Create(Text);
end;

//----------------------------------------------------------------------------

function PeekKeyword(var P: PChar; Keyword: PChar): Boolean;
var
  KeywordLen: Integer;
begin
  KeywordLen := StrLen(Keyword);
  Result := StrLIComp(P, KeyWord, KeywordLen) = 0;
end;

//----------------------------------------------------------------------------

function PeekIdentifier(var P: PChar):boolean;
var Q:PChar;
begin
  Q := P;
  Result := CheckIdentifier(P);
  P := Q;
end;


function ReadIdentifier(var P: PChar): string;
var
  PStart: PChar;
begin
  Result := '';

  if P^ in ['A'..'Z', '_', 'a'..'z'] then
  begin
    PStart := P;
    
    Inc(P);
    while P^ in ['0'..'9', 'A'..'Z', '_', 'a'..'z'] do
      Inc(P);

    SetString(Result, PStart, P - PStart);
  end;
end;

//----------------------------------------------------------------------------

procedure SkipChars(var P: PChar; Chars: TSysCharSet);
begin
  while P^ in Chars do
    Inc(P);
end;

//----------------------------------------------------------------------------

procedure SkipComments(var P: PChar);
var
  Test: PChar;
begin
  if P^ = '{' then
  begin
    Test := StrScan(P, '}');
    if Test <> nil then
      P := Test + 1;
  end
  else
  if StrLComp(P, '(*', 2) = 0 then
  begin
    Test := StrPos(P, '*)');
    if Test <> nil then
      P := Test + 2;
  end
  else
  if StrLComp(P, '//', 2) = 0 then
  begin
    Test := StrPos(P, #13#10);
    if Test <> nil then
      P := Test + 2;
  end;
end;

//----------------------------------------------------------------------------

procedure SkipCommentsAndBlanks(var P: PChar);
var
  Test: PChar;
begin
  repeat
    Test := P;
    SkipChars(P, Blanks);
    SkipComments(P);
  until Test = P;
end;

//----------------------------------------------------------------------------
{ TUsesList private }
//----------------------------------------------------------------------------

function TUsesList.GetCount: Integer;
var
  P: PChar;
begin
  Result := 0;

  if FText = '' then
    Exit;

  P := PChar(FText);
  // an empty uses clause consisting of only blanks and comments
  // (resulting from removal of the last unit) is valid too
  SkipCommentsAndBlanks(P);
  if P^ = #0 then
    Exit;

  if not CheckKeyword(P, SUses) then
    raise EUsesListError.Create(SInvalidUses);

  while P^ <> #0 do
  begin
    SkipCommentsAndBlanks(P);
    if not CheckIdentifier(P) then
      raise EUsesListError.Create(SInvalidUses);
    Inc(Result);
    SkipCommentsAndBlanks(P);

    if PeekKeyword(P, 'in') then
    begin
      Inc(P, 2);
      SkipCommentsAndBlanks(P);
      if P^ <> '''' then
        raise EUsesListError.Create(SInvalidUses);
      Inc(P);
        
      while not (P^ in [#0, '''']) do
        Inc(P);
      if P^ <> '''' then
        raise EUsesListError.Create(SInvalidUses);
      Inc(P);
      SkipCommentsAndBlanks(P);
    end;

    case P^ of
      ',':
        Inc(P);
      ';':
        Break;
      else
        if not PeekIdentifier(P) then
          raise EUsesListError.Create(SInvalidUses);
    end;
  end;
end;

//----------------------------------------------------------------------------

function TUsesList.GetItems(Index: Integer): string;
var
  P, PIdentifier: PChar;
  I: Integer;
begin
  Result := '';

  if (Index < 0) or (Index > Count - 1) then
    raise EUsesListError.CreateFmt(SListIndexError, [Index]);

  P := PChar(FText);
  if not CheckKeyword(P, SUses) then
    raise EUsesListError.Create(SInvalidUses);
  I := -1;
  while P^ <> #0 do
  begin
    SkipCommentsAndBlanks(P);
    PIdentifier := P;
    if not CheckIdentifier(P) then
      raise EUsesListError.Create(SInvalidUses);

    Inc(I);
    if I = Index then
    begin
      while PIdentifier^ in ['0'..'9', 'A'..'Z', '_', 'a'..'z'] do
      begin
        Result := Result + PIdentifier^;
        Inc(PIdentifier);
      end;
      Exit;
    end;
    SkipCommentsAndBlanks(P);

    if PeekKeyword(P, 'in') then
    begin
      Inc(P, 2);
      SkipCommentsAndBlanks(P);
      if P^ <> '''' then
        raise EUsesListError.Create(SInvalidUses);
      Inc(P);

      while not (P^ in [#0, '''']) do
        Inc(P);
      if P^ <> '''' then
        raise EUsesListError.Create(SInvalidUses);
      Inc(P);
      SkipCommentsAndBlanks(P);
    end;

    case P^ of
      ',':
        Inc(P);
      ';':
        Break;
      else
        if not PeekIdentifier(P) then
          raise EUsesListError.Create(SInvalidUses);
    end;
  end;
end;

//----------------------------------------------------------------------------
{ TUsesList public }
//----------------------------------------------------------------------------

constructor TUsesList.Create(const AText: PChar);
var
  P, PStart: PChar;
begin
  inherited Create;
  FText := '';
  if AText = nil then
    Exit;
    
  PStart := PChar(AText);
  P := PStart;
  if CheckKeyword(P, SUses) then
  begin
    while P^ <> #0 do
    begin
      SkipCommentsAndBlanks(P);
      if not CheckIdentifier(P) then
        raise EUsesListError.Create(SInvalidUses);
      SkipCommentsAndBlanks(P);


      if PeekKeyword(P, 'in') then
      begin
        Inc(P, 2);
        SkipCommentsAndBlanks(P);
        if P^ <> '''' then
          raise EUsesListError.Create(SInvalidUses);
        Inc(P);

        while not (P^ in [#0, '''']) do
          Inc(P);
        if P^ <> '''' then
          raise EUsesListError.Create(SInvalidUses);
        Inc(P);
        SkipCommentsAndBlanks(P);
      end;

      case P^ of
        ',':
          Inc(P);
        ';':
          begin
            Inc(P);
            Break;
          end;
        else
          if not PeekIdentifier(P) then
            raise EUsesListError.Create(SInvalidUses)
      end;
    end;
    SetString(FText, PStart, P - PStart);
  end;
end;

//----------------------------------------------------------------------------

function TUsesList.Add(const UnitName: string): Integer;
var
  I: Integer;
  P: PChar;
begin
  Result := -1;

  I := IndexOf(UnitName);
  if I <> -1 then
    raise EUsesListError.CreateFmt(SDuplicateUnit, [UnitName]);

  if FText = '' then
  begin
    FText := Format('%s'#13#10'  %s;'#13#10#13#10, [SUses, UnitName]);
    try
      Result := IndexOf(UnitName);
    except
      FText := '';
      raise;
    end;
  end
  else
  begin
    P := PChar(FText);
    if not CheckKeyword(P, SUses) then
      raise EUsesListError.Create(SInvalidUses);

    while P^ <> #0 do
    begin
      SkipCommentsAndBlanks(P);
      if not CheckIdentifier(P) then
        raise EUsesListError.Create(SInvalidUses);

      SkipCommentsAndBlanks(P);

      if PeekKeyword(P, 'in') then
      begin
        Inc(P, 2);
        SkipCommentsAndBlanks(P);
        if P^ <> '''' then
          raise EUsesListError.Create(SInvalidUses);
        Inc(P);

        while not (P^ in [#0, '''']) do
          Inc(P);
        if P^ <> '''' then
          raise EUsesListError.Create(SInvalidUses);
        Inc(P);
        SkipCommentsAndBlanks(P);
      end;

      case P^ of
        ',':
          Inc(P);
        ';':
          begin
            System.Insert(Format(', %s', [UnitName]), FText, P - PChar(FText) + 1);
            Result := IndexOf(UnitName);
            Break;
          end;
        else
          raise EUsesListError.Create(SInvalidUses);
      end;
    end;
  end;
end;

//----------------------------------------------------------------------------

function TUsesList.IndexOf(const UnitName: string): Integer;
var
  P, PIdentifier: PChar;
  Identifier: string;
  I: Integer;
begin
  Result := -1;

  if FText = '' then
    Exit;

  P := PChar(FText);
  if not CheckKeyword(P, SUses) then
    raise EUsesListError.Create(SInvalidUses);

  I := -1;
  while P^ <> #0 do
  begin
    SkipCommentsAndBlanks(P);
    PIdentifier := P;
    if not CheckIdentifier(P) then
      raise EUsesListError.Create(SInvalidUses);
    SetString(Identifier, PIdentifier, P - PIdentifier);

    Inc(I);
    if AnsiCompareText(UnitName, Identifier) = 0 then
    begin
      Result := I;
      Exit;
    end;
    SkipCommentsAndBlanks(P);

    if PeekKeyword(P, 'in') then
    begin
      Inc(P, 2);
      SkipCommentsAndBlanks(P);
      if P^ <> '''' then
        raise EUsesListError.Create(SInvalidUses);
      Inc(P);

      while not (P^ in [#0, '''']) do
        Inc(P);
      if P^ <> '''' then
        raise EUsesListError.Create(SInvalidUses);
      Inc(P);
      SkipCommentsAndBlanks(P);
    end;

    case P^ of
      ',':
        Inc(P);
      ';':
        Break;
      else
        raise EUsesListError.Create(SInvalidUses);
    end;
  end;
end;

//----------------------------------------------------------------------------

procedure TUsesList.Insert(Index: Integer; const UnitName: string);
var
  I: Integer;
  P: PChar;
begin
  if (Index < 0) or (Index > Count - 1) then
    raise EUsesListError.CreateFmt(SListIndexError, [Index]);
  I := IndexOf(UnitName);
  if I <> -1 then
    raise EUsesListError.CreateFmt(SDuplicateUnit, [UnitName]);

  if FText = '' then
  begin
    FText := Format('%s'#13#10'  %s;'#13#10#13#10, [SUses, UnitName]);
    try
      if Index <> IndexOf(UnitName) then
        Exit;
    except
      FText := '';
      raise;
    end;
  end
  else
  begin
    P := PChar(FText);
    if not CheckKeyword(P, SUses) then
      raise EUsesListError.Create(SInvalidUses);

    I := -1;
    while P^ <> #0 do
    begin
      SkipCommentsAndBlanks(P);
      Inc(I);
      if I = Index then
      begin
        System.Insert(Format('%s, ', [UnitName]), FText, P - PChar(FText) + 1);
        Exit;
      end;

      if not CheckIdentifier(P) then
        raise EUsesListError.Create(SInvalidUses);
      SkipCommentsAndBlanks(P);

      if PeekKeyword(P, 'in') then
      begin
        Inc(P, 2);
        SkipCommentsAndBlanks(P);
        if P^ <> '''' then
          raise EUsesListError.Create(SInvalidUses);
        Inc(P);

        while not (P^ in [#0, '''']) do
          Inc(P);
        if P^ <> '''' then
          raise EUsesListError.Create(SInvalidUses);
        Inc(P);
        SkipCommentsAndBlanks(P);
      end;

      case P^ of
        ',':
          Inc(P);
        else
          raise EUsesListError.Create(SInvalidUses);
      end;
    end;
  end;
end;

//----------------------------------------------------------------------------

procedure TUsesList.Remove(Index: Integer);
var
  Count, I, DelPos: Integer;
  P, PIdentifier: PChar;
begin
  Count := GetCount;
  if (Index < 0) or (Index > Count - 1) then
    raise EUsesListError.CreateFmt(SListIndexError, [Index]);

  P := PChar(FText);
  if not CheckKeyword(P, SUses) then
    raise EUsesListError.Create(SInvalidUses);

  if (Count = 1) and (Index = 0) then
  begin
    Delete(FText, 1, Length(SUses));
    P := PChar(FText);
  end;

  I := -1;
  while P^ <> #0 do
  begin
    SkipCommentsAndBlanks(P);
    Inc(I);

    if I = Index then
    begin
      // remove unit
      PIdentifier := P;
      if not CheckIdentifier(P) then
        raise EUsesListError.Create(SInvalidUses);
      DelPos := PIdentifier - PChar(FText) + 1;
      Delete(FText, DelPos, P - PIdentifier);
      // skip comments and blanks
      P := PChar(FText) + DelPos - 1;
      PIdentifier := P;
      SkipCommentsAndBlanks(P);
      // check <unitname> in <filename> syntax
      if PeekKeyword(P, 'in') then
      begin
        Inc(P, 2);
        SkipCommentsAndBlanks(P);
        if P^ <> '''' then
          raise EUsesListError.Create(SInvalidUses);
        Inc(P);

        while not (P^ in [#0, '''']) do
          Inc(P);
        if P^ <> '''' then
          raise EUsesListError.Create(SInvalidUses);
        Inc(P);
        SkipCommentsAndBlanks(P);
        DelPos := PIdentifier - PChar(FText) + 1;
        Delete(FText, DelPos, P - PIdentifier);
        P := PChar(FText) + DelPos - 1;
      end;

      // remove separator
      case P^ of
        ',', ';':
          begin
            DelPos := P - PChar(FText) + 1;
            Delete(FText, DelPos, 1);
          end;
        else
          raise EUsesListError.Create(SInvalidUses);
      end;
      // remove trailing spaces, if any
      PIdentifier := PChar(FText) + DelPos - 1;
      P := PIdentifier;
      SkipChars(P, Blanks);
      DelPos := PIdentifier - PChar(FText) + 1;
      Delete(FText, DelPos, P - PIdentifier);
      // skip further comments and blanks
      P := PChar(FText) + DelPos - 1;
      SkipCommentsAndBlanks(P);
      Exit;
    end;
    if not CheckIdentifier(P) then
      raise EUsesListError.Create(SInvalidUses);

    SkipCommentsAndBlanks(P);
    if PeekKeyword(P, 'in') then
    begin
      Inc(P, 2);
      SkipCommentsAndBlanks(P);
      if P^ <> '''' then
        raise EUsesListError.Create(SInvalidUses);
      Inc(P);

      while not (P^ in [#0, '''']) do
        Inc(P);
      if P^ <> '''' then
        raise EUsesListError.Create(SInvalidUses);
      Inc(P);
      SkipCommentsAndBlanks(P);
    end;

    case P^ of
      ',', ';':
        begin
          // make sure semicolon is the last separator in case the last unit is going to be removed
          if (Index = Count - 1) and (I = Index - 1) then
            P^ := ';';
          Inc(P);
        end;
      else
        raise EUsesListError.Create(SInvalidUses);
    end;
  end;
end;

//----------------------------------------------------------------------------
{ TProgramGoal public }
//----------------------------------------------------------------------------

constructor TProgramGoal.Create(Text: PChar);
var
  P, PStart: PChar;
begin
  FTextBeforeUses := '';
  FTextAfterUses := '';

  PStart := Text;
  P := PStart;
  
  // check 'program' label
  SkipCommentsAndBlanks(P);
  if not CheckKeyword(P, SProgram) then
    raise EUsesListError.Create(SInvalidProgram);
  SkipCommentsAndBlanks(P);
  if not CheckIdentifier(P) then
    raise EUsesListError.Create(SInvalidProgram);
  SkipCommentsAndBlanks(P);
  if P^ <> ';' then
    raise EUsesListError.Create(SInvalidProgram);
  Inc(P);
  SkipCommentsAndBlanks(P);

  // remember text before uses
  SetString(FTextBeforeUses, PStart, P - PStart);

  if PeekKeyword(P, SUses) then
  begin
    FUsesList := TUsesList.Create(P);
    PStart := P + Length(FUsesList.Text);
  end
  else // empty uses list
  begin
    FUsesList := TUsesList.Create(nil);
    PStart := P;
  end;
  // remember text after uses
  P := StrEnd(PStart);
  SetString(FTextAfterUses, PStart, P - PStart);
end;

//----------------------------------------------------------------------------

destructor TProgramGoal.Destroy;
begin
  FUsesList.Free;
  inherited Destroy;
end;

//----------------------------------------------------------------------------
{ TLibraryGoal public }
//----------------------------------------------------------------------------

constructor TLibraryGoal.Create(Text: PChar);
var
  P, PStart: PChar;
begin
  FTextBeforeUses := '';
  FTextAfterUses := '';

  PStart := Text;
  P := PStart;

  // check 'library' label
  SkipCommentsAndBlanks(P);
  if not CheckKeyword(P, SLibrary) then
    raise EUsesListError.Create(SInvalidLibrary);
  SkipCommentsAndBlanks(P);
  if not CheckIdentifier(P) then
    raise EUsesListError.Create(SInvalidLibrary);
  SkipCommentsAndBlanks(P);
  if P^ <> ';' then
    raise EUsesListError.Create(SInvalidLibrary);
  Inc(P);
  SkipCommentsAndBlanks(P);

  // remember text before uses
  SetString(FTextBeforeUses, PStart, P - PStart);

  if PeekKeyword(P, SUses) then
  begin
    FUsesList := TUsesList.Create(P);
    PStart := P + Length(FUsesList.Text);
  end
  else // empty uses list
  begin
    FUsesList := TUsesList.Create(nil);
    PStart := P;
  end;
  // remember text after uses
  P := StrEnd(PStart);
  SetString(FTextAfterUses, PStart, P - PStart);
end;

//----------------------------------------------------------------------------

destructor TLibraryGoal.Destroy;
begin
  FUsesList.Free;
  inherited Destroy;
end;

//----------------------------------------------------------------------------
{ TUnitGoal public }
//----------------------------------------------------------------------------

constructor TUnitGoal.Create(Text: PChar);
var
  P, PStart: PChar;
begin
  FTextBeforeIntf := '';
  FTextAfterIntf := '';
  FTextAfterImpl := '';

  PStart := Text;
  P := PStart;

  // check 'unit' label
  SkipCommentsAndBlanks(P);
  while (P^ <> #0) and not PeekKeyword(P, 'unit') do
  begin
    SkipChars(P, [#1..#255] - Blanks);
    SkipCommentsAndBlanks(P);
  end;
  if not CheckKeyword(P, SUnit) then
    raise EUsesListError.Create(SInvalidUnit);
  SkipCommentsAndBlanks(P);
  if not CheckIdentifier(P) then
    raise EUsesListError.Create(SInvalidUnit);
  SkipCommentsAndBlanks(P);
  if P^ <> ';' then
    raise EUsesListError.Create(SInvalidUnit);
  Inc(P);
  // check 'interface' label
//  SkipCommentsAndBlanks(P);
  while (P^ <> #0) and not PeekKeyword(P, 'interface') do
  begin
    SkipChars(P, [#1..#255] - Blanks);
    SkipCommentsAndBlanks(P);
  end;
  if not CheckKeyword(P, 'interface') then
    raise EUsesListError.Create(SInvalidUnit);
  SkipCommentsAndBlanks(P);

  // remember text before interface uses
  SetString(FTextBeforeIntf, PStart, P - PStart);
  if PeekKeyword(P, SUses) then
  begin
    FUsesIntf := TUsesList.Create(P);
    PStart := P + Length(FUsesIntf.Text);
  end
  else
  begin
    FUsesIntf := TUsesList.Create(nil);
    PStart := P;
  end;
  // locate implementation
  while (P^ <> #0) and not PeekKeyword(P, 'implementation') do
  begin
    SkipChars(P, [#1..#255] - Blanks);
    SkipCommentsAndBlanks(P);
  end;
  if not CheckKeyword(P, 'implementation') then
    raise EUsesListError.Create(SInvalidUnit);
  SkipCommentsAndBlanks(P);

  // remember text after interface uses
  SetString(FTextAfterIntf, PStart, P - PStart);
  if PeekKeyword(P, SUses) then
  begin
    FUsesImpl := TUsesList.Create(P);
    PStart := P + Length(FUsesImpl.Text);
  end
  else
  begin
    FUsesImpl := TUsesList.Create(nil);
    PStart := P;
  end;
  // remember text after implementation uses
  P := StrEnd(PStart);
  SetString(FTextAfterImpl, PStart, P - PStart);
end;

//----------------------------------------------------------------------------

destructor TUnitGoal.Destroy;
begin
  FUsesIntf.Free;
  FUsesImpl.Free;
  inherited Destroy;
end;

end.

--- NEW FILE: MainFrm.dfm ---
object frmMain: TfrmMain
  Left = 405
  Top = 189
  Width = 593
  Height = 463
  BorderWidth = 2
  Caption = 'Dependency Walker'
  Color = clBtnFace
  Constraints.MinHeight = 200
  Constraints.MinWidth = 300
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -11
  Font.Name = 'MS Shell Dlg 2'
  Font.Style = []
  Menu = mmMain
  OldCreateOrder = False
  ShowHint = True
  OnCloseQuery = FormCloseQuery
[...2279 lines suppressed...]
      E01FFFBA8FF5807FFFFFFFC78001FFFF00000000000000000000000000000000
      000000000000}
  end
  object popDiagram: TPopupMenu
    Images = Actions
    Left = 232
    Top = 104
    object CopyDiagramtoClipboard1: TMenuItem
      Action = acCopy
    end
  end
  object dlgSaveImage: TSaveDialog
    DefaultExt = 'bmp'
    Filter = 'Bitmap files (*.bmp)|*.bmp|All files|*.*'
    Options = [ofOverwritePrompt, ofHideReadOnly, ofEnableSizing]
    Title = 'Save Diagram Image'
    Left = 32
    Top = 152
  end
end

--- NEW FILE: MainFrm.pas ---
{$I JVCL.INC}
unit MainFrm;
interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
  JvDiagramShape, Dialogs, ComCtrls, Menus, ImgList, StdCtrls, ExtCtrls,
  ActnList, PersistSettings, DepWalkConsts, ToolWin, Buttons, PersistForm;

type
  (*
    // (p3) interposer class for TListBox that implements IPersistSettings (for the skiplist)
    TListBox = class(StdCtrls.TListBox, IUnknown, IPersistSettings)
    private
      {IPersistSettings}
      procedure Load(Storage: TCustomIniFile);
      procedure Save(Storage: TCustomIniFile);
    end;
   *)
[...1653 lines suppressed...]
    end;
  finally
    Errors.Free;
  end;
end;

function TfrmMain.GetSelected: TJvCustomDiagramShape;
var i: integer;
begin
  Result := nil;
  for i := 0 to sb.ControlCount - 1 do
    if (sb.Controls[i] is TJvBitmapShape) and TJvBitmapShape(sb.Controls[i]).Selected then
    begin
      Result := TJvCustomDiagramShape(sb.Controls[i]);
      Exit;
    end;
end;

end.


--- NEW FILE: OptionsFrm.dfm ---
object frmOptions: TfrmOptions
  Left = 531
  Top = 176
  ActiveControl = edShapeWidth
  BorderStyle = bsDialog
  Caption = 'Options'
  ClientHeight = 367
  ClientWidth = 322
  Color = clBtnFace
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -11
  Font.Name = 'MS Shell Dlg 2'
  Font.Style = []
  OldCreateOrder = False
  OnCreate = FormCreate
  PixelsPerInch = 96
  TextHeight = 13
  object btnOK: TButton
    Left = 153
    Top = 329
    Width = 75
    Height = 25
    Anchors = [akRight, akBottom]
    Caption = 'OK'
    Default = True
    ModalResult = 1
    TabOrder = 1
  end
  object btnCancel: TButton
    Left = 233
    Top = 329
    Width = 75
    Height = 25
    Anchors = [akRight, akBottom]
    Cancel = True
    Caption = 'Cancel'
    ModalResult = 2
    TabOrder = 2
  end
  object pcOptions: TPageControl
    Left = 2
    Top = 5
    Width = 318
    Height = 315
    ActivePage = tabGeneral
    Anchors = [akLeft, akTop, akRight, akBottom]
    TabOrder = 0
    object tabGeneral: TTabSheet
      Caption = 'General'
      object gbShapes: TGroupBox
        Left = 8
        Top = 0
        Width = 297
        Height = 81
        Anchors = [akLeft, akTop, akRight]
        Caption = ' Shapes '
        TabOrder = 0
        object Label1: TLabel
          Left = 16
          Top = 24
          Width = 32
          Height = 13
          Caption = '&Width:'
          FocusControl = edShapeWidth
        end
        object Label2: TLabel
          Left = 152
          Top = 24
          Width = 35
          Height = 13
          Caption = '&Height:'
          FocusControl = edShapeHeight
        end
        object edShapeWidth: TEdit
          Left = 16
          Top = 40
          Width = 130
          Height = 21
          TabOrder = 0
          Text = '50'
        end
        object edShapeHeight: TEdit
          Left = 152
          Top = 40
          Width = 130
          Height = 21
          TabOrder = 1
          Text = '50'
        end
      end
      object gbConnectors: TGroupBox
        Left = 7
        Top = 86
        Width = 297
        Height = 191
        Anchors = [akLeft, akTop, akRight, akBottom]
        Caption = ' Connectors '
        TabOrder = 1
        object Label3: TLabel
          Left = 16
          Top = 24
          Width = 56
          Height = 13
          Caption = 'Interface:'
          Font.Charset = DEFAULT_CHARSET
          Font.Color = clWindowText
          Font.Height = -11
          Font.Name = 'MS Shell Dlg 2'
          Font.Style = [fsBold]
          ParentFont = False
        end
        object Label4: TLabel
          Left = 16
          Top = 112
          Width = 95
          Height = 13
          Caption = 'Implementation:'
          Font.Charset = DEFAULT_CHARSET
          Font.Color = clWindowText
          Font.Height = -11
          Font.Name = 'MS Shell Dlg 2'
          Font.Style = [fsBold]
          ParentFont = False
        end
        object Label5: TLabel
          Left = 16
          Top = 48
          Width = 37
          Height = 13
          Caption = '&Normal:'
          FocusControl = cbIntfColor
        end
        object Label6: TLabel
          Left = 153
          Top = 48
          Width = 45
          Height = 13
          Caption = 'H&ighlight:'
          FocusControl = cbIntfSelColor
        end
        object Label7: TLabel
          Left = 16
          Top = 136
          Width = 37
          Height = 13
          Caption = 'Nor&mal:'
          FocusControl = cbImplColor
        end
        object Label8: TLabel
          Left = 153
          Top = 136
          Width = 45
          Height = 13
          Caption = 'Hi&ghlight:'
          FocusControl = cbImplSelColor
        end
        object cbIntfColor: TJvColorComboBox
          Left = 16
          Top = 64
          Width = 130
          Height = 20
          ColorNameMap.Strings = (
            'clBlack=Black'
            'clMaroon=Maroon'
            'clGreen=Green'
            'clOlive=Olive'
            'clNavy=Navy'
            'clPurple=Purple'
            'clTeal=Teal'
            'clGray=Gray'
            'clSilver=Silver'
            'clRed=Red'
            'clLime=Lime'
            'clYellow=Yellow'
            'clBlue=Blue'
            'clFuchsia=Fuchsia'
            'clAqua=Aqua'
            'clLtGray=Light Gray'
            'clDkGray=Dark Gray'
            'clWhite=White'
            'clMoneyGreen=Money Green'
            'clSkyBlue=Sky Blue'
            'clCream=Cream'
            'clMedGray=Medium Gray'
            'clScrollBar=ScrollBar'
            'clBackground=Background'
            'clActiveCaption=Active Caption'
            'clInactiveCaption=Inactive Caption'
            'clMenu=Menu'
            'clWindow=Window'
            'clWindowFrame=Window Frame'
            'clMenuText=Menu Text'
            'clWindowText=Window Text'
            'clCaptionText=Caption Text'
            'clActiveBorder=Active Border'
            'clInactiveBorder=Inactive Border'
            'clAppWorkSpace=Application Workspace'
            'clHighlight=Highlight'
            'clHighlightText=Highlight Text'
            'clBtnFace=Button Face'
            'clBtnShadow=Button Shadow'
            'clGrayText=Gray Text'
            'clBtnText=Button Text'
            'clInactiveCaptionText=Inactive Caption Text'
            'clBtnHighlight=Button Highlight'
            'cl3DDkShadow=3D Dark Shadow'
            'cl3DLight=3D Light'
            'clInfoText=Info Text'
            'clInfoBk=Info Background'
            'clHotLight=Hot Light'
            'clGradientActiveCaption=Gradient Active Caption'
            'clGradientInactiveCaption=Gradient Inactive Caption'
            'clMenuHighlight=Menu Highlight'
            'clMenuBar=MenuBar'
            'clNone=None'
            'clDefault=Default')
          ColorDialogText = 'Custom...'
          NewColorText = 'Custom'
          Options = [coText, coSysColors]
          DroppedDownWidth = 130
          TabOrder = 0
        end
        object cbIntfSelColor: TJvColorComboBox
          Left = 153
          Top = 64
          Width = 130
          Height = 20
          ColorNameMap.Strings = (
            'clBlack=Black'
            'clMaroon=Maroon'
            'clGreen=Green'
            'clOlive=Olive'
            'clNavy=Navy'
            'clPurple=Purple'
            'clTeal=Teal'
            'clGray=Gray'
            'clSilver=Silver'
            'clRed=Red'
            'clLime=Lime'
            'clYellow=Yellow'
            'clBlue=Blue'
            'clFuchsia=Fuchsia'
            'clAqua=Aqua'
            'clLtGray=Light Gray'
            'clDkGray=Dark Gray'
            'clWhite=White'
            'clMoneyGreen=Money Green'
            'clSkyBlue=Sky Blue'
            'clCream=Cream'
            'clMedGray=Medium Gray'
            'clScrollBar=ScrollBar'
            'clBackground=Background'
            'clActiveCaption=Active Caption'
            'clInactiveCaption=Inactive Caption'
            'clMenu=Menu'
            'clWindow=Window'
            'clWindowFrame=Window Frame'
            'clMenuText=Menu Text'
            'clWindowText=Window Text'
            'clCaptionText=Caption Text'
            'clActiveBorder=Active Border'
            'clInactiveBorder=Inactive Border'
            'clAppWorkSpace=Application Workspace'
            'clHighlight=Highlight'
            'clHighlightText=Highlight Text'
            'clBtnFace=Button Face'
            'clBtnShadow=Button Shadow'
            'clGrayText=Gray Text'
            'clBtnText=Button Text'
            'clInactiveCaptionText=Inactive Caption Text'
            'clBtnHighlight=Button Highlight'
            'cl3DDkShadow=3D Dark Shadow'
            'cl3DLight=3D Light'
            'clInfoText=Info Text'
            'clInfoBk=Info Background'
            'clHotLight=Hot Light'
            'clGradientActiveCaption=Gradient Active Caption'
            'clGradientInactiveCaption=Gradient Inactive Caption'
            'clMenuHighlight=Menu Highlight'
            'clMenuBar=MenuBar'
            'clNone=None'
            'clDefault=Default')
          ColorValue = clRed
          ColorDialogText = 'Custom...'
          NewColorText = 'Custom'
          Options = [coText, coSysColors]
          DroppedDownWidth = 130
          TabOrder = 1
        end
        object cbImplColor: TJvColorComboBox
          Left = 16
          Top = 152
          Width = 130
          Height = 20
          ColorNameMap.Strings = (
            'clBlack=Black'
            'clMaroon=Maroon'
            'clGreen=Green'
            'clOlive=Olive'
            'clNavy=Navy'
            'clPurple=Purple'
            'clTeal=Teal'
            'clGray=Gray'
            'clSilver=Silver'
            'clRed=Red'
            'clLime=Lime'
            'clYellow=Yellow'
            'clBlue=Blue'
            'clFuchsia=Fuchsia'
            'clAqua=Aqua'
            'clLtGray=Light Gray'
            'clDkGray=Dark Gray'
            'clWhite=White'
            'clMoneyGreen=Money Green'
            'clSkyBlue=Sky Blue'
            'clCream=Cream'
            'clMedGray=Medium Gray'
            'clScrollBar=ScrollBar'
            'clBackground=Background'
            'clActiveCaption=Active Caption'
            'clInactiveCaption=Inactive Caption'
            'clMenu=Menu'
            'clWindow=Window'
            'clWindowFrame=Window Frame'
            'clMenuText=Menu Text'
            'clWindowText=Window Text'
            'clCaptionText=Caption Text'
            'clActiveBorder=Active Border'
            'clInactiveBorder=Inactive Border'
            'clAppWorkSpace=Application Workspace'
            'clHighlight=Highlight'
            'clHighlightText=Highlight Text'
            'clBtnFace=Button Face'
            'clBtnShadow=Button Shadow'
            'clGrayText=Gray Text'
            'clBtnText=Button Text'
            'clInactiveCaptionText=Inactive Caption Text'
            'clBtnHighlight=Button Highlight'
            'cl3DDkShadow=3D Dark Shadow'
            'cl3DLight=3D Light'
            'clInfoText=Info Text'
            'clInfoBk=Info Background'
            'clHotLight=Hot Light'
            'clGradientActiveCaption=Gradient Active Caption'
            'clGradientInactiveCaption=Gradient Inactive Caption'
            'clMenuHighlight=Menu Highlight'
            'clMenuBar=MenuBar'
            'clNone=None'
            'clDefault=Default')
          ColorValue = clBtnShadow
          ColorDialogText = 'Custom...'
          NewColorText = 'Custom'
          Options = [coText, coSysColors]
          DroppedDownWidth = 130
          TabOrder = 2
        end
        object cbImplSelColor: TJvColorComboBox
          Left = 153
          Top = 152
          Width = 130
          Height = 20
          ColorNameMap.Strings = (
            'clBlack=Black'
            'clMaroon=Maroon'
            'clGreen=Green'
            'clOlive=Olive'
            'clNavy=Navy'
            'clPurple=Purple'
            'clTeal=Teal'
            'clGray=Gray'
            'clSilver=Silver'
            'clRed=Red'
            'clLime=Lime'
            'clYellow=Yellow'
            'clBlue=Blue'
            'clFuchsia=Fuchsia'
            'clAqua=Aqua'
            'clLtGray=Light Gray'
            'clDkGray=Dark Gray'
            'clWhite=White'
            'clMoneyGreen=Money Green'
            'clSkyBlue=Sky Blue'
            'clCream=Cream'
            'clMedGray=Medium Gray'
            'clScrollBar=ScrollBar'
            'clBackground=Background'
            'clActiveCaption=Active Caption'
            'clInactiveCaption=Inactive Caption'
            'clMenu=Menu'
            'clWindow=Window'
            'clWindowFrame=Window Frame'
            'clMenuText=Menu Text'
            'clWindowText=Window Text'
            'clCaptionText=Caption Text'
            'clActiveBorder=Active Border'
            'clInactiveBorder=Inactive Border'
            'clAppWorkSpace=Application Workspace'
            'clHighlight=Highlight'
            'clHighlightText=Highlight Text'
            'clBtnFace=Button Face'
            'clBtnShadow=Button Shadow'
            'clGrayText=Gray Text'
            'clBtnText=Button Text'
            'clInactiveCaptionText=Inactive Caption Text'
            'clBtnHighlight=Button Highlight'
            'cl3DDkShadow=3D Dark Shadow'
            'cl3DLight=3D Light'
            'clInfoText=Info Text'
            'clInfoBk=Info Background'
            'clHotLight=Hot Light'
            'clGradientActiveCaption=Gradient Active Caption'
            'clGradientInactiveCaption=Gradient Inactive Caption'
            'clMenuHighlight=Menu Highlight'
            'clMenuBar=MenuBar'
            'clNone=None'
            'clDefault=Default')
          ColorValue = clBlue
          ColorDialogText = 'Custom...'
          NewColorText = 'Custom'
          Options = [coText, coSysColors]
          DroppedDownWidth = 130
          TabOrder = 3
        end
      end
    end
    object tabPaths: TTabSheet
      Caption = 'Paths'
      ImageIndex = 1
      OnShow = tabPathsShow
      object Label9: TLabel
        Left = 8
        Top = 16
        Width = 96
        Height = 13
        Caption = '&List of library paths:'
        FocusControl = lvPaths
      end
      object lvPaths: TListView
        Left = 8
        Top = 31
        Width = 296
        Height = 178
        Anchors = [akLeft, akTop, akRight, akBottom]
        Columns = <
          item
            Width = -2
            WidthType = (
              -2)
          end>
        HideSelection = False
        MultiSelect = True
        ReadOnly = True
        RowSelect = True
        PopupMenu = popPaths
        ShowColumnHeaders = False
        TabOrder = 0
        ViewStyle = vsReport
        OnEnter = lvPathsEnter
        OnSelectItem = lvPathsSelectItem
      end
      object edLibPath: TEdit
        Left = 8
        Top = 218
        Width = 267
        Height = 21
        Anchors = [akLeft, akRight, akBottom]
        TabOrder = 1
      end
      object btnPathBrowse: TButton
        Left = 280
        Top = 218
        Width = 21
        Height = 21
        Action = acBrowse
        Anchors = [akRight, akBottom]
        TabOrder = 2
      end
      object btnReplace: TButton
        Left = 16
        Top = 250
        Width = 75
        Height = 25
        Action = acReplace
        Anchors = [akLeft, akBottom]
        TabOrder = 3
      end
      object btnAdd: TButton
        Left = 104
        Top = 250
        Width = 75
        Height = 25
        Action = acAdd
        Anchors = [akLeft, akBottom]
        TabOrder = 4
      end
      object btnDelete: TButton
        Left = 192
        Top = 250
        Width = 75
        Height = 25
        Action = acDelete
        Anchors = [akLeft, akBottom]
        TabOrder = 5
      end
    end
  end
  object alOptions: TActionList
    OnUpdate = alOptionsUpdate
    Left = 100
    Top = 112
    object acReplace: TAction
      Category = 'LibPaths'
      Caption = '&Replace'
      ShortCut = 16466
      OnExecute = acReplaceExecute
    end
    object acAdd: TAction
      Category = 'LibPaths'
      Caption = '&Add'
      ShortCut = 16429
      OnExecute = acAddExecute
    end
    object acDelete: TAction
      Category = 'LibPaths'
      Caption = '&Delete'
      ShortCut = 16430
      OnExecute = acDeleteExecute
    end
    object acBrowse: TAction
      Category = 'LibPaths'
      Caption = '...'
      ShortCut = 16397
      OnExecute = acBrowseExecute
    end
    object acDelInvalidPaths: TAction
      Category = 'LibPaths'
      Caption = 'Delete Invalid Paths'
      ShortCut = 24622
      OnExecute = acDelInvalidPathsExecute
    end
    object acGetD5Path: TAction
      Category = 'LibPaths'
      Caption = 'Delphi 5'
      OnExecute = acGetD5PathExecute
    end
    object acGetD6Path: TAction
      Category = 'LibPaths'
      Caption = 'Delphi 6'
      OnExecute = acGetD6PathExecute
    end
    object acGetD7Path: TAction
      Category = 'LibPaths'
      Caption = 'Delphi 7'
      OnExecute = acGetD7PathExecute
    end
    object acGetBCB5Path: TAction
      Category = 'LibPaths'
      Caption = 'C++ Builder 5'
      OnExecute = acGetBCB5PathExecute
    end
    object acGetBCB6Path: TAction
      Category = 'LibPaths'
      Caption = 'C++ Builder 6'
      OnExecute = acGetBCB6PathExecute
    end
    object acSystemPath: TAction
      Category = 'LibPaths'
      Caption = 'System Path'
      OnExecute = acSystemPathExecute
    end
    object acSelectAll: TAction
      Category = 'LibPaths'
      Caption = 'Select All'
      ShortCut = 16449
      OnExecute = acSelectAllExecute
    end
    object acInvertSelect: TAction
      Category = 'LibPaths'
      Caption = 'Invert Selection'
      ShortCut = 24649
      OnExecute = acInvertSelectExecute
    end
    object acUnselectAll: TAction
      Category = 'LibPaths'
      Caption = 'Unselect All'
      ShortCut = 24641
      OnExecute = acUnselectAllExecute
    end
  end
  object JvBrowseFolder1: TJvBrowseForFolderDialog
    Options = [odFileSystemDirectoryOnly, odStatusAvailable, odNewDialogStyle]
    Position = fpFormCenter
    RootDirectory = fdRootFolder
    Left = 206
    Top = 109
  end
  object popPaths: TPopupMenu
    Left = 150
    Top = 109
    object Add1: TMenuItem
      Action = acAdd
    end
    object Replace1: TMenuItem
      Action = acReplace
    end
    object Delete1: TMenuItem
      Action = acDelete
    end
    object N1: TMenuItem
      Caption = '-'
    end
    object InsertLibraryPath1: TMenuItem
      Caption = 'Insert Path'
      object Delphi51: TMenuItem
        Action = acGetD5Path
      end
      object Delphi61: TMenuItem
        Action = acGetD6Path
      end
      object Delphi71: TMenuItem
        Action = acGetD7Path
      end
      object N2: TMenuItem
        Caption = '-'
      end
      object CBuilder51: TMenuItem
        Action = acGetBCB5Path
      end
      object CBuilder61: TMenuItem
        Action = acGetBCB6Path
      end
      object N3: TMenuItem
        Caption = '-'
      end
      object SystemPath1: TMenuItem
        Action = acSystemPath
      end
    end
    object Select1: TMenuItem
      Caption = 'Select'
      object SelectAll1: TMenuItem
        Action = acSelectAll
      end
      object UnselectAll1: TMenuItem
        Action = acUnselectAll
      end
      object InvertSelection1: TMenuItem
        Action = acInvertSelect
      end
    end
    object N4: TMenuItem
      Caption = '-'
    end
    object DeleteInvalidPaths1: TMenuItem
      Action = acDelInvalidPaths
    end
  end
end

--- NEW FILE: OptionsFrm.pas ---
{$I JVCL.INC}
unit OptionsFrm;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, JvCombobox, JvColorCombo, ComCtrls, ActnList, ExtCtrls,
  JvBaseDlg, JvBrowseFolder, PersistForm, PersistSettings, Menus;

type
  // a TEdit that doesn't allow pasting of non-numeric text if Numeric is true
  TEdit = class(StdCtrls.TEdit)
  private
    procedure WMPaste(var Msg: TMessage); message WM_PASTE;
    function GetNumeric:boolean;
    procedure SetNumeric(Value:boolean);
  published
    property Numeric:boolean read GetNumeric write SetNumeric;
  end;

  TfrmOptions = class(TfrmPersistable)
    btnOK: TButton;
    btnCancel: TButton;
    pcOptions: TPageControl;
    tabGeneral: TTabSheet;
    tabPaths: TTabSheet;
    lvPaths: TListView;
    edLibPath: TEdit;
    btnPathBrowse: TButton;
    btnReplace: TButton;
    btnAdd: TButton;
    btnDelete: TButton;
    alOptions: TActionList;
    Label9: TLabel;
    JvBrowseFolder1: TJvBrowseForFolderDialog;
    acReplace: TAction;
    acAdd: TAction;
    acDelete: TAction;
    acBrowse: TAction;
    popPaths: TPopupMenu;
    acDelInvalidPaths: TAction;
    acGetD5Path: TAction;
    acGetD6Path: TAction;
    acGetD7Path: TAction;
    acGetBCB5Path: TAction;
    acGetBCB6Path: TAction;
    Add1: TMenuItem;
    Replace1: TMenuItem;
    Delete1: TMenuItem;
    N1: TMenuItem;
    InsertLibraryPath1: TMenuItem;
    CBuilder51: TMenuItem;
    CBuilder61: TMenuItem;
    N2: TMenuItem;
    Delphi51: TMenuItem;
    Delphi61: TMenuItem;
    Delphi71: TMenuItem;
    DeleteInvalidPaths1: TMenuItem;
    gbConnectors: TGroupBox;
    Label3: TLabel;
    Label4: TLabel;
    Label5: TLabel;
    Label6: TLabel;
    Label7: TLabel;
    Label8: TLabel;
    cbIntfColor: TJvColorComboBox;
    cbIntfSelColor: TJvColorComboBox;
    cbImplColor: TJvColorComboBox;
    cbImplSelColor: TJvColorComboBox;
    acSystemPath: TAction;
    N3: TMenuItem;
    SystemPath1: TMenuItem;
    acSelectAll: TAction;
    acInvertSelect: TAction;
    acUnselectAll: TAction;
    Select1: TMenuItem;
    SelectAll1: TMenuItem;
    UnselectAll1: TMenuItem;
    InvertSelection1: TMenuItem;
    N4: TMenuItem;
    gbShapes: TGroupBox;
    edShapeWidth: TEdit;
    edShapeHeight: TEdit;
    Label1: TLabel;
    Label2: TLabel;
    procedure acBrowseExecute(Sender: TObject);
    procedure acAddExecute(Sender: TObject);
    procedure acReplaceExecute(Sender: TObject);
    procedure acDeleteExecute(Sender: TObject);
    procedure alOptionsUpdate(Action: TBasicAction; var Handled: Boolean);
    procedure acGetD5PathExecute(Sender: TObject);
    procedure acGetD6PathExecute(Sender: TObject);
    procedure acGetD7PathExecute(Sender: TObject);
    procedure acGetBCB5PathExecute(Sender: TObject);
    procedure acGetBCB6PathExecute(Sender: TObject);
    procedure acDelInvalidPathsExecute(Sender: TObject);
    procedure lvPathsSelectItem(Sender: TObject; Item: TListItem;
      Selected: Boolean);
    procedure lvPathsEnter(Sender: TObject);
    procedure tabPathsShow(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure acSystemPathExecute(Sender: TObject);
    procedure acSelectAllExecute(Sender: TObject);
    procedure acInvertSelectExecute(Sender: TObject);
    procedure acUnselectAllExecute(Sender: TObject);
  private
    { Private declarations }
    { IPersistSettings }
    procedure ListViewAddPath(const S: string);
    procedure ListViewAddPaths(Version: integer; ForDelphi: boolean);
    procedure ListViewAddSystemPaths;
  protected
    procedure Load(Storage: TPersistStorage);override;
    procedure Save(Storage: TPersistStorage);override;
  public
    { Public declarations }
    class function Execute: boolean;
  end;


implementation
uses
{$IFNDEF COMPILER6_UP}
  FileCtrl,
{$ENDIF }
  DepWalkUtils, Registry;

{$R *.DFM}


{ TEdit }

function TEdit.GetNumeric: boolean;
begin
  HandleNeeded;
  if HandleAllocated then
    Result := GetWindowLong(Handle, GWL_STYLE) and ES_NUMBER = ES_NUMBER
  else
    Result := false;
end;

procedure TEdit.SetNumeric(Value: boolean);
begin
  HandleNeeded;
  if HandleAllocated then
  begin
    if Value then
      SetWindowLong(Handle, GWL_STYLE, GetWindowLong(Handle, GWL_STYLE) or ES_NUMBER)
    else
      SetWindowLong(Handle, GWL_STYLE, GetWindowLong(Handle, GWL_STYLE) and not ES_NUMBER);
  end;
end;

{$UNDEF RPLUS}
{$IFOPT R+}
{$R-}
{$DEFINE RPLUS}                
{$ENDIF}
procedure TEdit.WMPaste(var Msg: TMessage);
var S: string; V, C: integer;
begin
  S := Text;
  inherited;
  if Numeric then
  begin
    Val(Text, V, C);
    if C <> 0 then
      Text := S;
  end;
end;
{$IFDEF RPLUS}
{$UNDEF RPLUS}
{$R+}
{$ENDIF}

{ TfrmOptions }

class function TfrmOptions.Execute: boolean;
var Storage: TPersistStorage;
begin
  with self.Create(Application) do
  try
    pcOptions.ActivePageIndex := 0;
    Storage := PersistSettings.GetStorage;
    try
      Load(Storage);
      Result := ShowModal = mrOK;
      if Result then
      begin
        Save(Storage);
        Storage.UpdateFile;
      end;
    finally
      Storage.Free;
    end;
  finally
    Free;
  end;
end;

procedure TfrmOptions.acBrowseExecute(Sender: TObject);
begin
  JvBrowseFolder1.Directory := edLibPath.Text;
  if JvBrowseFolder1.Execute then
    edLibPath.Text := JvBrowseFolder1.Directory;
end;

procedure TfrmOptions.acAddExecute(Sender: TObject);
begin
  with lvPaths.Items.Add do
  begin

    Caption := edLibPath.Text;
    MakeVisible(true);
    Selected := true;
    Focused := true;
  end;
end;

procedure TfrmOptions.acReplaceExecute(Sender: TObject);
begin
  with lvPaths.Selected do
    Caption := edLibPath.Text;
end;

procedure TfrmOptions.acDeleteExecute(Sender: TObject);
var i, j: integer;
begin
  j := lvPaths.Items.Count;
  for i := lvPaths.Items.Count - 1 downto 0 do
    if lvPaths.Items[i].Selected then
    begin
      lvPaths.Items[i].Delete;
      j := i;
    end;
  if (j >= 0) and (j < lvPaths.Items.Count) then
  begin
    lvPaths.Items[j].MakeVisible(true);
    lvPaths.Items[j].Selected := true;
    lvPaths.Items[j].Focused := true;
  end;
  if lvPaths.CanFocus then lvPaths.SetFocus;
end;

procedure TfrmOptions.Load(Storage: TPersistStorage);
var S: TStringlist; i: integer;
begin
  inherited;

  edShapeHeight.Text := IntToStr(Storage.ReadInteger('Options', 'ShapeHeight', 50));
  edShapeWidth.Text := IntToStr(Storage.ReadInteger('Options', 'ShapeWidth', 100));
  cbIntfColor.ColorValue := Storage.ReadInteger('Options', 'IntfColor', clBlack);
  cbIntfSelColor.ColorValue := Storage.ReadInteger('Options', 'IntfSelColor', clRed);
  cbImplColor.ColorValue := Storage.ReadInteger('Options', 'ImplColor', clBtnShadow);
  cbImplSelColor.ColorValue := Storage.ReadInteger('Options', 'ImplSelColor', clBlue);
  lvPaths.Items.Clear;
  S := TStringlist.Create;
  try
    Storage.ReadSection('Library Paths', S);
    for i := 0 to S.Count - 1 do
      ListViewAddPath(S[i]);
  finally
    S.Free;
  end;
end;

procedure TfrmOptions.Save(Storage: TPersistStorage);
var i: integer;
begin
  inherited;
  i := StrToIntDef(edShapeHeight.Text, 50);
  if i < 40 then i := 40;
  Storage.WriteInteger('Options', 'ShapeHeight', i);
  i := StrToIntDef(edShapeWidth.Text, 100);
  if i < 50 then i := 50;
  Storage.WriteInteger('Options', 'ShapeWidth', i);

  Storage.WriteInteger('Options', 'IntfColor', cbIntfColor.ColorValue);
  Storage.WriteInteger('Options', 'IntfSelColor', cbIntfSelColor.ColorValue);
  Storage.WriteInteger('Options', 'ImplColor', cbImplColor.ColorValue);
  Storage.WriteInteger('Options', 'ImplSelColor', cbImplSelColor.ColorValue);

  Storage.EraseSection('Library Paths');
  for i := 0 to lvPaths.Items.Count - 1 do
    Storage.WriteString('Library Paths', lvPaths.Items[i].Caption, '');
end;

procedure TfrmOptions.ListViewAddPath(const S: string);
begin
  if (S <> '') and (lvPaths.FindCaption(0, S, false, true, true) = nil) then
    lvPaths.Items.Add.Caption := S;
end;

procedure TfrmOptions.ListViewAddPaths(Version: integer; ForDelphi: boolean);
var S: TStringlist; i: integer;
begin
  S := TStringlist.Create;
  try
    GetPathList(Version, ForDelphi, S);
    for i := 0 to S.Count - 1 do
      ListViewAddPath(S[i]);
  finally
    S.Free;
  end;
end;

procedure TfrmOptions.alOptionsUpdate(Action: TBasicAction;
  var Handled: Boolean);
begin
  acAdd.Enabled := DirectoryExists(edLibPath.Text)
    and (lvPaths.FindCaption(0, edLibPath.Text, false, true, true) = nil);
  acDelete.Enabled := (lvPaths.Selected <> nil);
  acReplace.Enabled := acAdd.Enabled and acDelete.Enabled;
  acDelInvalidPaths.Enabled := lvPaths.Items.Count > 0;
end;

procedure TfrmOptions.acGetD5PathExecute(Sender: TObject);
begin
  ListViewAddPaths(5, true);
end;


procedure TfrmOptions.acGetD6PathExecute(Sender: TObject);
begin
  ListViewAddPaths(6, true);
end;

procedure TfrmOptions.acGetD7PathExecute(Sender: TObject);
begin
  ListViewAddPaths(7, true);
end;

procedure TfrmOptions.acGetBCB5PathExecute(Sender: TObject);
begin
  ListViewAddPaths(5, false);
end;

procedure TfrmOptions.acGetBCB6PathExecute(Sender: TObject);
begin
  ListViewAddPaths(6, false);
end;

procedure TfrmOptions.acDelInvalidPathsExecute(Sender: TObject);
var i: integer;
begin
  for i := lvPaths.Items.Count - 1 downto 0 do
    if not DirectoryExists(lvPaths.Items[i].Caption) then
      lvPaths.Items[i].Delete;
end;

procedure TfrmOptions.lvPathsSelectItem(Sender: TObject; Item: TListItem;
  Selected: Boolean);
begin
  if Selected then
    edLibPath.Text := Item.Caption;
end;

procedure TfrmOptions.lvPathsEnter(Sender: TObject);
begin
  if (lvPaths.Selected = nil) and (lvPaths.Items.Count > 0) then
  begin
    lvPaths.Items[0].Selected := true;
    lvPaths.Items[0].Focused := true;
  end;
end;

procedure TfrmOptions.tabPathsShow(Sender: TObject);
begin
  if lvPaths.CanFocus then lvPaths.SetFocus;
end;


procedure TfrmOptions.FormCreate(Sender: TObject);
begin
  if edShapeWidth <> nil then
    edShapeWidth.Numeric := true;
  if ...
 
[truncated message content]