jvoutlookbar.pas

East make Tray Icon in delphi

    Buttons[Value].Down := True;
end;

//=== { TJvOutlookBarPages } =================================================

constructor TJvOutlookBarPages.Create(AOwner: TPersistent);
begin
  inherited Create(AOwner, TJvOutlookBarPage);
end;

{$IFDEF COMPILER5}
function TJvOutlookBarPages.Owner: TPersistent;
begin
  Result := GetOwner;
end;
{$ENDIF COMPILER5}

function TJvOutlookBarPages.Add: TJvOutlookBarPage;
begin
  Result := TJvOutlookBarPage(inherited Add);
end;

procedure TJvOutlookBarPages.Assign(Source: TPersistent);
var
  I: Integer;
begin
  if Source is TJvOutlookBarPages then
  begin
    BeginUpdate;
    try
      Clear;
      for I := 0 to TJvOutlookBarPages(Source).Count - 1 do
        Add.Assign(TJvOutlookBarPages(Source)[I]);
    finally
      EndUpdate
    end;
  end
  else
    inherited Assign(Source);
end;

function TJvOutlookBarPages.GetItem(Index: Integer): TJvOutlookBarPage;
begin
  Result := TJvOutlookBarPage(inherited Items[Index]);
end;

function TJvOutlookBarPages.Insert(Index: Integer): TJvOutlookBarPage;
begin
  Result := TJvOutlookBarPage(inherited Insert(Index));
end;

procedure TJvOutlookBarPages.SetItem(Index: Integer;
  const Value: TJvOutlookBarPage);
begin
  inherited Items[Index] := Value;
end;

procedure TJvOutlookBarPages.Update(Item: TCollectionItem);
begin
  inherited Update(Item);
  if Owner <> nil then
    TJvCustomOutlookBar(Owner).Repaint;
end;

//=== { TJvThemedTopBottomButton } ===========================================

{$IFDEF JVCLThemesEnabled}

type
  TJvThemedTopBottomButton = class(TJvRepeatButton)
  private
    FIsUpBtn: Boolean;
  protected
    procedure WMEraseBkgnd(var Msg: TWmEraseBkgnd); message WM_ERASEBKGND;
    procedure Paint; override;
  end;

procedure TJvThemedTopBottomButton.Paint;
var
  Button: TThemedScrollBar;
  Details: TThemedElementDetails;
begin
  if csDestroying in ComponentState then
    Exit;
  if ThemeServices.ThemesEnabled and not Flat then
  begin
    if not Enabled then
      Button := tsArrowBtnUpDisabled
    else
    if FState in [bsDown, bsExclusive] then
      Button := tsArrowBtnUpPressed
    else
    if MouseInControl then
      Button := tsArrowBtnUpHot
    else
      Button := tsArrowBtnUpNormal;

    if not FIsUpBtn then
      Button := TThemedScrollBar(Ord(tsArrowBtnDownNormal) + Ord(Button) - Ord(tsArrowBtnUpNormal));

    Details := ThemeServices.GetElementDetails(Button);

    ThemeServices.DrawElement(Canvas.Handle, Details, ClientRect, nil); //@ClipRect);
  end
  else
    inherited Paint;
end;

procedure TJvThemedTopBottomButton.WMEraseBkgnd(var Msg: TWmEraseBkgnd);
begin
  Msg.Result := 1;
end;

{$ENDIF JVCLThemesEnabled}

//=== { TJvCustomOutlookBar } ================================================

constructor TJvCustomOutlookBar.Create(AOwner: TComponent);
var
  Bmp: TBitmap;
begin
  inherited Create(AOwner);
  DoubleBuffered := True;
  ControlStyle := ControlStyle - [csAcceptsControls] + [csOpaque];
  IncludeThemeStyle(Self, [csNeedsBorderPaint]);
  Bmp := TBitmap.Create;
  try
    {$IFDEF JVCLThemesEnabled}
    FTopButton := TJvThemedTopBottomButton.Create(Self);
    TJvThemedTopBottomButton(FTopButton).FIsUpBtn := True;
    {$ELSE}
    FTopButton := TJvRepeatButton.Create(Self);
    {$ENDIF JVCLThemesEnabled}
    with FTopButton do
    begin
      Parent := Self;
      Visible := False;
      Transparent := False;
      Bmp.LoadFromResourceName(HInstance, 'JvCustomOutlookBarUPARROW');
      Glyph := Bmp;
      OnClick := DoUpClick;
      if csDesigning in ComponentState then
        Top := -1000;
    end;

    {$IFDEF JVCLThemesEnabled}
    FBtmButton := TJvThemedTopBottomButton.Create(Self);
    TJvThemedTopBottomButton(FBtmButton).FIsUpBtn := False;
    {$ELSE}
    FBtmButton := TJvRepeatButton.Create(Self);
    {$ENDIF JVCLThemesEnabled}
    with FBtmButton do
    begin
      Parent := Self;
      Visible := False;
      Transparent := False;
      Bmp.LoadFromResourceName(HInstance, 'JvCustomOutlookBarDOWNARROW');
      Glyph := Bmp;
      OnClick := DoDwnClick;
      if csDesigning in ComponentState then
        Top := -1000;
    end;
  finally
    Bmp.Free;
  end;

  FPages := TJvOutlookBarPages.Create(Self);
  FLargeChangeLink := TChangeLink.Create;
  FLargeChangeLink.OnChange := DoChangeLinkChange;
  FSmallChangeLink := TChangeLink.Create;
  FSmallChangeLink.OnChange := DoChangeLinkChange;
  FPageChangeLink := TChangeLink.Create;
  FPageChangeLink.OnChange := DoChangeLinkChange;
  FEdit := TJvOutlookBarEdit.CreateInternal(Self, Self, nil);
  FEdit.Top := -1000;
  // set up defaults
  Width := 100;
  Height := 220;
  Color := clBtnShadow;
  BorderStyle := bsSingle;
  ButtonSize := olbsLarge;
  PageButtonHeight := 19;

  FPressedPageBtn := -1;
  FNextActivePage := -1;
  FLastButtonIndex := -1;
  FPressedButtonIndex := -1;
  {$IFDEF JVCLThemesEnabled}
  FHotPageBtn := -1;
  FThemedBackGround := True;
  {$ENDIF JVCLThemesEnabled}
  ActivePageIndex := 0;
end;

destructor TJvCustomOutlookBar.Destroy;
begin
  FEdit.Free;
  FLargeChangeLink.Free;
  FSmallChangeLink.Free;
  FPageChangeLink.Free;
  FPages.Free;
  inherited Destroy;
end;

procedure TJvCustomOutlookBar.DoDwnClick(Sender: TObject);
begin
  if FBtmButton.Visible then
    with Pages[ActivePageIndex] do
      if TopButtonIndex < Buttons.Count then
        TopButtonIndex := TopButtonIndex + 1;
end;

procedure TJvCustomOutlookBar.DoUpClick(Sender: TObject);
begin
  if FTopButton.Visible then
    with Pages[ActivePageIndex] do
      if TopButtonIndex > 0 then
        TopButtonIndex := TopButtonIndex - 1;
end;

{$IFDEF VCL}
procedure TJvCustomOutlookBar.CreateParams(var Params: TCreateParams);
const
  BorderStyles: array [TBorderStyle] of DWORD = (0, WS_BORDER);
begin
  inherited CreateParams(Params);
  with Params do
  begin
    Style := Style or BorderStyles[FBorderStyle];
    if NewStyleControls and Ctl3D and (FBorderStyle = bsSingle) then
    begin
      Style := Style and not WS_BORDER;
      ExStyle := ExStyle or WS_EX_CLIENTEDGE;
    end;
  end;
end;
{$ENDIF VCL}

procedure TJvCustomOutlookBar.DoChangeLinkChange(Sender: TObject);
begin
  Invalidate;
end;

procedure TJvCustomOutlookBar.Notification(AComponent: TComponent;
  Operation: TOperation);
var
  I, J: Integer;
begin
  inherited Notification(AComponent, Operation);
  if Operation = opRemove then
  begin
    if AComponent = FLargeImages then
      LargeImages := nil
    else
    if AComponent = FSmallImages then
      SmallImages := nil
    else
    if AComponent = FPageImages then
      PageImages := nil;
    if (AComponent is TBasicAction) and not (csDestroying in ComponentState) then
    begin
      for I := 0 to Pages.Count - 1 do
        for J := 0 to Pages[I].Buttons.Count - 1 do
          if AComponent = Pages[I].Buttons[J].Action then
            Pages[I].Buttons[J].Action := nil;
    end;
  end;
