speedbar.pas

RX Library contains a large number of components, objects and routines for Borland Delphi with full

  Value.Caption := UniqueName;
  Result := FSections.Add(Value);
  if Result >= 0 then begin
    Value.FParent := Self;
    for I := 0 to Value.Count - 1 do begin
      Value[I].FSection := Result;
      SetItemParams(Value[I], not (csLoading in ComponentState));
    end;
  end;
end;

function TSpeedBar.AddSection(const ACaption: string): Integer;
var
  Section: TSpeedbarSection;
begin
  if Owner <> nil then Section := TSpeedbarSection.Create(Owner)
  else Section := TSpeedbarSection.Create(Self);
  Section.Caption := ACaption;
  Result := AppendSection(Section);
end;

procedure TSpeedBar.SetItemParams(Item: TSpeedItem; InitBounds: Boolean);
begin
  with Item do begin
    FParent := Self;
    with FButton do begin
      if InitBounds then SetBounds(0, 0, BtnWidth, BtnHeight);
      Style := FButtonStyle;
      Flat := (sbFlatBtns in Options);
      Transparent := (sbTransparentBtns in Options);
      GrayedInactive := (sbGrayedBtns in Options);
    end;
    SetEditing(FEditWin <> 0);
  end;
end;

function TSpeedBar.NewItem(AOwner: TComponent; Section: Integer;
  const AName: string): TSpeedItem;
begin
  Result := nil;
  if (Section >= 0) and (Section < FSections.Count) then begin
    Result := TSpeedItem.Create(AOwner);
    try
      Sections[Section].FList.Add(Result);
      Result.FSection := Section;
      SetItemParams(Result, True);
      if AName <> '' then
        with Result do begin
          Name := AName;
          Caption := AName;
          FButton.Visible := False;
          FButton.Parent := Self;
        end;
    except
      Result.Free;
      raise;
    end;
  end;
end;

procedure TSpeedBar.AddItem(Section: Integer; Item: TSpeedItem);
var
  I, Index: Integer;
begin
  if FindItem(Item, I, Index) then begin
    Sections[I].FList.Delete(Index);
    if Section >= FSections.Count then Section := FSections.Count - 1;
    Sections[Section].FList.Add(Item);
    Item.FSection := Section;
    Exit;
  end;
  if (Section >= 0) and (Item <> nil) then begin
    if Assigned(FOnAddItem) then begin
      FOnAddItem(Item);
      Section := Item.FSection;
    end;
    if FSections.Count = 0 then Section := AddSection('')
    else if Section >= FSections.Count then Section := FSections.Count - 1;
    Sections[Section].FList.Add(Item);
    Item.FSection := Section;
    SetItemParams(Item, not (csLoading in ComponentState));
    Item.FButton.Visible := False;
    Item.FButton.Parent := Self;
  end;
end;

function TSpeedBar.FindItem(Item: TSpeedItem; var Section,
  Index: Integer): Boolean;
var
  I: Integer;
begin
  Result := False;
  Section := -1;
  for I := 0 to FSections.Count - 1 do
    if FSections[I] <> nil then begin
      Index := Sections[I].FList.IndexOf(Item);
      if Index >= 0 then begin
        Section := I;
        Result := True;
        Exit;
      end;
    end;
end;

procedure TSpeedBar.AlignItemsToGrid;
begin
  ForEachItem(AlignItemToGrid, 0);
end;

procedure TSpeedBar.AlignItemToGrid(Item: TSpeedItem; Data: Longint);
begin
  if Item.Visible then begin
    if GetOrientation = boVertical then begin
      Item.Left := Trunc((Item.Left - FOffset.X) / FGridSize.X) * FGridSize.X + FOffset.X;
      Item.Top := Round((Item.Top - FOffset.Y) / FGridSize.Y) * FGridSize.Y + FOffset.Y;
    end
    else begin
      Item.Left := Round((Item.Left - FOffset.X) / FGridSize.X) * FGridSize.X + FOffset.X;
      Item.Top := Trunc((Item.Top - FOffset.Y) / FGridSize.Y) * FGridSize.Y + FOffset.Y;
    end;
  end;
end;

function TSpeedBar.AcceptDropItem(Item: TSpeedItem; X, Y: Integer): Boolean;
var
  I, Sect: Integer;
begin
  Result := False;
  if FindItem(Item, Sect, I) then begin
    if GetOrientation = boVertical then begin
      X := Trunc((X - FOffset.X) / FGridSize.X) * FGridSize.X + FOffset.X;
      Y := Round((Y - FOffset.Y) / FGridSize.Y) * FGridSize.Y + FOffset.Y;
    end
    else begin
      X := Round((X - FOffset.X) / FGridSize.X) * FGridSize.X + FOffset.X;
      Y := Trunc((Y - FOffset.Y) / FGridSize.Y) * FGridSize.Y + FOffset.Y;
    end;
    Item.Left := X;
    Item.Top := Y;
    Result := PtInRect(ClientRect, Point(X, Y));
    if Result then Item.FButton.BringToFront
    else Item.FButton.SendToBack;
    Item.Visible := Result;
  end;
end;

procedure TSpeedBar.SetItemEditing(Item: TSpeedItem; Data: Longint);
begin
  Item.SetEditing(FEditWin <> 0);
end;

function TSpeedBar.GetEditing: Boolean;
begin
  Result := (FEditWin <> 0);
end;

procedure TSpeedBar.SetEditing(Win: HWnd);
begin
  FEditWin := Win;
  ForEachItem(SetItemEditing, 0);
  if (FEditWin = 0) and not (csDesigning in ComponentState) then
    AfterCustomize;
end;

procedure TSpeedBar.Paint;
var
  XCnt, YCnt, X, Y: Integer;
  BevelSize, SaveIndex: Integer;
  Rect: TRect;
  C1, C2: TColor;

  procedure BevelLine(C: TColor; X1, Y1, X2, Y2: Integer);
  begin
    with Canvas do begin
      Pen.Color := C;
      MoveTo(X1, Y1);
      LineTo(X2, Y2);
    end;
  end;

begin
  if not FLocked then begin
    Rect := ClientRect;
    BevelSize := BorderWidth;
    if BevelOuter <> bvNone then Inc(BevelSize, BevelWidth);
    if BevelInner <> bvNone then Inc(BevelSize, BevelWidth);
    InflateRect(Rect, -BevelSize, -BevelSize);
    inherited Paint;
    if (FWallpaper.Graphic <> nil) and (FWallpaper.Width > 0) and
      (FWallpaper.Height > 0) then
    begin
      SaveIndex := SaveDC(Canvas.Handle);
      try
        with Rect do
          IntersectClipRect(Canvas.Handle, Left, Top, Right - Left +
            BevelSize, Bottom - Top + BevelSize);
        if sbStretchBitmap in Options then
          Canvas.StretchDraw(Rect, FWallpaper.Graphic)
        else begin
          XCnt := (ClientWidth - 2 * BevelSize) div FWallpaper.Width;
          YCnt := (ClientHeight - 2 * BevelSize) div FWallpaper.Height;
          for X := 0 to XCnt do
            for Y := 0 to YCnt do
              Canvas.Draw(Rect.Left + X * FWallpaper.Width,
                Rect.Top + Y * FWallpaper.Height, FWallpaper.Graphic);
        end;
      finally
        RestoreDC(Canvas.Handle, SaveIndex);
      end;
    end;
    if FBoundLines <> [] then begin
      C1 := clBtnShadow;
      C2 := clBtnHighlight;
      if blTop in FBoundLines then begin
        BevelLine(C1, Rect.Left, Rect.Top, Rect.Right, Rect.Top);
        BevelLine(C2, Rect.Left, Rect.Top + 1, Rect.Right, Rect.Top + 1);
      end;
      if blLeft in FBoundLines then begin
        BevelLine(C1, Rect.Left, Rect.Top, Rect.Left, Rect.Bottom);
        BevelLine(C2, Rect.Left + 1, Rect.Top + Integer(blTop in FBoundLines), Rect.Left + 1, Rect.Bottom);
      end;
      if blBottom in FBoundLines then begin
        BevelLine(C1, Rect.Left, Rect.Bottom - 2, Rect.Right, Rect.Bottom - 2);
        BevelLine(C2, Rect.Left, Rect.Bottom - 1, Rect.Right, Rect.Bottom - 1);
      end;
      if blRight in FBoundLines then begin
        BevelLine(C1, Rect.Right - 2, Rect.Top, Rect.Right - 2, Rect.Bottom - Integer(blBottom in FBoundLines));
        BevelLine(C2, Rect.Right - 1, Rect.Top, Rect.Right - 1, Rect.Bottom);
      end;
    end;
  end;
