📄 dependencywalkerdemomainform.pas

📁 East make Tray Icon in delphi
💻 PAS
📖 第 1 页 / 共 4 页
字号:
        AList.Sort(SortImplCompare)
      else
        AList.Sort(SortIntfCompare);
  else
    Exit; // no sorting
  end;
end;

procedure TDependencyWalkerDemoMainFrm.CreatePrintOut(Strings: TStrings; AFormat: TPrintFormat = pfText);
var
  i, j, ATag: integer;
  UsedByStrings, UsesStrings: TStringlist;
  AList: TList;
  AShape: TJvBitmapShape;
begin
  UsedByStrings := TStringlist.Create;
  UsesStrings := TStringlist.Create;
  AList := TList.Create;
  try
    Strings.Clear;
    // (p3) use same sorting as in the current view (defaults to "by Name"):
    CopyObjects(FFileShapes, AList);
    if acSortName.Checked then
      ATag := acSortName.Tag
    else if acSortLinksTo.Checked then
      ATag := acSortLinksTo.Tag
    else if acSortLinksFrom.Checked then
      ATag := acSortLinksFrom.Tag
    else
      ATag := -1; // no need to sort: FFileShapes already sorted by name
    SortItems(ATag, AList, acInvertSort.Checked);
    for i := 0 to AList.Count - 1 do
    begin
      AShape := TJvBitmapShape(AList[i]);
      UsesUnits(AShape, UsesStrings, '');
      UsedByUnits(AShape, UsedByStrings, '');
      case AFormat of
        pfText:
          begin
            Strings.Add(AShape.Caption.Text);
            Strings.Add('  ' + SUsesColon);
            if UsesStrings.Count < 1 then
              Strings.Add('    ' + SNone)
            else
              for j := 0 to UsesStrings.Count - 1 do
                Strings.Add('    ' + UsesStrings[j]);
            Strings.Add('  ' + SUsedByColon);
            if UsedByStrings.Count < 1 then
              Strings.Add('    ' + SNone)
            else
              for j := 0 to UsedByStrings.Count - 1 do
                Strings.Add('    ' + UsedByStrings[j]);
          end;
        pfHTML:
          begin
            Strings.Add(Format('<h3>%s:</h3>', [AShape.Caption.Text]));
            if UsesStrings.Count > 0 then
              Strings.Add(Format('<b>%s</b>', [SUsesColon]));
            Strings.Add('<ul>');
            for j := 0 to UsesStrings.Count - 1 do
              Strings.Add('<li>' + UsesStrings[j]);
            Strings.Add('</ul>');
            if UsedByStrings.Count > 0 then
              Strings.Add(Format('<b>%s</b>', [SUsedByColon]));
            Strings.Add('<ul>');
            for j := 0 to UsedByStrings.Count - 1 do
              Strings.Add('<li>' + UsedByStrings[j]);
            Strings.Add('</ul>');
          end;
        pfXML:
          begin
            // DO NOT LOCALIZE!
            Strings.Add(Format('<UNIT Name="%s">', [AShape.Caption.Text]));
            for j := 0 to UsesStrings.Count - 1 do
              Strings.Add(Format('<USES Name="%s" />', [UsesStrings[j]]));
            for j := 0 to UsedByStrings.Count - 1 do
              Strings.Add(Format('<USEDBY Name="%s" />', [UsedByStrings[j]]));
            Strings.Add('</UNIT>');
          end;
      end; // case
    end;
    // insert headers and footers:
    case AFormat of
      pfXML:
        begin
          // DO NOT LOCALIZE!
          Strings.Insert(0, '<?xml version="1.0" encoding="UTF-8" standalone="yes"?><DependencyWalker>');
          Strings.Add('</DependencyWalker>');
        end;
      pfHTML:
        begin
          // DO NOT LOCALIZE!
          Strings.Insert(0, Format('<html><head><title>%s</title><link rel="stylesheet" href="DependencyWalker.css" type="text/css"></head>', [SDependencyWalkerTitle]));
          Strings.Insert(1, Format('<body><h1>%s</h1><hr>', [SDependencyWalkerTitle]));
          Strings.Add('</body></html>');
        end;
    end; //
  finally
    UsedByStrings.Free;
    UsesStrings.Free;
    AList.Free;
  end;
