jvqperfmon95.pas

East make Tray Icon in delphi

      Result := Trunc((Value - FLastPerfData) * 1000 / (CurrentTickCount - FLastTime));
    FLastTime := CurrentTickCount;
    FLastPerfData := Value;
  end
  else
    Result := Value;
end;

function TJvPerfStatActiveItem.GetPerfDataStr: string;
var
  E: Extended;
begin
  E := GetPerfData;
  Result := Format('%.n', [E]);
end;

function TJvPerfStatActiveItem.InternalStartStop(Start: Boolean): Boolean;
const
  StartStopKeys: array [Boolean] of string = (StopDataKey, StartDataKey);
var
  Size, Dummy: Integer;
begin
  Result := False;
  with FOwner.Reg do
  begin
    RootKey := HKEY_DYN_DATA;
    if OpenKeyReadOnly(StartStopKeys[Start]) then
    begin
      Size := GetDataSize(FKey);
      if Size = SizeOf(Dummy) then
      begin
        ReadBinaryData(FKey, Dummy, Size);
        Result := True;
      end;
      CloseKey;
    end;
  end;
end;

procedure TJvPerfStatActiveItem.Start(NoCheckState: Boolean);
begin
  if not NoCheckState and FStarted then
    Exit;
  if not InternalStartStop(True) then
    raise EJvPerfStatException.CreateResFmt(@RsECantStart, [Key]);
  FStarted := True;
end;

procedure TJvPerfStatActiveItem.Stop(NoCheckState: Boolean);
begin
  if not NoCheckState and not FStarted then
    Exit;
  if not InternalStartStop(False) then
    raise EJvPerfStatException.CreateResFmt(@RsECantStop, [Key]);
  FStarted := False;
end;

//=== { TJvPerfStatItem } ====================================================

function TJvPerfStatItem.GetActiveItem: TJvPerfStatActiveItem;
begin
  Result := FActiveItem;
  if Result = nil then
    raise EJvPerfStatException.CreateResFmt(@RsEKeyNotExist, [FPerfStatKey]);
  Result.Start;
end;

function TJvPerfStatItem.GetDisplayName: string;
begin
  Result := FPerfStatKey;
  if Result = '' then
    Result := inherited GetDisplayName;
end;

function TJvPerfStatItem.GetExist: Boolean;
begin
  Result := (FActiveItem <> nil);
end;

procedure TJvPerfStatItem.SetPerfStatKey(const Value: string);
begin
  if FPerfStatKey <> Value then
  begin
    FPerfStatKey := Value;
    Changed(False);
  end;
end;

//=== { TJvPerfStatItems } ===================================================

constructor TJvPerfStatItems.Create(AOwner: TJvPerfStat95);
begin
  inherited Create(TJvPerfStatItem);
  FOwner := AOwner;
end;

function TJvPerfStatItems.Add: TJvPerfStatItem;
begin
  Result := TJvPerfStatItem(inherited Add);
end;

function TJvPerfStatItems.GetItem(Index: Integer): TJvPerfStatItem;
begin
  Result := TJvPerfStatItem(inherited GetItem(Index));
end;

function TJvPerfStatItems.GetOwner: TPersistent;
begin
  Result := FOwner;
end;

procedure TJvPerfStatItems.SetItem(Index: Integer; const Value: TJvPerfStatItem);
begin
  inherited SetItem(Index, Value);
end;

procedure TJvPerfStatItems.Update(Item: TCollectionItem);
var
  I: Integer;

  procedure BindItem(Item: TCollectionItem);
  begin
    with TJvPerfStatItem(Item) do
      FActiveItem := FOwner.Keys[PerfStatKey];
  end;

begin
  if csDesigning in FOwner.ComponentState then
    Exit;
  if Item = nil then
    for I := 0 to Count - 1 do
      BindItem(Items[I])
  else
    BindItem(Item);
end;

//=== { TJvPerfStat95 } ======================================================

constructor TJvPerfStat95.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FItems := TJvPerfStatItems.Create(Self);
  FWarnIfWrongOS := True;
  if not (csDesigning in ComponentState) then
  begin
    FActiveObjectsList := TObjectList.Create(True);
    Reg := TRegistry.Create;
    ReadActiveObjects;
  end;
end;

destructor TJvPerfStat95.Destroy;
begin
  if not (csDesigning in ComponentState) then
  begin
    StopAll;
    FreeAndNil(FActiveObjectsList);
    FreeAndNil(Reg);
  end;
  FreeAndNil(FItems);
  inherited Destroy;
end;

function TJvPerfStat95.GetActiveObjectCount: Integer;
begin
  Result := FActiveObjectsList.Count;
end;

function TJvPerfStat95.GetActiveObjects(Index: Integer): TJvPerfStatActiveItem;
begin
  Result := TJvPerfStatActiveItem(FActiveObjectsList.Items[Index]);
end;

function TJvPerfStat95.GetCategories(Index: Integer): TJvPerfStatCategory;
begin
  if (Index < 0) or (Index > GetCategoryCount - 1) then
    raise EJvPerfStatException.CreateResFmt(@SListIndexError, [Index]);
  Result := FCategories[Index];
  with Result do
  begin
    Category := MultiByteStringToString(Category);
    Name := MultiByteStringToString(Name);
  end;
end;

function TJvPerfStat95.GetCategoryCount: Integer;
begin
  Result := Length(FCategories);
end;

function TJvPerfStat95.GetKeys(const Name: string): TJvPerfStatActiveItem;
var
  I: Integer;
  FindKey: string;
begin
  FindKey := StringToMultiByteString(Name);
  Result := nil;
  for I := 0 to FActiveObjectsList.Count - 1 do
    if ActiveObjects[I].FKey = FindKey then
    begin
      Result := ActiveObjects[I];
      Break;
    end;
end;

procedure TJvPerfStat95.Loaded;
begin
  inherited Loaded;
  if FWarnIfWrongOS and not (csDesigning in ComponentState) then
    ShowWrongOSWarning;
end;

procedure TJvPerfStat95.ReadActiveObjects;
var
  List1, List2: TStringList;
  I1, I2: Integer;
begin
  List1 := TStringList.Create;
  List2 := TStringList.Create;
  try
    FActiveObjectsList.Clear;
    Reg.RootKey := HKEY_LOCAL_MACHINE;
    if Reg.OpenKeyReadOnly(PerfEnumKey) then
    begin
      Reg.GetKeyNames(List1);
      Reg.CloseKey;
      List1.Sort;
      SetLength(FCategories, List1.Count);
      for I1 := 0 to List1.Count - 1 do
        if Reg.OpenKeyReadOnly(PerfEnumKey + '\' + List1[I1]) then
        begin
          Reg.GetKeyNames(List2);
          FCategories[I1].Category := List1[I1];
          FCategories[I1].Name := Reg.ReadString('Name');
          Reg.CloseKey;
          for I2 := 0 to List2.Count - 1 do
            FActiveObjectsList.Add(TJvPerfStatActiveItem.Create(Self,
              Format('%s\%s', [List1[I1], List2[I2]]), I1));
        end;
    end
    else
      raise EJvPerfStatException.CreateRes(@RsECantOpenPerfKey);
  finally
    List2.Free;
    List1.Free;
  end;
end;

function TJvPerfStat95.ReadMBStringValue(const Name: string): string;
begin
  Result := MultiByteStringToString(Reg.ReadString(Name));
end;

procedure TJvPerfStat95.SetItems(const Value: TJvPerfStatItems);
begin
  FItems.Assign(Value);
end;

procedure TJvPerfStat95.StopAll;
var
  I: Integer;
begin
  for I := 0 to FActiveObjectsList.Count - 1 do
    ActiveObjects[I].Stop;
end;

{$IFDEF UNITVERSIONING}
const
  UnitVersioning: TUnitVersionInfo = (
    RCSfile: '$RCSfile: JvQPerfMon95.pas,v $';
    Revision: '$Revision: 1.16 $';
    Date: '$Date: 2004/11/06 22:08:20 $';
    LogPath: 'JVCL\run'
  );

initialization
  RegisterUnitVersion(HInstance, UnitVersioning);

finalization
  UnregisterUnitVersion(HInstance);
{$ENDIF UNITVERSIONING}

end.