jvqmrumanager.pas

East make Tray Icon in delphi

  end;
end;

procedure TJvMRUManager.UpdateRecentMenu;
const
  AccelDelimChars: array[TAccelDelimiter] of Char = (Tab, ' ');
var
  I: Integer;
  L: Cardinal;
  S: string;
  C: string[2];
  ShortCut: TShortCut;
  Item: TMenuItem;
begin
  ClearRecentMenu;
  DoDuplicateFixUp;
  DoBeforeUpdate;
  if Assigned(FRecentMenu) then
  begin
    if ((Strings.Count > 0) and (FRecentMenu.Count > 0) and (MenuLocation = mruChild)) then
      AddMenuItem(NewLine);
    for I := 0 to Strings.Count - 1 do
    begin
      if (FSeparateSize > 0) and (I > 0) and (I mod FSeparateSize = 0) then
        AddMenuItem(NewLine)
      else
      if (I = 0) and (MenuLocation = mruSibling) and (FRecentMenu.Count = 0) then
        AddMenuItem(NewLine);
      S := Strings[I];
      ShortCut := scNone;
      GetItemData(S, ShortCut, Longint(Strings.Objects[I]));
      Item := NewItem(GetShortHint(S), ShortCut, False, True,
        MenuItemClick, 0, '');
      Item.Hint := GetLongHint(S);
      if FShowAccelChar then
      begin
        L := Cardinal(I) + FStartAccel;
        if L < 10 then
          C := '&' + Char(Ord('0') + L)
        else
        if L <= (Ord('Z') + 10) then
          C := '&' + Char(L + Ord('A') - 10)
        else
          C := ' ';
        Item.Caption := C + AccelDelimChars[FAccelDelimiter] + DoMinimizeName(S);
      end;
      Item.Tag := I;
      AddMenuItem(Item);
      GetItemInfo(Item);
    end;
    DoAfterUpdate;
    if AutoEnable then
      FRecentMenu.Enabled := IsMenuEnabled;
  end;
end;

procedure TJvMRUManager.ClearRecentMenu;
var
  Item: TMenuItem;
begin
  while FItems.Count > 0 do
  begin
    Item := TMenuItem(FItems[0]);
    FItems.Remove(Item);
    // (p3) it doesn't matter if the item is in FRecentMenu or not - it still needs to be freed
    // this also avoids duplicates when MenuLocation = mruSibling 
//    if Assigned(FRecentMenu) and (FRecentMenu.IndexOf(Item) >= 0) then
    Item.Free;
  end;
  if Assigned(FRecentMenu) and AutoEnable then
    FRecentMenu.Enabled := IsMenuEnabled;
end;

procedure TJvMRUManager.SetRecentMenu(Value: TMenuItem);
begin
  ClearRecentMenu;
  FRecentMenu := Value;
  if Value <> nil then
    Value.FreeNotification(Self);
  FreeAndNil(FCanvas);
  UpdateRecentMenu;
end;

procedure TJvMRUManager.SetSeparateSize(Value: Word);
begin
  if FSeparateSize <> Value then
  begin
    FSeparateSize := Value;
    if FAutoUpdate then
      UpdateRecentMenu;
  end;
end;

procedure TJvMRUManager.ListChanged(Sender: TObject);
begin
  Change;
  if FAutoUpdate then
    UpdateRecentMenu;
end;

procedure TJvMRUManager.IniSave(Sender: TObject);
begin
  if (Name <> '') and Assigned(IniStorage) then
    InternalSave(GetDefaultSection(Self));
end;

procedure TJvMRUManager.IniLoad(Sender: TObject);
begin
  if (Name <> '') and Assigned(IniStorage) then
    InternalLoad(GetDefaultSection(Self));
end;

procedure TJvMRUManager.Change;
begin
  if Assigned(FOnChange) then
    FOnChange(Self);
end;

procedure TJvMRUManager.DoReadItem(AppStorage: TJvCustomAppStorage; const Path: string;
  Index: Integer; var RecentName: string; var UserData: Longint);
