dependencywalkerdemomainform.pas

East make Tray Icon in delphi

procedure TDependencyWalkerDemoMainFrm.acFindExecute(Sender: TObject);
var S: string;
  i: integer;
begin
  S := '';
  if InputQuery(SFindTitle, SFindNameColon, S) and (S <> '') then
  begin
    i := FFileShapes.IndexOf(S);
    if i < 0 then
      ShowMessageFmt(SFindNotFoundFmt, [S])
    else
    begin
      TJvCustomDiagramShape(FFileShapes.Objects[i]).Selected := true;
      // (p3) the caption (mostly) extends further to the right than the image,
      // so scroll the caption to make as much of the shape as possible visible
      sb.ScrollInView(TJvCustomDiagramShape(FFileShapes.Objects[i]).Caption);
    end;
  end;
end;

procedure TDependencyWalkerDemoMainFrm.acAddToSkipListExecute(Sender: TObject);
var ASHape: TJvCustomDiagramShape;
begin
  AShape := Selected;
  if AShape <> nil then
  begin
    lbSkipList.Items.Add(ChangeFileExt(ExtractFilename(AShape.Caption.Text), ''));
    acDelShape.Execute;
  end;
end;

procedure TDependencyWalkerDemoMainFrm.acViewStatusBarExecute(Sender: TObject);
begin
  acViewStatusBar.Checked := not acViewStatusBar.Checked;
  StatusBar1.Visible := acViewStatusBar.Checked;
end;

procedure TDependencyWalkerDemoMainFrm.acViewSkipListExecute(Sender: TObject);
begin
  acViewSkipList.Checked := not acViewSkipList.Checked;
  pnlSkipList.Visible := acViewSkipList.Checked;
  vertSplitter.Visible := acViewSkipList.Checked;
  if pnlSkipList.Visible then
    vertSplitter.Left := pnlSkipList.Left;
end;

procedure TDependencyWalkerDemoMainFrm.acViewToolBarExecute(Sender: TObject);
begin
  acViewToolBar.Checked := not acViewToolBar.Checked;
  cbToolbar.Visible := acViewToolBar.Checked;
end;

procedure TDependencyWalkerDemoMainFrm.acViewDetailsExecute(Sender: TObject);
begin
  acViewDetails.Checked := not acViewDetails.Checked;
  pnlStats.Visible := acViewDetails.Checked;
  horzSplitter.Visible := pnlStats.Visible;
  if pnlStats.Visible then
    horzSplitter.Top := pnlStats.Top - 1;
end;

procedure TDependencyWalkerDemoMainFrm.acRefreshExecute(Sender: TObject);
begin
  sb.Invalidate;
end;

procedure TDependencyWalkerDemoMainFrm.acSaveBMPExecute(Sender: TObject);
var b: TBitmap;
begin
  if dlgSaveImage.Execute then
  begin
    b := TBitmap.Create;
    try
      CreateDiagramBitmap(b);
      b.SaveToFile(dlgSaveImage.Filename);
    finally
      b.Free;
    end;
    ShellExecute(Handle, 'open', PChar(dlgSaveImage.Filename), nil, nil, SW_SHOWNORMAL);
  end;
end;

procedure TDependencyWalkerDemoMainFrm.acCopyExecute(Sender: TObject);
var
  AFormat: Word;
  b: TBitmap;
  AData: Cardinal;
  APalette: HPALETTE;
begin
  b := TBitmap.Create;
  try
    CreateDiagramBitmap(b);
    b.SaveToClipboardFormat(AFormat, AData, APalette);
    Clipboard.SetAsHandle(AFormat, AData);
  finally
    b.Free;
  end;
end;

procedure TDependencyWalkerDemoMainFrm.acSaveDiagramExecute(Sender: TObject);
begin
  with TSaveDialog.Create(nil) do
  try
    if Execute then
      TJvCustomDiagramShape.SaveToFile(Filename, sb);
  finally
    Free;
  end;
end;

procedure TDependencyWalkerDemoMainFrm.acOpenDiagramExecute(Sender: TObject);
begin
  with TOpenDialog.Create(nil) do
  try
    if Execute then
    begin
      FFileShapes.Clear;
      FLoadedFiles.Clear;
      TJvCustomDiagramShape.LoadFromFile(Filename, sb);
      // TODO: update FFileShapes list with new items
      // NB! loading a saved diagram looses the info about interface/implementation uses!
    end;
  finally
    Free;
  end;
end;