end;

procedure TDependencyWalkerDemoMainFrm.LoadSettings;
begin
  LoadSkipList;
  AutoLoad(self);
  Application.HintShortCuts := true;
end;

procedure TDependencyWalkerDemoMainFrm.SaveSettings;
begin
  SaveSkipList;
  AutoSave(self);
end;

function Max(Val1, Val2: integer): integer;
begin
  Result := Val1;
  if Val2 > Val1 then
    Result := Val2;
end;

// (p3) probably not the most effective code in the world but it does seem to work...

procedure PaintScrollBox(sb: TScrollBox; Canvas: TCanvas);
var sbPos: TPoint;
  tmpPos: integer;
begin
  sbPos.X := sb.HorzScrollBar.Position;
  sbPos.Y := sb.VertScrollBar.Position;
  try
    sb.HorzScrollBar.Position := 0;
    sb.VertScrollBar.Position := 0;
    while true do
    begin
      while true do
      begin
        sb.PaintTo(Canvas.Handle, sb.HorzScrollBar.Position, sb.VertScrollBar.Position);
        tmpPos := sb.VertScrollBar.Position;
        sb.VertScrollBar.Position := sb.VertScrollBar.Position + sb.ClientHeight;
        if sb.VertScrollBar.Position = tmpPos then
          Break;
      end;
      sb.VertScrollBar.Position := 0;
      tmpPos := sb.HorzScrollBar.Position;
      sb.HorzScrollBar.Position := sb.HorzScrollBar.Position + sb.ClientWidth;
      if sb.HorzScrollBar.Position = tmpPos then
        Break;
    end;
  finally
    sb.HorzScrollBar.Position := sbPos.X;
    sb.VertScrollBar.Position := sbPos.Y;
  end;
end;

procedure TDependencyWalkerDemoMainFrm.CreateDiagramBitmap(Bmp: TBitmap);
begin
  // add some extra pixels around the edges...
  bmp.Width := Max(sb.ClientWidth, sb.HorzScrollBar.Range) + 10;
  bmp.Height := Max(sb.ClientHeight, sb.VertScrollBar.Range) + 10;
  bmp.Canvas.Brush.Color := sb.Color;
  bmp.Canvas.FillRect(Rect(0, 0, bmp.Width, bmp.Height));
  PaintScrollBox(sb, bmp.Canvas);
end;

procedure TDependencyWalkerDemoMainFrm.GetSearchPaths;
var ini: TCustomIniFile;
begin
  FreeAndNil(FSearchPaths);
  FSearchPaths := TStringlist.Create;
  ini := GetStorage;
  try
    ini.ReadSection('Library Paths', FSearchPaths);
  finally
    ini.Free;
  end;
end;

// (p3) create and return the type of TPersistStorage we are currently using

// main form event handlers (normal, run-time assigned) and actions

// (p3) bring the Shape to the front so we can see it

procedure TDependencyWalkerDemoMainFrm.DoShapeClick(Sender: TObject);
begin
  TJvBitmapShape(Sender).BringToFront;
  TJvBitmapShape(Sender).Caption.BringToFront;
end;

// (p3) highlight the shapes connectors when it is selected

procedure TDependencyWalkerDemoMainFrm.DoShapeMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  inherited;
  if Button = mbLeft then
    HighLightConnectors(Sender as TJvCustomDiagramShape);
  ShowInlineStats(Sender as TJvCustomDiagramShape);
end;

procedure TDependencyWalkerDemoMainFrm.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
  //  Clear;
  SaveSettings;
  FFileShapes.Free;
  FLoadedFiles.Free;
  FreeAndNil(FSearchPaths);
end;

procedure TDependencyWalkerDemoMainFrm.sbMouseWheel(Sender: TObject;
  Shift: TShiftState; WheelDelta: Integer; MousePos: TPoint;
  var Handled: Boolean);
begin
  Handled := true;
  with sb do
    if (ssShift in Shift) and (HorzScrollBar.IsScrollBarVisible) then
      HorzScrollBar.Position := HorzScrollBar.Position - iff(ssCtrl in Shift, WheelDelta * 3, WheelDelta)
    else if (VertScrollBar.IsScrollBarVisible) then
      VertScrollBar.Position := VertScrollBar.Position - iff(ssCtrl in Shift, WheelDelta * 3, WheelDelta);
end;

procedure TDependencyWalkerDemoMainFrm.acOpenExecute(Sender: TObject);
var
  Errors: TStringlist; // S: string;
begin
  ForceCurrentDirectory := true;
  dlgSelectFiles.InitialDir := FInitialDir;
  if dlgSelectFiles.Execute then
  begin
    FInitialDir := ExtractFilePath(dlgSelectFiles.Filename);
    Errors := TStringlist.Create;
    try
      ParseUnits(dlgSelectFiles.Files, Errors);
      if Errors.Count > 0 then
      begin
        ShowMessageFmt(SParseErrorsFmt, [Errors.Text]);
        // copy to clipboard as well
        Clipboard.SetTextBuf(PChar(Errors.Text));
      end;
    finally
      Errors.Free;
    end;
  end;
end;

procedure TDependencyWalkerDemoMainFrm.acExitExecute(Sender: TObject);
begin
  Close;
end;

procedure TDependencyWalkerDemoMainFrm.acArrangeAction(Sender: TObject);
var
  AList: TList;
begin
  WaitCursor;
  SuspendRedraw(sb, true);
  TJvCustomDiagramShape.UnselectAllShapes(sb);
  Selected := nil;
  AList := TList.Create;
  try
    FLeft := cStartX;
    FTop := cStartY;
    // (p3) reset here so it will be easier to check wich one is used as radio-item
    // (actions doesn't support RadioItem functionality but menus do):
    acSortName.Checked := false;
    acSortLinksTo.Checked := false;
    acSortLinksFrom.Checked := false;
    acSortIntfImpl.Checked := false;

    sb.HorzScrollBar.Position := 0;
    sb.VertScrollBar.Position := 0;
    CopyObjects(FFileShapes, AList);
    SortItems((Sender as TAction).Tag, AList, acInvertSort.Checked);
    Arrange(AList);
  finally
    SuspendRedraw(sb, false);
    AList.Free;
  end;
  TAction(Sender).Checked := true;
end;

procedure TDependencyWalkerDemoMainFrm.acInvertSortExecute(Sender: TObject);
begin
  acInvertSort.Checked := not acInvertSort.Checked;
end;

procedure TDependencyWalkerDemoMainFrm.acAddExecute(Sender: TObject);
var
  S: string;
begin
  S := '';
  if InputQuery(SAddSkipListTitle, SAddSkipListCaption, S) and (S <> '') and not InSkipList(S) then
    lbSkipList.Items.Add(ChangeFileExt(ExtractFilename(S), ''));
end;

procedure TDependencyWalkerDemoMainFrm.acDeleteExecute(Sender: TObject);
var
  i: integer;
begin
  if not YesNo(SConfirmDelete, SDelSelItemsPrompt) then
    Exit;
  with lbSkipList do
    for i := Items.Count - 1 downto 0 do
      if Selected[i] then
        Items.Delete(i);
end;

procedure TDependencyWalkerDemoMainFrm.acAboutExecute(Sender: TObject);
begin
  ShowMessage(SAboutText);
end;

procedure TDependencyWalkerDemoMainFrm.acNewExecute(Sender: TObject);
begin
  if YesNo(SConfirmClear, SClearDiagramPrompt) then
  begin
    Clear(true);
    LoadSettings;
  end;
end;

