jvspeedbar.pas

East make Tray Icon in delphi

begin
  Result := FButton.Cursor;
end;

procedure TJvSpeedItem.SetCursor(Value: TCursor);
begin
  FButton.Cursor := Value;
end;

function TJvSpeedItem.GetHint: string;
begin
  Result := FButton.Hint;
end;

procedure TJvSpeedItem.SetHint(const Value: string);
begin
  FButton.Hint := Value;
end;

function TJvSpeedItem.GetAction: TBasicAction;
begin
  Result := FButton.Action;
end;

procedure TJvSpeedItem.SetAction(Value: TBasicAction);
begin
  FButton.Action := Value;
end;

procedure TJvSpeedItem.ButtonClick;
begin
  FButton.ButtonClick;
end;

function TJvSpeedItem.CheckBtnMenuDropDown: Boolean;
begin
  Result := FButton.CheckBtnMenuDropDown;
end;

procedure TJvSpeedItem.Click;
begin
  FButton.Click;
end;

function TJvSpeedItem.GetTag: Longint;
begin
  Result := inherited Tag;
end;

procedure TJvSpeedItem.SetTag(Value: Longint);
begin
  inherited Tag := Value;
  FButton.Tag := Value;
end;

function TJvSpeedItem.GetDropDownMenu: TPopupMenu;
begin
  Result := FButton.DropDownMenu;
end;

procedure TJvSpeedItem.SetDropDownMenu(Value: TPopupMenu);
begin
  FButton.DropDownMenu := Value;
end;

function TJvSpeedItem.GetMarkDropDown: Boolean;
begin
  Result := FButton.MarkDropDown;
end;

procedure TJvSpeedItem.SetMarkDropDown(Value: Boolean);
begin
  FButton.MarkDropDown := Value;
end;

function TJvSpeedItem.GetWordWrap: Boolean;
begin
  Result := FButton.WordWrap;
end;

procedure TJvSpeedItem.SetWordWrap(Value: Boolean);
begin
  FButton.WordWrap := Value;
end;

function TJvSpeedItem.GetLeft: Integer;
begin
  Result := FButton.Left;
end;

function TJvSpeedItem.GetTop: Integer;
begin
  Result := FButton.Top;
end;

procedure TJvSpeedItem.SetLeft(Value: Integer);
begin
  FButton.Left := Value;
end;

procedure TJvSpeedItem.SetTop(Value: Integer);
begin
  FButton.Top := Value;
end;

const
  InternalVer = 1;

//=== { TJvSpeedBar } ========================================================

constructor TJvSpeedBar.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FSections := TList.Create;
  FButtonSize := DefaultButtonSize;
  FButtonStyle := bsNew;
  FWallpaper := TPicture.Create;
  FWallpaper.OnChange := WallpaperChanged;
  FIniLink := TJvIniLink.Create;
  FIniLink.OnSave := IniSave;
  FIniLink.OnLoad := IniLoad;
  FOffset.X := MinButtonsOffset;
  FOffset.Y := FOffset.X;
  Height := 2 * FOffset.Y + DefaultButtonSize.Y;
  FRowCount := 1;
  FEditWin := NullHandle;
  FOptions := [sbAllowDrag, sbGrayedBtns];
  ControlStyle := ControlStyle - [csSetCaption, csReplicatable];
  IncludeThemeStyle(Self, [csNeedsBorderPaint, csParentBackground]);
  ParentShowHint := False;
  ShowHint := True;
  SetFontDefault;
  inherited Align := alTop;
  FAlign := alTop;
  UpdateGridSize;
  FImageChangeLink := TChangeLink.Create;
  FImageChangeLink.OnChange := ImageListChange;
  if not Registered then
  begin
    {$IFDEF COMPILER7_UP}
    GroupDescendentsWith(TJvSpeedItem, TControl);
    GroupDescendentsWith(TJvSpeedBarSection, TControl);
    {$ENDIF COMPILER7_UP}
    RegisterClasses([TJvSpeedItem, TJvSpeedBarSection, TJvSpeedBarButton]);
    Registered := True;
  end;
end;

destructor TJvSpeedBar.Destroy;
begin
  FOnVisibleChanged := nil;
  FOnApplyAlign := nil;
  FOnPosChanged := nil;
  FIniLink.Free;
  FWallpaper.OnChange := nil;
  FWallpaper.Free;
  FWallpaper := nil;
  if FEditWin <> NullHandle then
  begin
    SendMessage(FEditWin, CM_SPEEDBARCHANGED, SBR_DESTROYED, Longint(Self));
    FEditWin := NullHandle;
  end;
  ClearSections;
  FSections.Free;
  FImageChangeLink.Free;
  inherited Destroy;
end;

procedure TJvSpeedBar.Loaded;
begin
  inherited Loaded;
  if (FReserved = 0) and FFix then
  begin { fix previous version error }
    inherited Align := alTop;
    FAlign := alTop;
  end;
  UpdateGridSize;
  ForEachItem(SetItemButtonSize, 0);
end;

procedure TJvSpeedBar.ReadData(Reader: TReader);
begin
  FReserved := Reader.ReadInteger;
end;

procedure TJvSpeedBar.WriteData(Writer: TWriter);
begin
  Writer.WriteInteger(InternalVer);
end;

procedure TJvSpeedBar.ReadAllowDrag(Reader: TReader);
begin
  if Reader.ReadBoolean then
    Options := Options + [sbAllowDrag]
  else
    Options := Options - [sbAllowDrag];
end;

procedure TJvSpeedBar.ReadDesignStyle(Reader: TReader);
begin
  FDesignStyle := Reader.ReadBoolean;
end;

procedure TJvSpeedBar.WriteDesignStyle(Writer: TWriter);
begin
  Writer.WriteBoolean(NewStyleControls);
end;

procedure TJvSpeedBar.ReadSections(Reader: TReader);
var
  TmpList: TStringList;
  I: Integer;
begin
  TmpList := TStringList.Create;
  try
    Reader.ReadListBegin;
    while not Reader.EndOfList do
      TmpList.AddObject(Reader.ReadString, nil);
    Reader.ReadListEnd;
    if (Reader.Ancestor = nil) or (TmpList.Count > 0) then
      for I := 0 to TmpList.Count - 1 do
        if SearchSection(TmpList[I]) < 0 then
          AddSection(TmpList[I]);
  finally
    TmpList.Free;
  end;
end;

procedure TJvSpeedBar.WriteSections(Writer: TWriter);
var
  I: Integer;
begin
  Writer.WriteListBegin;
  for I := 0 to FSections.Count - 1 do
    Writer.WriteString(Sections[I].Caption);
  Writer.WriteListEnd;
end;

procedure TJvSpeedBar.DefineProperties(Filer: TFiler);
begin
  inherited DefineProperties(Filer);
  Filer.DefineProperty('Sections', ReadSections, WriteSections, False);
  Filer.DefineProperty('NewStyle', ReadDesignStyle, WriteDesignStyle, False);
  Filer.DefineProperty('InternalVer', ReadData, WriteData,Filer.Ancestor = nil);
  { AllowDrag reading for backward compatibility only }
  Filer.DefineProperty('AllowDrag', ReadAllowDrag, nil, False);
end;

function TJvSpeedBar.GetSection(Index: Integer): TJvSpeedBarSection;
begin
  Result := TJvSpeedBarSection(FSections[Index]);
end;

function TJvSpeedBar.GetSectionCount: Integer;
begin
  Result := FSections.Count;
end;

procedure TJvSpeedBar.ForEachItem(Proc: TForEachItem; Data: Longint);
var
  I, Idx: Integer;
  Sect: TJvSpeedBarSection;
begin
  for I := 0 to FSections.Count - 1 do
    if FSections[I] <> nil then
    begin
      Sect := TJvSpeedBarSection(FSections[I]);
      for Idx := 0 to Sect.Count - 1 do
      begin
        if (Sect[Idx] <> nil) and Assigned(Proc) then
          Proc(TJvSpeedItem(Sect[Idx]), Data);
      end;
    end;
end;

function TJvSpeedBar.MinButtonsOffset: Integer;
begin
  Result := BorderWidth + 2 * Ord(not (sbFlatBtns in Options));
  if BevelOuter <> bvNone then
    Inc(Result, BevelWidth);
  if BevelInner <> bvNone then
    Inc(Result, BevelWidth);
end;

procedure TJvSpeedBar.SetItemVisible(Item: TJvSpeedItem; Data: Longint);
var
  ItemVisible: Boolean;
begin
  ItemVisible := Item.Visible and Self.Visible;
  Item.FButton.Visible := ItemVisible;
  if (Item.FButton.Parent <> Self) and ItemVisible then
    Item.FButton.Parent := Self;
end;

procedure TJvSpeedBar.SetItemEnabled(Item: TJvSpeedItem; Data: Longint);
begin
  Item.FButton.Enabled := Item.Enabled and Self.Enabled;
end;

procedure TJvSpeedBar.SetItemButtonSize(Item: TJvSpeedItem; Data: Longint);
begin
  ApplyItemSize(Item, Data);
  Item.Visible := Item.Visible; { update visible and parent after loading }
end;

procedure TJvSpeedBar.SwapItemBounds(Item: TJvSpeedItem; Data: Longint);
begin
  Item.FButton.SetBounds(Item.Top, Item.Left, FButtonSize.X, FButtonSize.Y);
end;

procedure TJvSpeedBar.SetFontDefault;
{$IFDEF VCL}
var
  NCMetrics: TNonClientMetrics;
begin
  ParentFont := False;
  with Font do
  begin
    NCMetrics.cbSize := SizeOf(TNonClientMetrics);
    if SystemParametersInfo(SPI_GETNONCLIENTMETRICS, 0, @NCMetrics, 0) then
    begin
      Handle := CreateFontIndirect(NCMetrics.lfMenuFont);
      Charset := DEFAULT_CHARSET;
    end
    else
    begin
      Name := 'MS Sans Serif';
      Size := 8;
      Style := [];
      Color := clBtnText;
    end;
  end;
end;
{$ENDIF VCL}
{$IFDEF VisualCLX}
begin
  ParentFont := False;
  with Font do
  begin
    Name := 'Helvetica';
    Height := 11;
    Style := [];
    Color := clBtnText;
  end;
end;
{$ENDIF VisualCLX}

procedure TJvSpeedBar.VisibleChanged;
begin
  inherited VisibleChanged;
  if not (csLoading in ComponentState) then
    ForEachItem(SetItemVisible, 0);
  if Assigned(FOnVisibleChanged) then
    FOnVisibleChanged(Self);
end;

procedure TJvSpeedBar.EnabledChanged;
begin
  inherited EnabledChanged;
  if not ((csLoading in ComponentState) or (csDesigning in ComponentState)) then
    ForEachItem(SetItemEnabled, 0);
end;

procedure TJvSpeedBar.WallpaperChanged(Sender: TObject);
begin
  Invalidate;
end;

procedure TJvSpeedBar.SetWallpaper(Value: TPicture);
begin
  FWallpaper.Assign(Value);
end;

procedure TJvSpeedBar.ClearSections;
begin
  while FSections.Count > 0 do
    RemoveSection(FSections.Count - 1);
  FSections.Clear;
end;

function TJvSpeedBar.Items(Section, Index: Integer): TJvSpeedItem;
var
  List: TJvSpeedBarSection;
begin
  Result := nil;
  if (Section >= 0) and (Section < FSections.Count) then
  begin
    List := Sections[Section];
    if List <> nil then
      if (Index >= 0) and (Index < List.Count) then
        Result := List[Index];
  end;
end;

function TJvSpeedBar.ItemsCount(Section: Integer): Integer;
begin
  Result := 0;
  if (Section >= 0) and (Section < FSections.Count) then
  begin
    if FSections[Section] <> nil then
      Result := Sections[Section].Count;
  end;
end;

procedure TJvSpeedBar.RemoveSection(Section: Integer);
var
  Sect: TJvSpeedBarSection;
  Item: TJvSpeedItem;
begin
  Sect := Sections[Section];
  if Sect <> nil then
  begin
    while Sect.Count > 0 do
    begin
      Item := Sect[0];
      Item.Free;
    end;
    Sect.FParent := nil;
    Sect.Free;
    FSections[Section] := nil;
  end;
  FSections.Delete(Section);
end;

procedure TJvSpeedBar.DeleteSection(Section: Integer);
var
  Sect: TJvSpeedBarSection;
  I: Integer;
begin
  Sect := Sections[Section];
  if Sect <> nil then
  begin
    for I := Sect.Count - 1 downto 0 do
      RemoveItem(TJvSpeedItem(Sect[I]));
    Sect.FParent := nil;
    FSections[Section] := nil;
  end;
  FSections.Delete(Section);
end;

procedure TJvSpeedBar.RemoveItem(Item: TJvSpeedItem);
var
  I, Index: Integer;
begin
  if FindItem(Item, I, Index) then
  begin
    Item.FButton.Parent := nil;
    Item.FParent := nil;
    Item.FSection := -1;
    Sections[I].FList.Delete(Index);
  end;
end;

function TJvSpeedBar.SearchSection(const ACaption: string): Integer;
var
  I: Integer;
begin