jvqspeedbutton.pas

East make Tray Icon in delphi

    NeedRepaint := 
      HotTrack or (FFlat and Enabled and not FDragging);

    inherited MouseLeave(Control); // set MouseOver

    if NeedRepaint then
      Repaint;
  end;
end;

procedure TJvCustomSpeedButton.CMSysColorChange(var Msg: TMessage);
begin
  TJvxButtonGlyph(FGlyph).Invalidate;
  Invalidate;
end;

procedure TJvCustomSpeedButton.TextChanged;
begin
  Invalidate;
end;

procedure TJvCustomSpeedButton.VisibleChanged;
begin
  inherited VisibleChanged;
  if Visible then
    UpdateTracking;
end;

constructor TJvCustomSpeedButton.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  ParentColor := False;
  Color := clBtnFace;
  FHotTrack := False;
  FHotTrackFont := TFont.Create;
  FFontSave := TFont.Create;
  SetBounds(0, 0, 25, 25);
  ControlStyle := [csCaptureMouse, csOpaque, csDoubleClicks];
  ControlStyle := ControlStyle + [csReplicatable];
  FInactiveGrayed := True;
  FGlyph := TJvxButtonGlyph.Create;
  TJvxButtonGlyph(FGlyph).GrayNewStyle := True;
  ParentFont := True;
  ParentShowHint := False;
  ShowHint := True;
  FSpacing := 1;
  FMargin := -1;
  FInitRepeatPause := 500;
  FRepeatPause := 100;
  FStyle := bsAutoDetect;
  FLayout := blGlyphTop;
  FMarkDropDown := True;
  FHotTrackFontOptions := DefaultTrackFontOptions;
  FDoubleBuffered := True;
  {Inserted by (ag) 2004-09-04}
  FHotTrackOptions := TJvSpeedButtonHotTrackOptions.Create;
  {Insert End}
  Inc(ButtonCount);
end;

destructor TJvCustomSpeedButton.Destroy;
begin
  {Inserted by (ag) 2004-09-04}
  FHotTrackOptions.Free;
  {Insert End}
  TJvxButtonGlyph(FGlyph).Free;
  Dec(ButtonCount);
  if FRepeatTimer <> nil then
    FRepeatTimer.Free;
  FHotTrackFont.Free;
  FFontSave.Free;
  inherited Destroy;
end;

procedure TJvCustomSpeedButton.DoMouseUp(Button: TMouseButton; Shift: TShiftState;
  X, Y: Integer);
var
  DoClick: Boolean;