begin
  if Assigned(FOnReadItem) then
    FOnReadItem(Self, AppStorage, Path, Index, RecentName, UserData)
  else
  begin
    RecentName := AppStorage.ReadString(AppStorage.ConcatPaths(
      [Path, Format(siRecentItem, [Index])]), RecentName);
    UserData := AppStorage.ReadInteger(AppStorage.ConcatPaths(
      [Path, Format(siRecentData, [Index])]), UserData);
  end;
end;

procedure TJvMRUManager.DoWriteItem(AppStorage: TJvCustomAppStorage; const Path: string;
  Index: Integer; const RecentName: string; UserData: Longint);
begin
  if Assigned(FOnWriteItem) then
    FOnWriteItem(Self, AppStorage, Path, Index, RecentName, UserData)
  else
  begin
    AppStorage.WriteString(AppStorage.ConcatPaths(
      [Path, Format(siRecentItem, [Index])]), RecentName);
    if UserData = 0 then
      AppStorage.DeleteValue(AppStorage.ConcatPaths(
        [Path, Format(siRecentData, [Index])]))
    else
      AppStorage.WriteInteger(AppStorage.ConcatPaths(
        [Path, Format(siRecentData, [Index])]), UserData);
  end;
end;

procedure TJvMRUManager.InternalLoad(const Section: string);
begin
  if Assigned(IniStorage) then
    with IniStorage do
      LoadFromAppStorage(AppStorage, AppStorage.ConcatPaths([AppStoragePath, Section]));
end;

procedure TJvMRUManager.InternalSave(const Section: string);
begin
  if Assigned(IniStorage) then
    with IniStorage do
      SaveToAppStorage(AppStorage, AppStorage.ConcatPaths([AppStoragePath, Section]));
end;

procedure TJvMRUManager.LoadFromAppStorage(const AppStorage: TJvCustomAppStorage; const Path: string);
var
  I: Integer;
  S: string;
  UserData: Longint;
  AMode: TRecentMode;
begin
  AMode := Mode;
  Strings.BeginUpdate;
  try
    Strings.Clear;
    Mode := rmInsert;
    for I := FStrings.MaxSize - 1 downto 0 do
    begin
      S := '';
      UserData := 0;
      DoReadItem(AppStorage, Path, I, S, UserData);
      if S <> '' then
        Add(S, UserData);
    end;
  finally
    Mode := AMode;
    Strings.EndUpdate;
  end;
end;

procedure TJvMRUManager.SaveToAppStorage(const AppStorage: TJvCustomAppStorage; const Path: string);
var
  I: Integer;
begin
  AppStorage.DeleteSubTree(Path);
  for I := 0 to Strings.Count - 1 do
    DoWriteItem(AppStorage, Path, I, Strings[I], Longint(Strings.Objects[I]));
end;

procedure TJvMRUManager.Load;
begin
  IniLoad(nil);
end;

procedure TJvMRUManager.Save;
begin
  IniSave(nil);
end;

procedure TJvMRUManager.DoAfterUpdate;
begin
  if Assigned(FOnAfterUpdate) then
    FOnAfterUpdate(Self);
end;

procedure TJvMRUManager.DoBeforeUpdate;
begin
  if Assigned(FOnBeforeUpdate) then
    FOnBeforeUpdate(Self);
end;

procedure TJvMRUManager.RemoveInvalid;
var
  I: Integer;
begin
  for I := Strings.Count - 1 downto 0 do
    if not FileExists(Strings[I]) then
      Strings.Delete(I);
end;

procedure TJvMRUManager.GetItemInfo(Item: TMenuItem);
begin
  if Assigned(FOnItemInfo) then
    FOnItemInfo(Self, Item);
end;

procedure TJvMRUManager.SetDuplicates(const Value: TDuplicates);
begin
  if FDuplicates <> Value then
  begin
    FDuplicates := Value;
    if FAutoUpdate then
      UpdateRecentMenu;
  end;
end;

//=== { TJvRecentStrings } ===================================================

constructor TJvRecentStrings.Create;
begin
  inherited Create;
  FMaxSize := 10;
  FMode := rmInsert;
end;

procedure TJvRecentStrings.SetMaxSize(Value: Integer);
begin
  if FMaxSize <> Value then
  begin
    FMaxSize := Max(1, Value);
    DeleteExceed;
  end;
end;

procedure TJvRecentStrings.DeleteExceed;
var
  I: Integer;
begin
  BeginUpdate;
  try
    if FMode = rmInsert then
      for I := Count - 1 downto FMaxSize do
        Delete(I)
    else
    begin { rmAppend }
      while Count > FMaxSize do
        Delete(0);
    end;
  finally
    EndUpdate;
  end;
end;

procedure TJvRecentStrings.Remove(const S: string);
var
  I: Integer;
begin
  I := IndexOf(S);
  if I >= 0 then
    Delete(I);
end;

function TJvRecentStrings.Add(const S: string): Integer;
begin
  Result := IndexOf(S);
  if Result >= 0 then
  begin
    if FMode = rmInsert then
      Move(Result, 0)
    else { rmAppend }
      Move(Result, Count - 1);
  end
  else
  begin
    BeginUpdate;
    try
      if FMode = rmInsert then
        Insert(0, S)
      else { rmAppend }
        Insert(Count, S);
      DeleteExceed;
    finally
      EndUpdate;
    end;
  end;
  if FMode = rmInsert then
    Result := 0
  else { rmAppend }
    Result := Count - 1;
end;

procedure TJvRecentStrings.AddStrings(Strings: TStrings);
var
  I: Integer;
begin
  BeginUpdate;
  try
    if FMode = rmInsert then
    begin
      for I := Min(Strings.Count, FMaxSize) - 1 downto 0 do
        AddObject(Strings[I], Strings.Objects[I]);
    end
    else { rmAppend }
      for I := 0 to Min(Strings.Count, FMaxSize) - 1 do
        AddObject(Strings[I], Strings.Objects[I]);
    DeleteExceed;
  finally
    EndUpdate;
  end;
end;

procedure TJvMRUManager.SetMenuLocation(const Value: TMenuLocation);
begin
  if FMenuLocation <> Value then
  begin
    FMenuLocation := Value;
    UpdateRecentMenu;
  end;
end;

function TJvMRUManager.IsMenuEnabled: Boolean;
begin
  Result := ((MenuLocation = mruChild) and (FRecentMenu.Count > 0)) or
    ((MenuLocation = mruSibling) and (Strings.Count > 0));
end;

procedure TJvMRUManager.SetMaxLength(const Value: Integer);
begin
  if FMaxLength <> Value then
  begin
    FMaxLength := Value;
    UpdateRecentMenu;
  end;
end;

function TJvMRUManager.GetCanvas: TCanvas;
begin
  if FCanvas = nil then
  begin
    FCanvas := TCanvas.Create;
    if RecentMenu <> nil then
      FCanvas.Handle := GetDC(GetDesktopWindow);
  end;
  Result := FCanvas;
end;

function TJvMRUManager.DoMinimizeName(const S: string): string;
begin
  Result := '';
  if MaxLength > 0 then
  begin
    if not StartEllipsis then
      Result := PathCompactPath(  
        QPainter_handle(GetCanvas.Handle), 
        S, GetCanvas.TextWidth('n') * MaxLength, cpCenter)
    else
    if Length(S) > MaxLength then
      Result := '...' + Copy(S, Length(S) - MaxLength + 1, MaxInt);
  end;
  if (Result = '...') or (Result = '') then
    Result := S;
end;

procedure TJvMRUManager.SetStartEllipsis(const Value: Boolean);
begin
  if FStartEllipsis <> Value then
  begin
    FStartEllipsis := Value;
    UpdateRecentMenu;
  end;
end;

{$IFDEF UNITVERSIONING}
const
  UnitVersioning: TUnitVersionInfo = (
    RCSfile: '$RCSfile: JvQMRUManager.pas,v $';
    Revision: '$Revision: 1.16 $';
    Date: '$Date: 2004/09/07 23:11:18 $';
    LogPath: 'JVCL\run'
  );

initialization
  RegisterUnitVersion(HInstance, UnitVersioning);

finalization
  UnregisterUnitVersion(HInstance);
{$ENDIF UNITVERSIONING}

end.