jvcaptionbutton.pas

East make Tray Icon in delphi

    Images := TJvCaptionButton(Source).Images;
    Layout := TJvCaptionButton(Source).Layout;
    Margin := TJvCaptionButton(Source).Margin;
    Position := TJvCaptionButton(Source).Position;
    Spacing := TJvCaptionButton(Source).Spacing;
    Standard := TJvCaptionButton(Source).Standard;
    // set toggle before down
    Toggle := TJvCaptionButton(Source).Toggle;
    Down := TJvCaptionButton(Source).Down;
    Visible := TJvCaptionButton(Source).Visible;
  end
  else
    inherited Assign(Source);
end;

procedure TJvCaptionButton.CalcButtonParts(ACanvas: TCanvas;
  ButtonRect: TRect; var RectText, RectImage: TRect);
// copied from TJvCustomImageButton
const
  CDefaultMargin = 4;
var
  BlockWidth, ButtonWidth, ButtonHeight, BlockMargin, InternalSpacing: Integer;
  LMargin: Integer;
  OldFont: TFont;
begin
  SetRect(RectText, 0, 0, 0, 0);
  OldFont := ACanvas.Font;
  ACanvas.Font := Font;
  DrawText(ACanvas, Caption, -1, RectText, DT_CALCRECT or Alignments[FAlignment]);
  ACanvas.Font := OldFont;
  if IsImageVisible then
  begin
    with Images do
      SetRect(RectImage, 0, 0, Width - 1, Height - 1);
    InternalSpacing := Spacing;
  end
  else
  begin
    SetRect(RectImage, 0, 0, 0, 0);
    InternalSpacing := 0;
  end;
  BlockWidth := RectImage.Right + InternalSpacing + RectText.Right;
  ButtonWidth := ButtonRect.Right - ButtonRect.Left;
  if Margin = -1 then
    LMargin := CDefaultMargin
  else
    LMargin := Margin;

  case Alignment of
    taLeftJustify:
      BlockMargin := LMargin;
    taRightJustify:
      BlockMargin := ButtonWidth - BlockWidth - LMargin - 1;
  else {taCenter}
    BlockMargin := (ButtonWidth - BlockWidth) div 2
  end;
  case Layout of
    cbImageLeft:
      begin
        OffsetRect(RectImage, BlockMargin, 0);
        OffsetRect(RectText, RectImage.Right + InternalSpacing, 0);
      end;
    cbImageRight:
      begin
        OffsetRect(RectText, BlockMargin, 0);
        OffsetRect(RectImage, RectText.Right + InternalSpacing, 0);
      end;
  end;
  ButtonHeight := ButtonRect.Bottom - ButtonRect.Top;
  OffsetRect(RectImage, ButtonRect.Left, (ButtonHeight - RectImage.Bottom) div 2 + ButtonRect.Top);
  OffsetRect(RectText, ButtonRect.Left, (ButtonHeight - RectText.Bottom) div 2 + ButtonRect.Top);
end;

procedure TJvCaptionButton.CalcDefaultButtonRect(Wnd: THandle);
const
  CSpaceBetweenButtons = 2;
var
  Style: DWORD;
  ExStyle: DWORD;
  FrameSize: TSize;
begin
  if Wnd = 0 then
    Exit;

  { 0. Init some local vars }
  FNeedRecalculate := False;
  Style := GetWindowLong(Wnd, GWL_STYLE);
  FHasCaption := Style and WS_CAPTION = WS_CAPTION;
  if not FHasCaption then
    Exit;

  ExStyle := GetWindowLong(Wnd, GWL_EXSTYLE);
  FHasSmallCaption := ExStyle and WS_EX_TOOLWINDOW = WS_EX_TOOLWINDOW;
  {$IFDEF JVCLThemesEnabled}
  FCaptionActive := (GetActiveWindow = Wnd) and IsForegroundTask;
  {$ENDIF JVCLThemesEnabled}

  if Style and WS_THICKFRAME = WS_THICKFRAME then
  begin
    FrameSize.cx := GetSystemMetrics(SM_CXSIZEFRAME);
    FrameSize.cy := GetSystemMetrics(SM_CYSIZEFRAME);
  end
  else
  begin
    FrameSize.cx := GetSystemMetrics(SM_CXFIXEDFRAME);
    FrameSize.cy := GetSystemMetrics(SM_CYFIXEDFRAME);
  end;

  { 1. Calc FDefaultButtonTop }
  FDefaultButtonTop := FrameSize.cy + 2;

  { 2. Calc FDefaultButtonHeight }
  if FHasSmallCaption then
    FCaptionHeight := GetSystemMetrics(SM_CYSMCAPTION)
  else
    FCaptionHeight := GetSystemMetrics(SM_CYCAPTION);
  FDefaultButtonHeight := FCaptionHeight - 5;

  { 3. Calc FDefaultButtonWidth }
  {$IFDEF JVCLThemesEnabled}
  if IsThemed then
    FDefaultButtonWidth := FDefaultButtonHeight
  else
  {$ENDIF JVCLThemesEnabled}
  if FHasSmallCaption then
    FDefaultButtonWidth := GetSystemMetrics(SM_CXSMSIZE) - CSpaceBetweenButtons
  else
    FDefaultButtonWidth := GetSystemMetrics(SM_CXSIZE) - CSpaceBetweenButtons;

  { 4. Calc FDefaultButtonLeft }
  FDefaultButtonLeft := FrameSize.cx;
  Inc(FDefaultButtonLeft, FDefaultButtonWidth + CSpaceBetweenButtons);

  if Style and WS_SYSMENU = WS_SYSMENU then
  begin
    { 4a. Avoid close button }
    Inc(FDefaultButtonLeft, FDefaultButtonWidth + CSpaceBetweenButtons);

    if not FHasSmallCaption then
    begin
      if (Style and WS_MAXIMIZEBOX = WS_MAXIMIZEBOX) or
        (Style and WS_MINIMIZEBOX = WS_MINIMIZEBOX) then
      begin
        {$IFDEF JVCLThemesEnabled}
        if IsThemed then
          { 4b. If it have Max or Min button, both are visible. When themed
                the CONTEXTHELP button is then never visible }
          Inc(FDefaultButtonLeft, 2 * (FDefaultButtonWidth + CSpaceBetweenButtons))
        else
        {$ENDIF JVCLThemesEnabled}
        begin
          { 4b. If it have Max or Min button, both are visible. }
          Inc(FDefaultButtonLeft, 2 * FDefaultButtonWidth + CSpaceBetweenButtons);

          { 4c. If it have CONTEXTHELP button, avoid it. }
          if ((Style and WS_MAXIMIZEBOX = 0) or (Style and WS_MINIMIZEBOX = 0)) and
            (ExStyle and WS_EX_CONTEXTHELP = WS_EX_CONTEXTHELP) then
            Inc(FDefaultButtonLeft, FDefaultButtonWidth + 2 * CSpaceBetweenButtons);
        end;
      end
      else
      { 4c. If it have CONTEXTHELP button, avoid it. }
      if ExStyle and WS_EX_CONTEXTHELP = WS_EX_CONTEXTHELP then
        Inc(FDefaultButtonLeft, FDefaultButtonWidth + CSpaceBetweenButtons);
    end;
  end;
end;

procedure TJvCaptionButton.Click;
begin
  if csDesigning in ComponentState then
    DesignerSelectComponent(Self)
  else
  if Enabled then
  begin
    { Call OnClick if assigned and not equal to associated action's OnExecute.
      If associated action's OnExecute assigned then call it, otherwise, call
      OnClick. }
    if Assigned(FOnClick) and (Action <> nil) and (@FOnClick <> @Action.OnExecute) then
      FOnClick(Self)
    else
    if {not (csDesigning in ComponentState) and} Assigned(ActionLink) then
      FActionLink.Execute{$IFDEF COMPILER6_UP}(Self){$ENDIF}
    else
    if Assigned(FOnClick) then
      FOnClick(Self);
  end;
end;