procedure TDependencyWalkerDemoMainFrm.alMainUpdate(Action: TBasicAction;
  var Handled: Boolean);
begin
  acDelete.Enabled := lbSkipList.SelCount > 0;
  acNew.Enabled := sb.ControlCount > 0;
  acFind.Enabled := acNew.Enabled;
  acReport.Enabled := acNew.Enabled;
  acCopy.Enabled := acNew.Enabled;
  acSaveBMP.Enabled := acCopy.Enabled;
  mnuSort.Enabled := sb.ControlCount > 1;

  acDelShape.Enabled := Selected <> nil;
  acUnitStats.Enabled := acDelShape.Enabled;
  acAddToSkipList.Enabled := acDelShape.Enabled;
  acParseUnit.Enabled := acDelShape.Enabled;
  acUnitView.Enabled := acDelShape.Enabled;
end;

procedure TDependencyWalkerDemoMainFrm.acUnitStatsExecute(Sender: TObject);
var
  AShape: TJvCustomDiagramShape;
  i: integer;
  S: string;
  UsedByStrings, UsesStrings: TStringlist;
begin
  AShape := Selected;
  if AShape = nil then
    AShape := TJvCustomDiagramShape(popShape.PopupComponent);
  if AShape = nil then
    Exit;

  // (p3) collect the stats for the file
  // since we can't guarantee that the file can be found
  // on the system, only collect what we know explicitly (name, links):
  UsedByStrings := TStringlist.Create;
  UsesStrings := TStringlist.Create;
  try
    UsesUnits(AShape, UsesStrings);
    UsedByUnits(AShape, UsedByStrings);
    if UsedByStrings.Count < 1 then
      UsedByStrings.Add(SNone);
    if UsesStrings.Count < 1 then
      UsesStrings.Add(SNone);
    i := FFileShapes.IndexOfObject(AShape);
    if i > -1 then
      S := FFileShapes[i]
    else
      S := ChangeFileExt(AShape.Caption.Text, cPascalExt);
    TfrmUnitStats.Execute(S, UsedByStrings, UsesStrings);
  finally
    UsedByStrings.Free;
    UsesStrings.Free;
  end;
end;

procedure TDependencyWalkerDemoMainFrm.acDelShapeExecute(Sender: TObject);
var AShape: TJvCustomDiagramShape;
  i: integer;
begin
  // (p3) Can't use TJvCustomDiagramShape.DeleteSelectedShapes here since
  // we need to remove the item from the FFileShapes list as well:
  AShape := Selected;
  if (AShape <> nil) and YesNo(SConfirmDelete, Format(SDelSelItemFmt, [AShape.Caption.Text])) then
  begin
    repeat
      i := FFileShapes.IndexOfObject(AShape);
      if i > -1 then
        FFileShapes.Delete(i);
      AShape.Free;
      AShape := Selected;
    until AShape = nil;
  end;
end;

procedure TDependencyWalkerDemoMainFrm.acReportExecute(Sender: TObject);
const
  // DO NOT LOCALIZE!
  cFormatExt: array[TPrintFormat] of PChar = ('.txt', '.htm', '.xml');
var
  S: TStringlist;
  AFileName: string;
  Ini: TPersistStorage;
begin
  if not TfrmPrint.Execute then
    Exit;
  Ini := GetStorage;
  try
    FPrintFormat := TPrintFormat(Ini.ReadInteger('Printing', 'Print Format', Ord(FPrintFormat)));
  finally
    Ini.Free;
  end;

  WaitCursor;
  S := TStringlist.Create;
  try
    CreatePrintOut(S, FPrintFormat);
    if S.Count > 0 then
    begin
      AFilename := ExtractFilePath(Application.Exename) + 'DependencyWalker' + cFormatExt[FPrintFormat];
      S.SaveToFile(AFilename);
      // show in default viewer: let user decide whether to print or not after viewing
      ShellExecute(Handle, 'open', PChar(AFilename), nil, nil, SW_SHOWNORMAL);
    end;
  finally
    S.Free;
  end;
end;
⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -