⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 jvqspeedbar.pas

📁 East make Tray Icon in delphi
💻 PAS
📖 第 1 页 / 共 5 页
字号:
  end;
end;

procedure TJvSpeedBar.AddItem(Section: Integer; Item: TJvSpeedItem);
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 TJvSpeedBar.FindItem(Item: TJvSpeedItem; 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 TJvSpeedBar.AlignItemsToGrid;
begin
  ForEachItem(AlignItemToGrid, 0);
end;

procedure TJvSpeedBar.AlignItemToGrid(Item: TJvSpeedItem; 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 TJvSpeedBar.AcceptDropItem(Item: TJvSpeedItem; 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 TJvSpeedBar.SetItemEditing(Item: TJvSpeedItem; Data: Longint);
begin
  Item.SetEditing(FEditWin <> NullHandle);
end;

function TJvSpeedBar.GetEditing: Boolean;
begin
  Result := (FEditWin <> NullHandle);
end;

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

procedure TJvSpeedBar.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;
    Canvas.Brush.Color := Color; 
      Canvas.FillRect(Rect);
    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 + Ord(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 - Ord(blBottom in FBoundLines));
        BevelLine(C2, Rect.Right - 1, Rect.Top, Rect.Right - 1, Rect.Bottom);
      end;
    end;
  end;
end;

procedure TJvSpeedBar.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 <> NullHandle then
      SendMessage(FEditWin, CM_SPEEDBARCHANGED, SBR_BTNSIZECHANGED, Longint(Self));
  end;
end;

procedure TJvSpeedBar.SetOrientation(Value: TBarOrientation);
begin
  if GetOrientation <> Value then
  begin
    if FPosition = bpAuto then
      raise EJvSpeedbarError.CreateRes(@RsEAutoSpeedbarMode);
    ApplyOrientation(Value);
  end;
end;

function TJvSpeedBar.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 TJvSpeedBar.GetAlign: TAlign;
begin
  Result := FAlign;
end;

procedure TJvSpeedBar.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 EJvSpeedbarError.CreateRes(@RsEAutoSpeedbarMode);
    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 EJvSpeedbarError.CreateRes(@RsEAutoSpeedbarMode);
      end;
    FAlign := inherited Align;
  end;
end;

procedure TJvSpeedBar.ChangeScale(M, D, MH, DH: 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, MH, DH);
    if sfOffsetX in Flags then
      FOffset.X := MulDiv(FOffset.X, MH, DH); 
    if (sfBtnSizeY in Flags) and not (csFixedHeight in ControlStyle) then
      FButtonSize.Y := MulDiv(FButtonSize.Y, M, D);
    if sfOffsetY in Flags then
      FOffset.Y := MulDiv(FOffset.Y, M, D);
    UpdateGridSize;
    inherited ChangeScale(M, D , MH, DH );
    ApplyButtonSize;
    AlignItemsToGrid;
    FScaleFlags := [];
  finally
    EnableAlign;
  end;
end;

procedure TJvSpeedBar.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 TJvSpeedBar.FlatItem(Item: TJvSpeedItem; Data: Longint);
begin
  Item.FButton.Flat := Boolean(Data);
end;

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

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

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

procedure TJvSpeedBar.SetOptions(Value: TJvSpeedBarOptions);
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 TJvSpeedBar.OffsetItem(Item: TJvSpeedItem; 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 TJvSpeedBar.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 TJvSpeedBar.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 TJvSpeedBar.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));
        while Bas

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -