jvcaptionbutton.pas

East make Tray Icon in delphi

    DeleteObject(DrawRgn);
  end;
  {$ENDIF JVCLThemesEnabled}
end;

procedure TJvCaptionButton.DrawStandardButton(ACanvas: TCanvas);
const
  {$IFDEF JVCLThemesEnabled}
  CElements: array [TJvStandardButton] of TThemedWindow =
   (twWindowDontCare, twCloseButtonNormal, twHelpButtonNormal, twMaxButtonNormal,
    twMinButtonNormal, twRestoreButtonNormal, twMinButtonNormal);
  {$ENDIF JVCLThemesEnabled}
  CDrawFlags: array [TJvStandardButton] of Word =
   (0, DFCS_CAPTIONCLOSE, DFCS_CAPTIONHELP, DFCS_CAPTIONMAX, DFCS_CAPTIONMIN,
    DFCS_CAPTIONRESTORE, 0);
  CDown: array [Boolean] of Word = (0, DFCS_PUSHED);
  CEnabled: array [Boolean] of Word = (DFCS_INACTIVE, 0);
var
  DrawRect: TRect;
  {$IFDEF JVCLThemesEnabled}
  Details: TThemedElementDetails;
  CaptionButton: TThemedWindow;
  {$ENDIF JVCLThemesEnabled}
begin
  if csDestroying in ComponentState then
    Exit;
  with FButtonRect do
    DrawRect := Rect(0, 0, Right - Left, Bottom - Top);

  {$IFDEF JVCLThemesEnabled}
  if IsThemed then
  begin
    CaptionButton := CElements[FStandard];
    { Note : There is only a small close button (??) }
    if FHasSmallCaption and (FStandard = tsbClose) then
      CaptionButton := twSmallCloseButtonNormal;

    if not Enabled then
      Inc(CaptionButton, 3)
    else
    if FDown then
      { If Down and inactive, draw inactive border }
      Inc(CaptionButton, 2)
    else
    if FMouseInControl then
      Inc(CaptionButton);

    Details := ThemeServices.GetElementDetails(CaptionButton);
    { Special state for buttons drawn on a not active caption }
    if not FCaptionActive and (Details.State = 1) then
      Details.State := 5;
    ThemeServices.DrawElement(ACanvas.Handle, Details, DrawRect)
  end
  else
  {$ENDIF JVCLThemesEnabled}
  if Standard = tsbMinimizeToTray then
  begin
    DrawButtonFace(ACanvas, DrawRect, 1, bsAutoDetect, False, FDown, False);
    if Enabled then
    begin
      ACanvas.Brush.Color := clWindowText;
      with DrawRect do
        ACanvas.FillRect(Rect(Right - 7, Bottom - 5, Right - 4, Bottom - 3));
    end
    else
    begin
      ACanvas.Brush.Color := clBtnHighlight;
      with DrawRect do
        ACanvas.FillRect(Rect(Right - 6, Bottom - 4, Right - 3, Bottom - 2));
      ACanvas.Brush.Color := clBtnShadow;
      with DrawRect do
        ACanvas.FillRect(Rect(Right - 7, Bottom - 5, Right - 4, Bottom - 3));
    end;
  end
  else
    DrawFrameControl(ACanvas.Handle, DrawRect, DFC_CAPTION, {DFCS_ADJUSTRECT or}
      CDrawFlags[Standard] or CDown[Down] or CEnabled[Enabled]);
end;

procedure TJvCaptionButton.ForwardToToolTip(Msg: TMessage);
var
  ForwardMsg: TMsg;
begin
  if FToolTipHandle = 0 then
    Exit;

  // forward to tool tip
  ForwardMsg.lParam := Msg.LParam;
  ForwardMsg.wParam := Msg.WParam;
  ForwardMsg.message := Msg.Msg;
  ForwardMsg.hwnd := ParentFormHandle;
  SendMessage(FToolTipHandle, TTM_RELAYEVENT, 0, Integer(@ForwardMsg));
end;

function TJvCaptionButton.GetAction: TBasicAction;
begin
  if FActionLink <> nil then
    Result := FActionLink.Action
  else
    Result := nil;
end;

function TJvCaptionButton.GetActionLinkClass: TJvCaptionButtonActionLinkClass;
begin
  Result := TJvCaptionButtonActionLink;
end;

function TJvCaptionButton.GetIsImageVisible: Boolean;
begin
  Result := Assigned(Images) and (ImageIndex > -1) and (ImageIndex < Images.Count);
end;

{$IFDEF JVCLThemesEnabled}
function TJvCaptionButton.GetIsThemed: Boolean;
begin
  Result := GlobalXPData.IsThemed;
end;
{$ENDIF JVCLThemesEnabled}

function TJvCaptionButton.GetParentForm: TCustomForm;
begin
  if Owner is TControl then
    Result := Forms.GetParentForm(TControl(Owner))
  else
    Result := nil;
end;

