jvbutton.pas

East make Tray Icon in delphi

    if FForceSameSize then
      SetBounds(Left, Top, Width, Height);
  end;
end;

procedure TJvCustomGraphicButton.SetBounds(ALeft, ATop, AWidth, AHeight: Integer);
var
  Form: TCustomForm;
  Msg: TCMForceSize;
  {$IFDEF VisualCLX}
  I: Integer;
  {$ENDIF VisualCLX}
begin
  inherited SetBounds(ALeft, ATop, AWidth, AHeight);
  if ForceSameSize then
  begin
    Form := GetParentForm(Self);
    if Assigned(Form) then
    begin
      Msg.Msg := CM_FORCESIZE;
      Msg.Sender := Self;
      Msg.NewSize.X := AWidth;
      Msg.NewSize.Y := AHeight;
      Form.Broadcast(Msg);
      {$IFDEF VisualCLX}
      for I := 0 to Form.ControlCount - 1 do
        if Form.Controls[I] is TJvCustomGraphicButton then
          TJvCustomGraphicButton(Form.Controls[I]).ForceSize(Self, AWidth, AHeight);
      {$ENDIF VisualCLX}
    end;
  end;
end;

procedure TJvCustomGraphicButton.CMForceSize(var Msg: TCMForceSize);
begin
  with Msg do
    ForceSize(Sender, NewSize.x, NewSize.y);
end;

function TJvCustomGraphicButton.GetPattern: TBitmap;
begin
  Result := CreateBrushPattern;
end;

procedure TJvCustomGraphicButton.SetAllowAllUp(const Value: Boolean);
begin
  if FAllowAllUp <> Value then
  begin
    FAllowAllUp := Value;
    UpdateExclusive;
  end;
end;

procedure TJvCustomGraphicButton.SetGroupIndex(const Value: Integer);
begin
  if FGroupIndex <> Value then
  begin
    FGroupIndex := Value;
    UpdateExclusive;
  end;
end;

procedure TJvCustomGraphicButton.UpdateExclusive;
var
  Msg: TCMButtonPressed;
  {$IFDEF VisualCLX}
  I: Integer;
  {$ENDIF VisualCLX}
begin
  if (GroupIndex <> 0) and (Parent <> nil) then
  begin
    Msg.Msg := CM_JVBUTTONPRESSED;
    Msg.Index := GroupIndex;
    Msg.Control := Self;
    Msg.Result := 0;
    Parent.Broadcast(Msg);
    {$IFDEF VisualCLX}
    for I := 0 to Parent.ControlCount - 1 do
      if Parent.Controls[I] is TJvCustomGraphicButton then
        TJvCustomGraphicButton(Parent.Controls[I]).ButtonPressed(Self, GroupIndex);
    {$ENDIF VisualCLX}
  end;
end;

procedure TJvCustomGraphicButton.CMButtonPressed(var Msg: TCMButtonPressed);
begin
  ButtonPressed(TJvCustomGraphicButton(Msg.Control), Msg.Index);
end;

procedure TJvCustomGraphicButton.SetHotFont(const Value: TFont);
begin
  FHotFont.Assign(Value);
end;

procedure TJvCustomGraphicButton.SetHotTrackFontOptions(const Value: TJvTrackFontOptions);
begin
  if FHotTrackFontOptions <> Value then
  begin
    FHotTrackFontOptions := Value;
    UpdateTrackFont(HotTrackFont, Font, HotTrackFontOptions);
  end;
end;

procedure TJvCustomGraphicButton.SetDropArrow(const Value: Boolean);
begin
  if FDropArrow <> Value then
  begin
    FDropArrow := Value;
    Invalidate;
  end;
end;

procedure TJvCustomGraphicButton.SetDropDownMenu(const Value: TPopupMenu);
begin
  if FDropDownMenu <> Value then
  begin
    FDropDownMenu := Value;
    if DropArrow then
      Invalidate;
  end;
end;

{$IFDEF VCL}
procedure TJvCustomGraphicButton.CMSysColorChange(var Msg: TMessage);
begin
  inherited;
  RepaintBackground;
end;
{$ENDIF VCL}

procedure TJvCustomGraphicButton.FontChanged;
begin
  inherited FontChanged;
  UpdateTrackFont(HotTrackFont, Font, HotTrackFontOptions);
end;

procedure TJvCustomGraphicButton.TextChanged;
begin
  inherited TextChanged;
  RepaintBackground;
end;

procedure TJvCustomGraphicButton.Click;
begin
  inherited Click;
  if GroupIndex <> 0 then
  begin
    if AllowAllUp then
      Down := not Down
    else
      Down := True;
  end;
end;

procedure TJvCustomGraphicButton.ButtonPressed(Sender: TJvCustomGraphicButton;
  AGroupIndex: Integer);
