{----------------------------------------------------------------------------- The contents of this file are subject to the Mozilla Public License Version 1.1 (the "License"); you may not use this file except in compliance with the License. You may obtain a copy of the License at http://www.mozilla.org/MPL/MPL-1.1.html Software distributed under the License is distributed on an "AS IS" basis, WITHOUT WARRANTY OF ANY KIND, either expressed or implied. See the License for the specific language governing rights and limitations under the License. The Original Code is: JvRadioGroup.PAS, released on 2002-07-16. The Initial Developer of the Original Code is Rudolph Velthuis Portions created by Rudolph Velthuis are Copyright (C) 1997 drs. Rudolph Velthuis. All Rights Reserved. Contributor(s): marcelb - renaming TJvDialButton, adding on/off state and on/off color for pointer. You may retrieve the latest version of this file at the Project JEDI's JVCL home page, located at http://jvcl.delphi-jedi.org Description: TJvDialButton component, a button like the dial on a radio. Known Issues: -----------------------------------------------------------------------------} // $Id$ unit JvDialButton; {$mode objfpc}{$H+} interface uses LCLType, LCLIntf, LMessages, //Windows, Messages, Classes, Graphics, Controls, Forms, ExtCtrls, ComCtrls, JvComponent; type TJvDialPointerShape = (psLine, psTriangle, psDot, psOwnerDraw); TJvTickLength = (tlShort, tlMiddle, tlLong); TJvDialAngle = 0..3600; // 0.0 - 360.0 deg // in decidegrees (use 100 for 10 degrees) TJvRepeatValue = 10..1000; // mouse repeat values TJvCustomDialButton = class; TJvDialDrawEvent = procedure(Sender: TJvCustomDialButton; ARect: TRect) of object; TJvDialComputeTicks = procedure(Sender: TJvCustomDialButton) of object; PTick = ^TTick; TTick = record Value: Integer; Length: Integer; Color: TColor; Changed: Boolean; end; TJvCustomDialButton = class(TJvCustomControl) private FBitmap: TBitmap; FBitmapRect: TRect; FBitmapInvalid: Boolean; // FBorderStyle: TBorderStyle; FButtonEdge: Integer; FDefaultPos: Integer; FFrequency: Integer; FLargeChange: Integer; FMax: Integer; FMaxAngle: TJvDialAngle; FMin: Integer; FMinAngle: TJvDialAngle; FPointerRect: TRect; FPointerColor: TColor; FPointerColorOff: TColor; FPointerPenWidth: Integer; FPointerSize: Integer; FPointerShape: TJvDialPointerShape; FPosition: Integer; FRadius: Integer; FSize: Integer; FState: Boolean; FSmallChange: Integer; FTicks: TList; FTickStyle: TTickStyle; FIncrementing: Boolean; FRepeatTimer: TTimer; FRepeatRate: TJvRepeatValue; FRepeatDelay: TJvRepeatValue; FOnChange: TNotifyEvent; FOnDrawPointer: TJvDialDrawEvent; FOnComputeTicks: TJvDialComputeTicks; function CalcBounds(var AWidth, AHeight: Integer): Boolean; function GetAngle: TJvDialAngle; function GetCenter: TPoint; procedure SetAngle(Value: TJvDialAngle); procedure SetButtonEdge(Value: Integer); procedure SetDefaultPos(Value: Integer); procedure SetFrequency(Value: Integer); procedure SetLargeChange(Value: Integer); procedure SetMin(Value: Integer); procedure SetMinAngle(Value: TJvDialAngle); procedure SetMax(Value: Integer); procedure SetMaxAngle(Value: TJvDialAngle); procedure SetPointerColor(Value: TColor); procedure SetPointerColorOff(Value: TColor); procedure SetPointerPenWidth(Value: Integer); procedure SetPointerSize(Value: Integer); procedure SetPointerShape(Value: TJvDialPointerShape); procedure SetPosition(Value: Integer); procedure SetRadius(Value: Integer); procedure SetSmallChange(Value: Integer); procedure SetState(Value: Boolean); procedure SetTickStyle(Value: TTickStyle); procedure UpdateSize; procedure TimerExpired(Sender: TObject); procedure ComputeTicks; protected function AngleToPos(AnAngle: TJvDialAngle): Integer; procedure BitmapNeeded; dynamic; procedure Change; dynamic; procedure ClearTicks; // procedure Click; override; // procedure CreateParams(var Params: TCreateParams); override; // procedure CMCtl3DChanged(var Msg: TLMessage); message CM_CTL3DCHANGED; // procedure WMSysColorChange(var Msg: TLMessage); message LM_SYSCOLORCHANGE; // procedure WndProc(var Msg: TLMessage); override; // procedure FocusSet(PrevWnd: THandle); override; // procedure FocusKilled(NextWnd: THandle); override; procedure ColorChanged; override; procedure ParentColorChanged; override; procedure DrawBorder; dynamic; procedure DrawButton; dynamic; procedure DrawPointer; dynamic; procedure DrawTick(ACanvas: TCanvas; var Tick: TTick); dynamic; procedure DrawTicks; dynamic; procedure KeyDown(var Key: Word; Shift: TShiftState); override; procedure Loaded; override; procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override; procedure MouseMove(Shift: TShiftState; X, Y: Integer); override; procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override; procedure Paint; override; function PosToAngle(Pos: Integer): TJvDialAngle; // procedure SetBorderStyle(Value: TBorderStyle); override; procedure SetTicks(Value: TTickStyle); virtual; procedure IncPos(Shift: TShiftState); dynamic; procedure DecPos(Shift: TShiftState); dynamic; property Ticks: TList read FTicks write FTicks stored True; // to be published later: property Angle: TJvDialAngle read GetAngle write SetAngle stored False; // in decidegrees (use 100 for 10 degrees) property BorderStyle default bsNone; property ButtonEdge: Integer read FButtonEdge write SetButtonEdge default 2; property DefaultPos: Integer read FDefaultPos write SetDefaultPos; property Frequency: Integer read FFrequency write SetFrequency default 10; property LargeChange: Integer read FLargeChange write SetLargeChange default 2; property Max: Integer read FMax write SetMax default 100; property MaxAngle: TJvDialAngle read FMaxAngle write SetMaxAngle default 3300; // in decidegrees (use 100 for 10 degrees) property Min: Integer read FMin write SetMin default 0; property MinAngle: TJvDialAngle read FMinAngle write SetMinAngle default 300; // in decidegrees (use 100 for 10 degrees) property PointerColorOn: TColor read FPointerColor write SetPointerColor default clBtnText; property PointerColorOff: TColor read FPointerColorOff write SetPointerColorOff default clGrayText; property PointerPenWidth: Integer read FPointerPenWidth write SetPointerPenWidth default 3; property PointerSize: Integer read FPointerSize write SetPointerSize default 33; property PointerShape: TJvDialPointerShape read FPointerShape write SetPointerShape default psLine; property Position: Integer read FPosition write SetPosition default 0; property Radius: Integer read FRadius write SetRadius; property RepeatDelay: TJvRepeatValue read FRepeatDelay write FRepeatDelay default 400; property RepeatRate: TJvRepeatValue read FRepeatRate write FRepeatRate default 100; property SmallChange: Integer read FSmallChange write SetSmallChange default 1; property State: Boolean read FState write SetState default True; property TickStyle: TTickStyle read FTickStyle write SetTickStyle stored True; property TabStop default True; property OnChange: TNotifyEvent read FOnChange write FOnChange; property OnDrawPointer: TJvDialDrawEvent read FOnDrawPointer write FOnDrawPointer; property OnComputeTicks: TJvDialComputeTicks read FOnComputeTicks write FOnComputeTicks; public constructor Create(AOwner: TComponent); override; destructor Destroy; override; function AngleToPoint(AnAngle: TJvDialAngle; ACenter: TPoint; ARadius: Integer): TPoint; procedure SetAngleParams(AnAngle, AMin, AMax: TJvDialAngle); virtual; procedure SetBounds(ALeft, ATop, AWidth, AHeight: Integer); override; procedure SetParams(APosition, AMin, AMax: Integer); virtual; procedure SetTick(Value: Integer; Length: TJvTickLength); virtual; function RadToAngle(const Radian: Double): TJvDialAngle; function AngleToRad(AnAngle: TJvDialAngle): Double; property Bitmap: TBitmap read FBitmap; property Center: TPoint read GetCenter; end; TJvDialButton = class(TJvCustomDialButton) published // properties property Align; property Angle; property BorderSpacing; property BorderStyle; property ButtonEdge; property Color; property Cursor; property DefaultPos; property DragCursor; property DragMode; property Enabled; property Frequency; property LargeChange; property Max; property MaxAngle; property Min; property MinAngle; property ParentColor; property ParentShowHint; property PointerColorOn; property PointerColorOff; property PointerPenWidth; property PointerSize; property PointerShape; property PopupMenu; property Position; property Radius; property RepeatDelay; property RepeatRate; property ShowHint; property SmallChange; property State; property TickStyle; property TabOrder; property TabStop; property Visible; // events property OnChange; property OnClick; property OnComputeTicks; property OnDblClick; property OnDragDrop; property OnDragOver; property OnDrawPointer; property OnEndDrag; property OnEnter; property OnExit; property OnKeyDown; property OnKeyPress; property OnKeyUp; property OnMouseDown; {$IFDEF RTL180_UP} property OnMouseActivate; property OnMouseEnter; property OnMouseLeave; {$ENDIF RTL180_UP} property OnMouseMove; property OnMouseUp; property OnMouseWheel; property OnMouseWheelDown; property OnMouseWheelUp; property OnStartDrag; end; implementation uses lclstrconsts, //Consts, Math, JvResources, // wp: instead of Consts JvThemes; const dAngleToRadian = Pi / 1800; dRadianToAngle = 1800 / Pi; rcMaxEdge = 100; rcMinEdge = 0; rcMinRadius = 15; tlLongLen = 10; tlMiddleLen = 6; tlShortLen = 4; MinBorder = 1; TickBorder = tlLongLen; function GetShiftState: TShiftState; begin Result := []; if GetKeyState(VK_SHIFT) < 0 then Include(Result, ssShift); if GetKeyState(VK_CONTROL) < 0 then Include(Result, ssCtrl); if GetKeyState(VK_MENU) < 0 then Include(Result, ssAlt); end; constructor TJvCustomDialButton.Create(AOwner: TComponent); begin inherited Create(AOwner); ControlStyle := ControlStyle + [csClickEvents, csCaptureMouse]; IncludeThemeStyle(Self, [csParentBackground]); FTicks := TList.Create; // FBorderStyle := bsNone; FButtonEdge := 5; FDefaultPos := 0; FFrequency := 10; FLargeChange := 2; FMax := 100; FMaxAngle := 3300; FMin := 0; FMinAngle := 300; FPointerColor := clBtnText; FPointerColorOff := clGrayText; FPointerPenWidth := 3; FPointerSize := 33; FRadius := rcMinRadius; FSmallChange := 1; FState := True; TabStop := True; FTickStyle := tsAuto; FBitmapInvalid := True; FPointerRect.Left := -1; // Only on start up Width := 120; Height := 120; FRepeatDelay := 400; FRepeatRate := 100; SetTicks(FTickStyle); Position := 0; end; destructor TJvCustomDialButton.Destroy; begin FBitmap.Free; ClearTicks; FTicks.Free; FRepeatTimer.Free; inherited Destroy; end; // Convert position Pos to an angle. function TJvCustomDialButton.PosToAngle(Pos: Integer): TJvDialAngle; begin Result := FMinAngle + ((FMaxAngle - FMinAngle) * (Pos - FMin) div (FMax - FMin)); end; // Convert angle AnAngle to a position. function TJvCustomDialButton.AngleToPos(AnAngle: TJvDialAngle): Integer; begin Result := FMin + ((FMax - FMin) * (AnAngle - FMinAngle) div (FMaxAngle - FMinAngle)); end; // Convert polar coordinates defined by AnAngle, ACenter and ARadius to a TPoint. function TJvCustomDialButton.AngleToPoint(AnAngle: TJvDialAngle; ACenter: TPoint; ARadius: Integer): TPoint; var RadAngle: Double; begin RadAngle := AngleToRad(AnAngle); Result.X := ACenter.X - Round(ARadius * Sin(RadAngle)); Result.Y := ACenter.Y + Round(ARadius * Cos(RadAngle)); end; // Convert a APoint to an angle (relative to ACenter) in radians, where // bottom is 0, left is Pi/2, top is Pi and so on. function PointToRad(const APoint, ACenter: TPoint): Double; var N: Integer; begin N := APoint.X - ACenter.X; if N = 0 then Result := 0.5 * Pi else Result := ArcTan((ACenter.Y - APoint.Y) / N); if N < 0 then Result := Result + Pi; Result := 1.5 * Pi - Result; end; // Get current angle (from position). function TJvCustomDialButton.GetAngle: TJvDialAngle; begin Result := PosToAngle(FPosition); end; // Set current angle. Sets Position. procedure TJvCustomDialButton.SetAngle(Value: TJvDialAngle); begin SetAngleParams(Value, FMinAngle, FMaxAngle); end; // Set border style. Redraw if necessary. (* procedure TJvCustomDialButton.SetBorderStyle(Value: TBorderStyle); begin if Value <> inherited BorderStyle then begin FBorderStyle := Value; if HandleAllocated then begin { wp RecreateWnd; } DrawBorder; end; end; end; *) // Set positional (Cartesian) parameters, value checked and invalidate if // necessary. procedure TJvCustomDialButton.SetParams(APosition, AMin, AMax: Integer); var Invalid: Boolean; InvalidTicks: Boolean; lChanged: Boolean; begin lChanged := False; // Ensure minimum and maximum in right order. if AMax < AMin then raise EInvalidOperation.CreateResFmt(@RsPropertyOutOfRange, [ClassName]); // Limit Position to Min and Max. if APosition < AMin then APosition := AMin; if APosition > AMax then APosition := AMax; Invalid := False; InvalidTicks := False; // Change Min if necessary and flag redrawing if so. if FMin <> AMin then begin FMin := AMin; InvalidTicks := True; end; // Change Max if necessary and flag redrawing if so. if FMax <> AMax then begin FMax := AMax; InvalidTicks := True; end; if InvalidTicks then begin ComputeTicks; Invalid := True; end; // Change Position if necessary and draw pointer accordingly. if APosition <> FPosition then begin FPosition := APosition; BitmapNeeded; Invalid := true; //DrawPointer; lChanged := True; end; // If redrawing flagged, cause a redraw, redoing the bitmap too. if Invalid then begin FBitmapInvalid := True; lChanged := True; Invalidate; end; if lChanged then // Notify the user of changes. Change; end; // Set all angle parameters at once. procedure TJvCustomDialButton.SetAngleParams(AnAngle, AMin, AMax: TJvDialAngle); var Invalid: Boolean; InvalidTicks: Boolean; Pos: Integer; begin // Error if AMax < AMin if AMax < AMin then raise EInvalidOperation.CreateResFmt(@RsPropertyOutOfRange, [ClassName]); // Confine AnAngle to limits. if AnAngle < AMin then AnAngle := AMin; if AnAngle > AMax then AnAngle := AMax; Invalid := False; InvalidTicks := False; // Set MinAngle. if FMinAngle <> AMin then begin FMinAngle := AMin; InvalidTicks := True; end; // Set MaxAngle. if FMaxAngle <> AMax then begin FMaxAngle := AMax; InvalidTicks := True; end; if InvalidTicks then begin ComputeTicks; 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 TJvCustomDialButton.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 TJvCustomDialButton.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 TJvCustomDialButton.SetMin(Value: Integer); begin SetParams(FPosition, Value, FMax); end; procedure TJvCustomDialButton.SetMinAngle(Value: TJvDialAngle); begin SetAngleParams(PosToAngle(FPosition), Value, FMaxAngle); end; procedure TJvCustomDialButton.SetMax(Value: Integer); begin SetParams(FPosition, FMin, Value); end; procedure TJvCustomDialButton.SetMaxAngle(Value: TJvDialAngle); begin SetAngleParams(PosToAngle(FPosition), FMinAngle, Value); end; procedure TJvCustomDialButton.SetPosition(Value: Integer); begin SetParams(Value, FMin, FMax); end; function TJvCustomDialButton.CalcBounds(var AWidth, AHeight: Integer): Boolean; var ASize: Integer; begin Result := False; ASize := rcMinRadius + MinBorder + TickBorder; if BorderStyle = 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 TJvCustomDialButton.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 BorderStyle = 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 TJvCustomDialButton.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 TJvCustomDialButton.SetState(Value: Boolean); begin if Value <> FState then begin FState := Value; DrawPointer; end; end; procedure TJvCustomDialButton.SetTickStyle(Value: TTickStyle); begin if FTickStyle <> Value then begin FTickStyle := Value; ComputeTicks; FBitmapInvalid := True; Invalidate; end; end; procedure TJvCustomDialButton.Change; begin if Assigned(FOnChange) then FOnChange(Self); end; procedure TJvCustomDialButton.SetSmallChange(Value: Integer); begin if Value > FLargeChange then Value := FLargeChange div 2; if Value < 1 then Value := 1; FSmallChange := Value; end; procedure TJvCustomDialButton.SetLargeChange(Value: Integer); begin if Value <= FSmallChange + 1 then Value := FSmallChange + 1; FLargeChange := Value; end; procedure TJvCustomDialButton.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.CreateResFmt(@RsOutOfRange, [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 TJvCustomDialButton.DrawTick(ACanvas: TCanvas; var Tick: TTick); var Pt: TPoint; ValueAngle: Integer; begin ValueAngle := PosToAngle(Tick.Value); ACanvas.Pen.Color := Tick.Color; Pt := AngleToPoint(ValueAngle, Center, FRadius); ACanvas.MoveTo(Pt.X, Pt.Y); Pt := AngleToPoint(ValueAngle, GetCenter, FRadius + Tick.Length); ACanvas.LineTo(Pt.X, Pt.Y); Tick.Changed := False; end; procedure TJvCustomDialButton.Paint; begin if csCreating in ControlState then Exit; Canvas.Brush.Color := Parent.Brush.Color; DrawThemedBackground(Self, Canvas, ClientRect); BitmapNeeded; Canvas.Draw(0, 0, FBitmap); DrawBorder; DrawPointer; end; procedure TJvCustomDialButton.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 - FPointerPenWidth, Center.Y - InnerRadius - FPointerPenWidth, Center.X + InnerRadius + 1 + FPointerPenWidth, Center.Y + InnerRadius + 1 + FPointerPenWidth); 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. if State then begin Canvas.Pen.Color := FPointerColor; Canvas.Brush.Color := FPointerColor; end else begin Canvas.Pen.Color := FPointerColorOff; Canvas.Brush.Color := FPointerColorOff; end; 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.Pen.Width := FPointerPenWidth; 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)); InflateRect(FPointerRect, FPointerPenWidth, FPointerPenWidth); Canvas.Pen.Width := 1; end; psTriangle: begin SmallRadius := FPointerSize * InnerRadius div 100; Outer := AngleToPoint(Angle, Center, InnerRadius); Inner := AngleToPoint(Angle - 150, Center, InnerRadius - SmallRadius); Extra := AngleToPoint(Angle + 150, Center, InnerRadius - 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); Canvas.Ellipse(FPointerRect.Left, FPointerRect.Top, FPointerRect.Right, FPointerRect.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. Region := CreateEllipticRgn(FPointerRect.Left - 1, FPointerRect.Top - 1, FPointerRect.Right + 1, FPointerRect.Bottom + 1); SelectClipRgn(Canvas.Handle, Region); try FOnDrawPointer(Self, FPointerRect); except 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; {$IFDEF JVCLThemesEnabled} if FBitmapInvalid or StyleServices.Enabled then {$ELSE} if FBitmapInvalid then {$ENDIF JVCLThemesEnabled} 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; {$IFDEF JVCLThemesEnabled} if StyleServices.Enabled 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; FaceClr, HighlightClr, ShadowClr: TColor; Size: Integer; lCanvas: TCanvas; I: Integer; lColor: TColor; xL, yT, xR, yB: Integer; begin Size := 2 * FRadius + 1; lCanvas := FBitmap.Canvas; lCanvas.Brush.Color := Parent.Brush.Color; lCanvas.Brush.Style := bsSolid; {$IFDEF JVCLThemesEnabled} if not StyleServices.Enabled then {$ENDIF JVCLThemesEnabled} lCanvas.FillRect(FBitmapRect); xL := FSize div 2 - FRadius; xR := xL + 2*FRadius; yT := FSize div 2 - FRadius; yB := yT + 2*FRadius; lCanvas.Pen.Style := psClear; HighlightClr := ColorToRGB(clBtnHighlight); if Color = clDefault then lColor := clGray else lColor := Color; FaceClr := ColorToRGB(lColor); // darking the color by halving each color part value ShadowClr := (ColorToRGB(lColor) and $00FEFEFE) shr 1; for I := 0 to Size do begin lCanvas.Brush.Color := Blend(Cos(I * HalfPi / Size), HighlightClr, FaceClr); lCanvas.Pie(xL, yT, xR, yB, I+1, 0, I-1, 0); lCanvas.Pie(xL, yT, xR, yB, 0, I-1, 0, I+1); end; for I := 0 to Size do begin lCanvas.Brush.Color := Blend(1.0 - Sin(I * HalfPi / Size), FaceClr, ShadowClr); lCanvas.Pie(xL, yT, xR, yB, Size, I+1, Size, I-1); lCanvas.Pie(xL, yT, xR, yB, I-1, Size, I+1, Size); end; // Draw top of disk. lCanvas.Pen.Style := psSolid; lCanvas.Pen.Color := lColor; lCanvas.Brush.Color := lColor; Edge := FButtonEdge * FRadius div 100 + 1; lCanvas.Ellipse(xL + Edge, yT + Edge, xR - Edge, yB - Edge); // Draw bounding circle. lCanvas.Pen.Color := clBtnText; lCanvas.Brush.Style := bsClear; lCanvas.Ellipse(xL, yT, xR, yB); 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 StyleServices.Enabled 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[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; (* { - strange: does not compile in qt with these methods... procedure TJvCustomDialButton.FocusKilled(NextWnd: THandle); begin inherited FocusKilled(NextWnd); if HandleAllocated then DrawBorder; end; procedure TJvCustomDialButton.FocusSet(PrevWnd: THandle); 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 Result.X := FSize div 2; Result.Y := Result.X; end; procedure TJvCustomDialButton.ClearTicks; var I: Integer; begin if FTicks <> nil then with FTicks do begin for I := 0 to Count - 1 do if Items[I] <> nil then Dispose(PTick(Items[I])); Clear; end; end; { procedure TJvCustomDialButton.Click; begin inherited Click; FState := not FState; Invalidate; end; } (* 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]; { wp: no Ctrl3D if 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 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.SetPointerPenWidth(Value: Integer); begin if (Value <> FPointerPenWidth) and (FPointerShape = psLine) then begin FPointerPenWidth := Value; 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; { wp: no Ctl3D procedure TJvCustomDialButton.CMCtl3DChanged(var Msg: TLMessage); begin inherited; FBitmapInvalid := True; RecreateWnd; end; } { wp: cannot convert... procedure TJvCustomDialButton.WndProc(var Msg: TLMessage); begin if Msg.Msg = CN_KEYDOWN then DoKeyDown(TLMKey(Msg)); inherited WndProc(Msg); end; } { procedure TJvCustomDialButton.WMSysColorChange(var Msg: TMessage); begin FBitmapInvalid := True; Invalidate; 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.ComputeTicks; begin if csLoading in ComponentState then Exit; ClearTicks; case FTickStyle of tsNone: ; tsAuto: SetTicks(FTickStyle); tsManual: if Assigned(FOnComputeTicks) then FOnComputeTicks(Self); end; end; procedure TJvCustomDialButton.Loaded; begin inherited Loaded; ComputeTicks; Change; end; function TJvCustomDialButton.RadToAngle(const Radian: Double): TJvDialAngle; begin Result := Round(dRadianToAngle * Radian); end; end.