dependencywalkerdemomainform.pas

jvcl driver development envionment

{******************************************************************

                       JEDI-VCL Demo

 Copyright (C) 2002 Project JEDI

 Original author:

 Contributor(s):

 You may retrieve the latest version of this file at the JEDI-JVCL
 home page, located at http://jvcl.sourceforge.net

 The contents of this file are used with permission, subject to
 the Mozilla Public License Version 1.1 (the "License"); you may
 not use this file except in compliance with the License. You may
 obtain a copy of the License at
 http://www.mozilla.org/MPL/MPL-1_1Final.html

 Software distributed under the License is distributed on an
 "AS IS" basis, WITHOUT WARRANTY OF ANY KIND, either express or
 implied. See the License for the specific language governing
 rights and limitations under the License.

******************************************************************}

{$I jvcl.inc}

unit DependencyWalkerDemoMainForm;

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;
   *)
  TDependencyWalkerDemoMainFrm = class(TfrmPersistable)
    StatusBar1: TStatusBar;
    mmMain: TMainMenu;
    File1: TMenuItem;
    SelectFiles1: TMenuItem;
    N1: TMenuItem;
    Exit1: TMenuItem;
    Help1: TMenuItem;
    About1: TMenuItem;
    dlgSelectFiles: TOpenDialog;
    il32: TImageList;
    New1: TMenuItem;
    vertSplitter: TSplitter;
    pnlDiagram: TPanel;
    pnlSkipList: TPanel;
    lbSkipList: TListBox;
    pnlDiagramTitle: TPanel;
    pnlSkipListTitle: TPanel;
    popSkipList: TPopupMenu;
    Add1: TMenuItem;
    Delete1: TMenuItem;
    Edit1: TMenuItem;
    mnuSort: TMenuItem;
    N2: TMenuItem;
    Skiplist1: TMenuItem;
    Add2: TMenuItem;
    Delete2: TMenuItem;
    alMain: TActionList;
    acOpen: TAction;
    acExit: TAction;
    acSortName: TAction;
    acSortLinksTo: TAction;
    acSortLinksFrom: TAction;
    acInvertSort: TAction;
    acAdd: TAction;
    acDelete: TAction;
    acNew: TAction;
    acAbout: TAction;
    byName1: TMenuItem;
    byLinksTo1: TMenuItem;
    LinksFrom1: TMenuItem;
    N3: TMenuItem;
    InvertSort1: TMenuItem;
    popShape: TPopupMenu;
    acUnitStats: TAction;
    Statistics1: TMenuItem;
    Delete3: TMenuItem;
    N4: TMenuItem;
    acDelShape: TAction;
    acReport: TAction;
    Print1: TMenuItem;
    acFind: TAction;
    Find1: TMenuItem;
    cbToolbar: TCoolBar;
    tbStandard: TToolBar;
    tbSelectFiles: TToolButton;
    tbNew: TToolButton;
    ToolButton3: TToolButton;
    tbAddSkip: TToolButton;
    tbDelSkip: TToolButton;
    Actions: TImageList;
    tbReport: TToolButton;
    ToolButton7: TToolButton;
    tbFind: TToolButton;
    tbUnitStats: TToolButton;
    tbAbout: TToolButton;
    ToolButton11: TToolButton;
    tbDelShape: TToolButton;
    ToolButton13: TToolButton;
    acAddToSkipList: TAction;
    Addtoskiplist1: TMenuItem;
    View1: TMenuItem;
    acViewStatusBar: TAction;
    acViewSkipList: TAction;
    SpeedButton1: TSpeedButton;
    StatusBar2: TMenuItem;
    Skiplist2: TMenuItem;
    acViewToolBar: TAction;
    Toolbar1: TMenuItem;
    N6: TMenuItem;
    acRefresh: TAction;
    sb: TScrollBox;
    acSaveBMP: TAction;
    acCopy: TAction;
    popDiagram: TPopupMenu;
    CopyDiagramtoClipboard1: TMenuItem;
    CopyDiagramtoClipboard2: TMenuItem;
    N5: TMenuItem;
    SaveImage1: TMenuItem;
    N7: TMenuItem;
    dlgSaveImage: TSaveDialog;
    ToolButton1: TToolButton;
    ToolButton2: TToolButton;
    acSaveDiagram: TAction;
    acOpenDiagram: TAction;
    acParseUnit: TAction;
    Parseunit1: TMenuItem;
    N8: TMenuItem;
    acOptions: TAction;
    Options1: TMenuItem;
    N10: TMenuItem;
    Shapes1: TMenuItem;
    Addtoskiplist2: TMenuItem;
    Statistics2: TMenuItem;
    Delete4: TMenuItem;
    ParseUnit2: TMenuItem;
    N9: TMenuItem;
    N11: TMenuItem;
    acUnitView: TAction;
    ViewSource1: TMenuItem;
    ViewSource2: TMenuItem;
    acSortIntfImpl: TAction;
    byINterfaceImplementation1: TMenuItem;
    pnlStats: TPanel;
    Panel2: TPanel;
    SpeedButton2: TSpeedButton;
    horzSplitter: TSplitter;
    reStatistics: TRichEdit;
    acViewDetails: TAction;
    Statistics3: TMenuItem;
    acNoSort: TAction;
    none1: TMenuItem;
    procedure FormCreate(Sender: TObject);
    procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
    procedure sbMouseWheel(Sender: TObject; Shift: TShiftState;
      WheelDelta: Integer; MousePos: TPoint; var Handled: Boolean);
    procedure acOpenExecute(Sender: TObject);
    procedure acExitExecute(Sender: TObject);
    procedure acArrangeAction(Sender: TObject);
    procedure acInvertSortExecute(Sender: TObject);
    procedure acAddExecute(Sender: TObject);
    procedure acDeleteExecute(Sender: TObject);
    procedure acAboutExecute(Sender: TObject);
    procedure acNewExecute(Sender: TObject);
    procedure alMainUpdate(Action: TBasicAction; var Handled: Boolean);
    procedure acUnitStatsExecute(Sender: TObject);
    procedure acDelShapeExecute(Sender: TObject);
    procedure acReportExecute(Sender: TObject);
    procedure acFindExecute(Sender: TObject);
    procedure acAddToSkipListExecute(Sender: TObject);
    procedure acViewStatusBarExecute(Sender: TObject);
    procedure acViewSkipListExecute(Sender: TObject);
    procedure acViewToolBarExecute(Sender: TObject);
    procedure acRefreshExecute(Sender: TObject);
    procedure acSaveBMPExecute(Sender: TObject);
    procedure acCopyExecute(Sender: TObject);
    procedure acSaveDiagramExecute(Sender: TObject);
    procedure acOpenDiagramExecute(Sender: TObject);
    procedure sbMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure sbMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
    procedure sbMouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure acParseUnitExecute(Sender: TObject);
    procedure acOptionsExecute(Sender: TObject);
    procedure acUnitViewExecute(Sender: TObject);
    procedure sbExit(Sender: TObject);
    procedure acViewDetailsExecute(Sender: TObject);
    procedure acNoSortExecute(Sender: TObject);
  private
    { Private declarations }
    FFocusRectAnchor: TPoint;
    FFocusRect: TRect;
    FDrawing: boolean;

    FPrintFormat: TPrintFormat;
    FFileShapes, FLoadedFiles, FSearchPaths: TStringlist;
    FInitialDir: string;
    FLeft, FTop: integer;
    FOffsetX, FOffsetY: integer;
    FReload: boolean;
    FIntfLineColor, FImplLineColor, FIntfSelColor, FImplSelColor: TColor;

    function GetPersistStorage: TPersistStorage;
    procedure LoadSettings;
    procedure SaveSettings;
    function FindUnit(const Filename: string; const DefaultExt: string = '.pas'): string;
    procedure GetSearchPaths;
    procedure Clear(ClearAll: boolean);
    procedure CreatePrintOut(Strings: TStrings; AFormat: TPrintFormat = pfText);
    function GetFileShape(const Filename: string; var IsNew: boolean): TJvBitmapShape;
    procedure ParseUnits(Files, Errors: TStrings);
    procedure ParseUnit(const Filename: string; Errors: TStrings);
    function GetUses(const Filename: string; AUsesIntf, AUsesImpl: TStrings; var ErrorMessage: string): boolean;
    procedure Connect(StartShape, EndShape: TJvCustomDiagramShape; IsInterface: boolean);
    procedure LoadSkipList;
    procedure SaveSkipList;
    function InSkipList(const Filename: string): boolean;
    procedure Arrange(AList: TList);
    procedure DoShapeClick(Sender: TObject);
    procedure DoShapeMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
    procedure SortItems(ATag: integer; AList: TList; InvertedSort: boolean);

    procedure CreateDiagramBitmap(Bmp: TBitmap);
    procedure HighlightConnectors(AShape: TJvCustomDiagramShape);
    procedure DoBeginFocusRect(Sender: TObject; ARect: TRect; Button: TMouseButton; Shift: TShiftState; var Allow: boolean);
    procedure DoEndFocusRect(Sender: TObject; ARect: TRect; Button: TMouseButton; Shift: TShiftState);
    procedure DoFocusingRect(Sender: TObject; ARect: TRect; Shift: TShiftState; var Continue: boolean);
    procedure SetSelected(const Value: TJvCustomDiagramShape);
    procedure ShowInlineStats(AShape: TJvCustomDiagramShape);
    function GetSelected: TJvCustomDiagramShape;
  protected
    procedure Load(Storage: TPersistStorage); override;
    procedure Save(Storage: TPersistStorage); override;
  public
    { Public declarations }
    property Selected: TJvCustomDiagramShape read GetSelected write SetSelected;
  end;

var
  DependencyWalkerDemoMainFrm: TDependencyWalkerDemoMainFrm;

implementation

uses
  JCLParseUses,
  DepWalkUtils,
  Clipbrd,
  IniFiles,
  StatsFrm,
  ShellAPI,
  PrintFrm,
  Registry,
{$IFNDEF COMPILER6_UP}
  JvJCLUTils, JvJVCLUtils,
{$ENDIF}
  OptionsFrm;

{$R *.dfm}

(*
{ TListBox }

procedure TListBox.Load(Storage: TCustomIniFile);
begin
  Exit;
  if Storage.SectionExists(Name) then
  begin
    Sorted := false;
    Storage.ReadSection(Name, Items);
    Sorted := true;
  end;
end;

procedure TListBox.Save(Storage: TCustomIniFile);
var i: integer;
begin
  Exit;
  Storage.EraseSection(Name);
  for i := 0 to Items.Count - 1 do
    Storage.WriteString(Name, Items[i], '');
end;

*)

// utility functions

// (p3) copy Strings.Objects to TList

procedure CopyObjects(Strings: TStrings; AList: TList);
var
  i: integer;
begin
  for i := 0 to Strings.Count - 1 do
    AList.Add(Strings.Objects[i]);
end;

// (p3) returns the number of links that are connected to AShape