begin
  if AGroupIndex = GroupIndex then
    if Sender <> Self then
    begin
      if Sender.Down and Down then
      begin
        FDown := False;
        Exclude(FStates, bsMouseDown);
        RepaintBackground;
      end;
      FAllowAllUp := Sender.AllowAllUp;
    end;
end;

procedure TJvCustomGraphicButton.ForceSize(Sender: TControl; AWidth, AHeight: Integer);
begin
  if Sender <> Self then
    inherited SetBounds(Left, Top, AWidth, AHeight);
end;

//=== { TJvCustomButton } ====================================================

constructor TJvCustomButton.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FDropArrow := False;
  FHotTrack := False;
  FHotFont := TFont.Create;
  FFontSave := TFont.Create;
  // ControlStyle := ControlStyle + [csAcceptsControls];
  FWordWrap := True;
  FForceSameSize := False;
  FHotTrackFontOptions := DefaultTrackFontOptions;
end;

destructor TJvCustomButton.Destroy;
begin
  FHotFont.Free;
  FFontSave.Free;
  inherited Destroy;
end;

procedure TJvCustomButton.Click;
var
  Tmp: TPoint;
begin
  inherited Click;
  Tmp := ClientToScreen(Point(0, Height));
  DoDropDownMenu(Tmp.X, Tmp.Y);
end;

procedure TJvCustomButton.DrawDropArrow(Canvas: TCanvas; ArrowRect: TRect);
var
  I: Integer;
begin
  if not Enabled then
    Canvas.Pen.Color := clInactiveCaption
  else
    Canvas.Pen.Color := clWindowText;
  for I := 0 to (ArrowRect.Bottom - ArrowRect.Top) do
  begin
    if ArrowRect.Left + I <= ArrowRect.Right - I then
    begin
      Canvas.MoveTo(ArrowRect.Left + I, ArrowRect.Top + I);
      Canvas.LineTo(ArrowRect.Right - I, ArrowRect.Top + I);
    end;
  end;
end;


{$IFDEF VCL}
procedure TJvCustomButton.CreateParams(var Params: TCreateParams);
begin
  inherited CreateParams(Params);
  Params.Style := Params.Style or BS_MULTILINE;
end;
{$ENDIF VCL}

procedure TJvCustomButton.SetHotTrackFontOptions(const Value: TJvTrackFontOptions);
begin
  if FHotTrackFontOptions <> Value then
  begin
    FHotTrackFontOptions := Value;
    UpdateTrackFont(HotTrackFont, Font, HotTrackFontOptions);
  end;
end;

procedure TJvCustomButton.SetDropArrow(const Value: Boolean);
begin
  if FDropArrow <> Value then
  begin
    FDropArrow := Value;
    Invalidate;
  end;
end;

procedure TJvCustomButton.SetHotFont(const Value: TFont);
begin
  FHotFont.Assign(Value);
end;

procedure TJvCustomButton.SetDropDownMenu(const Value: TPopupMenu);
begin
  if FDropDownMenu <> Value then
  begin
    FDropDownMenu := Value;
    if DropArrow then
      Invalidate;
  end;
end;

procedure TJvCustomButton.MouseEnter(Control: TControl);
begin
  if not MouseOver then
  begin
    if FHotTrack then
    begin
      FFontSave.Assign(Font);
      Font.Assign(FHotFont);
    end;
    inherited MouseEnter(Control);
  end;
end;

procedure TJvCustomButton.MouseLeave(Control: TControl);
begin
  if MouseOver then
  begin
    if FHotTrack then
      Font.Assign(FFontSave);
    inherited MouseLeave(Control);
  end;
end;

procedure TJvCustomButton.FontChanged;
begin
  inherited FontChanged;
  UpdateTrackFont(HotTrackFont, Font, HotTrackFontOptions);
end;

function TJvCustomButton.GetRealCaption: string;
begin
  if WordWrap then
    Result := StringReplace(Caption, JvBtnLineSeparator, Lf, [rfReplaceAll])
  else
    Result := Caption;
end;

procedure TJvCustomButton.SetWordWrap(const Value: Boolean);
begin
  if FWordWrap <> Value then
  begin
    FWordWrap := Value;
    Invalidate;
  end;
end;

procedure TJvCustomButton.SetForceSameSize(const Value: Boolean);
begin
  if FForceSameSize <> Value then
  begin
    FForceSameSize := Value;
    if FForceSameSize then
      SetBounds(Left, Top, Width, Height);
  end;
end;

procedure TJvCustomButton.SetBounds(ALeft, ATop, AWidth, AHeight: Integer);
var
  Form: TCustomForm;
  Msg: TCMForceSize;
  {$IFDEF VisualCLX}
  I: Integer;
  {$ENDIF VisualCLX}
