projanalyzerfrm.pas

East make Tray Icon in delphi

    begin
      BorImage.FileName := PackagesList[I];
      if BorImage.IsPackage then
      begin
        ShortPackageName := ExtractFileName(PackagesList[I]);
        with BorImage.PackageInfo do
          for U := 0 to ContainsCount - 1 do
          begin
            SetLength(FPackageUnits, C + 1);
            FPackageUnits[C].UnitName := ContainsNames[U];
            FPackageUnits[C].PackageName := ShortPackageName;
            Inc(C);
          end;
      end;
    end;
    BorImage.FileName := FileName;
    ResourcesSize := BorImage.Directories[IMAGE_DIRECTORY_ENTRY_RESOURCE].Size;
    with BorImage do
    begin
      SetLength(FDfms, FormCount);
      for I := 0 to FormCount - 1 do
      begin
        FDfms[I].Name := Forms[I].FormObjectName;
        FDfms[I].Size := Forms[I].ResItem.RawEntryDataSize;
      end;
    end;
  finally
    BorImage.Free;
    PackagesList.Free;
  end;
  StatusBar1.Panels[0].Text := Format(RsStatusText,
    [FUnitsSum.Count, Length(FDfms), FCodeSize, FDataSize, FBssSize, ResourcesSize]);
  with ActionList1 do
    for I := 0 to ActionCount - 1 do
      with TAction(Actions[I]) do
        if (Tag = 1) and Checked then
        begin
          Execute;
          Break;
        end;
end;

//------------------------------------------------------------------------------

procedure TProjectAnalyzerForm.ShowDetails;
var
  I: Integer;
begin
  with UnitListView do
  begin
    Items.BeginUpdate;
    Items.Clear;
    for I := 0 to Length(FUnits) - 1 do
      with Items.Add, FUnits[I] do
      begin
        Caption := Name;
        SubItems.Add(Format('%.0n', [IntToExtended(Size)]));
        SubItems.Add(Group);
        SubItems.Add(FindPackageForUnitName(Name));
        case Group[1] of
          'D': ImageIndex := 3;
          'B': ImageIndex := 4;
        else
          ImageIndex := 2;
        end;
      end;
    AlphaSort;
    Items.EndUpdate;
  end;
end;

//------------------------------------------------------------------------------

procedure TProjectAnalyzerForm.ShowSummary;
var
  I: Integer;
begin
  with UnitListView do
  begin
    Items.BeginUpdate;
    Items.Clear;
    for I := 0 to FUnitsSum.Count - 1 do
      with Items.Add, FUnitsSum do
      begin
        Caption := Strings[I];
        SubItems.Add(Format('%.0n', [IntToExtended(Integer(Objects[I]))]));
        SubItems.Add(RsCodeData);
        SubItems.Add(FindPackageForUnitName(Strings[I]));
        ImageIndex := 2;
      end;
    AlphaSort;
    Items.EndUpdate;
  end;
end;

//------------------------------------------------------------------------------

procedure TProjectAnalyzerForm.ShowDfms;
var
  I: Integer;
begin
  with UnitListView do
  begin
    Items.BeginUpdate;
    Items.Clear;
    for I := 0 to Length(FDfms) - 1 do
      with Items.Add do
      begin
        Caption := FDfms[I].Name;
        SubItems.Add(Format('%.0n', [IntToExtended(FDfms[I].Size)]));
        SubItems.Add('');
        SubItems.Add('');
        ImageIndex := ShowDfms1.ImageIndex;
      end;
    AlphaSort;
    Items.EndUpdate;
  end;
end;

//------------------------------------------------------------------------------

procedure TProjectAnalyzerForm.OnMapSegmentEvent(Sender: TObject; const Address: TJclMapAddress;
  Length: Integer; const ClassName, UnitName: string);
var
  C: Integer;
  ClassName1: Char;
begin
  C := System.Length(FUnits);
  SetLength(FUnits, C + 1);
  if System.Length(ClassName) > 0 then
    ClassName1 := ClassName[1]
  else
    ClassName1 := #0;
  FUnits[C].Name := UnitName;
  FUnits[C].Size := Length;
  FUnits[C].Group := ClassName;
  case ClassName1 of
    'B': begin
           Inc(FBssSize, Length);
           Length := 0;
         end;  
    'C': Inc(FCodeSize, Length);
    'D': Inc(FDataSize, Length);
  end;
  C := FUnitsSum.IndexOf(UnitName);
  if C = -1 then
    FUnitsSum.AddObject(UnitName, Pointer(Length))
  else
    FUnitsSum.Objects[C] := Pointer(Integer(FUnitsSum.Objects[C]) + Length);