end;

procedure TSpeedBar.ApplyOrientation(Value: TBarOrientation);
begin
  if (GetOrientation <> Value) and not (csReading in ComponentState) then begin
    FLocked := True;
    try
      FOrientation := Value;
      SwapInt(Integer(FButtonSize.X), Integer(FButtonSize.Y));
      SwapInt(Integer(FGridSize.X), Integer(FGridSize.Y));
      SwapInt(Integer(FOffset.X), Integer(FOffset.Y));
      ForEachItem(SwapItemBounds, 0);
    finally
      FLocked := False;
      Invalidate;
    end;
    if FEditWin <> 0 then
      SendMessage(FEditWin, CM_SPEEDBARCHANGED, SBR_BTNSIZECHANGED, Longint(Self));
  end;
end;

procedure TSpeedBar.SetOrientation(Value: TBarOrientation);
begin
  if GetOrientation <> Value then begin
    if (FPosition = bpAuto) then
      raise ESpeedbarError.Create(SAutoSpeedbarMode);
    ApplyOrientation(Value);
  end;
end;

function TSpeedBar.GetOrientation: TBarOrientation;
begin
  if FPosition = bpCustom then Result := FOrientation
  else
    case Align of
      alLeft, alRight: Result := boVertical;
      alTop, alBottom: Result := boHorizontal;
      else Result := FOrientation;
    end;
end;

function TSpeedBar.GetAlign: TAlign;
begin
  Result := FAlign;
end;

procedure TSpeedBar.SetAlign(Value: TAlign);
var
  X, Y: Integer;
begin
  { fix previous version error }
  if (csLoading in ComponentState) and (Value = alNone) and
    (Position = bpAuto) then FFix := True;
  if Align <> Value then begin
    X := Width; Y := Height;
    if (FPosition = bpAuto) and (Value in [alClient, alNone]) then
      raise ESpeedbarError.Create(SAutoSpeedbarMode);
    inherited Align := Value;
    if (csLoading in ComponentState) then begin
      Width := X; Height := Y;
    end;
    if FPosition = bpAuto then
      case Value of
        alLeft, alRight: ApplyOrientation(boVertical);
        alTop, alBottom: ApplyOrientation(boHorizontal);
        else if not (csLoading in ComponentState) then
          raise ESpeedbarError.Create(SAutoSpeedbarMode);
      end;
    FAlign := inherited Align;
  end;
end;

procedure TSpeedBar.ChangeScale(M, D: Integer);
var
  Flags: TSbScaleFlags;
begin
  DisableAlign;
  try
    if csLoading in ComponentState then Flags := ScaleFlags
    else Flags := [sfOffsetX, sfOffsetY, sfBtnSizeX, sfBtnSizeY];
    if (sfBtnSizeX in Flags) and not (csFixedWidth in ControlStyle) then
      FButtonSize.X := MulDiv(FButtonSize.X, M, D);
    if (sfBtnSizeY in Flags) and not (csFixedHeight in ControlStyle) then
      FButtonSize.Y := MulDiv(FButtonSize.Y, M, D);
    if (sfOffsetX in Flags) then
      FOffset.X := MulDiv(FOffset.X, M, D);
    if (sfOffsetY in Flags) then
      FOffset.Y := MulDiv(FOffset.Y, M, D);
    UpdateGridSize;
    inherited ChangeScale(M, D);
    ApplyButtonSize;
    AlignItemsToGrid;
    FScaleFlags := [];
  finally
    EnableAlign;
  end;
end;

procedure TSpeedBar.AlignControls(AControl: TControl; var Rect: TRect);
var
  P: TPoint;
  Min: Integer;
begin
  if FBoundLines <> [] then begin
    if blTop in FBoundLines then Inc(Rect.Top, 2);
    if blBottom in FBoundLines then Dec(Rect.Bottom, 2);
    if blLeft in FBoundLines then Inc(Rect.Left, 2);
    if blRight in FBoundLines then Dec(Rect.Right, 2);
  end;
  inherited AlignControls(AControl, Rect);
  Min := MinButtonsOffset;
  if FOffset.X < Min then begin
    P.X := Min - FOffset.X;
    FOffset.X := Min;
  end else P.X := 0;
  if FOffset.Y < Min then begin
    P.Y := Min - FOffset.Y;
    FOffset.Y := Min;
  end else P.Y := 0;
  if not (csLoading in ComponentState) and ((P.X <> 0) or (P.Y <> 0)) then
    ForEachItem(OffsetItem, Longint(@P));
end;

procedure TSpeedBar.FlatItem(Item: TSpeedItem; Data: Longint);
begin
  Item.FButton.Flat := Boolean(Data);
end;

procedure TSpeedBar.GrayedItem(Item: TSpeedItem; Data: Longint);
begin
  Item.FButton.GrayedInactive := Boolean(Data);
end;

procedure TSpeedBar.TransparentItem(Item: TSpeedItem; Data: Longint);
begin
  Item.FButton.Transparent := Boolean(Data);
end;

procedure TSpeedBar.SetBoundLines(Value: TBoundLines);
begin
  if FBoundLines <> Value then begin
    FBoundLines := Value;
    Realign;
    Invalidate;
  end;
end;

procedure TSpeedBar.SetOptions(Value: TSpeedbarOptions);
var
  FlatChanged: Boolean;
begin
  if FOptions <> Value then begin
    FlatChanged := (sbFlatBtns in FOptions) <> (sbFlatBtns in Value);
    FOptions := Value;
    ForEachItem(FlatItem, Longint(sbFlatBtns in Options));
    ForEachItem(TransparentItem, Longint(sbTransparentBtns in Options));
    ForEachItem(GrayedItem, Longint(sbGrayedBtns in Options));
    UpdateGridSize;
    if FlatChanged then Realign;
    Invalidate;
  end;
end;

procedure TSpeedBar.OffsetItem(Item: TSpeedItem; Data: Longint);
var
  P: TPoint;
begin
  P := PPoint(Data)^;
  Item.FButton.SetBounds(Item.Left + P.X, Item.Top + P.Y, FButtonSize.X,
    FButtonSize.Y);
end;

function TSpeedBar.GetButtonsOffset(Index: Integer): Integer;
begin
  if Index = 0 then Result := FOffset.X
  else if Index = 1 then Result := FOffset.Y
  else Result := 0;
end;

procedure TSpeedBar.SetButtonsOffset(Index: Integer; Value: Integer);
var
  P: TPoint;
begin
  if Value < MinButtonsOffset then Value := MinButtonsOffset;
  P.X := 0; P.Y := 0;
  if Index = 0 then begin
    P.X := Value - FOffset.X;
    FOffset.X := Value;
    Include(FScaleFlags, sfOffsetX);
  end
  else if Index = 1 then begin
    P.Y := Value - FOffset.Y;
    FOffset.Y := Value;
    Include(FScaleFlags, sfOffsetY);
  end;
  if (P.X <> 0) or (P.Y <> 0) then
    ForEachItem(OffsetItem, Longint(@P));
end;

procedure TSpeedBar.UpdateGridSize;
var
  Base: Integer;
begin
  case Orientation of
    boHorizontal: Base := FButtonSize.X;
    else {boVertical:} Base := FButtonSize.Y;
  end;
  case Orientation of
    boHorizontal:
      begin
        FGridSize.X := Max(1, Min(8, Base div 3)