You've already forked lazarus-ccr
industrial: Fix LCL scaling for TmKnob. New properties MarkSizeKind, Shadow, ShadowColor and BorderColor.
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@7301 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
@ -51,10 +51,6 @@ uses
|
||||
LclIntf, Types, SysUtils, Classes, Graphics, Math,
|
||||
Controls, Forms, Dialogs, ComCtrls;
|
||||
|
||||
const
|
||||
DEFAULT_KNOB_FACE_COLOR = clSilver;
|
||||
DEFAULT_KNOB_MARK_SIZE = 6;
|
||||
|
||||
type
|
||||
TKnobAngleRange = (
|
||||
arTop270, arTop180, arTop120, arTop90,
|
||||
@ -64,38 +60,51 @@ type
|
||||
);
|
||||
TKnobChangeEvent = procedure(Sender: TObject; AValue: Longint) of object;
|
||||
TKnobMarkStyle = (msLine, msCircle, msTriangle);
|
||||
TKnobMarkSizeKind = (mskPercentage, mskPixels);
|
||||
|
||||
TmKnob = class(TCustomControl)
|
||||
private
|
||||
{ Private declarations }
|
||||
const
|
||||
DEFAULT_KNOB_MARK_SIZE = 20;
|
||||
private
|
||||
FMaxValue: Integer;
|
||||
FMinValue: Integer;
|
||||
FCurValue: Integer;
|
||||
FFaceColor: TColor;
|
||||
FTickColor: TColor;
|
||||
FBorderColor: TColor;
|
||||
FAllowDrag: Boolean;
|
||||
FOnChange: TKnobChangeEvent;
|
||||
FFollowMouse: Boolean;
|
||||
FMarkSize: Integer;
|
||||
FMarkSizeKind: TKnobMarkSizeKind;
|
||||
FMarkStyle: TKnobMarkStyle;
|
||||
FAngleRange: TKnobAngleRange;
|
||||
FRotationEffect: Boolean;
|
||||
FShadow: Boolean;
|
||||
FShadowColor: TColor;
|
||||
FTransparent: Boolean;
|
||||
function GetAngleOrigin: Double;
|
||||
function GetAngleRange: Double;
|
||||
procedure SetAllowDrag(AValue: Boolean);
|
||||
procedure SetAngleRange(AValue: TKnobAngleRange);
|
||||
procedure SetBorderColor(AValue: TColor);
|
||||
procedure SetCurValue(AValue: Integer);
|
||||
procedure SetFaceColor(AColor: TColor);
|
||||
procedure SetMarkSize(AValue: Integer);
|
||||
procedure SetMarkSizeKind(AValue: TKnobMarkSizeKind);
|
||||
procedure SetMarkStyle(AValue: TKnobMarkStyle);
|
||||
procedure SetMaxValue(AValue: Integer);
|
||||
procedure SetMinValue(AValue: Integer);
|
||||
procedure SetShadow(AValue: Boolean);
|
||||
procedure SetShadowColor(AValue: TColor);
|
||||
procedure SetTickColor(AValue: TColor);
|
||||
procedure SetTransparent(AValue: Boolean);
|
||||
procedure UpdatePosition(X, Y: Integer);
|
||||
|
||||
protected { Protected declarations }
|
||||
protected
|
||||
procedure DoAutoAdjustLayout(const AMode: TLayoutAdjustmentPolicy;
|
||||
const AXProportion, AYProportion: Double); override;
|
||||
class function GetControlClassDefaultSize: TSize; override;
|
||||
procedure KnobChange;
|
||||
procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
|
||||
@ -104,35 +113,40 @@ type
|
||||
procedure Paint; override;
|
||||
|
||||
public
|
||||
{ Public declarations }
|
||||
constructor Create(AOwner: TComponent); override;
|
||||
|
||||
published
|
||||
{ Published declarations }
|
||||
property Align;
|
||||
property AllowUserDrag: Boolean read FAllowDrag write SetAllowDrag default True;
|
||||
property AngleRange: TKnobAngleRange read FAngleRange write SetAngleRange default arTop270;
|
||||
property BorderColor: TColor read FBorderColor write SetBorderColor default clBtnHighlight;
|
||||
property BorderSpacing;
|
||||
property Color;
|
||||
property FaceColor: TColor read FFaceColor write SetFaceColor default DEFAULT_KNOB_FACE_COLOR;
|
||||
property FaceColor: TColor read FFaceColor write SetFaceColor default clSilver;
|
||||
property TickColor: TColor read FTickColor write SetTickColor default clBlack;
|
||||
property Position: Integer read FCurValue write SetCurValue;
|
||||
property RotationEffect: Boolean read FRotationEffect write FRotationEffect default false;
|
||||
property Enabled;
|
||||
property MarkSize: Integer read FMarkSize write SetMarkSize default DEFAULT_KNOB_MARK_SIZE;
|
||||
property MarkSizeKind: TKnobMarkSizeKind read FMarkSizeKind write SetMarkSizeKind default mskPercentage;
|
||||
property MarkStyle: TKnobMarkStyle read FMarkStyle write SetMarkStyle default msLine;
|
||||
property Max: Integer read FMaxValue write SetMaxValue default 100;
|
||||
property Min: Integer read FMinValue write SetMinvalue default 0;
|
||||
property OnChange: TKnobChangeEvent read FOnChange write FOnChange;
|
||||
property ParentColor;
|
||||
property ParentShowHint;
|
||||
property Shadow: Boolean read FShadow write SetShadow default true;
|
||||
property ShadowColor: TColor read FShadowColor write SetShadowColor default clBtnShadow;
|
||||
property ShowHint;
|
||||
property Transparent: Boolean read FTransparent write SetTransparent default true;
|
||||
property Visible;
|
||||
end;
|
||||
|
||||
|
||||
implementation
|
||||
|
||||
{ Rotates point P around the Center by the angle given by its sin and cos.
|
||||
The angle is relative to the upward y axis in clockwise direction. }
|
||||
function Rotate(P, Center: TPoint; SinAngle, CosAngle: Double): TPoint;
|
||||
begin
|
||||
P.X := P.X - Center.X;
|
||||
@ -141,6 +155,9 @@ begin
|
||||
Result.Y := round(sinAngle * P.X + cosAngle * P.Y) + Center.Y;
|
||||
end;
|
||||
|
||||
|
||||
{ TmKnob }
|
||||
|
||||
constructor TmKnob.Create(AOwner: TComponent);
|
||||
begin
|
||||
inherited Create(AOwner);
|
||||
@ -154,11 +171,26 @@ begin
|
||||
FMarkStyle := msLine;
|
||||
FMarkSize := DEFAULT_KNOB_MARK_SIZE;
|
||||
FTickColor := clBlack;
|
||||
FFaceColor := DEFAULT_KNOB_FACE_COLOR;
|
||||
FFaceColor := clSilver;
|
||||
FBorderColor := clBtnHighlight;
|
||||
FFollowMouse := false;
|
||||
FAllowDrag := true;
|
||||
FAngleRange := arTop270;
|
||||
FTransparent := true;
|
||||
FShadow := true;
|
||||
FShadowColor := clBtnShadow;
|
||||
end;
|
||||
|
||||
procedure TmKnob.DoAutoAdjustLayout(
|
||||
const AMode: TLayoutAdjustmentPolicy;
|
||||
const AXProportion, AYProportion: Double);
|
||||
begin
|
||||
inherited DoAutoAdjustLayout(AMode, AXProportion, AYProportion);
|
||||
if AMode in [lapAutoAdjustWithoutHorizontalScrolling, lapAutoAdjustForDPI] then
|
||||
begin
|
||||
if FMarkSizeKind = mskPixels then
|
||||
FMarkSize := Round(FMarkSize * AXProportion);
|
||||
end;
|
||||
end;
|
||||
|
||||
function TmKnob.GetAngleOrigin: Double;
|
||||
@ -223,102 +255,11 @@ begin
|
||||
UpdatePosition(X,Y)
|
||||
end;
|
||||
|
||||
(*
|
||||
procedure TmKnob.Paint;
|
||||
var R : TRect;
|
||||
Bm : TBitMap;
|
||||
Co,Si,Angle : Double;
|
||||
X, Y,W, H : Integer;
|
||||
dx,dy,gx,gy : Integer;
|
||||
OuterPoint : TPoint;
|
||||
begin
|
||||
{ Initialize offscreen BitMap }
|
||||
Bm := TBitMap.Create;
|
||||
if ( csdesigning in componentstate) then
|
||||
if Height < Width then
|
||||
Height:=Width
|
||||
else
|
||||
Width:=Height;
|
||||
|
||||
Bm.Width := Width;
|
||||
Bm.Height := Height;
|
||||
Bm.Canvas.Brush.Color := clBTNFACE; //clWindow;
|
||||
R.Left := 0;
|
||||
R.Top := 0;
|
||||
R.Right := Width ;//- 1;
|
||||
R.Bottom := Height;// - 1;
|
||||
W := R.Right - R.Left -4;
|
||||
H := R.Bottom - R.Top -4;
|
||||
{ This weird thing make knob "shake", emulating a rotation effect.
|
||||
Not so pretty, but I like it..............}
|
||||
if fRotationEffect then
|
||||
if (position mod 2) <> 0 then
|
||||
inc(h);
|
||||
|
||||
Bm.Canvas.FillRect(R);
|
||||
|
||||
with Bm.Canvas do
|
||||
begin
|
||||
|
||||
Brush.Color := FaceColor;
|
||||
Pen.Width := 2;
|
||||
Pen.Color := Cl3dlight;
|
||||
ellipse(1, 1, W-1, H-1);
|
||||
Pen.Color := Clbtnshadow;
|
||||
ellipse(3, 3, W+2, H+2);
|
||||
|
||||
Pen.Color := Clbtnface;
|
||||
Pen.Width := 1;
|
||||
RoundRect(2,2,w,h,w,h);
|
||||
Pen.Width := 3;
|
||||
Pen.Color := TickColor;
|
||||
|
||||
if Position >= 0 then
|
||||
begin
|
||||
Brush.Color := FaceColor;
|
||||
X := W div 2;
|
||||
Y := H div 2;
|
||||
dX := W div 6;
|
||||
dY := H div 6;
|
||||
gX := W div 32;
|
||||
gY := H div 32;
|
||||
|
||||
Angle:=(Position - (Min + Max)/2 ) / (Max - Min) * 5 ;
|
||||
|
||||
Si:=Sin(Angle);
|
||||
Co:=Cos(Angle);
|
||||
OuterPoint.X:=Round(X + Si * (X-dx));
|
||||
OuterPoint.Y:=Round(Y - Co * (Y-dy));
|
||||
MoveTo(OuterPoint.X,OuterPoint.y);
|
||||
|
||||
case MarkStyle of
|
||||
msLine : LineTo(Round(X + Si * (X-gx)),Round(Y - Co * (Y-gy)));
|
||||
{ this implementation of circle style is very poor but for my needing is enough}
|
||||
msCircle : begin
|
||||
Brush.Color := TickColor;
|
||||
RoundRect(OuterPoint.X-3, OuterPoint.Y-3,
|
||||
OuterPoint.X+3, OuterPoint.Y+3,
|
||||
OuterPoint.X+3, OuterPoint.Y+3);
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
Canvas.CopyMode := cmSrcCopy;
|
||||
Canvas.Draw(0, 0, Bm);
|
||||
bm.Destroy;
|
||||
end;
|
||||
*)
|
||||
|
||||
procedure TmKnob.Paint;
|
||||
const
|
||||
cPENWIDTH = 1;
|
||||
cMARGIN = 4*cPENWIDTH;
|
||||
var
|
||||
R: TRect;
|
||||
bmp: TBitmap;
|
||||
Angle, sinAngle, cosAngle: Double;
|
||||
//X, Y,
|
||||
W, H: Integer;
|
||||
i: Integer;
|
||||
P: array[0..3] of TPoint;
|
||||
@ -328,8 +269,8 @@ var
|
||||
ctr: TPoint;
|
||||
penwidth: Integer;
|
||||
begin
|
||||
margin := Scale96ToFont(cMARGIN);
|
||||
penwidth := Scale96ToFont(cPENWIDTH);
|
||||
margin := 4;
|
||||
penwidth := 1;
|
||||
|
||||
{ Initialize offscreen BitMap }
|
||||
bmp := TBitmap.Create;
|
||||
@ -373,22 +314,32 @@ begin
|
||||
Pen.Style := psSolid;
|
||||
R := Rect(ctr.X, ctr.Y, ctr.X, ctr.Y);
|
||||
InflateRect(R, radius - penwidth, radius - penwidth);
|
||||
if FShadow then
|
||||
OffsetRect(R, -penwidth, -penwidth);
|
||||
Ellipse(R);
|
||||
|
||||
Pen.Color := clBtnShadow;
|
||||
if FShadow then
|
||||
begin
|
||||
Pen.Color := FShadowColor;
|
||||
OffsetRect(R, 3*penwidth, 3*penwidth);
|
||||
Ellipse(R);
|
||||
end;
|
||||
|
||||
Pen.Color := clBtnFace;
|
||||
Pen.Color := FBorderColor;
|
||||
Pen.Width := 1;
|
||||
if FShadow then
|
||||
OffsetRect(R, -2*penwidth, -2*penwidth);
|
||||
Ellipse(R);
|
||||
|
||||
if Position >= 0 then
|
||||
begin
|
||||
case FMarkSizeKind of
|
||||
mskPercentage:
|
||||
markersize := radius * FMarkSize div 100;
|
||||
if markersize < 5 then markersize := 5;
|
||||
mskPixels:
|
||||
markerSize := FMarkSize;
|
||||
end;
|
||||
if markersize < 2 then markersize := 2;
|
||||
|
||||
Angle := (Position - (Min + Max)/2 ) / (Max - Min) * GetAngleRange + GetAngleOrigin;
|
||||
SinCos(Angle, sinAngle, cosAngle);
|
||||
@ -398,8 +349,8 @@ begin
|
||||
begin
|
||||
Pen.Width := 3;
|
||||
Pen.Color := TickColor;
|
||||
P[0] := Point(ctr.X, markersize);
|
||||
P[1] := Point(P[0].X, P[0].Y + markersize);
|
||||
P[0] := Point(ctr.X, ctr.Y - radius + penwidth);
|
||||
P[1] := Point(ctr.X, ctr.Y - radius + penwidth + markersize);
|
||||
for i:=0 to 1 do
|
||||
P[i] := Rotate(P[i], ctr, sinAngle, cosAngle);
|
||||
MoveTo(P[0].X, P[0].Y);
|
||||
@ -409,7 +360,8 @@ begin
|
||||
begin
|
||||
Brush.Color := TickColor;
|
||||
Pen.Style := psClear;
|
||||
P[0] := Rotate(Point(ctr.X, MARGIN + markersize + H div 32), ctr, sinAngle, cosAngle);
|
||||
P[0] := Point(ctr.X, ctr.Y - radius + markersize + 2*penwidth);
|
||||
P[0] := Rotate(P[0], ctr, sinAngle, cosAngle);
|
||||
R := Rect(P[0].X, P[0].Y, P[0].X, P[0].Y);
|
||||
InflateRect(R, markersize, markersize);
|
||||
Ellipse(R);
|
||||
@ -418,7 +370,8 @@ begin
|
||||
begin
|
||||
Brush.Color := TickColor;
|
||||
Pen.Style := psClear;
|
||||
P[0] := Point(ctr.X, H div 32);
|
||||
// P[0] := Point(ctr.X, H div 32);
|
||||
P[0] := Point(ctr.X, ctr.Y - radius + 2*penwidth);
|
||||
P[1] := Point(P[0].X - markersize, P[0].Y + markersize*2);
|
||||
P[2] := Point(P[0].X + markersize, P[0].Y + markersize*2);
|
||||
P[3] := P[0];
|
||||
@ -455,6 +408,15 @@ begin
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TmKnob.SetBorderColor(AValue: TColor);
|
||||
begin
|
||||
if AValue <> FBorderColor then
|
||||
begin
|
||||
FBorderColor := AValue;
|
||||
Invalidate;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TmKnob.SetCurValue(AValue: Integer);
|
||||
var
|
||||
tmp: Integer;
|
||||
@ -489,6 +451,15 @@ begin
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TmKnob.SetMarkSizeKind(AValue: TKnobMarkSizeKind);
|
||||
begin
|
||||
if AValue <> FMarkSizeKind then
|
||||
begin
|
||||
FMarkSizeKind := AValue;
|
||||
Invalidate;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TmKnob.SetMarkStyle(AValue: TKnobMarkStyle);
|
||||
begin
|
||||
if AValue <> FMarkStyle then
|
||||
@ -516,6 +487,24 @@ begin
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TmKnob.SetShadow(AValue: Boolean);
|
||||
begin
|
||||
if AValue <> FShadow then
|
||||
begin
|
||||
FShadow := AValue;
|
||||
Invalidate;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TmKnob.SetShadowColor(AValue: TColor);
|
||||
begin
|
||||
if AValue <> FShadowColor then
|
||||
begin
|
||||
FShadowColor := AValue;
|
||||
Invalidate;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TmKnob.SetTickColor(AValue: TColor);
|
||||
begin
|
||||
if AValue <> FTickColor then
|
||||
|
||||
Reference in New Issue
Block a user