📄 qilineargauge.pas
字号:
{*******************************************************}
{ }
{ TiLinearGauge Component }
{ }
{ Copyright (c) 1997,2003 Iocomp Software }
{ }
{*******************************************************}
{$I iInclude.inc}
{$ifdef iVCL}unit iLinearGauge;{$endif}
{$ifdef iCLX}unit QiLinearGauge;{$endif}
interface
uses
{$I iIncludeUses.inc}
{$IFDEF iVCL} iTypes, iGPFunctions, iGaugePointer, iGaugeComponent;{$ENDIF}
{$IFDEF iCLX}QiTypes, QiGPFunctions, QiGaugePointer, QiGaugeComponent;{$ENDIF}
type
TiLinearGauge = class(TiGaugeComponent)
private
FBarRect : TRect;
FOrientation : TiOrientation;
FOrientationTickMarks : TiOrientationSide;
FEndsMargin : Integer;
FShowTicksAxis : Boolean;
FReverseScale : Boolean;
FMouseDownX : Integer;
FMouseDownY : Integer;
FOldCurrentValue : Double;
FOnAutoSize : TNotifyEvent;
FPointerOverlap : Integer;
FAutoCenter : Boolean;
FCenterOffsetX : Integer;
FCenterOffsetY : Integer;
FMinPointer : TiGaugePointer;
FMaxPointer : TiGaugePointer;
procedure SetOrientationTickMarks(const Value: TiOrientationSide);
procedure SetOrientation (const Value: TiOrientation);
procedure SetEndsMargin (const Value: Integer);
procedure SetShowTicksAxis (const Value: Boolean);
procedure SetReverseScale (const Value: Boolean);
procedure SetAutoCenter (const Value: Boolean);
procedure CalcPoints;
procedure CalcAutoCenterOffsets;
function GetTravelRange : Integer;
property TravelRange : Integer read GetTravelRange;
function GetPositionPixels(Value : Double) : Integer;
procedure SetPointerStyle (const Value: TiLinearGaugePointerStyle);
procedure SetPointerSize (const Value: Integer);
procedure SetPointerColor (const Value: TColor);
procedure SetPointerOffSet (const Value: Integer);
function GetPointerStyle : TiLinearGaugePointerStyle;
function GetPointerSize : Integer;
function GetPointerColor : TColor;
function GetPointerOffSet : Integer;
protected
procedure DrawTicks (Canvas: TCanvas);
procedure DrawSections (Canvas: TCanvas);
procedure DrawIndicator(Canvas: TCanvas);
procedure DrawPointer (Canvas: TCanvas; APointer: TiGaugePointer);
procedure DrawMinMax (Canvas: TCanvas);
procedure DrawLimits (Canvas: TCanvas);
procedure InitializePointer(iGaugePointer : TiGaugePointer); override;
procedure iPaintTo(Canvas: TCanvas); override;
procedure iMouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
procedure iMouseUp (Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
procedure iMouseMove( Shift: TShiftState; X, Y: Integer); override;
property OnAutoSize : TNotifyEvent read FOnAutoSize write FOnAutoSize;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
function GetPointersOffSet(Index: Integer): Integer;
function GetPointersStyle (Index: Integer): TiLinearGaugePointerStyle;
procedure SetPointersOffSet(Index: Integer; Value: Integer);
procedure SetPointersStyle(Index: Integer; Value: TiLinearGaugePointerStyle);
published
property EndsMargin : Integer read FEndsMargin write SetEndsMargin default 10;
property Orientation : TiOrientation read FOrientation write SetOrientation default ioVertical;
property OrientationTickMarks : TiOrientationSide read FOrientationTickMarks write SetOrientationTickMarks default iosBottomRight;
property PointerStyle : TiLinearGaugePointerStyle read GetPointerStyle write SetPointerStyle default ilgpsPointer;
property PointerSize : Integer read GetPointerSize write SetPointerSize default 10;
property PointerColor : TColor read GetPointerColor write SetPointerColor default clBlack;
property PointerOffSet : Integer read GetPointerOffSet write SetPointerOffSet default 0;
property ShowTicksAxis : Boolean read FShowTicksAxis write SetShowTicksAxis default True;
property ReverseScale : Boolean read FReverseScale write SetReverseScale default False;
property AutoCenter : Boolean read FAutoCenter write SetAutoCenter default False;
property BackGroundColor;
property BorderStyle;
property BackGroundPicture;
property CachedDrawing;
property Transparent;
property OffsetX;
property OffsetY;
property TickMajorStyle;
property TickMinorStyle;
property ShowTicksMajor;
property ShowTicksMinor;
property ShowTickLabels;
property TickMajorCount;
property TickMajorColor;
property TickMajorLength default 20;
property TickMinorAlignment;
property TickMinorCount;
property TickMinorColor;
property TickMinorLength default 7;
property TickMargin default 0;
property TickLabelMargin;
property TickLabelFont;
property TickLabelPrecision;
property PrecisionStyle;
property OnCustomizeTickLabel;
property SectionColor1;
property SectionColor2;
property SectionColor3;
property SectionColor4;
property SectionColor5;
property SectionCount;
property SectionEnd1;
property SectionEnd2;
property SectionEnd3;
property SectionEnd4;
property ShowMaxPointer;
property ShowMinPointer;
property MinMaxPointerSize;
property MinMaxPointerMargin;
property MaxPointerColor;
property MinPointerColor;
property MinMaxUserCanMove;
property AutoScaleEnabled;
property AutoScaleDesiredTicks;
property AutoScaleMaxTicks;
property AutoScaleStyle;
property Width default 60;
property Height default 200;
end;
implementation
//****************************************************************************************************************************************************
constructor TiLinearGauge.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
Width := 60;
Height := 200;
TickMajorLength := 20;
TickMinorLength := 7;
TickMargin := 0;
FEndsMargin := 10;
FShowTicksAxis := True;
FMinPointer := TiGaugePointer.Create(nil);
FMaxPointer := TiGaugePointer.Create(nil);
CreateBackGroundPicture;
end;
//****************************************************************************************************************************************************
destructor TiLinearGauge.Destroy;
begin
FMinPointer.Free;
FMaxPointer.Free;
inherited;
end;
//****************************************************************************************************************************************************
procedure TiLinearGauge.SetEndsMargin (const Value:Integer);begin SetIntegerProperty(Value,FEndsMargin, irtBackGround);end;
procedure TiLinearGauge.SetShowTicksAxis (const Value:Boolean);begin SetBooleanProperty(Value,FShowTicksAxis,irtBackGround);end;
procedure TiLinearGauge.SetReverseScale (const Value:Boolean);begin SetBooleanProperty(Value,FReverseScale, irtBackGround);end;
procedure TiLinearGauge.SetAutoCenter (const Value:Boolean);begin SetBooleanProperty(Value,FAutoCenter, irtBackGround);end;
//****************************************************************************************************************************************************
procedure TiLinearGauge.SetOrientationTickMarks(const Value: TiOrientationSide);
begin
if FOrientationTickMarks <> Value then
begin
FOrientationTickMarks := Value;
BackGroundChange;
end;
end;
//****************************************************************************************************************************************************
procedure TiLinearGauge.SetOrientation(const Value: TiOrientation);
var
TempWidth : Integer;
begin
if FOrientation <> Value then
begin
FOrientation := Value;
if not Loading then
begin
TempWidth := Width;
Width := Height;
Height := TempWidth;
if Assigned(FOnAutoSize) then FOnAutoSize(Self);
end;
BackGroundChange;
end;
end;
//****************************************************************************************************************************************************
function TiLinearGauge.GetTravelRange : Integer;
var
DrawRect : TRect;
begin
DrawRect := Rect(0, 0 ,Width, Height);
with DrawRect do
case Forientation of
ioHorizontal : Result := Right - Left - (2 * FEndsMargin);
ioVertical : Result := Bottom - Top - (2 * FEndsMargin);
else Result := 0;
end;
end;
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -