jvradiocontrol.pas

East make Tray Icon in delphi

        end;
      end;
  end;
  InflateRect(FPointerRect, 1, 1);
end;

procedure TJvCustomRadioControl.BitmapNeeded;
begin
  if FBitmap = nil then
  begin
    FBitmap := TBitmap.Create;
    FBitmapInvalid := True;
  end;
  if FBitmapInvalid then
  begin
    if FBitmap.Width <> FSize + 1 then
    begin
      FBitmap.Width := FSize + 1;
      FBitmap.Height := FSize + 1;
      FBitmapRect := Bounds(0, 0, FSize + 1, FSize + 1);
    end;

    // Draw on bitmap.
    DrawButton;
    DrawTicks;
  end;
end;

function Blend(const Factor: Double; const Color1, Color2: TColor): TColor;
var
  Factor2: Double;
begin
  Factor2 := 1.0 - Factor;
  with TRGBQuad(Result) do
  begin
    rgbBlue := Trunc(Factor * TRGBQuad(Color1).rgbBlue + Factor2 * TRGBQuad(Color2).rgbBlue);
    rgbGreen := Trunc(Factor * TRGBQuad(Color1).rgbGreen + Factor2 * TRGBQuad(Color2).rgbGreen);
    rgbRed := Trunc(Factor * TRGBQuad(Color1).rgbRed + Factor2 * TRGBQuad(Color2).rgbRed);
    rgbReserved := 0;
  end;
end;

procedure TJvCustomRadioControl.DrawButton;
const
  HalfPi = 1.57079632679489661923;
var
  Edge: Integer;
  ButtonRect: TRect;
  Face, Highlight, Shadow: TColor;
  Size: Integer;
  OldOrg: TPoint;
  C: TCanvas;
  I: Integer;
begin
  Size := 2 * FRadius + 1;
  ButtonRect := Bounds(0, 0, Size, Size);
  C := FBitmap.Canvas;
  C.Brush.Color := Parent.Brush.Color;
  C.Brush.Style := bsSolid;
  C.FillRect(FBitmapRect);
  SetViewPortOrgEx(C.Handle, FSize div 2 - FRadius, FSize div 2 - FRadius,
    @OldOrg);

  // Draw edge.
  C.Pen.Style := psClear;

  Highlight := ColorToRGB(clBtnHighlight);
  Face := ColorToRGB(Color);
  Shadow := (ColorToRGB(Color) and $00FEFEFE) shr 1;

  for I := 0 to Size do
  begin
    C.Brush.Color := Blend(Cos(I * HalfPi / Size), Highlight, Face);
    C.Pie(0, 0, Size, Size, I + 1, 0, I - 1, 0);
    C.Pie(0, 0, Size, Size, 0, I - 1, 0, I + 1);
  end;

  for I := 0 to Size do
  begin
    C.Brush.Color := Blend(1.0 - Sin(I * HalfPi / Size), Face, Shadow);
    C.Pie(0, 0, Size, Size, Size, I + 1, Size, I - 1);
    C.Pie(0, 0, Size, Size, I - 1, Size, I + 1, Size);
  end;

  // Draw top of disk.
  C.Pen.Style := psSolid;
  C.Pen.Color := Color;
  C.Brush.Color := Color;
  Edge := FButtonEdge * FRadius div 100 + 1;
  C.Ellipse(0 + Edge, 0 + Edge, 0 + Size - Edge, 0 + Size - Edge);

  // Draw bounding circle.
  C.Pen.Color := clBtnText;
  C.Brush.Style := bsClear;
  C.Ellipse(0, 0, Size, Size);

  // Reset viewport origin.
  SetViewportOrgEx(C.Handle, OldOrg.X, OldOrg.Y, nil);
  FBitmapInvalid := False;
end;

procedure TJvCustomRadioControl.SetPointerShape(Value: TJvRadioPointerShape);
begin
  if Value <> FPointerShape then
  begin
    FPointerShape := Value;
    Invalidate;
  end;