begin
  inherited SetBounds(ALeft, ATop, AWidth, AHeight);
  if ForceSameSize then
  begin
    Form := GetParentForm(Self);
    if Assigned(Form) then
    begin
      Msg.Msg := CM_FORCESIZE;
      Msg.Sender := Self;
      Msg.NewSize.X := AWidth;
      Msg.NewSize.Y := AHeight;
      Form.Broadcast(Msg);
      {$IFDEF VisualCLX}
      for I := 0 to Form.ControlCount - 1 do
        if Form.Controls[I] is TJvCustomButton then
          TJvCustomButton(Form.Controls[I]).ForceSize(Self, AWidth, AHeight);
      {$ENDIF VisualCLX}
    end;
  end;
end;

procedure TJvCustomButton.CMForceSize(var Msg: TCMForceSize);
begin
  with Msg do
    ForceSize(Sender, NewSize.x, NewSize.y);
end;

procedure TJvCustomButton.Notification(AComponent: TComponent;
  Operation: TOperation);
begin
  inherited Notification(AComponent, Operation);
  if (Operation = opRemove) and (AComponent = FDropDownMenu) then
    DropDownMenu := nil;
end;

procedure TJvCustomGraphicButton.RepaintBackground;
var
  R: TRect;
begin
  if (Parent <> nil) and Parent.HandleAllocated then
  begin
    R := BoundsRect;
    InvalidateRect(Parent.Handle, @R, True);
  end;
  Repaint;
end;

procedure TJvCustomButton.ForceSize(Sender: TControl; AWidth, AHeight: Integer);
begin
  if Sender <> Self then
    inherited SetBounds(Left, Top, AWidth, AHeight);
end;

function TJvCustomButton.DoDropDownMenu(X, Y: Integer): Boolean;
var
  {$IFDEF VCL}
  Msg: TMsg;
  {$ENDIF VCL}
  Handled: Boolean;
begin
  Result := (DropDownMenu <> nil);
  if Result then
  begin
    DropDownMenu.PopupComponent := Self;
    case DropDownMenu.Alignment of
      paRight:
        Inc(X, Width);
      paCenter:
        Inc(X, Width div 2);
    end;
    Handled := False;
    if Assigned(FOnDropDownMenu) then
      FOnDropDownMenu(Self, Point(X, Y), Handled);
    if not Handled then
      DropDownMenu.Popup(X, Y)
    else
      Exit;
    {$IFDEF VCL}
    { wait 'til menu is done }
    while PeekMessage(Msg, 0, WM_MOUSEFIRST, WM_MOUSELAST, PM_REMOVE) do
      {nothing};
    {$ENDIF VCL}
    {$IFDEF VisualCLX}
    repeat
      Application.ProcessMessages;
    until not QWidget_isVisible(DropDownMenu.Handle);
    {$ENDIF VisualCLX}
  end;
end;

//=== { TJvDropDownButton } ==================================================

constructor TJvDropDownButton.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  Width := 16;
  Height := 16;
end;

procedure TJvDropDownButton.Paint;
var
  PaintRect: TRect;
  DrawFlags: Integer;
  DC: HDC;
  Bmp: TBitmap;
begin
  // adjust FState and FDragging
  DC := Canvas.Handle;
  Bmp := TBitmap.Create;
  try
    Bmp.Width := 1;
    Bmp.Height := 1;
    Canvas.Handle := Bmp.Canvas.Handle;
    try
      inherited Paint;
    finally
      Canvas.Handle := DC;
    end;
  finally
    Bmp.Free;
  end;

  PaintRect := Rect(0, 0, Width, Height);
  DrawFlags := DFCS_SCROLLCOMBOBOX or DFCS_ADJUSTRECT;
  if FState in [bsDown, bsExclusive] then
    DrawFlags := DrawFlags or DFCS_PUSHED;

  {$IFDEF JVCLThemesEnabled}
  if ThemeServices.ThemesEnabled then
    DrawThemedFrameControl(Self, Canvas.Handle, PaintRect, DFC_SCROLL, DrawFlags)
  else
  {$ENDIF JVCLThemesEnabled}
  begin
    {$IFDEF VisualCLX}
    Canvas.Start;
    RequiredState(Canvas, [csHandleValid, csPenValid, csBrushValid]);
    {$ENDIF VisualCLX}
    DrawFrameControl(Canvas.Handle, PaintRect, DFC_SCROLL, DrawFlags);

    {$IFDEF VisualCLX}
    Canvas.Stop;
    {$ENDIF VisualCLX}
  end;
end;

procedure TJvCustomGraphicButton.DropDownClose;
begin
  if Assigned(FOnDropDownClose) then
    FOnDropDownClose(Self);
end;

initialization
  {$IFDEF UNITVERSIONING}
  RegisterUnitVersion(HInstance, UnitVersioning);
  {$ENDIF UNITVERSIONING}

finalization
  FreeAndNil(GlobalPattern);
  {$IFDEF UNITVERSIONING}
  UnregisterUnitVersion(HInstance);
  {$ENDIF UNITVERSIONING}

end.