jvqdialbutton.pas

East make Tray Icon in delphi

          DeleteObject(Region);
          SelectClipRgn(Canvas.Handle, 0);
          raise;
        end;
      end;
  end;
  InflateRect(FPointerRect, 1, 1);
end;

procedure TJvCustomDialButton.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 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; 
  Canvas.Start;
  try 
    Canvas.Brush.Color := Parent.Brush.Color;
    Canvas.Brush.Style := bsSolid; 
      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; 
  finally
    Canvas.Stop;
  end; 
  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; 
  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.DoExit;
begin
  inherited DoExit;
  if HandleAllocated then
    DrawBorder;
end;

procedure TJvCustomDialButton.DoEnter;
begin
  inherited DoEnter;
  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;



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;



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}
const
  UnitVersioning: TUnitVersionInfo = (
    RCSfile: '$RCSfile: JvQDialButton.pas,v $';
    Revision: '$Revision: 1.16 $';
    Date: '$Date: 2004/11/06 22:08:16 $';
    LogPath: 'JVCL\run'
  );

initialization
  RegisterUnitVersion(HInstance, UnitVersioning);

finalization
  UnregisterUnitVersion(HInstance);
{$ENDIF UNITVERSIONING}

end.