dependencywalkerdemomainform.pas

East make Tray Icon in delphi

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

{ TDependencyWalkerDemoMainFrm }

{ IPersistSettings }

procedure TDependencyWalkerDemoMainFrm.Load(Storage: TPersistStorage);
begin
  // DO NOT LOCALIZE!
  if not FReload then
    inherited;
  FReload := true;
  acInvertSort.Checked := Storage.ReadBool(ClassName, 'InvertSort', false);
  FInitialDir := Storage.ReadString(ClassName, 'InitialDir', '');
  pnlSkipList.Width := Storage.ReadInteger(ClassName, 'vertSplitter', pnlSkipList.Width);
  pnlStats.Height := Storage.ReadInteger(ClassName, 'horzSplitter', pnlStats.Height);
  StatusBar1.Top := ClientHeight;
  if not acViewStatusBar.Checked = Storage.ReadBool(ClassName, acViewStatusBar.Name, acViewStatusBar.Checked) then
    acViewStatusBar.Execute; // toggle to other state
  if not acViewToolbar.Checked = Storage.ReadBool(ClassName, acViewToolbar.Name, acViewToolbar.Checked) then
    acViewToolbar.Execute;
  if not acViewSkipList.Checked = Storage.ReadBool(ClassName, acViewSkipList.Name, acViewSkipList.Checked) then
    acViewSkipList.Execute;
  if not acViewDetails.Checked = Storage.ReadBool(ClassName, acViewDetails.Name, acViewDetails.Checked) then
    acViewDetails.Execute;
  FOffsetX := Storage.ReadInteger('Options', 'ShapeWidth', 100);
  FOffsetY := Storage.ReadInteger('Options', 'ShapeHeight', 100);
  FIntfLineColor := Storage.ReadInteger('Options', 'IntfColor', clBlack);
  FIntfSelColor := Storage.ReadInteger('Options', 'IntfSelColor', clRed);
  FImplLineColor := Storage.ReadInteger('Options', 'ImplColor', clBtnShadow);
  FImplSelColor := Storage.ReadInteger('Options', 'ImplSelColor', clBlue);
end;

procedure TDependencyWalkerDemoMainFrm.Save(Storage: TPersistStorage);
begin
  inherited;
  Storage.WriteBool(ClassName, 'InvertSort', acInvertSort.Checked);
  Storage.WriteString(ClassName, 'InitialDir', FInitialDir);
  Storage.WriteInteger(ClassName, 'vertSplitter', pnlSkipList.Width);
  Storage.WriteInteger(ClassName, 'horzSplitter', pnlStats.Height);
  Storage.WriteBool(ClassName, acViewStatusBar.Name, acViewStatusBar.Checked);
  Storage.WriteBool(ClassName, acViewToolbar.Name, acViewToolbar.Checked);
  Storage.WriteBool(ClassName, acViewSkipList.Name, acViewSkipList.Checked);
  Storage.WriteBool(ClassName, acViewDetails.Name, acViewDetails.Checked);
end;

// main form utility functions

// (p3) highlights the connectors (arrows) going to and from AShape

procedure TDependencyWalkerDemoMainFrm.HighlightConnectors(AShape: TJvCustomDiagramShape);
var i: integer; C: TJvConnector; Changed: boolean;
begin
  Changed := false;
  for i := 0 to AShape.Parent.ControlCount - 1 do
  begin
    if AShape.Parent.Controls[i] is TJvConnector then
    begin
      C := TJvConnector(AShape.Parent.Controls[i]);
      if (C.StartConn.Shape = AShape) or (C.EndConn.Shape = AShape) then
      begin
        Changed := true;
        if C.LineColor = FIntfLineColor then
          C.LineColor := FIntfSelColor
        else if C.LineColor = FImplLineColor then
          C.LineColor := FImplSelColor
        else
          Changed := false;
        if Changed then
          C.Invalidate;
      end
      else // reset to standard color
      begin
        Changed := true;
        if C.LineColor = FIntfSelColor then
          C.LineColor := FIntfLineColor
        else if C.LineColor = FImplSelColor then
          C.LineColor := FImplLineColor
        else
          Changed := false;
        if Changed then
          C.Invalidate;
      end;
    end;
  end;
  if Changed then
  begin
    AShape.Parent.Repaint;
    //    AShape.BringToFront;
  end;
end;

// (p3) returns an existing or new shape
// Filename is checked against unique list

function TDependencyWalkerDemoMainFrm.GetFileShape(const Filename: string; var IsNew: boolean): TJvBitmapShape;
var
  i: integer;
  AFilename: string;
begin
  AFilename := FindUnit(Filename);
  i := FFileShapes.IndexOf(AFilename);
  IsNew := false;
  if i < 0 then
  begin
    IsNew := true;
    Result := TJvBitmapShape.Create(self);
    Result.Images := il32;
    Result.ImageIndex := cUnitUsedImageIndex; // always set "used" as default
    Result.Hint := AFilename;
    Result.ShowHint := True;
    Result.OnClick := DoShapeClick;
    Result.OnDblClick := acParseUnitExecute;
    Result.OnMouseDown := DoShapeMouseDown;

    Result.PopupMenu := popShape;
    Result.Top := FTop;
    Result.Left := FLeft;
    Result.Parent := sb;
    Result.Caption := TJvTextShape.Create(self);
    Result.Caption.Parent := sb;
    Result.Caption.Enabled := false;
    Result.Caption.Tag := integer(Result);
    Result.Caption.Text := ChangeFileExt(ExtractFilename(AFilename), '');
    Result.AlignCaption(taLeftJustify);
    Result.BringToFront;
    i := FFileShapes.AddObject(AFilename, Result);
  end;
  Result := TJvBitmapShape(FFileShapes.Objects[i]);
end;

// (p3) connects two shapes with a single head arrow pointing towards EndShape
// colors differently depending on if it's interface link or an implementation link

procedure TDependencyWalkerDemoMainFrm.Connect(StartShape, EndShape: TJvCustomDiagramShape; IsInterface: boolean);
var
  arr: TJvSingleHeadArrow;
begin
  arr := TJvSingleHeadArrow.Create(self);
  with arr do
  begin
    if IsInterface then
      LineColor := FIntfLineColor
    else
      LineColor := FImplLineColor;
    // Set the start connection
    StartConn.Side := csRight;
    StartConn.Offset := StartShape.Height div 2;
    StartConn.Shape := StartShape;
    // Set the end connection
    EndConn.Side := csLeft;
    EndConn.Offset := EndShape.Height div 2;
    EndConn.Shape := EndShape;
    // Ensure the size is correct
    SetBoundingRect;
    Parent := sb;
    SendToBack;
  end;
end;

// (p3) Builds a list of all units used by Filename and adds the unit names to AUses
// returns true if no errors, any exception message is added to ErrorMessage but th eprocessing
// is not aborted

function TDependencyWalkerDemoMainFrm.GetUses(const Filename: string; AUsesIntf, AUsesImpl: TStrings; var ErrorMessage: string): boolean;
var
  UL: TUsesList;
  i: integer;
  P: PChar;
begin
  Result := true;
  try
    with TMemoryStream.Create do
    try
      LoadFromFile(Filename);
      AUsesIntf.Clear;
      AUSesImpl.Clear;
      P := PChar(Memory);
      with TUnitGoal.Create(P) do
      try
        UL := UsesIntf;
        for i := 0 to UL.Count - 1 do
          if not InSkipList(UL.Items[i]) then
            AUsesIntf.Add(UL.Items[i]);
        UL := UsesImpl;
        for i := 0 to UL.Count - 1 do
          if not InSkipList(UL.Items[i]) then
            AUsesImpl.Add(UL.Items[i]);
      finally
        Free;
      end;
    finally
      Free;
    end;
  except
    on E: EFOpenError do
    begin
      Result := false;
      ErrorMessage := E.Message + #13#10 + SCheckPaths;
    end;
    on E: Exception do
    begin
      Result := false;
      ErrorMessage := E.Message;
    end;
  end;
end;

// (p3) reads a single file's uses. Creates, connects and positions the shapes as necessary

procedure TDependencyWalkerDemoMainFrm.ParseUnit(const Filename: string; Errors: TStrings);
var
  AUsesIntf, AUsesImpl: TStringlist;
  FS: TJvBitmapShape;
  i: integer;
  AFilename, ErrMsg: string;
  b, IsNew: boolean;
begin
  AFilename := FindUnit(Filename);
  if InSkipList(AFilename) then
    Exit;
  AUsesIntf := TStringlist.Create;
  AUsesImpl := TStringlist.Create;
  try
    b := GetUses(AFilename, AUsesIntf, AUsesImpl, ErrMsg);
    if not b and (Errors <> nil) then
      Errors.Add(Format('%s: %s', [AFilename, ErrMsg]));
    FS := GetFileShape(AFilename, IsNew);
    if b then
      FS.ImageIndex := cUnitParsedImageIndex; // this is a parsed file
    if IsNew then
    begin
      Inc(FLeft, FOffsetX);
      FLoadedFiles.Add(AFilename);
    end;
    for i := 0 to AUsesIntf.Count - 1 do
    begin
      //add the used unit and connect to the parsed file
      Connect(FS, GetFileShape(AUsesIntf[i], IsNew), true);
      if IsNew then
        Inc(FTop, FOffsetY);
    end;
    for i := 0 to AUsesImpl.Count - 1 do
    begin
      //add the used unit and connect to the parsed file
      Connect(FS, GetFileShape(AUsesImpl[i], IsNew), false);
      if IsNew then
        Inc(FTop, FOffsetY);
    end;
  finally
    AUsesIntf.Free;
    AUsesImpl.Free;
  end;
  Application.ProcessMessages;
end;

// (p3) reads a list of filenames and calls ParseUnit for each

procedure TDependencyWalkerDemoMainFrm.ParseUnits(Files, Errors: TStrings);
var
  i, aCount: integer;
begin
  WaitCursor;
  SuspendRedraw(sb, true);
  try
    for i := 0 to Files.Count - 1 do
    begin
      StatusBar1.Panels[0].Text := Files[i];
      StatusBar1.Update;
      aCount := FFileShapes.Count;
      FTop := cStartY;
      ParseUnit(Files[i], Errors);
      if aCount < FFileShapes.Count then
        Inc(FLeft, FOffsetX);
    end;
  finally
    SuspendRedraw(sb, false);
  end;
  StatusBar1.Panels[0].Text := Format(SParsedStatusFmt, [Files.Count, FFileShapes.Count]);
end;

// (p3) tries to find Filename and return it's full path and filename
// if it fails, the original Filename is returned instead

function TDependencyWalkerDemoMainFrm.FindUnit(const Filename: string; const DefaultExt: string = '.pas'): string;
var i: integer;
begin
  Result := ExpandUNCFileName(Filename);
  if FileExists(Result) then
    Exit;
  Result := ChangeFileExt(Result, DefaultExt);
  if FileExists(Result) then
    Exit;
  Result := ExtractFilePath(dlgSelectFiles.FileName) + ExtractFileName(Result);
  if FileExists(Result) then
    Exit;

  if FSearchPaths = nil then
    GetSearchPaths;
  Result := ExtractFileName(Result);
  for i := 0 to FSearchPaths.Count - 1 do
    if FileExists(IncludeTrailingPathDelimiter(FSearchPaths[i]) + Result) then
    begin
      Result := IncludeTrailingPathDelimiter(FSearchPaths[i]) + Result;
      Exit;
    end;

  Result := Filename;