end;

procedure TJvCustomRadioControl.DrawBorder;
var
  ARect: TRect;
begin
  ARect := ClientRect;
  InflateRect(ARect, -1, -1);
  Canvas.Brush.Style := bsClear;
  Canvas.Pen.Color := Parent.Brush.Color;
  Canvas.Rectangle(ARect.Left, ARect.Top, ARect.Right, ARect.Bottom);
  Canvas.Brush.Style := bsSolid;
  if GetFocus = Self.Handle then
    Canvas.DrawFocusRect(ARect);
end;

procedure TJvCustomRadioControl.DrawTicks;
var
  I: Integer;
begin
  if (FTickStyle = tsNone) or (FTicks = nil) or (FTicks.Count = 0) then
    Exit;
  for I := 0 to FTicks.Count - 1 do
    DrawTick(FBitmap.Canvas, PTick(FTicks.List[I])^);
end;

procedure TJvCustomRadioControl.UpdateSize;
begin
  FSize := 2 * (MinBorder + FRadius + TickBorder) + 1;
end;

procedure TJvCustomRadioControl.SetBounds(ALeft, ATop, AWidth, AHeight: Integer);
begin
  if CalcBounds(AWidth, AHeight) then
    FBitmapInvalid := True;
  inherited SetBounds(ALeft, ATop, AWidth, AHeight);
  SetRadius(AWidth + AHeight);
end;

procedure TJvCustomRadioControl.CMParentColorChanged(var Msg: TMessage);
begin
  FBitmapInvalid := True;
  inherited;
end;

// Set button edge in percent (0 - 100).

procedure TJvCustomRadioControl.SetButtonEdge(Value: Integer);
begin
  if Value < rcMinEdge then
    Value := rcMinEdge;
  if Value > rcMaxEdge then
    Value := rcMaxEdge;
  if Value <> FButtonEdge then
  begin
    FButtonEdge := Value;
    if not FBitmapInvalid then
    begin
      FBitmapInvalid := True;
      Invalidate;
    end;
  end;
end;

procedure TJvCustomRadioControl.WMKillFocus(var Msg: TWMKillFocus);
begin
  inherited;
  if HandleAllocated then
    DrawBorder;
end;

procedure TJvCustomRadioControl.WMSetFocus(var Msg: TWMSetFocus);
begin
  inherited;
  if HandleAllocated then
    DrawBorder;
end;

procedure TJvCustomRadioControl.MouseDown(Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
var
  A: TJvRadioAngle;
begin
  inherited MouseDown(Button, Shift, X, Y);
  if not Focused then
  begin
    SetFocus;
    Invalidate;
  end;
  if PtInRect(FPointerRect, Point(X, Y)) then
    MouseCapture := True
  else
  begin
    A := RadToAngle(PointToRad(Point(X, Y), GetCenter));
    if A < Angle then
    begin
      DecPos(Shift);
      FIncrementing := False;
    end
    else
    begin
      IncPos(Shift);
      FIncrementing := True;
    end;
    if FRepeatTimer = nil then
      FRepeatTimer := TTimer.Create(Self);
    FRepeatTimer.OnTimer := TimerExpired;
    FRepeatTimer.Interval := FRepeatDelay;
    FRepeatTimer.Enabled := True;
  end;
end;

procedure TJvCustomRadioControl.TimerExpired(Sender: TObject);
begin
  FRepeatTimer.Enabled := False;
  FRepeatTimer.Interval := FRepeatRate;
  if FIncrementing then
    IncPos(GetShiftState)
  else
    DecPos(GetShiftState);
  FRepeatTimer.Enabled := True;
end;

procedure TJvCustomRadioControl.MouseMove(Shift: TShiftState; X, Y: Integer);
begin
  inherited MouseMove(Shift, X, Y);
  if MouseCapture then
    SetAngle(RadToAngle(PointToRad(Point(X, Y), GetCenter)));
end;

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

function TJvCustomRadioControl.GetCenter: TPoint;
begin
  with Result do
  begin
    X := FSize div 2;
    Y := X;
  end;
end;

procedure TJvCustomRadioControl.ClearTicks;
var
  I: Integer;
begin
  if FTicks <> nil then
    with FTicks do
    begin
      for I := 0 to Count - 1 do
        if List[I] <> nil then
          Dispose(PTick(List[I]));
      Clear;
    end;
end;

procedure TJvCustomRadioControl.CreateParams(var Params: TCreateParams);
const
  BorderStyles: array[TBorderStyle] of Cardinal = (0, WS_BORDER);
begin
  inherited CreateParams(Params);
  Params.Style := Params.Style or BorderStyles[FBorderStyle];
  if NewStyleControls and Ctl3D and (FBorderStyle = bsSingle) then
  begin
    Params.Style := Params.Style and not WS_BORDER;
    Params.ExStyle := Params.ExStyle or WS_EX_STATICEDGE;
  end;
end;

procedure TJvCustomRadioControl.SetPointerColor(Value: TColor);
begin
  if Value <> FPointerColor then
  begin
    FPointerColor := Value;
    DrawPointer;
  end;
end;

procedure TJvCustomRadioControl.CMCtl3DChanged(var Msg: TMessage);
begin
  inherited;
  FBitmapInvalid := True;
  RecreateWnd;
end;

procedure TJvCustomRadioControl.IncPos(Shift: TShiftState);
begin
  if ssShift in Shift then
    Position := Position + FLargeChange
  else
  if ssCtrl in Shift then
    Position := FMax
  else
    Position := Position + FSmallChange;
end;

procedure TJvCustomRadioControl.DecPos(Shift: TShiftState);
begin
  if ssShift in Shift then
    Position := Position - FLargeChange
  else
  if ssCtrl in Shift then
    Position := FMin
  else
    Position := Position - FSmallChange;
end;

procedure TJvCustomRadioControl.KeyDown(var Key: Word; Shift: TShiftState);
begin
  case Key of
    VK_UP, VK_RIGHT:
      IncPos(Shift);
    VK_DOWN, VK_LEFT:
      DecPos(Shift);
    VK_PRIOR:
      IncPos(Shift + [ssShift]);
    VK_NEXT:
      DecPos(Shift + [ssShift]);
    VK_HOME:
      Position := FMin;
    VK_END:
      Position := FMax;
  else
    begin
      inherited KeyDown(Key, Shift);
      Exit;
    end;
  end;
  // (rom) unreachable code
  //Key := 0;
  //inherited KeyDown(Key, Shift);
end;

procedure TJvCustomRadioControl.WndProc(var Msg: TMessage);
begin
  if Msg.Msg = CN_KEYDOWN then
    DoKeyDown(TWMKey(Msg));
  inherited WndProc(Msg);
end;

procedure TJvCustomRadioControl.WMSysColorChange(var Msg: TMessage);
begin
  FBitmapInvalid := True;
  Invalidate;
end;

procedure TJvCustomRadioControl.SetPointerSize(Value: Integer);
begin
  if Value > 100 then
    Value := 100
  else
  if Value < 1 then
    Value := 1;
  if Value <> FPointerSize then
  begin
    FPointerSize := Value;
    DrawPointer;
  end;
end;

function TJvCustomRadioControl.AngleToRad(AnAngle: TJvRadioAngle): Double;
begin
  Result := dAngleToRadian * AnAngle;
end;

procedure TJvCustomRadioControl.CMColorChanged(var Msg: TMessage);
begin
  FBitmapInvalid := True;
  inherited;
end;

procedure TJvCustomRadioControl.Loaded;
begin
  inherited Loaded;
  Change;
end;

function TJvCustomRadioControl.RadToAngle(const Radian: Double): TJvRadioAngle;
begin
  Result := Round(dRadianToAngle * Radian);
end;

end.