function GetNumLinksTo(AShape: TJvCustomDiagramShape): integer;
var
  i: integer;
begin
  Result := 0;
  for i := 0 to AShape.Parent.ControlCount - 1 do
    if (AShape.Parent.Controls[i] is TJvConnector) and
      (TJvConnector(AShape.Parent.Controls[i]).EndConn.Shape = AShape) then
      Inc(Result);
end;

// (p3) returns the number of links that are connected from AShape

function GetNumLinksFrom(AShape: TJvCustomDiagramShape): integer;
var
  i: integer;
begin
  Result := 0;
  for i := 0 to AShape.Parent.ControlCount - 1 do
    if (AShape.Parent.Controls[i] is TJvConnector) and
      (TJvConnector(AShape.Parent.Controls[i]).StartConn.Shape = AShape) then
      Inc(Result);
end;

// (p3) retrievs the shapes that AShape is connected to and store their name and pointers in Strings

procedure UsesUnits(AShape: TJvCustomDiagramShape; Strings: TStrings; const Ext: string = cPascalExt);
var i: integer;
begin
  Strings.Clear;
  for i := 0 to AShape.Parent.ControlCount - 1 do
    if (AShape.Parent.Controls[i] is TJvConnector) and
      (TJvConnector(AShape.Parent.Controls[i]).StartConn.Shape = AShape) then
      with TJvConnector(AShape.Parent.Controls[i]).EndConn do
        Strings.AddObject(ChangeFileExt(Shape.Caption.Text, Ext), Shape);
end;

// (p3) retrieves the shapes that connects to AShape and store their name and pointers in Strings

procedure UsedByUnits(AShape: TJvCustomDiagramShape; Strings: TStrings; const Ext: string = cPascalExt);
var i: integer;
begin
  Strings.Clear;
  for i := 0 to AShape.Parent.ControlCount - 1 do
    if (AShape.Parent.Controls[i] is TJvConnector) and
      (TJvConnector(AShape.Parent.Controls[i]).EndConn.Shape = AShape) then
      with TJvConnector(AShape.Parent.Controls[i]).StartConn do
        Strings.AddObject(ChangeFileExt(Shape.Caption.Text, Ext), Shape);
end;

// (p3) returns the first selected shape that isn't a TJvTextShape or a TJvConnector
// (NOTE: I'm relying on that TJvTextShape has a nil Caption and TJvConnectors cannot be selected)

function GetFirstSelectedShape(Parent: TWInControl): TJvCustomDiagramShape;
var i: integer;
begin
  for i := 0 to Parent.ControlCount - 1 do
    if (Parent.Controls[i] is TJvCustomDiagramShape) and TJvCustomDiagramShape(Parent.Controls[i]).Selected and
      // don't be fooled by captions (they are also TJvCustomDiagramShape):
    not (TJvCustomDiagramShape(Parent.Controls[i]).Caption = nil) then
    begin
      Result := TJvCustomDiagramShape(Parent.Controls[i]);
      Exit;
    end;
  Result := nil;
end;

// TList sorting functions:

function NameCompare(Item1, Item2: Pointer): integer;
begin
  Result := CompareText(
    TJvCustomDiagramShape(Item1).Caption.Text,
    TJvCustomDiagramShape(Item2).Caption.Text);
end;

function InvertNameCompare(Item1, Item2: Pointer): integer;
begin
  Result := -NameCompare(Item1, Item2);
end;

function MinLinksToCompare(Item1, Item2: Pointer): integer;
begin
  Result := GetNumLinksTo(Item1) - GetNumLinksTo(Item2);
  if Result = 0 then
    Result := GetNumLinksFrom(Item1) - GetNumLinksFrom(Item2);
  if Result = 0 then
    NameCompare(Item1, Item2);
end;

function MaxLinksToCompare(Item1, Item2: Pointer): integer;
begin
  Result := -MinLinksToCompare(Item1, Item2);
end;

function MinLinksFromCompare(Item1, Item2: Pointer): integer;
begin
  Result := GetNumLinksFrom(Item1) - GetNumLinksFrom(Item2);
  if Result = 0 then
    Result := GetNumLinksTo(Item1) - GetNumLinksTo(Item2);
  if Result = 0 then
    NameCompare(Item1, Item2);
end;

function MaxLinksFromCompare(Item1, Item2: Pointer): integer;
begin
  Result := -MinLinksFromCompare(Item1, Item2);
end;

function SortIntfCompare(Item1, Item2: Pointer): integer;
begin
  Result := TJvBitmapShape(Item1).ImageIndex - TJvBitmapShape(Item2).ImageIndex;
end;