end;

// (p3) removes all shapes and links

procedure TDependencyWalkerDemoMainFrm.Clear(ClearAll: boolean);
// var i: integer;
begin
  WaitCursor;
  FreeAndNil(FSearchPaths);
  FFileShapes.Clear;
  if ClearAll then
    FLoadedFiles.Clear;
  TJvCustomDiagramShape.DeleteAllShapes(sb);
  FLeft := cStartX;
  FTop := cStartY;
//  Selected := nil;
  StatusBar1.Panels[0].Text := SStatusReady;
end;

procedure TDependencyWalkerDemoMainFrm.FormCreate(Sender: TObject);
begin
  SetStorageHandler(GetPersistStorage);
  FFileShapes := TStringlist.Create;
  FLoadedFiles := TStringlist.Create;
  FFileShapes.Sorted := true;
  FFileShapes.Duplicates := dupError;
  FLeft := cStartX;
  FTop := cStartY;
  LoadSettings;
end;

procedure TDependencyWalkerDemoMainFrm.LoadSkipList;
var
  //  i: integer;
  AFilename: string;
begin
  AFilename := ExtractFilePath(Application.Exename) + 'SkipList.txt';
  if FileExists(AFilename) then
  begin
    lbSkipList.Sorted := false;
    lbSkipList.Items.LoadFromFile(AFilename);
    {    for i := lbSkipList.Items.Count - 1 downto 0 do
        begin
          lbSkipList.Items[i] := ExtractFileName(ChangeFileExt(lbSkipList.Items[i], ''));
          if lbSkipList.Items[i] = '' then
            lbSkipList.Items.Delete(i);
        end; }
    lbSkipList.Sorted := true;
  end;
end;

procedure TDependencyWalkerDemoMainFrm.SaveSkipList;
begin
  lbSkipList.Items.SaveToFile(ExtractFilePath(Application.Exename) + 'SkipList.txt');
end;

function TDependencyWalkerDemoMainFrm.InSkipList(const Filename: string): boolean;
begin
  Result := (lbSkipList.Items.IndexOf(ChangeFileExt(ExtractFileName(Filename), '')) > -1);
end;

// (p3) arranges the shapes in AList into a grid of rows and columns
// tries to make the grid as "square" as possible (Rows = Cols)

procedure TDependencyWalkerDemoMainFrm.Arrange(AList: TList);
var
  Cols, i: integer;
  FS: TJvCustomDiagramShape;
begin
  if AList.Count = 0 then
    Exit;
  Cols := round(sqrt(AList.Count));
  FLeft := 0;
  FTop := 0;
  for i := 0 to AList.Count - 1 do
  begin
    if (i mod Cols = 0) then // new row or first row
    begin
      FLeft := cStartX;
      if i = 0 then
        Inc(FTop, cStartY) // first row
      else
        Inc(FTop, FOffsetY);
    end;
    FS := TJvCustomDiagramShape(AList[i]);
    FS.SetBounds(FLeft, FTop, FS.Width, FS.Height);
    Inc(FLeft, FOffsetX);
  end;
  Dec(FLeft, FOffsetX);
end;

function iff(Condition: boolean; TrueValue, FalseValue: integer): integer;
begin
  if Condition then
    Result := TrueValue
  else
    Result := FalseValue;
end;

procedure TDependencyWalkerDemoMainFrm.SortItems(ATag: integer; AList: TList; InvertedSort: boolean);
begin
  case ATag of
    0:
      if InvertedSort then
        AList.Sort(InvertNameCompare)
      else
        AList.Sort(NameCompare);
    1:
      if InvertedSort then
        AList.Sort(MaxLinksToCompare)
      else
        AList.Sort(MinLinksToCompare);
    2:
      if InvertedSort then
        AList.Sort(MaxLinksFromCompare)
      else
        AList.Sort(MinLinksFromCompare);
    3:
      if InvertedSort then