procedure TJvCaptionButton.CreateToolTip(Wnd: THandle);
var
  ToolInfo: TToolInfo;
begin
  if csDesigning in ComponentState then
    Exit;

  DestroyToolTip;

  if Wnd = 0 then
    Exit;

  FToolTipHandle := CreateWindowEx(0, TOOLTIPS_CLASS, nil, TTS_ALWAYSTIP,
    Integer(CW_USEDEFAULT), Integer(CW_USEDEFAULT),
    Integer(CW_USEDEFAULT), Integer(CW_USEDEFAULT),
    ParentForm.Handle, // Thus automatically destroyed if ParentForm handle is destroyed.
    0, HInstance, nil);

  if FToolTipHandle = 0 then
    Exit;

  // initialize tooltip info
  ToolInfo.cbSize := SizeOf(TToolInfo);
  ToolInfo.uFlags := TTF_IDISHWND; { Thus ignores rect param }
  ToolInfo.hwnd := Wnd;
  ToolInfo.uId := Wnd;
  ToolInfo.lpszText := LPSTR_TEXTCALLBACK;

  // register button with tooltip
  SendMessage(FToolTipHandle, TTM_ADDTOOL, 0, Integer(@ToolInfo));
end;

procedure TJvCaptionButton.DestroyToolTip;
begin
  if FToolTipHandle <> 0 then
  begin
    DestroyWindow(FToolTipHandle);
    FToolTipHandle := 0;
  end;
end;

procedure TJvCaptionButton.DoActionChange(Sender: TObject);
begin
  if Sender = Action then
    ActionChange(Sender, False);
end;

procedure TJvCaptionButton.DrawButton(DC: HDC);
var
  Canvas: TControlCanvas;
begin
  if not Visible or not FHasCaption or (csDestroying in ComponentState) then
    Exit;

  Canvas := TControlCanvas.Create;
  try
    Canvas.Handle := DC;

    UpdateButtonRect(ParentFormHandle);

    with FButtonRect do
    begin
      FBuffer.Width := Right - Left;
      FBuffer.Height := Bottom - Top;
    end;

    {$IFDEF JVCLThemesEnabled}
    DrawButtonBackground(FBuffer.Canvas);
    {$ENDIF JVCLThemesEnabled}

    { We do a buffered drawing, otherwise you get flickering on XP, and you
      have to hassle with the clipping rects. }
    if FStandard <> tsbNone then
      DrawStandardButton(FBuffer.Canvas)
    else
      DrawNonStandardButton(FBuffer.Canvas);

    Canvas.Draw(FButtonRect.Left, FButtonRect.Top, FBuffer);
  finally
    Canvas.Handle := 0;
    Canvas.Free;
  end;
end;

{$IFDEF JVCLThemesEnabled}
procedure TJvCaptionButton.DrawButtonBackground(ACanvas: TCanvas);
const
  CCaption: array [Boolean, Boolean] of TThemedWindow =
   (
    (twCaptionInactive, twCaptionActive),
    (twSmallCaptionInactive, twSmallCaptionActive)
   );
var
  Details: TThemedElementDetails;
  ClipRect: TRect;
  CaptionRect: TRect;
begin
  if not IsThemed or (csDestroying in ComponentState) then
    Exit;

  { We basically draw the background to display 4 pixels - the corners of the
    rect - correct <g>. Don't know a better way to do this. }

  { Determine the rect of the caption }
  GetWindowRect(ParentFormHandle, CaptionRect);
  OffsetRect(CaptionRect, -CaptionRect.Left, -CaptionRect.Top);
  CaptionRect.Bottom := FCaptionHeight + 4;
  { Offset it so the place where the button is, is at (0, 0) }
  OffsetRect(CaptionRect, -FButtonRect.Left, -FButtonRect.Top);
  with FButtonRect do
    ClipRect := Rect(0, 0, Right - Left, Bottom - Top);

  Details := ThemeServices.GetElementDetails(CCaption[FHasSmallCaption, FCaptionActive]);
  ThemeServices.DrawElement(ACanvas.Handle, Details, CaptionRect, @ClipRect);
end;
{$ENDIF JVCLThemesEnabled}

procedure TJvCaptionButton.DrawButtonImage(ACanvas: TCanvas; ImageBounds: TRect);
begin
  if csDestroying in ComponentState then
    Exit;
  with ImageBounds do
    if IsImageVisible then
      Images.Draw(ACanvas, Left, Top, ImageIndex, Enabled);
end;

procedure TJvCaptionButton.DrawButtonText(ACanvas: TCanvas; TextBounds: TRect);
var
  Flags: DWORD;
  OldFont: TFont;
begin
  Flags := DT_VCENTER or Alignments[FAlignment];
  with ACanvas do
  begin
    Brush.Style := bsClear;
    if not Enabled then
    begin
      OffsetRect(TextBounds, 1, 1);
      OldFont := Font;
      Font := Self.Font;
      Font.Color := clBtnHighlight;
      DrawText(ACanvas, Caption, Length(Caption), TextBounds, Flags);
      OffsetRect(TextBounds, -1, -1);
      Font.Color := clBtnShadow;
      DrawText(ACanvas, Caption, Length(Caption), TextBounds, Flags);
      Font := OldFont;
    end
    else
    begin
      OldFont := Font;
      Font := Self.Font;
      DrawText(ACanvas, Caption, Length(Caption), TextBounds, Flags);
      Font := OldFont;
    end;
  end;
end;

procedure TJvCaptionButton.DrawNonStandardButton(ACanvas: TCanvas);
{$IFDEF JVCLThemesEnabled}
const
  cState_Normal = 1;
  cState_Hot = 2;
  cState_Pushed = 3;
  cState_Disabled = 4;
{$ENDIF JVCLThemesEnabled}
var
  DrawRect: TRect;
  RectText, RectImage: TRect;
  {$IFDEF JVCLThemesEnabled}
  State: Integer;
  DrawRgn: HRGN;
  {$ENDIF JVCLThemesEnabled}
begin
  if csDestroying in ComponentState then
    Exit;
  with FButtonRect do
    DrawRect := Rect(0, 0, Right - Left, Bottom - Top);

  {$IFDEF JVCLThemesEnabled}
  // Satisfy the compiler
  DrawRgn := 0;

  { 1. Draw the button }
  if IsThemed then
  begin
    if not Enabled then
      State := 4
    else
    if FDown then
      State := 3
    else
    if FMouseInControl then
      State := 2
    else
      State := 1;

    { Special state for buttons drawn on a not active caption }
    if not FCaptionActive then
      Inc(State, 4);

    if ForceDrawSimple or not GlobalXPData.Draw(ACanvas, State, DrawRect) then
      GlobalXPData.DrawSimple(ACanvas, State, DrawRect)
  end
  else
  {$ENDIF JVCLThemesEnabled}
    DrawButtonFace(ACanvas, DrawRect, 1, bsAutoDetect, False, FDown, False);

  { 2. Draw the text & picture }
  {$IFDEF JVCLThemesEnabled}
  if IsThemed then
  begin
    { 2a. If themed, only draw in the inner bit of the button using a clip region }
    with DrawRect do
      DrawRgn := CreateRectRgn(Left + 2, Top + 2, Right - 2, Bottom - 2);

    SelectClipRgn(ACanvas.Handle, DrawRgn);
  end;
  {$ENDIF JVCLThemesEnabled}

  if FDown then
  begin
    {$IFDEF JVCLThemesEnabled}
    if IsThemed then
      OffsetRect(DrawRect, 1, 0)
    else
    {$ENDIF JVCLThemesEnabled}
      OffsetRect(DrawRect, 1, 1);
  end;
  { 2b. Calc position and Draw the picture & text }
  CalcButtonParts(ACanvas, DrawRect, RectText, RectImage);
  DrawButtonText(ACanvas, RectText);
  DrawButtonImage(ACanvas, RectImage);
  { 2c. Clean up }
  {$IFDEF JVCLThemesEnabled}
  if IsThemed then
  begin
    SelectClipRgn(ACanvas.Handle, 0);