jvdialbutton.pas

East make Tray Icon in delphi

    end;

    {$IFDEF JVCLThemesEnabled}
    if ThemeServices.ThemesEnabled then
      FBitmap.Canvas.CopyRect(FBitmapRect, Canvas, FBitmapRect);
    {$ENDIF JVCLThemesEnabled}

    // 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 TJvCustomDialButton.DrawButton;
const
  HalfPi = 1.57079632679489661923;
var
  Edge: Integer;
  ButtonRect: TRect;
  Face, Highlight, Shadow: TColor;
  Size: Integer;
  OldOrg: TPoint;
  Canvas: TCanvas;
  I: Integer;
begin
  Size := 2 * FRadius + 1;
  ButtonRect := Bounds(0, 0, Size, Size);
  Canvas := FBitmap.Canvas;
  {$IFDEF VisualCLX}
  Canvas.Start;
  try
  {$ENDIF VisualCLX}
    Canvas.Brush.Color := Parent.Brush.Color;
    Canvas.Brush.Style := bsSolid;
    {$IFDEF JVCLThemesEnabled}
    if not ThemeServices.ThemesEnabled then
    {$ENDIF JVCLThemesEnabled}
      Canvas.FillRect(FBitmapRect);
    SetViewportOrgEx(Canvas.Handle, FSize div 2 - FRadius, FSize div 2 - FRadius,
      @OldOrg);
    try
      // Draw edge.
      Canvas.Pen.Style := psClear;

      Highlight := ColorToRGB(clBtnHighlight);
      Face := ColorToRGB(Color);
      // darking the color by halving each color part value
      Shadow := (ColorToRGB(Color) and $00FEFEFE) shr 1;

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

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

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

      // Draw bounding circle.
      Canvas.Pen.Color := clBtnText;
      Canvas.Brush.Style := bsClear;
      Canvas.Ellipse(0, 0, Size, Size);
    finally
      // Reset viewport origin.
      SetViewportOrgEx(Canvas.Handle, OldOrg.X, OldOrg.Y, nil);
    end;
  {$IFDEF VisualCLX}
  finally
    Canvas.Stop;
  end;
  {$ENDIF VisualCLX}
  FBitmapInvalid := False;
end;

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

procedure TJvCustomDialButton.DrawBorder;
var
  ARect: TRect;
begin
  ARect := ClientRect;
  InflateRect(ARect, -1, -1);
  Canvas.Brush.Style := bsClear;
  {$IFDEF JVCLThemesEnabled}
  if ThemeServices.ThemesEnabled then
  begin
    BitmapNeeded;
    Canvas.Pen.Color := FBitmap.Canvas.Pixels[0, 0]
  end
  else
  {$ENDIF JVCLThemesEnabled}
  Canvas.Pen.Color := Parent.Brush.Color;
  Canvas.Rectangle(ARect.Left, ARect.Top, ARect.Right, ARect.Bottom);
  Canvas.Brush.Style := bsSolid;
  if Focused then
    Canvas.DrawFocusRect(ARect);
end;

procedure TJvCustomDialButton.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 TJvCustomDialButton.UpdateSize;
begin
  FSize := 2 * (MinBorder + FRadius + TickBorder) + 1;
end;

procedure TJvCustomDialButton.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 TJvCustomDialButton.ParentColorChanged;
begin
  FBitmapInvalid := True;
  inherited ParentColorChanged;
end;

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

procedure TJvCustomDialButton.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 TJvCustomDialButton.FocusKilled(NextWnd: HWND);
begin
  inherited FocusKilled(NextWnd);
  if HandleAllocated then
    DrawBorder;
end;

procedure TJvCustomDialButton.FocusSet(PrevWnd: HWND);
begin
  inherited FocusSet(PrevWnd);
  if HandleAllocated then
    DrawBorder;
end;

procedure TJvCustomDialButton.MouseDown(Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
var
  A: TJvDialAngle;
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 TJvCustomDialButton.TimerExpired(Sender: TObject);
begin
  FRepeatTimer.Enabled := False;
  FRepeatTimer.Interval := FRepeatRate;
  if FIncrementing then
    IncPos(GetShiftState)
  else
    DecPos(GetShiftState);
  FRepeatTimer.Enabled := True;
end;

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

procedure TJvCustomDialButton.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 TJvCustomDialButton.GetCenter: TPoint;
begin
  with Result do
  begin
    X := FSize div 2;
    Y := X;
  end;
end;

procedure TJvCustomDialButton.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 TJvCustomDialButton.Click;
begin
  inherited Click;
  FState := not FState;
  Invalidate;
end;

{$IFDEF VCL}
procedure TJvCustomDialButton.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;
{$ENDIF VCL}

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

procedure TJvCustomDialButton.SetPointerColorOff(Value: TColor);
begin
  if Value <> FPointerColorOff then
  begin
    FPointerColorOff := Value;
    if not State then
      DrawPointer;
  end;
end;

procedure TJvCustomDialButton.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 TJvCustomDialButton.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 TJvCustomDialButton.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
    inherited KeyDown(Key, Shift);
    Exit;
  end;
  Key := 0;
  inherited KeyDown(Key, Shift);
end;

{$IFDEF VCL}

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

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

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

{$ENDIF VCL}

procedure TJvCustomDialButton.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 TJvCustomDialButton.AngleToRad(AnAngle: TJvDialAngle): Double;
begin
  Result := dAngleToRadian * AnAngle;
end;

procedure TJvCustomDialButton.ColorChanged;
begin
  FBitmapInvalid := True;
  inherited ColorChanged;
end;

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

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

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

finalization
  UnregisterUnitVersion(HInstance);
{$ENDIF UNITVERSIONING}

end.