procedure TDependencyWalkerDemoMainFrm.sbMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  inherited;
  SetCaptureControl(sb);
  // (p3) unselect any selected shape
  Selected := nil;
  if sb.CanFocus then
    sb.SetFocus;
  FDrawing := false;
  if Button = mbLeft then
  begin
    // initiate a focus rect
    FFocusRectAnchor.X := X;
    FFocusRectAnchor.Y := Y;
    FFocusRect := Rect(FFocusRectAnchor.X, FFocusRectAnchor.Y, 0, 0);
    DoBeginFocusRect(sb, FFocusRect, Button, Shift, FDrawing);
  end;
end;

procedure Swap(var Val1, Val2: integer);
var tmp: integer;
begin
  tmp := Val1;
  Val1 := Val2;
  Val2 := tmp;
end;

function NormalizedRect(ALeft, ATop, ARight, ABottom: integer): TRect;
begin
  if ALeft > ARight then
    Swap(ALeft, ARight);
  if ATop > ABottom then
    Swap(ATop, ABottom);
  Result := Rect(ALeft, ATop, ARight, ABottom);
end;

procedure TDependencyWalkerDemoMainFrm.sbMouseMove(Sender: TObject;
  Shift: TShiftState; X, Y: Integer);
var DC: HDC;
begin
  inherited;
  if not FDrawing then
    Exit;
  DC := GetDC(sb.Handle);
  try
    // erase previous rect
    DrawFocusRect(DC, FFocusRect);
    FFocusRect := NormalizedRect(FFocusRectAnchor.X, FFocusRectAnchor.Y, X, Y);
    // draw new rect
    DoFocusingRect(sb, FFocusRect, Shift, FDrawing);
    if FDrawing then
      DrawFocusRect(DC, FFocusRect);
  finally
    ReleaseDC(sb.Handle, DC);
  end;
end;

procedure TDependencyWalkerDemoMainFrm.sbMouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
var DC: HDC;
begin
  inherited;
  if FDrawing then
  begin
    DC := GetDC(sb.Handle);
    try
      // erase last focus rect
      DrawFocusRect(DC, FFocusRect);
      DoEndFocusRect(sb, FFocusRect, Button, Shift);
    finally
      ReleaseDC(sb.Handle, DC);
    end;
    ReleaseCapture;
  end;
  FDrawing := false;
end;

procedure TDependencyWalkerDemoMainFrm.DoBeginFocusRect(Sender: TObject; ARect: TRect;
  Button: TMouseButton; Shift: TShiftState; var Allow: boolean);
begin
  Allow := sb.ControlCount > 0;
end;

procedure GetControlsInRect(AParent: TWinControl; ARect: TRect; PartialOK: boolean; AList: TList);
var i: integer;
begin
  for i := 0 to AParent.ControlCount - 1 do
    with AParent.Controls[i] do
      if PtInRect(ARect, Point(Left, Top)) then
      begin
        if PartialOK or PtInRect(ARect, Point(Left + Width, Top + Height)) then
          AList.Add(AParent.Controls[i]);
      end
      else if PartialOK and PtInRect(ARect, Point(Left + Width, Top + Height)) then
        AList.Add(AParent.Controls[i])
end;

procedure TDependencyWalkerDemoMainFrm.DoFocusingRect(Sender: TObject; ARect: TRect; Shift: TShiftState; var Continue: boolean);
var AList: TList; i: integer;
begin
  AList := TList.Create;
  if not (ssShift in Shift) then
    TJvCustomDiagramShape.UnselectAllShapes(sb);
  try
    GetControlsInRect(sb, ARect, true, AList);
    for i := 0 to AList.Count - 1 do
      if TObject(AList[i]) is TJvBitmapShape then
        TJvBitmapShape(TObject(AList[i])).Selected := true;
    TJvBitmapShape.SetMultiSelected(sb, AList.Count > 1);
  finally
    AList.Free;
  end;
end;

procedure TDependencyWalkerDemoMainFrm.DoEndFocusRect(Sender: TObject; ARect: TRect; Button: TMouseButton; Shift: TShiftState);
var AList: TList; i: integer;
begin
  AList := TList.Create;
  if not (ssShift in Shift) then
    TJvCustomDiagramShape.UnselectAllShapes(sb);
  try
    GetControlsInRect(sb, ARect, true, AList);
    for i := 0 to AList.Count - 1 do
      if TObject(AList[i]) is TJvBitmapShape then
        TJvBitmapShape(TObject(AList[i])).Selected := true;
    TJvBitmapShape.SetMultiSelected(sb, AList.Count > 1);
  finally
    AList.Free;
  end;
end;

procedure TDependencyWalkerDemoMainFrm.sbExit(Sender: TObject);
begin
  inherited;
  FDrawing := false;
end;

// (p3) do a recursive parse of a unit

procedure TDependencyWalkerDemoMainFrm.acParseUnitExecute(Sender: TObject);
var Errors: TStringList; i, aCount: integer;AShape:TJvCustomDiagramShape;
begin
  WaitCursor;
  AShape := Selected;
  i := FFileShapes.IndexOfObject(AShape);
  if i < 0 then
  begin
    if AShape <> nil then
      ShowMessageFmt(SFileNotFoundFmt, [AShape.Caption.Text])
    else
      ShowMessage(SUnitNotFound);
    Exit;
  end;
  Errors := TStringlist.Create;
  try
    FTop := cStartY;
    aCount := FFileShapes.Count;
    Inc(FLeft, FOffsetX); // start new row
    ParseUnit(FFileShapes[i], Errors);
    if Errors.Count > 0 then
    begin
      ShowMessageFmt(SParseErrorsFmt, [Errors.Text]);
      // copy to clipboard as well
      Clipboard.SetTextBuf(PChar(Errors.Text));
    end;
    if aCount = FFileShapes.Count then // nothing happended, so reset FLeft
      Dec(FLeft, FOffsetX);
  finally
    Errors.Free;
  end;
end;

procedure TDependencyWalkerDemoMainFrm.acOptionsExecute(Sender: TObject);
begin
  if TfrmOptions.Execute then
  begin
    FreeAndNil(FSearchPaths);
    if sb.ControlCount = 0 then
      LoadSettings
    else
      ShowMessage(SRestartForNewOptions);
  end;
end;

procedure TDependencyWalkerDemoMainFrm.acUnitViewExecute(Sender: TObject);
var AFilename: string;
begin
  AFilename := FindUnit(Selected.Caption.Text);
  if FileExists(AFilename) then
    ShellExecute(Handle, 'open', PChar(AFilename), nil, nil, SW_SHOWNORMAL)
  else
    ShowMessageFmt(SFileNotFoundFmt, [AFilename]);
end;

function TDependencyWalkerDemoMainFrm.GetPersistStorage: TPersistStorage;
begin
  Result := TPersistStorage(TMemIniFile.Create(ChangeFileExt(Application.ExeName, cIniFileExt)));
  // ...could just as well have been:
  //Result := TPersistStorage(TRegistryIniFile.Create('\Software\JEDI\JVCL\Demos\Dependency Walker'));
end;

procedure SetRESelText(RE: TRichEdit; AColor: TColor; AStyle: TFontStyles; const AText: string);
begin
  RE.SelAttributes.Color := AColor;
  RE.SelAttributes.Style := AStyle;
  RE.SelText := AText;
end;

procedure TDependencyWalkerDemoMainFrm.ShowInlineStats(AShape: TJvCustomDiagramShape);
var
  i: integer;
  S: string;
  UsedByStrings, UsesStrings: TStringlist;
begin
  reStatistics.Lines.Clear;
  if AShape <> nil then
  begin
    // (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);
      SetRESelText(reStatistics, clNavy, [fsBold], S + ':'#13#10#13#10);
      SetRESelText(reStatistics, clBlack, [fsBold], 'uses:' + #13#10);
      for i := 0 to UsesStrings.Count - 1 do
        SetRESelText(reStatistics, clBlack, [], #9 + UsesStrings[i] + #13#10);
      SetRESelText(reStatistics, clBlack, [fsBold], 'used by:'#13#10);
      for i := 0 to UsedByStrings.Count - 1 do
        SetRESelText(reStatistics, clBlack, [], #9 + UsedByStrings[i] + #13#10);
    finally
      UsedByStrings.Free;
      UsesStrings.Free;
    end;
  end;
  // scroll to top:
  reStatistics.SelStart := 0;
  SendMessage(reStatistics.Handle, EM_SCROLLCARET, 0, 0);
end;

procedure TDependencyWalkerDemoMainFrm.SetSelected(const Value: TJvCustomDiagramShape);
begin
  if Value <> nil then
  begin
    Value.Selected := true;
    ShowInlineStats(Value);
  end
  else
    TJvCustomDiagramShape.UnselectAllShapes(sb);
end;

procedure TDependencyWalkerDemoMainFrm.acNoSortExecute(Sender: TObject);
var Errors: TStringlist;
begin
  acSortName.Checked := false;
  acSortLinksTo.Checked := false;
  acSortLinksFrom.Checked := false;
  acSortIntfImpl.Checked := false;
  acNoSort.Checked := true;
  Clear(false);
  Errors := TStringlist.Create;
  try
    ParseUnits(FLoadedFiles, 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;

function TDependencyWalkerDemoMainFrm.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.