end;

//------------------------------------------------------------------------------

procedure TProjectAnalyzerForm.UnitListViewColumnClick(Sender: TObject; Column: TListColumn);
begin
  JvListViewSortClick(Column, 0, 1);
  TListView(Sender).AlphaSort;
end;

//------------------------------------------------------------------------------

procedure TProjectAnalyzerForm.UnitListViewCompare(Sender: TObject; Item1,
  Item2: TListItem; Data: Integer; var Compare: Integer);
begin
  JvListViewCompare(TListView(Sender), Item1, Item2, Compare);
end;

//------------------------------------------------------------------------------

procedure TProjectAnalyzerForm.ShowDetails1Execute(Sender: TObject);
begin
  ShowDetails;
  ShowDetails1.Checked := True;
  ShowSummary1.Checked := False;
  ShowDfms1.Checked := False;
end;

//------------------------------------------------------------------------------

procedure TProjectAnalyzerForm.ShowSummary1Execute(Sender: TObject);
begin
  ShowSummary;
  ShowSummary1.Checked := True;
  ShowDetails1.Checked := False;
  ShowDfms1.Checked := False;
end;

//------------------------------------------------------------------------------

procedure TProjectAnalyzerForm.ShowDfms1Execute(Sender: TObject);
begin
  ShowDfms;
  ShowDetails1.Checked := False;
  ShowSummary1.Checked := False;
  ShowDfms1.Checked := True;
end;

//------------------------------------------------------------------------------

procedure TProjectAnalyzerForm.TextLabelsItemClick(Sender: TObject);
begin
  TextLabelsItem.Checked := not TextLabelsItem.Checked;
  ToolBar1.ShowCaptions := TextLabelsItem.Checked;
  ToolBar1.ButtonHeight := 0;
  ToolBar1.ButtonWidth := 0;
end;

//------------------------------------------------------------------------------

procedure TProjectAnalyzerForm.Copy1Execute(Sender: TObject);
var
  SL: TStringList;
begin
  SL := TStringList.Create;
  try
    JvListViewToStrings(UnitListView, SL, False, True);
    SL.Add('');
    SL.Add(StatusBar1.Panels[0].Text);
    Clipboard.AsText := SL.Text;
  finally
    SL.Free;
  end;
end;

//------------------------------------------------------------------------------

procedure TProjectAnalyzerForm.Save1Execute(Sender: TObject);
var
  SL: TStringList;
begin
  with SaveDialog1 do
  begin
    FileName := '';
    if Execute then
    begin
      SL := TStringList.Create;
      try
        JvListViewToStrings(UnitListView, SL, False, True);
        SL.SaveToFile(FileName);
      finally
        SL.Free;
      end;
    end;
  end;
end;

//------------------------------------------------------------------------------

function TProjectAnalyzerForm.FindPackageForUnitName(const UnitName: string): string;
var
  I: Integer;
begin
  Result := '';
  if UnitName <> 'SysInit' then
    for I := 0 to Length(FPackageUnits) - 1 do
      if FPackageUnits[I].UnitName = UnitName then
      begin
        Result := FPackageUnits[I].PackageName;
        Break;
      end;
end;

//------------------------------------------------------------------------------

procedure TProjectAnalyzerForm.SetStatusBarText(const Value: string);
begin
  with StatusBar1 do
  begin
    Panels[0].Text := Value;
    Repaint;
  end;
end;

//------------------------------------------------------------------------------

procedure TProjectAnalyzerForm.ClearContent;
begin
  ClearData;
  StatusBarText := '';
  UnitListView.Items.BeginUpdate;
  UnitListView.Items.Clear;
  UnitListView.Items.EndUpdate;
  Show;
  Repaint;
end;

//------------------------------------------------------------------------------

procedure TProjectAnalyzerForm.ShowDetails1Update(Sender: TObject);
begin
  TAction(Sender).Enabled := (Length(FUnits) > 0);
end;

//------------------------------------------------------------------------------

procedure TProjectAnalyzerForm.ClearData;
begin
  FDfms := nil;
  FUnits := nil;
  FUnitsSum.Clear;
  FCodeSize := 0;
  FDataSize := 0;
  FBssSize := 0;
  FPackageUnits := nil;
end;

end.