begin
  if FDragging and (Button = mbLeft) then
  begin
    FDragging := False;
    DoClick := (X >= 0) and (X < ClientWidth) and (Y >= 0) and (Y <= ClientHeight);
    if FGroupIndex = 0 then
    begin
      FState := rbsUp;
      { Calling Click might open a new window or something which will remove
        the focus; if the new window is modal then UpdateTracking won't be
        called until the window is closed, thus: }
      Perform(CM_MOUSELEAVE, 0, 0);
      { Even if the mouse is not in the control (DoClick=False) we must redraw
        the image, because it must change from hot -> normal }
      //if not DoClick then
        Invalidate;
    end
    else
    if DoClick then
    begin
      SetDown(not FDown);
      if FDown then
        Repaint;
    end
    else
    begin
      if FDown then
        FState := rbsExclusive;
      Repaint;
    end;
    if DoClick and not FMenuTracking then
    begin
      Click;
    end;
  end;
  { After a Click call a lot can happen thus check whether we're hot or not: }
  UpdateTracking;
end;

function TJvCustomSpeedButton.GetAlignment: TAlignment;
begin
  Result := TJvxButtonGlyph(FGlyph).Alignment;
end;

function TJvCustomSpeedButton.GetDropDownMenuPos: TPoint;
begin
  if Assigned(FDropDownMenu) then
  begin
    if MenuPosition = dmpBottom then
    begin
      case FDropDownMenu.Alignment of
        paLeft:
          Result := Point(-1, Height);
        paRight:
          Result := Point(Width + 1, Height);
      else {paCenter}
        Result := Point(Width div 2, Height);
      end;
    end
    else { dmpRight }
    begin
      case FDropDownMenu.Alignment of
        paLeft:
          Result := Point(Width, -1);
        paRight:
          Result := Point(-1, -1);
      else {paCenter}
        Result := Point(Width div 2, Height);
      end;
    end;
  end
  else
    Result := Point(0, 0);
end;

function TJvCustomSpeedButton.GetGrayNewStyle: Boolean;
begin
  Result := TJvxButtonGlyph(FGlyph).GrayNewStyle;
end;

function TJvCustomSpeedButton.GetWordWrap: Boolean;
begin
  Result := TJvxButtonGlyph(FGlyph).WordWrap;
end;

procedure TJvCustomSpeedButton.Loaded;
var
  LState: TJvButtonState;
begin
  inherited Loaded;

  if Enabled then
  begin
    if Flat then
      LState := rbsInactive
    else
      LState := rbsUp;
  end
  else
    LState := rbsDisabled;
  TJvxButtonGlyph(FGlyph).CreateButtonGlyph(LState);
end;

procedure TJvCustomSpeedButton.MouseDown(Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
var
  P: TPoint; 
begin
  try
    if FMenuTracking then
      Exit;
    inherited MouseDown(Button, Shift, X, Y);
    if not MouseOver and Enabled then
    begin
      MouseOver := True;
      Invalidate {Repaint};
    end;
    if (Button = mbLeft) and Enabled {and not (ssDouble in Shift)} then
    begin
      if not FDown then
      begin
        FState := rbsDown;
        Invalidate {Repaint};
      end;
      FDragging := True;
      FMenuTracking := True;
      try
        P := GetDropDownMenuPos;
        if CheckMenuDropDown(PointToSmallPoint(P), False) then
          DoMouseUp(Button, Shift, X, Y); 
      finally
        FMenuTracking := False;
      end;
      if FAllowTimer then
      begin
        if FRepeatTimer = nil then
          FRepeatTimer := TTimer.Create(Self);
        FRepeatTimer.Interval := InitPause;
        FRepeatTimer.OnTimer := TimerExpired;
        FRepeatTimer.Enabled := True;
      end;
    end;
  finally 
     // (ahuser) Maybe we should remove the WM_RBUTTONDOWN code and make this
     // code available for VCL and VisualCLX.
    if Button = mbRight then
      UpdateTracking; 
  end;
end;

procedure TJvCustomSpeedButton.MouseMove(Shift: TShiftState; X, Y: Integer);
var
  NewState: TJvButtonState;
begin
  inherited MouseMove(Shift, X, Y);
  if FDragging then
  begin
    if not FDown then
      NewState := rbsUp
    else
      NewState := rbsExclusive;
    if (X >= 0) and (X < ClientWidth) and (Y >= 0) and (Y <= ClientHeight) then
      if FDown then
        NewState := rbsExclusive
      else
        NewState := rbsDown;
    if NewState <> FState then
    begin
      FState := NewState;
      Repaint;
    end;
  end;
end;

procedure TJvCustomSpeedButton.MouseUp(Button: TMouseButton; Shift: TShiftState;
  X, Y: Integer);
begin
  inherited MouseUp(Button, Shift, X, Y);
  DoMouseUp(Button, Shift, X, Y);
  if FRepeatTimer <> nil then
    FRepeatTimer.Enabled := False;

  // (ahuser) Maybe we should remove the WM_RBUTTONUP code and make this
  // code available for VCL and VisualCLX.
  if Button = mbRight then
    UpdateTracking;
    
end;

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

procedure TJvCustomSpeedButton.Paint;
var
  PaintRect: TRect;
  LState: TJvButtonState;
  Offset: TPoint; 
begin
  if not Enabled {and not (csDesigning in ComponentState)} then
  begin
    FState := rbsDisabled;
    FDragging := False;
  end
  else
  if FState = rbsDisabled then
    if FDown and (GroupIndex <> 0) then
      FState := rbsExclusive
    else
      FState := rbsUp;

  if FFlat and not MouseOver and not (csDesigning in ComponentState) then
    { rbsInactive : flat and not 'mouse in control', thus
        - picture might be painted gray
        - no border, unless button is exclusive
    }
    LState := rbsInactive
  else
    LState := FState;

  PaintRect := Rect(0, 0, Width, Height);
 
  begin
    with Canvas do
    begin
      if FTransparent then
        CopyParentImage(Self, Canvas)
      else
      begin
        Brush.Color := Self.Color;
        Brush.Style := bsSolid;
        FillRect(PaintRect);
      end;
      if (LState <> rbsInactive) or (FState = rbsExclusive) then
        PaintRect := DrawButtonFrame(Canvas, PaintRect,
          FState in [rbsDown, rbsExclusive], FFlat, FStyle, Color)
      else
      if FFlat then
        InflateRect(PaintRect, -2, -2);
    end;
    if (FState = rbsExclusive) and not Transparent and
      (not FFlat or (LState = rbsInactive)) then
    begin
      Canvas.Brush.Bitmap := AllocPatternBitmap(clBtnFace, clBtnHighlight);
      InflateRect(PaintRect, 1, 1);
      Canvas.FillRect(PaintRect);
      InflateRect(PaintRect, -1, -1);
    end;
    if FState in [rbsDown, rbsExclusive] then
      Offset := Point(1, 1)
    else
      Offset := Point(0, 0);

    { Check whether the image need to be painted gray.. }
    if (FState = rbsDisabled) or not FInactiveGrayed then
      { .. do not paint gray image }
      LState := FState;

    if (MouseOver or FDragging) and HotTrack then
    begin
      Canvas.Font := Self.HotTrackFont;
      {Inserted by (ag) 2004-09-04}
      if HotTrackOptions.Enabled then
        begin
          Canvas.Brush.Color := HotTrackOptions.Color;
          Canvas.Brush.Style := bsSolid;
          Canvas.Pen.Color := HotTrackOptions.FrameColor;
          Canvas.Rectangle(0, 0, Width, Height);
        end;
      {Insert End}
    end else
      Canvas.Font := Self.Font;
  PaintImage(Canvas, PaintRect, Offset, LState,
      FMarkDropDown and Assigned(FDropDownMenu));
  end;
end;

procedure TJvCustomSpeedButton.SetAlignment(Value: TAlignment);
begin
  if Alignment <> Value then
  begin
    TJvxButtonGlyph(FGlyph).Alignment := Value;
    Invalidate;
  end;
end;

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

procedure TJvCustomSpeedButton.SetAllowTimer(Value: Boolean);
begin
  FAllowTimer := Value;
  if not FAllowTimer and (FRepeatTimer <> nil) then
  begin
    FRepeatTimer.Enabled := False;
    FRepeatTimer.Free;
    FRepeatTimer := nil;
  end;
end;

procedure TJvCustomSpeedButton.SetDown(Value: Boolean);
begin
  if FGroupIndex = 0 then
    Value := False;
  if Value <> FDown then
  begin
    if FDown and not FAllowAllUp then
      Exit;
    FDown := Value;
    if Value then
    begin
      if FState = rbsUp then
        Invalidate;
      FState := rbsExclusive;
    end
    else
    begin
      FState := rbsUp;
    end;
    Repaint;
    if Value then
      UpdateExclusive;
    Invalidate;
  end;
end;

procedure TJvCustomSpeedButton.SetDropdownMenu(Value: TPopupMenu);
begin
  FDropDownMenu := Value;
  if Value <> nil then
    Value.FreeNotification(Self);
  if FMarkDropDown then
    Invalidate;
end;

procedure TJvCustomSpeedButton.SetFlat(Value: Boolean);
begin
  if Value <> FFlat then
  begin
    FFlat := Value;
    Invalidate;
  end;
end;

procedure TJvCustomSpeedButton.SetGrayNewStyle(const Value: Boolean);
begin
  if GrayNewStyle <> Value then
  begin
    TJvxButtonGlyph(FGlyph).GrayNewStyle := Value;
    Invalidate;
  end;
end;