end;

procedure TJvCustomOutlookBar.DrawPageButton(R: TRect; Index: Integer; Pressed: Boolean);
var
  SavedDC, ATop: Integer;
  SavedColor: TColor;
  Flags: Cardinal;
  HasImage: Boolean;
begin
  ATop := R.Top + 1;
  if Pressed then
  begin
    if BorderStyle = bsNone then
      Frame3D(Canvas, R, clBtnShadow, clBtnHighlight, 1)
    else
    begin
      Frame3D(Canvas, R, cl3DDkShadow, clBtnHighlight, 1);
      Frame3D(Canvas, R, clBtnShadow, clBtnFace, 1);
    end;
  end
  else
  begin
    if BorderStyle = bsNone then
      Frame3D(Canvas, R, clBtnHighlight, clBtnShadow, 1)
    else
    begin
      Frame3D(Canvas, R, clBtnHighlight, cl3DDkShadow, 1);
      Frame3D(Canvas, R, clBtnFace, clBtnShadow, 1);
    end;
  end;
  Flags := DT_CENTER or DT_VCENTER or DT_SINGLELINE;
  HasImage := Assigned(PageImages) and (Pages[Index].ImageIndex >= 0) and (Pages[Index].ImageIndex < PageImages.Count);
  SavedDC := SaveDC(Canvas.Handle);
  try
    case Pages[Index].Alignment of
      taLeftJustify:
        begin
          if HasImage then
          begin
            PageImages.Draw(Canvas, 4, ATop, Pages[Index].ImageIndex,
              {$IFDEF VisualCLX} itImage, {$ENDIF} Pages[Index].Enabled);
            Inc(R.Left, PageImages.Width + 8);
          end
          else
            Inc(R.Left, 4);
          Flags := DT_LEFT or DT_VCENTER or DT_SINGLELINE;
        end;
      taCenter:
        if HasImage then
        begin
          PageImages.Draw(Canvas, 4, ATop, Pages[Index].ImageIndex,
            {$IFDEF VisualCLX} itImage, {$ENDIF} Pages[Index].Enabled);
          Inc(R.Left, PageImages.Width + 4);
        end;
      taRightJustify:
        begin
          if HasImage then
          begin
            PageImages.Draw(Canvas, 4, ATop, Pages[Index].ImageIndex,
              {$IFDEF VisualCLX} itImage, {$ENDIF} Pages[Index].Enabled);
            Inc(R.Left, PageImages.Width + 8);
          end;
          Dec(R.Right, 4);
          Flags := DT_RIGHT or DT_VCENTER or DT_SINGLELINE;
        end;
    end;
  finally
    RestoreDC(Canvas.Handle, SavedDC);
  end;
  SetBkMode(Canvas.Handle, TRANSPARENT);
  OffsetRect(R, 0, -1);
  SavedColor := Canvas.Font.Color;
  try
    if not Pages[Index].Enabled then
    begin
      OffsetRect(R, 1, 1);
      Canvas.Font.Color := clWhite;
      DrawText(Canvas, Pages[Index].Caption, -1, R, Flags or DT_END_ELLIPSIS);
      OffsetRect(R, -1, -1);
      Canvas.Font.Color := clGrayText;
    end;
    DrawText(Canvas, Pages[Index].Caption, -1, R, Flags or DT_END_ELLIPSIS);
  finally
    Canvas.Font.Color := SavedColor;
  end;
end;

function TJvCustomOutlookBar.DrawTopPages: Integer;
var
  R: TRect;
  I: Integer;
  {$IFDEF JVCLThemesEnabled}
  ToolBar: TThemedToolBar;
  Details: TThemedElementDetails;
  ClipRect: TRect;
  LColor: Cardinal;
  {$ENDIF JVCLThemesEnabled}
begin
  Result := -1;
  if csDestroying in ComponentState then
    Exit;
  R := GetPageButtonRect(0);

  for I := 0 to Pages.Count - 1 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);
    if I >= ActivePageIndex then
    begin