{****************************************************************** 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. ******************************************************************} unit DependencyWalkerDemoMainForm; {$I jvcl.inc} 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; 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 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('

%s:

', [AShape.Caption.Text])); if UsesStrings.Count > 0 then Strings.Add(Format('%s', [SUsesColon])); Strings.Add(''); if UsedByStrings.Count > 0 then Strings.Add(Format('%s', [SUsedByColon])); Strings.Add(''); end; pfXML: begin // DO NOT LOCALIZE! Strings.Add(Format('', [AShape.Caption.Text])); for j := 0 to UsesStrings.Count - 1 do Strings.Add(Format('', [UsesStrings[j]])); for j := 0 to UsedByStrings.Count - 1 do Strings.Add(Format('', [UsedByStrings[j]])); Strings.Add(''); end; end; // case end; // insert headers and footers: case AFormat of pfXML: begin // DO NOT LOCALIZE! Strings.Insert(0, ''); Strings.Add(''); end; pfHTML: begin // DO NOT LOCALIZE! Strings.Insert(0, Format('%s', [SDependencyWalkerTitle])); Strings.Insert(1, Format('

%s

', [SDependencyWalkerTitle])); Strings.Add(''); 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; 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.