jvqoutlookbar.pas

East make Tray Icon in delphi

  FPressedButtonIndex := -1; 
  ActivePageIndex := 0;
  QWidget_setBackgroundMode(Handle, QWidgetBackgroundMode_NoBackground);
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;



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,  itImage,  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,  itImage,  Pages[Index].Enabled);
          Inc(R.Left, PageImages.Width + 4);
        end;
      taRightJustify:
        begin
          if HasImage then
          begin
            PageImages.Draw(Canvas, 4, ATop, Pages[Index].ImageIndex,  itImage,  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; 
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 
      begin
        Canvas.Brush.Color := clBtnFace;
        Canvas.FillRect(R);
      end;
      DrawPageButton(R, I, FPressedPageBtn = I);
    end;
    OffsetRect(R, 0, PageButtonHeight);
    if I >= ActivePageIndex then
    begin
      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; 
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;
 
  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 
      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,  itImage, 
                      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;  
                DrawText(Canvas, Pages[Index].Buttons[I].Caption, -1, R3,
                  DT_EXPANDTABS or DT_SINGLELINE or DT_CENTER or DT_VCENTER); 
              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,  itImage, 
                      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);  
                DrawText(Canvas, Pages[Index].Buttons[I].Caption, -1, R3,
                  DT_EXPANDTABS or DT_SINGLELINE or DT_LEFT or DT_VCENTER or DT_NOCLIP); 
              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; 
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 
        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; 
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 
      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);