function TJvCaptionButton.GetParentFormHandle: THandle;
var
  P: TCustomForm;
begin
  P := GetParentForm;
  if Assigned(P) and P.HandleAllocated then
    Result := P.Handle
  else
    Result := 0;
end;

function TJvCaptionButton.HandleButtonDown(var Msg: TWMNCHitMessage): Boolean;
begin
  Result := Visible and Enabled and (Msg.HitTest = htCaptionButton) and
    MouseOnButton(Msg.XCursor, Msg.YCursor, False);

  if Result then
  begin
    FMouseButtonDown := True;
    if Toggle then
      FDown := not FDown
    else
      FDown := True;
    with TWMMouse(Msg) do
      MouseDown(mbLeft, KeysToShiftState(Keys), XPos, YPos);
    {if not Toggle then}
    SetCapture(ParentFormHandle);
    Redraw(rkIndirect);

    { Note: If Toggle = False -> click event is fired in HandleButtonUp }
    if Toggle then
      Click;
  end
  else
  if FDown and not Toggle then
  begin
    FMouseButtonDown := False;
    FDown := False;
    Redraw(rkIndirect);
  end;
end;

function TJvCaptionButton.HandleButtonUp(var Msg: TWMNCHitMessage): Boolean;
var
  DoClick: Boolean;
  P: TPoint;
begin
  Result := False;

  if not FMouseButtonDown then
    Exit;

  Result := FDown and MouseOnButton(Msg.XCursor, Msg.YCursor, Msg.Msg = WM_LBUTTONUP);
  { Note: If Toggle = True -> click event is fired in HandleButtonDown }
  DoClick := Result and not Toggle;

  FMouseButtonDown := False;
  ReleaseCapture;

  if not Toggle then
  begin
    FDown := False;
    Redraw(rkIndirect);
  end;

  if DoClick then
    Click;

  //(p3) we need to convert MouseUp message because they are in client coordinates (MouseDown are already in screen coords, so no need to change)
  with TWMMouse(Msg) do
  begin
    P := Point(XPos, YPos);
    Assert(ParentForm <> nil, '');
    P := ParentForm.ClientToScreen(P);
    MouseUp(mbLeft, KeysToShiftState(Keys), P.X, P.Y);
  end;
end;

function TJvCaptionButton.HandleHitTest(var Msg: TWMNCHitTest): Boolean;
var
  CurPos: TPoint;
begin
  Result := Visible and MouseOnButton(Msg.XPos, Msg.YPos, False);
  if Result then
    Msg.Result := htCaptionButton;

  if not Result and Visible and MouseInControl then
  begin
    // We can get weird hittest values (probably from the hint window) so
    // double check that the mouse is not on the button.
    // Actually we wrongfully assumed that Msg represents the current mouse
    // position so we have to double check.
    GetCursorPos(CurPos);
    if not MouseOnButton(CurPos.X, CurPos.Y, False) then
    begin
      SetMouseInControl(False);
      Redraw(rkIndirect);
    end;
  end;

  //Result := False;
end;

function TJvCaptionButton.HandleMouseMove(var Msg: TWMNCHitMessage): Boolean;
var
  DoRedraw: Boolean;
  MouseWasInControl: Boolean;
begin
  Result := FMouseButtonDown;

  if Result then
  begin
    MouseWasInControl := FMouseInControl;
    SetMouseInControl(MouseOnButton(Msg.XCursor, Msg.YCursor, Msg.Msg = WM_MOUSEMOVE));
    DoRedraw := (FMouseInControl <> MouseWasInControl) or
      // User presses mouse button, but left the caption button
      (FDown and not Toggle and not FMouseInControl) or
      // User presses mouse button, and enters the caption button
      (not FDown and not Toggle and FMouseInControl);

    FDown := (FDown and Toggle) or
      (FMouseButtonDown and not Toggle and FMouseInControl);
    if DoRedraw then
      Redraw(rkIndirect);
  end;
  // (p3) don't handle mouse move here: it is triggered even if the mouse is outside the button
  //  with TWmMouseMove(Msg) do
  //    MouseMove(KeysToShiftState(Keys), XPos, YPos);
end;

procedure TJvCaptionButton.HandleNCActivate(var Msg: TWMNCActivate);
begin
  {$IFDEF JVCLThemesEnabled}
  FCaptionActive := Msg.Active;
  {$ENDIF JVCLThemesEnabled}
  SetMouseInControl(MouseInControl and Msg.Active);

  Redraw(rkDirect);
end;

procedure TJvCaptionButton.HandleNCMouseMove(var Msg: TWMNCHitMessage);
var
  IsOnButton: Boolean;
begin
  IsOnButton := MouseOnButton(Msg.XCursor, Msg.YCursor, False);
  if Visible then
  begin
    if (IsOnButton <> FMouseInControl) then
    begin
      SetMouseInControl(not FMouseInControl);
      if not Down then
        Redraw(rkIndirect);
    end;
   // (p3) only handle mouse move if we are inside the button or it will be triggered for the entire NC area
    if IsOnButton then
      with TWMMouseMove(Msg) do
        MouseMove(KeysToShiftState(Keys), XPos, YPos);
  end;
end;

procedure TJvCaptionButton.HandleNCPaintAfter(Wnd: THandle; var Msg: TWMNCPaint);
begin
  if FRgnChanged then
  begin
    DeleteObject(Msg.RGN);
    Msg.RGN := FSaveRgn;
    FRgnChanged := False;
  end;

  Redraw(rkDirect);
end;

procedure TJvCaptionButton.HandleNCPaintBefore(Wnd: THandle; var Msg: TWMNCPaint);
var
  WindowRect: TRect;
  DrawRgn: HRGN;
  LButtonRect: TRect;
begin
  { Note: There is one problem with this reduce flickering method: This
          function is executed before windows handles the WM_NCPAINT and
          HandleNCPaintAfter is executed after windows handles WM_NCPAINT.

          When you resize a form, the value returned by API GetWindowRect is
          adjusted when windows handles the WM_NCPAINT.

          Thus return value of GetWindowRect in HandleNCPaintBefore differs
          from return value of GetWindowRect in HandleNCPaintAfter.
        ->
          Thus value of FButtonRect in HandleNCPaintBefore differs
          from return value of FButtonRect in HandleNCPaintAfter.

          (Diff is typically 1 pixel)

          This causes a light flickering at the edge of the button when
          you resize the form.

          To see it, put Sleep(1000) or so, before and after the DrawButton call
          in HandleNCPaintAfter and resize the screen horizontally
  }
  if Wnd = 0 then
    Exit;

  FSaveRgn := Msg.RGN;
  FRgnChanged := False;
  { Calculate button rect in screen coordinates, put it in LButtonRect }
  UpdateButtonRect(Wnd);
  LButtonRect := FButtonRect;
  GetWindowRect(Wnd, WindowRect);
  OffsetRect(LButtonRect, WindowRect.Left, WindowRect.Top);
  { Check if button rect is in the to be updated region.. }
  if RectInRegion(FSaveRgn, LButtonRect) then
  begin
    { ..If so remove the button rectangle from the region (otherwise the caption
      background would be drawn over the button, which causes flicker) }
    with LButtonRect do
      DrawRgn := CreateRectRgn(Left, Top, Right, Bottom);
    try
      Msg.RGN := CreateRectRgn(0, 0, 1, 1);
      FRgnChanged := True;
      CombineRgn(Msg.RGN, FSaveRgn, DrawRgn, RGN_DIFF);
    finally
      DeleteObject(DrawRgn);
    end;
  end;
end;

function TJvCaptionButton.HandleNotify(var Msg: TWMNotify): Boolean;
var
  CurPos: TPoint;
  LButtonRect, WindowRect: TRect;
begin
  // if we receive a TTN_GETDISPINFO notification
  // and it is from the tooltip
  Result := (Msg.NMHdr.code = TTN_NEEDTEXT) and (Msg.NMHdr.hwndFrom = FToolTipHandle);

  if Result and (ShowHint or (ParentShowHint and ParentForm.ShowHint)) then
  begin
    // get cursor position
    GetCursorPos(CurPos);
    GetWindowRect(ParentFormHandle, WindowRect);
    LButtonRect := FButtonRect;
    OffsetRect(LButtonRect, WindowRect.Left, WindowRect.Top);

    // if the mouse is in the area of the button
    if PtInRect(LButtonRect, CurPos) then
      if Msg.NMHdr.code = TTN_NEEDTEXTA then
      begin
        with PNMTTDispInfoA(Msg.NMHdr)^ do
        begin
          // then we return the hint
          lpszText := PChar(FHint);
          hinst := 0;
          uFlags := TTF_IDISHWND;
          hdr.idFrom := ParentFormHandle;
        end;
      end
      else
        with PNMTTDispInfoW(Msg.NMHdr)^ do
        begin
          // then we return the hint
          lpszText := PWideChar(WideString(FHint));
          hinst := 0;
          uFlags := TTF_IDISHWND;
          hdr.idFrom := ParentFormHandle;
        end
    else
      //else we hide the tooltip
      HideToolTip;
  end;
end;

procedure TJvCaptionButton.HideToolTip;
begin
  if FToolTipHandle <> 0 then
    SendMessage(FToolTipHandle, TTM_POP, 0, 0);
end;

procedure TJvCaptionButton.Hook;
var
  P: TCustomForm;
begin
  //if not Visible or not FHasCaption then
  // Exit;

  P := ParentForm;
  if Assigned(P) then
  begin
    RegisterWndProcHook(P, WndProcAfter, hoAfterMsg);
    RegisterWndProcHook(P, WndProcBefore, hoBeforeMsg);

    if P.HandleAllocated then
      CreateToolTip(P.Handle);
  end;
end;

procedure TJvCaptionButton.ImageListChange(Sender: TObject);
begin
  if Sender = Images then