jvoutlookbar.pas

East make Tray Icon in delphi

      Result := I;
      Exit;
    end;
  end;
  Result := Pages.Count - 1;
end;

procedure TJvCustomOutlookBar.DrawButtons(Index: Integer);
var
  I, H: Integer;
  R, R2, R3: TRect;
  C: TColor;
  SavedDC: Integer;
  SavedColor: TColor;
  {$IFDEF JVCLThemesEnabled}
  ThemedColor: Cardinal;
  Details: TThemedElementDetails;
  {$ENDIF JVCLThemesEnabled}
begin
  if csDestroying in ComponentState then
    Exit;
  if (Index < 0) or (Index >= Pages.Count) or (Pages[Index].Buttons = nil) or
    (Pages[Index].Buttons.Count <= 0) then
    Exit;
  R2 := GetPageRect(Index);
  R := GetButtonRect(Index, Pages[Index].TopButtonIndex);
  H := GetButtonHeight(Index);
  C := Canvas.Pen.Color;
  Canvas.Font := Pages[Index].Font;

  {$IFDEF JVCLThemesEnabled}
  if ThemeServices.ThemesEnabled then
  begin
    Details := ThemeServices.GetElementDetails(ttbButtonNormal);
    with Details do
      GetThemeColor(ThemeServices.Theme[Element], Part, State, TMT_TEXTCOLOR, ThemedColor);
  end;
  {$ENDIF JVCLThemesEnabled}
  try
    Canvas.Brush.Style := bsClear;
    for I := Pages[Index].TopButtonIndex to Pages[Index].Buttons.Count - 1 do
    begin
      Canvas.Font := Pages[Index].Font;
//      Canvas.Rectangle(R);  // DEBUG
      {$IFDEF JVCLThemesEnabled}
      if ThemeServices.ThemesEnabled then
        Canvas.Font.Color := ThemedColor;
      {$ENDIF JVCLThemesEnabled}
      if Pages[Index].Buttons[I].Down then
      begin
        Canvas.Font := Pages[Index].DownFont;
        DrawButtonFrame(Index, I, I);
      end;
      if DoDrawButton(R, I, Pages[Index].Buttons[I].Down, I = FLastButtonIndex) then
        case Pages[Index].ButtonSize of
          olbsLarge:
            begin
              SavedColor := Canvas.Font.Color;
              try
                SavedDC := SaveDC(Canvas.Handle);
                try
                  if LargeImages <> nil then
                    LargeImages.Draw(Canvas, R.Left + ((R.Right - R.Left) - LargeImages.Width) div 2, R.Top + 4,
                      Pages[Index].Buttons[I].ImageIndex,
                      {$IFDEF VisualCLX} itImage, {$ENDIF}
                      Pages[Index].Enabled and Pages[Index].Buttons[I].Enabled);
                finally
                  RestoreDC(Canvas.Handle, SavedDC);
                end;
                R3 := GetButtonTextRect(ActivePageIndex, I);
                SetBkMode(Canvas.Handle, TRANSPARENT);
                if not Pages[Index].Enabled or not Pages[Index].Buttons[I].Enabled then
                begin
                  if ColorToRGB(Pages[Index].Color) = ColorToRGB(clGrayText) then
                    Canvas.Font.Color := clBtnFace
                  else
                    Canvas.Font.Color := clGrayText;
                end;
                {$IFDEF VCL}
                DrawText(Canvas.Handle, PChar(Pages[Index].Buttons[I].Caption), -1, R3,
                  DT_EXPANDTABS or DT_SINGLELINE or DT_CENTER or DT_VCENTER);
                {$ENDIF VCL}
                {$IFDEF VisualCLX}
                DrawText(Canvas, Pages[Index].Buttons[I].Caption, -1, R3,
                  DT_EXPANDTABS or DT_SINGLELINE or DT_CENTER or DT_VCENTER);
                {$ENDIF VisualCLX}
              finally
                Canvas.Font.Color := SavedColor;
              end;
            end;
          olbsSmall:
            begin
              SavedColor := Canvas.Font.Color;
              try
                SavedDC := SaveDC(Canvas.Handle);
                try
                  if SmallImages <> nil then
                    SmallImages.Draw(Canvas, R.Left + 2, R.Top + 2,
                      Pages[Index].Buttons[I].ImageIndex,
                      {$IFDEF VisualCLX} itImage, {$ENDIF}
                      Pages[Index].Enabled and Pages[Index].Buttons[I].Enabled);
                finally
                  RestoreDC(Canvas.Handle, SavedDC);
                end;
                R3 := GetButtonTextRect(ActivePageIndex, I);
                SetBkMode(Canvas.Handle, TRANSPARENT);
                if not Pages[Index].Enabled or not Pages[Index].Buttons[I].Enabled then
                begin
                  if ColorToRGB(Pages[Index].Color) = ColorToRGB(clGrayText) then
                    Canvas.Font.Color := clBtnFace
                  else
                    Canvas.Font.Color := clGrayText;
                end;
                InflateRect(R3, -4, 0);
                {$IFDEF VCL}
                DrawText(Canvas.Handle, PChar(Pages[Index].Buttons[I].Caption), -1, R3,
                  DT_EXPANDTABS or DT_SINGLELINE or DT_LEFT or DT_VCENTER or DT_NOCLIP or DT_EDITCONTROL);
                {$ENDIF VCL}
                {$IFDEF VisualCLX}
                DrawText(Canvas, Pages[Index].Buttons[I].Caption, -1, R3,
                  DT_EXPANDTABS or DT_SINGLELINE or DT_LEFT or DT_VCENTER or DT_NOCLIP);
                {$ENDIF VisualCLX}
              finally
                Canvas.Font.Color := SavedColor;
              end;
            end;
        end;
      OffsetRect(R, 0, H);
      if R.Top >= R2.Bottom then
        Break;
    end;
  finally
    Canvas.Font := Self.Font;
    Canvas.Pen.Color := C;
  end;
end;

procedure TJvCustomOutlookBar.DrawArrowButtons(Index: Integer);
var
  R: TRect;
  H: Integer;
begin
  if csDestroying in ComponentState then
    Exit;
  if (Index < 0) or (Index >= Pages.Count) or (Pages[Index].Buttons = nil) or
    (Pages[Index].Buttons.Count <= 0) then
  begin
    TopButton.Visible := False;
    BtmButton.Visible := False;
  end
  else
  begin
    R := GetPageRect(Index);
    H := GetButtonHeight(Index);
    TopButton.Visible := (Pages.Count > 0) and (R.Top < R.Bottom - 20) and (Pages[Index].TopButtonIndex > 0);
    BtmButton.Visible := (Pages.Count > 0) and (R.Top < R.Bottom - 20) and
      (R.Bottom - R.Top < (Pages[Index].Buttons.Count - Pages[Index].TopButtonIndex) * H);
  // remove the last - H to show arrow
  // button when the bottom of the last button is beneath the edge
  end;
  if TopButton.Visible then
    TopButton.SetBounds(ClientWidth - 20, R.Top + 4, 16, 16)
  else
  if csDesigning in ComponentState then
    TopButton.Top := -1000;
  if BtmButton.Visible then
    BtmButton.SetBounds(ClientWidth - 20, R.Bottom - 20, 16, 16)
  else
  if csDesigning in ComponentState then
    BtmButton.Top := -1000;
  TopButton.Enabled := TopButton.Visible and Pages[Index].Enabled;
  BtmButton.Enabled := BtmButton.Visible and Pages[Index].Enabled;
end;

function TJvCustomOutlookBar.DrawPicture(R: TRect; Picture: TPicture): Boolean;
var
  Bmp: TBitmap;
begin
  Result := Assigned(Picture) and Assigned(Picture.Graphic) and not Picture.Graphic.Empty;
  if csDestroying in ComponentState then
    Exit;
  if Result then
  begin
    Bmp := TBitmap.Create;
    try
      Bmp.Assign(Picture.Graphic);
      Canvas.Brush.Bitmap := Bmp;
      Canvas.FillRect(R);
      Canvas.Brush.Bitmap := nil;
    finally
      Bmp.Free;
    end;
  end;
end;

procedure TJvCustomOutlookBar.DrawCurrentPage(PageIndex: Integer);
var
  R: TRect;
  AColor: TColor;
  {$IFDEF JVCLThemesEnabled}
  Details: TThemedElementDetails;
  {$ENDIF JVCLThemesEnabled}
begin
  if csDestroying in ComponentState then
    Exit;
  if (PageIndex < 0) or (PageIndex >= Pages.Count) or (Pages[PageIndex].Buttons = nil) then
    Exit;
  R := GetPageRect(PageIndex);
  AColor := Canvas.Brush.Color;
  try
    Canvas.Brush.Color := Pages[PageIndex].Color;
    Canvas.Font := Self.Font;
    if DoDrawPage(R, PageIndex) then
    begin
      if not DrawPicture(R, Pages[PageIndex].Picture) then
      begin
        {$IFDEF JVCLThemesEnabled}
        if (Canvas.Brush.Color = clDefault) and ThemedBackground and ThemeServices.ThemesEnabled then
        begin
          Details := ThemeServices.GetElementDetails(tebHeaderBackgroundNormal);
          ThemeServices.DrawElement(Canvas.Handle, Details, R);
        end
        else
        {$ENDIF JVCLThemesEnabled}
        begin
          if Canvas.Brush.Color = clDefault then
            Canvas.Brush.Color := Self.Color;
          Canvas.FillRect(R);
        end;
      end;
    end;
    DrawButtonFrame(ActivePageIndex, FLastButtonIndex, FPressedButtonIndex);
    DrawButtons(PageIndex);
  finally
    Canvas.Brush.Color := AColor;
    Canvas.Brush.Style := bsClear;
    SetBkMode(Canvas.Handle, TRANSPARENT);
  end;
  DrawArrowButtons(PageIndex);
end;

procedure TJvCustomOutlookBar.DrawBottomPages(StartIndex: Integer);
var
  R: TRect;
  I: Integer;
  {$IFDEF JVCLThemesEnabled}
  Details: TThemedElementDetails;
  ClipRect: TRect;
  ToolBar: TThemedToolBar;
  LColor: Cardinal;
  {$ENDIF JVCLThemesEnabled}
begin
  if csDestroying in ComponentState then
    Exit;
  R := GetPageButtonRect(Pages.Count - 1);
  for I := Pages.Count - 1 downto StartIndex do
  begin
    if DoDrawPageButton(R, I, FPressedPageBtn = I) then
    begin
      {$IFDEF JVCLThemesEnabled}
      if ThemeServices.ThemesEnabled then
      begin
        if (FPressedPageBtn = I) or (FHotPageBtn = I) then
          ToolBar := ttbButtonPressed
        else
          ToolBar := ttbButtonHot;
        Details := ThemeServices.GetElementDetails(ToolBar);

        if BorderStyle = bsNone then
        begin
          ClipRect := R;
          InflateRect(R, 1, 1);
          ThemeServices.DrawElement(Canvas.Handle, Details, R, @ClipRect);
          InflateRect(R, -1, -1);
        end
        else
          ThemeServices.DrawElement(Canvas.Handle, Details, R);

        { Determine text color }
        if FPressedPageBtn = I then
          ToolBar := ttbButtonPressed
        else
        if FHotPageBtn = I then
          ToolBar := ttbButtonHot
        else
          ToolBar := ttbButtonNormal;
        Details := ThemeServices.GetElementDetails(ToolBar);

        with Details do
          GetThemeColor(ThemeServices.Theme[Element], Part, State, TMT_TEXTCOLOR, LColor);
        Canvas.Font.Color := LColor;
      end
      else
      {$ENDIF JVCLThemesEnabled}
      begin
        Canvas.Brush.Color := clBtnFace;
        Canvas.FillRect(R);
      end;
      DrawPageButton(R, I, FPressedPageBtn = I);
    end;
    OffsetRect(R, 0, -PageButtonHeight);
  end;
end;

function TJvCustomOutlookBar.GetPageButtonAtPos(P: TPoint): TJvOutlookBarPage;
var
  I: Integer;
begin
  // TODO: rewrite more optimal (no loop)
  for I := 0 to Pages.Count - 1 do
  begin
    if PtInRect(GetPageButtonRect(I), P) then
    begin
      Result := Pages[I];
      Exit;
    end;
  end;
  Result := nil;
end;

function TJvCustomOutlookBar.GetPageButtonRect(Index: Integer): TRect;
begin
  Result := Rect(0, 0, 0, 0);
  if (Index < 0) or (Index >= Pages.Count) then
    Exit;
  Result := Rect(0, 0, ClientWidth, PageButtonHeight);
  if Index <= ActivePageIndex then
    OffsetRect(Result, 0, PageButtonHeight * Index)
  else
    OffsetRect(Result, 0, (ClientHeight - PageButtonHeight * (Pages.Count - Index)));
end;

function TJvCustomOutlookBar.GetPageTextRect(Index: Integer): TRect;
begin
  Result := GetPageButtonRect(Index);
  InflateRect(Result, -2, -2);
end;

function TJvCustomOutlookBar.GetPageRect(Index: Integer): TRect;
begin
  if (Index < 0) or (Index >= Pages.Count) then
    Result := Rect(0, 0, 0, 0)
  else
    Result := Rect(0, PageButtonHeight * Index + PageButtonHeight, ClientWidth, ClientHeight - (Pages.Count - Index) *
      PageButtonHeight + PageButtonHeight);
end;

function TJvCustomOutlookBar.GetButtonAtPos(P: TPoint): TJvOutlookBarButton;
var
  I, H: Integer;
  R, B: TRect;
begin
  // this always returns the button in the visible part of the active page (if any)
  Result := nil;
  if (ActivePageIndex < 0) or (ActivePageIndex >= Pages.Count) then
    Exit;
  B := GetButtonRect(ActivePageIndex, 0);
  H := GetButtonHeight(ActivePageIndex);
  R := GetPageRect(ActivePageIndex);
  for I := 0 to Pages[ActivePageIndex].Buttons.Count - 1 do
  begin
    if PtInRect(B, P) then
    begin
      Result := Pages[ActivePageIndex].Buttons[I];
      Exit;
    end;
    OffsetRect(B, 0, H);
    if B.Top >= R.Bottom then
      Break;
  end;
end;

function TJvCustomOutlookBar.GetButtonRect(PageIndex, ButtonIndex: Integer): TRect;
var
  H: Integer;
begin
  Result := Rect(0, 0, 0, 0);
  if (PageIndex < 0) or (PageIndex >= Pages.Count) or
    (ButtonIndex < 0) or (ButtonIndex >= Pages[PageIndex].Buttons.Count) then
    Exit;
  H := GetButtonHeight(PageIndex);
  case Pages[PageIndex].ButtonSize of
    olbsLarge:
      if LargeImages <> nil then
      begin
        Result := Rect(0, 0, Max(LargeImages.Width, Canvas.TextWidth(Pages[PageIndex].Buttons[ButtonIndex].Caption)) +
          4, H);
        OffsetRect(Result, (ClientWidth - (Result.Right - Result.Left)) div 2, cButtonTopOffset);
      end
      else
        Result := Rect(0, 0, ClientWidth, cButtonTopOffset + H);
    olbsSmall:
      if SmallImages <> nil then
      begin
        Result := Rect(0, 0, SmallImages.Width + Canvas.TextWidth(Pages[PageIndex].Buttons[ButtonIndex].Caption) + 8,
          H);
        OffsetRect(Result, cButtonLeftOffset, cButtonTopOffset);
      end
      else
        Result := Rect(0, 0, ClientWidth, cButtonTopOffset + H);
  end;
  OffsetRect(Result, 0, (ButtonIndex - Pages[PageIndex].TopButtonIndex) * H + GetPageRect(PageIndex).Top);
end;

function TJvCustomOutlookBar.GetButtonFrameRect(PageIndex, ButtonIndex: Integer): TRect;
var
  H: Integer;
begin
  Result := Rect(0, 0, 0, 0);
  if (PageIndex < 0) or (PageIndex >= Pages.Count) or
    (ButtonIndex < 0) or (ButtonIndex >= Pages[PageIndex].Buttons.Count) then
    Exit;
  H := GetButtonHeight(PageIndex);
  case Pages[PageIndex].ButtonSize of
    olbsLarge:
      if LargeImages <> nil then
      begin
        Result := Rect(0, 0, LargeImages.Width + 6, LargeImages.Heig