jvradiocontrol.pas

East make Tray Icon in delphi

  // Change Max if necessary and flag redrawing if so.
  if FMax <> AMax then
  begin
    FMax := AMax;
    Invalid := True;
  end;

  // Change Position if necessary and draw pointer accordingly.
  if APosition <> FPosition then
  begin
    FPosition := APosition;
    DrawPointer;
    Changed := True;
  end;

  // If redrawing flagged, cause a redraw, redoing the bitmap too.
  if Invalid then
  begin
    FBitmapInvalid := True;
    Changed := True;
    Invalidate;
  end;

  if Changed then
    // Notify the user of changes.
    Change;
end;

// Set all angle parameters at once.

procedure TJvCustomRadioControl.SetAngleParams(AnAngle, AMin, AMax: TJvRadioAngle);
var
  Invalid: Boolean;
  Pos: Integer;
begin
  // Error if AMax < AMin
  if AMax < AMin then
    raise EInvalidOperation.CreateFmt(SPropertyOutOfRange, [Self.Classname]);

  // Confine AnAngle to limits.
  if AnAngle < AMin then
    AnAngle := AMin;
  if AnAngle > AMax then
    AnAngle := AMax;
  Invalid := False;

  // Set MinAngle.
  if FMinAngle <> AMin then
  begin
    FMinAngle := AMin;
    Invalid := True;
  end;

  // Set MaxAngle.
  if FMaxAngle <> AMax then
  begin
    FMaxAngle := AMax;
    Invalid := True;
  end;

  // Redraw if necessary
  if Invalid then
  begin
    FBitmapInvalid := True;
    Invalidate;
  end;

  // Set Position.
  Pos := AngleToPos(AnAngle);
  if Pos <> FPosition then
    SetParams(Pos, FMin, FMax);
end;

procedure TJvCustomRadioControl.SetDefaultPos(Value: Integer);
begin
  // Change this if side effects are needed, e.g. to show a default pos marker.
  if Value <> FDefaultPos then
    FDefaultPos := Value;
end;

procedure TJvCustomRadioControl.SetFrequency(Value: Integer);
begin
  if Value <> FFrequency then
  begin
    FFrequency := Value;
    if FFrequency < 1 then FFrequency := 1; 
    if FTickStyle = tsAuto then
    begin
      ClearTicks;
      SetTicks(FTickStyle);
    end;
    FBitmapInvalid := True;
    Invalidate;
  end;
end;

procedure TJvCustomRadioControl.SetMin(Value: Integer);
begin
  SetParams(FPosition, Value, FMax);
end;

procedure TJvCustomRadioControl.SetMinAngle(Value: TJvRadioAngle);
begin
  SetAngleParams(PosToAngle(FPosition), Value, FMaxAngle);
end;

procedure TJvCustomRadioControl.SetMax(Value: Integer);
begin
  SetParams(FPosition, FMin, Value);
end;

procedure TJvCustomRadioControl.SetMaxAngle(Value: TJvRadioAngle);
begin
  SetAngleParams(PosToAngle(FPosition), FMinAngle, Value);
end;

procedure TJvCustomRadioControl.SetPosition(Value: Integer);
begin
  SetParams(Value, FMin, FMax);
end;

function TJvCustomRadioControl.CalcBounds(var AWidth, AHeight: Integer): Boolean;
var
  ASize: Integer;
begin
  Result := False;
  ASize := rcMinRadius + MinBorder + TickBorder;
  if FBorderStyle = bsSingle then
    Inc(ASize, GetSystemMetrics(SM_CXBORDER));
  ASize := 2 * ASize + 1;
  if AWidth < ASize then
  begin
    AWidth := ASize;
    Result := True;
  end;
  if AHeight < ASize then
  begin
    AHeight := ASize;
    Result := True;
  end;
end;

procedure TJvCustomRadioControl.SetRadius(Value: Integer);
var
  MaxRadius: Integer;
begin
  if Width <= Height then
    MaxRadius := (Width - 1) div 2 - MinBorder - TickBorder
  else
    MaxRadius := (Height - 1) div 2 - MinBorder - TickBorder;
  if FBorderStyle = bsSingle then
    Dec(MaxRadius, GetSystemMetrics(SM_CXBORDER));
  if Value > MaxRadius then
    Value := MaxRadius;
  if Value < rcMinRadius then
    Value := rcMinRadius;
  if Value <> FRadius then
  begin
    FRadius := Value;
    FBitmapInvalid := True;
    Invalidate;
  end;
  UpdateSize;
end;

procedure TJvCustomRadioControl.SetTicks(Value: TTickStyle);
var
  L: TJvTickLength;
  I: Integer;
begin
  if Value <> tsNone then
  begin
    SetTick(FMin, tlLong);
    SetTick(FMax, tlLong);
  end;
  if Value = tsAuto then
  begin
    I := FMin + FFrequency;
    L := tlMiddle;
    while I < FMax do
    begin
      SetTick(I, L);
      if L = tlMiddle then
        L := tlLong
      else
        L := tlMiddle;
      Inc(I, FFrequency);
    end;
  end;
end;

procedure TJvCustomRadioControl.SetTickStyle(Value: TTickStyle);
begin
  if FTickStyle <> Value then
  begin
    FTickStyle := Value;
    ClearTicks;
    SetTicks(Value);
    FBitmapInvalid := True;
    Invalidate;
  end;
end;

procedure TJvCustomRadioControl.Change;
begin
  if Assigned(FOnChange) then
    FOnChange(Self);
end;

procedure TJvCustomRadioControl.SetSmallChange(Value: Integer);
begin
  if Value > FLargeChange then
    Value := FLargeChange div 2;
  if Value < 1 then
    Value := 1;
  FSmallChange := Value;
end;

procedure TJvCustomRadioControl.SetLargeChange(Value: Integer);
begin
  if Value <= FSmallChange + 1 then
    Value := FSmallChange + 1;
  FLargeChange := Value;
end;

procedure TJvCustomRadioControl.SetTick(Value: Integer; Length: TJvTickLength);
const
  Lengths: array [TJvTickLength] of Byte =
    (tlShortLen, tlMiddleLen, tlLongLen);
var
  P: PTick;
  I: Integer;
begin
  if (Value < FMin) or (Value > FMax) then
    raise EInvalidOperation.CreateFmt(SOutOfRange, [FMin, FMax]);
  for I := 0 to FTicks.Count - 1 do
  begin
    P := FTicks.Items[I];
    if P^.Value = Value then
    begin
      if P^.Length <> Lengths[Length] then
      begin
        P^.Length := Lengths[Length];
        P^.Changed := True;
        Invalidate;
      end;
      Exit;
    end;
  end;
  New(P);
  P^.Value := Value;
  P^.Length := Lengths[Length];
  P^.Changed := True;
  P^.Color := clBtnText;
  FTicks.Add(P);
  if HandleAllocated then
  begin
    DrawTick(FBitmap.Canvas, P^);
    DrawTick(Canvas, P^);
  end;
end;

procedure TJvCustomRadioControl.DrawTick(ACanvas: TCanvas; var T: TTick);
var
  Pt: TPoint;
  ValueAngle: Integer;
begin
  ValueAngle := PosToAngle(T.Value);
  ACanvas.Pen.Color := T.Color;
  Pt := AngleToPoint(ValueAngle, Center, FRadius);
  ACanvas.MoveTo(Pt.X, Pt.Y);
  Pt := AngleToPoint(ValueAngle, GetCenter, FRadius + T.Length);
  ACanvas.LineTo(Pt.X, Pt.Y);
  T.Changed := False;
end;

procedure TJvCustomRadioControl.Paint;
begin
  Canvas.Brush.Color := Parent.Brush.Color;
  Canvas.FillRect(ClientRect);
  BitmapNeeded;
  Canvas.CopyRect(FBitmapRect, FBitmap.Canvas, FBitmapRect);
  DrawBorder;
  DrawPointer;
end;

procedure TJvCustomRadioControl.DrawPointer;
var
  Outer, Inner, Extra: TPoint;
  InnerRadius, DotRadius: Integer;
  Region: HRgn;
  SmallRadius: Integer;

  function Lowest(A, B, C: Integer): Integer;
  begin
    if A < B then
      if A < C then
        Result := A
      else
        Result := C
    else
    if B < C then
      Result := B
    else
      Result := C
  end;

  function Highest(A, B, C: Integer): Integer;
  begin
    if A > B then
      if A > C then
        Result := A
      else
        Result := C
    else
    if B > C then
      Result := B
    else
      Result := C;
  end;

begin
  if not HandleAllocated then
    Exit;
  InnerRadius := (100 - FButtonEdge) * FRadius div 100 - 1;
  if FPointerRect.Left < 0 then
    FPointerRect := Rect(Center.X - InnerRadius,
      Center.Y - InnerRadius,
      Center.X + InnerRadius + 1,
      Center.Y + InnerRadius + 1);
  Canvas.CopyRect(FPointerRect, FBitmap.Canvas, FPointerRect);
  // This is for a solid dot. I'd also like to make a Ctl3D type of dot or
  // an open type of dot. We'd also have to make a disabled type of dot.
  Canvas.Pen.Color := FPointerColor;
  Canvas.Brush.Color := FPointerColor;
  case FPointerShape of
    psLine:
      begin
        Outer := AngleToPoint(Angle, Center, InnerRadius);
        Canvas.MoveTo(Outer.X, Outer.Y);
        Inner := AngleToPoint(Angle, Center, (101 - FPointerSize) * InnerRadius div 100);
        Canvas.LineTo(Inner.X, Inner.Y);
        FPointerRect := Rect(Math.Min(Inner.X, Outer.X),
          Math.Min(Inner.Y, Outer.Y),
          Math.Max(Inner.X, Outer.X),
          Math.Max(Inner.Y, Outer.Y));
      end;
    psTriangle:
      begin
        SmallRadius := FPointerSize * InnerRadius div 100;
        Outer := AngleToPoint(Angle, Center, InnerRadius);
        Inner := AngleToPoint(Angle - 1500, Outer, SmallRadius);
        Extra := AngleToPoint(Angle + 1500, Outer, SmallRadius);
        Canvas.Polygon([Outer, Inner, Extra]);
        FPointerRect := Rect(Lowest(Outer.X, Inner.X, Extra.X),
          Lowest(Outer.Y, Inner.Y, Extra.Y),
          Highest(Outer.X, Inner.X, Extra.X),
          Highest(Outer.Y, Inner.Y, Extra.Y));
      end;
    psDot:
      begin
        DotRadius := FPointerSize * InnerRadius div 200;
        Inner := AngleToPoint(Angle, Center, InnerRadius - DotRadius);
        if Inner.X > Center.X then
          Inc(Inner.X);
        if Inner.Y > Center.Y then
          Inc(Inner.Y);
        FPointerRect := Rect(Inner.X - DotRadius,
          Inner.Y - DotRadius,
          Inner.X + DotRadius,
          Inner.Y + DotRadius);
        with FPointerRect do
          Canvas.Ellipse(Left, Top, Right, Bottom);
      end;
    psOwnerDraw:
      if Assigned(FOnDrawPointer) then
      begin
        DotRadius := FPointerSize * InnerRadius div 200;
        Outer := AngleToPoint(Angle, Center, InnerRadius - DotRadius);
        if Outer.X > Center.X then
          Inc(Outer.X);
        if Outer.Y > Center.Y then
          Inc(Outer.Y);
        FPointerRect := Rect(Outer.X - DotRadius,
          Outer.Y - DotRadius,
          Outer.X + DotRadius,
          Outer.Y + DotRadius);

        // Create a clipping region to protect the area outside the button
        // face.
        with FPointerRect do
          Region := CreateEllipticRgn(Left - 1, Top - 1, Right + 1, Bottom + 1);
        SelectClipRgn(Canvas.Handle, Region);
        try
          FOnDrawPointer(Self, FPointerRect);
        except
          DeleteObject(Region);
          SelectClipRgn(Canvas.Handle, 0);
          raise;