You've already forked lazarus-ccr
industrial: v0.3. Improoved TmKnow icons
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@6771 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
@ -66,6 +66,12 @@
|
|||||||
</Win32>
|
</Win32>
|
||||||
</Options>
|
</Options>
|
||||||
</Linking>
|
</Linking>
|
||||||
|
<Other>
|
||||||
|
<CustomOptions Value="-dTICKER"/>
|
||||||
|
<OtherDefines Count="1">
|
||||||
|
<Define0 Value="TICKER"/>
|
||||||
|
</OtherDefines>
|
||||||
|
</Other>
|
||||||
</CompilerOptions>
|
</CompilerOptions>
|
||||||
<Debugging>
|
<Debugging>
|
||||||
<Exceptions Count="3">
|
<Exceptions Count="3">
|
||||||
|
@ -10,7 +10,7 @@ object MainForm: TMainForm
|
|||||||
Font.Color = clWindowText
|
Font.Color = clWindowText
|
||||||
OnCreate = FormCreate
|
OnCreate = FormCreate
|
||||||
Position = poDefaultPosOnly
|
Position = poDefaultPosOnly
|
||||||
LCLVersion = '1.9.0.0'
|
LCLVersion = '2.1.0.0'
|
||||||
Scaled = False
|
Scaled = False
|
||||||
object Panel1: TPanel
|
object Panel1: TPanel
|
||||||
Left = 0
|
Left = 0
|
||||||
@ -543,10 +543,10 @@ object MainForm: TMainForm
|
|||||||
TabOrder = 0
|
TabOrder = 0
|
||||||
end
|
end
|
||||||
object AboutLabel: TLabel
|
object AboutLabel: TLabel
|
||||||
Left = 96
|
Left = 199
|
||||||
Height = 40
|
Height = 40
|
||||||
Top = 0
|
Top = 0
|
||||||
Width = 682
|
Width = 579
|
||||||
Alignment = taCenter
|
Alignment = taCenter
|
||||||
Anchors = [akLeft, akRight, akBottom]
|
Anchors = [akLeft, akRight, akBottom]
|
||||||
AutoSize = False
|
AutoSize = False
|
||||||
@ -556,6 +556,15 @@ object MainForm: TMainForm
|
|||||||
OnClick = AboutLabelClick
|
OnClick = AboutLabelClick
|
||||||
OnMouseMove = AboutLabelMouseMove
|
OnMouseMove = AboutLabelMouseMove
|
||||||
end
|
end
|
||||||
|
object StartStopButton: TButton
|
||||||
|
Left = 104
|
||||||
|
Height = 25
|
||||||
|
Top = 8
|
||||||
|
Width = 75
|
||||||
|
Caption = 'Stop'
|
||||||
|
OnClick = StartStopButtonClick
|
||||||
|
TabOrder = 1
|
||||||
|
end
|
||||||
end
|
end
|
||||||
object Panel3: TPanel
|
object Panel3: TPanel
|
||||||
Left = 0
|
Left = 0
|
||||||
|
@ -1,6 +1,6 @@
|
|||||||
unit main;
|
unit main;
|
||||||
|
|
||||||
{$DEFINE TICKER}
|
//{$DEFINE TICKER}
|
||||||
|
|
||||||
{$IFDEF LCL}
|
{$IFDEF LCL}
|
||||||
{$MODE DELPHI}
|
{$MODE DELPHI}
|
||||||
@ -10,7 +10,12 @@ unit main;
|
|||||||
interface
|
interface
|
||||||
|
|
||||||
uses
|
uses
|
||||||
Windows, Messages, ShellApi, SysUtils, Classes, Graphics, Controls,
|
{$IFDEF LCL}
|
||||||
|
LCLIntf,
|
||||||
|
{$ELSE}
|
||||||
|
Windows, Messages, ShellApi,
|
||||||
|
{$ENDIF}
|
||||||
|
SysUtils, Classes, Graphics, Controls,
|
||||||
Forms, Dialogs, ExtCtrls, StdCtrls, Spin, A3nalogGauge;
|
Forms, Dialogs, ExtCtrls, StdCtrls, Spin, A3nalogGauge;
|
||||||
|
|
||||||
type
|
type
|
||||||
@ -18,6 +23,7 @@ type
|
|||||||
{ TMainForm }
|
{ TMainForm }
|
||||||
|
|
||||||
TMainForm = class(TForm)
|
TMainForm = class(TForm)
|
||||||
|
StartStopButton: TButton;
|
||||||
Panel1: TPanel;
|
Panel1: TPanel;
|
||||||
Panel2: TPanel;
|
Panel2: TPanel;
|
||||||
Panel3: TPanel;
|
Panel3: TPanel;
|
||||||
@ -81,6 +87,7 @@ type
|
|||||||
AAModeBox: TComboBox;
|
AAModeBox: TComboBox;
|
||||||
AAModeLabel: TLabel;
|
AAModeLabel: TLabel;
|
||||||
procedure FormCreate(Sender: TObject);
|
procedure FormCreate(Sender: TObject);
|
||||||
|
procedure StartStopButtonClick(Sender: TObject);
|
||||||
procedure StyleBoxChange(Sender: TObject);
|
procedure StyleBoxChange(Sender: TObject);
|
||||||
procedure TimerTimer(Sender: TObject);
|
procedure TimerTimer(Sender: TObject);
|
||||||
{$IFDEF TICKER}
|
{$IFDEF TICKER}
|
||||||
@ -133,6 +140,7 @@ type
|
|||||||
AnalogGauge2: TA3nalogGauge;
|
AnalogGauge2: TA3nalogGauge;
|
||||||
AnalogGauge3: TA3nalogGauge;
|
AnalogGauge3: TA3nalogGauge;
|
||||||
FDelta: Double;
|
FDelta: Double;
|
||||||
|
FStartTime: TDateTime;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
var
|
var
|
||||||
@ -147,6 +155,9 @@ implementation
|
|||||||
{$DEFINE TICKER}
|
{$DEFINE TICKER}
|
||||||
{$ENDIF}
|
{$ENDIF}
|
||||||
|
|
||||||
|
const
|
||||||
|
BASE_CAPTION = 'AntiAliased Analog Gauge demo';
|
||||||
|
|
||||||
procedure TMainForm.FormCreate(Sender: TObject);
|
procedure TMainForm.FormCreate(Sender: TObject);
|
||||||
begin
|
begin
|
||||||
AnalogGauge1 := TA3nalogGauge.Create(self);
|
AnalogGauge1 := TA3nalogGauge.Create(self);
|
||||||
@ -217,6 +228,21 @@ begin
|
|||||||
{$IFDEF TICKER}
|
{$IFDEF TICKER}
|
||||||
AnalogGauge1.OnFrames := FramesChanged;
|
AnalogGauge1.OnFrames := FramesChanged;
|
||||||
{$ENDIF}
|
{$ENDIF}
|
||||||
|
|
||||||
|
FStartTime := Now;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TMainForm.StartStopButtonClick(Sender: TObject);
|
||||||
|
begin
|
||||||
|
Timer.Enabled := not Timer.Enabled;
|
||||||
|
if Timer.Enabled then begin
|
||||||
|
FStartTime := now;
|
||||||
|
StartStopButton.Caption := 'Stop';
|
||||||
|
AnalogGauge1.Position := 0;
|
||||||
|
end else begin
|
||||||
|
Caption := BASE_CAPTION + ' (' + FormatDateTime('n:ss.zzz', Now - FStartTime) + ')';
|
||||||
|
StartStopButton.Caption := 'Start';
|
||||||
|
end;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
procedure TMainForm.StyleBoxChange(Sender: TObject);
|
procedure TMainForm.StyleBoxChange(Sender: TObject);
|
||||||
@ -658,14 +684,22 @@ begin
|
|||||||
Control := Sender as TLabel;
|
Control := Sender as TLabel;
|
||||||
if (X > 0) and (X < Control.Width) and
|
if (X > 0) and (X < Control.Width) and
|
||||||
(Y > 0) and (Y < Control.Height) then begin
|
(Y > 0) and (Y < Control.Height) then begin
|
||||||
|
{$IFDEF LCL}
|
||||||
|
Screen.Cursor := crHandPoint
|
||||||
|
{$ELSE}
|
||||||
Control.Font.Style := Control.Font.Style + [fsUnderLine];
|
Control.Font.Style := Control.Font.Style + [fsUnderLine];
|
||||||
Control.Cursor := crHandPoint;
|
Control.Cursor := crHandPoint;
|
||||||
Windows.SetCursor(Screen.Cursors[Control.Cursor]);
|
Windows.SetCursor(Screen.Cursors[Control.Cursor]);
|
||||||
SetCaptureControl(Control);
|
SetCaptureControl(Control);
|
||||||
|
{$ENDIF}
|
||||||
end else begin
|
end else begin
|
||||||
|
{$IFDEF LCL}
|
||||||
|
Screen.Cursor := crDefault;
|
||||||
|
{$ELSE}
|
||||||
Control.Font.Style := Control.Font.Style - [fsUnderLine];
|
Control.Font.Style := Control.Font.Style - [fsUnderLine];
|
||||||
Control.Cursor := crDefault;
|
Control.Cursor := crDefault;
|
||||||
SetCaptureControl(nil);
|
SetCaptureControl(nil);
|
||||||
|
{$ENDIF}
|
||||||
end;
|
end;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
@ -677,7 +711,11 @@ begin
|
|||||||
Control := Sender as TLabel;
|
Control := Sender as TLabel;
|
||||||
Control.Font.Style := Control.Font.Style - [fsUnderLine];
|
Control.Font.Style := Control.Font.Style - [fsUnderLine];
|
||||||
Control.Cursor := crDefault; SetCaptureControl(nil);
|
Control.Cursor := crDefault; SetCaptureControl(nil);
|
||||||
|
{$IFDEF LCL}
|
||||||
|
OpenURL('http://irnis.net/');
|
||||||
|
{$ELSE}
|
||||||
ShellExecute(0, nil, PChar('http://www.irnis.net/'), nil, nil, SW_SHOWDEFAULT);
|
ShellExecute(0, nil, PChar('http://www.irnis.net/'), nil, nil, SW_SHOWDEFAULT);
|
||||||
|
{$ENDIF}
|
||||||
end;
|
end;
|
||||||
|
|
||||||
end.
|
end.
|
||||||
|
@ -13,6 +13,7 @@ object MainForm: TMainForm
|
|||||||
Height = 96
|
Height = 96
|
||||||
Top = 200
|
Top = 200
|
||||||
Width = 88
|
Width = 88
|
||||||
|
TickColor = clCream
|
||||||
Position = 0
|
Position = 0
|
||||||
MarkStyle = msCircle
|
MarkStyle = msCircle
|
||||||
OnChange = KnobChange
|
OnChange = KnobChange
|
||||||
|
Binary file not shown.
Before Width: | Height: | Size: 943 B After Width: | Height: | Size: 1.1 KiB |
Binary file not shown.
Before Width: | Height: | Size: 1.4 KiB After Width: | Height: | Size: 1.8 KiB |
Binary file not shown.
Before Width: | Height: | Size: 1.9 KiB After Width: | Height: | Size: 2.6 KiB |
@ -2,22 +2,17 @@ unit A3nalogGauge;
|
|||||||
|
|
||||||
{.$DEFINE TICKER}
|
{.$DEFINE TICKER}
|
||||||
|
|
||||||
{$IFDEF FPC}
|
{$MODE DELPHI}
|
||||||
{$MODE DELPHI}
|
|
||||||
{$IFNDEF WINDOWS}
|
{$IFNDEF WINDOWS}
|
||||||
{$UNDEF TICKER}
|
{$UNDEF TICKER}
|
||||||
{$ENDIF}
|
|
||||||
{$ENDIF}
|
{$ENDIF}
|
||||||
|
|
||||||
interface
|
interface
|
||||||
|
|
||||||
uses
|
uses
|
||||||
{$IFDEF LCL}
|
|
||||||
LCLIntf, LCLType, LCLProc, Types,
|
LCLIntf, LCLType, LCLProc, Types,
|
||||||
{$IFDEF TICKER} Windows,{$ENDIF} // for QueryPerformanceCounter
|
{$IFDEF TICKER} Windows,{$ENDIF} // for QueryPerformanceCounter
|
||||||
{$ELSE}
|
|
||||||
Windows, Messages,
|
|
||||||
{$ENDIF}
|
|
||||||
SysUtils, Classes, Graphics, Controls;
|
SysUtils, Classes, Graphics, Controls;
|
||||||
|
|
||||||
type
|
type
|
||||||
@ -81,9 +76,7 @@ type
|
|||||||
FBackBitmap: TBitmap;
|
FBackBitmap: TBitmap;
|
||||||
FFaceBitmap: TBitmap;
|
FFaceBitmap: TBitmap;
|
||||||
FAABitmap: TBitmap;
|
FAABitmap: TBitmap;
|
||||||
{$IFDEF LCL}
|
|
||||||
FBitmapsValid: Boolean;
|
FBitmapsValid: Boolean;
|
||||||
{$ENDIF}
|
|
||||||
{$IFDEF TICKER}
|
{$IFDEF TICKER}
|
||||||
// performance tracking
|
// performance tracking
|
||||||
FTicker: Int64;
|
FTicker: Int64;
|
||||||
@ -93,33 +86,33 @@ type
|
|||||||
{$ENDIF}
|
{$ENDIF}
|
||||||
// set properties
|
// set properties
|
||||||
procedure SetFrameColor(C: TColor);
|
procedure SetFrameColor(C: TColor);
|
||||||
procedure SetFMinColor(C: TColor);
|
procedure SetMinColor(C: TColor);
|
||||||
procedure SetFMidColor(C: TColor);
|
procedure SetMidColor(C: TColor);
|
||||||
procedure SetFMaxColor(C: TColor);
|
procedure SetMaxColor(C: TColor);
|
||||||
procedure SetFFaceColor(C: TColor);
|
procedure SetFaceColor(C: TColor);
|
||||||
procedure SetFTicksColor(C: TColor);
|
procedure SetTicksColor(C: TColor);
|
||||||
procedure SetFValueColor(C: TColor);
|
procedure SetValueColor(C: TColor);
|
||||||
procedure SetFCaptionColor(C: TColor);
|
procedure SetCaptionColor(C: TColor);
|
||||||
procedure SetFArrowColor(C: TColor);
|
procedure SetArrowColor(C: TColor);
|
||||||
procedure SetFMarginColor(C: TColor);
|
procedure SetMarginColor(C: TColor);
|
||||||
procedure SetFCenterColor(C: TColor);
|
procedure SetCenterColor(C: TColor);
|
||||||
procedure SetFCircleColor(C: TColor);
|
procedure SetCircleColor(C: TColor);
|
||||||
procedure SetFCenterRadius(I: Integer);
|
procedure SetCenterRadius(I: Integer);
|
||||||
procedure SetFCircleRadius(I: Integer);
|
procedure SetCircleRadius(I: Integer);
|
||||||
procedure SetFScaleAngle(I: Integer);
|
procedure SetScaleAngle(I: Integer);
|
||||||
procedure SetFMargin(I: Integer);
|
procedure SetMargin(I: Integer);
|
||||||
procedure SetFStyle(S: TStyle);
|
procedure SetStyle(S: TStyle);
|
||||||
procedure SetFArrowWidth(I: Integer);
|
procedure SetArrowWidth(I: Integer);
|
||||||
procedure SetFNumMainTicks(I: Integer);
|
procedure SetNumMainTicks(I: Integer);
|
||||||
procedure SetFLengthMainTicks(I: Integer);
|
procedure SetLengthMainTicks(I: Integer);
|
||||||
procedure SetFLengthSubTicks(I: Integer);
|
procedure SetLengthSubTicks(I: Integer);
|
||||||
procedure SetFFaceOptions(O: TFaceOptions);
|
procedure SetFaceOptions(O: TFaceOptions);
|
||||||
procedure SetFPosition(V: Single);
|
procedure SetPosition(V: Single);
|
||||||
procedure SetFScaleValue(I: Integer);
|
procedure SetScaleValue(I: Integer);
|
||||||
procedure SetFMaximum(I: Integer);
|
procedure SetMaximum(I: Integer);
|
||||||
procedure SetFMinimum(I: Integer);
|
procedure SetMinimum(I: Integer);
|
||||||
procedure SetFCaption(const S: string);
|
procedure SetCaption(const S: string);
|
||||||
procedure SetFAntiAliased(V: TAntialiased);
|
procedure SetAntiAliased(V: TAntialiased);
|
||||||
procedure SetCaptionFont(AValue: TFont);
|
procedure SetCaptionFont(AValue: TFont);
|
||||||
function GetAAMultiplier: Integer;
|
function GetAAMultiplier: Integer;
|
||||||
|
|
||||||
@ -133,13 +126,10 @@ type
|
|||||||
procedure RedrawScale;
|
procedure RedrawScale;
|
||||||
procedure Paint; override;
|
procedure Paint; override;
|
||||||
procedure Resize; override;
|
procedure Resize; override;
|
||||||
{$IFDEF LCL}
|
|
||||||
procedure FontChanged(Sender: TObject); override;
|
procedure FontChanged(Sender: TObject); override;
|
||||||
class function GetControlClassDefaultSize: TSize; override;
|
class function GetControlClassDefaultSize: TSize; override;
|
||||||
{$ELSE}
|
//procedure CMFontChanged(var Msg: TMessage); message CM_FontChanged;
|
||||||
procedure CMFontChanged(var Msg: TMessage); message CM_FontChanged;
|
//procedure WMEraseBkGnd(var Msg: TMessage); message WM_ERASEBKGND;
|
||||||
procedure WMEraseBkGnd(var Msg: TMessage); message WM_ERASEBKGND;
|
|
||||||
{$ENDIF}
|
|
||||||
|
|
||||||
public
|
public
|
||||||
constructor Create(AOwner: TComponent); override;
|
constructor Create(AOwner: TComponent); override;
|
||||||
@ -147,61 +137,63 @@ type
|
|||||||
|
|
||||||
published
|
published
|
||||||
property Angle: Integer
|
property Angle: Integer
|
||||||
read FScaleAngle write SetFScaleAngle default 120;
|
read FScaleAngle write SetScaleAngle default 120;
|
||||||
property AntiAliased: TAntialiased
|
property AntiAliased: TAntialiased
|
||||||
read FAntiAliased write SetFAntiAliased default aaNone;
|
read FAntiAliased write SetAntiAliased default aaNone;
|
||||||
property ArrowColor: TColor
|
property ArrowColor: TColor
|
||||||
read FArrowColor write SetFArrowColor default clBlack;
|
read FArrowColor write SetArrowColor default clBlack;
|
||||||
property ArrowWidth: Integer
|
property ArrowWidth: Integer
|
||||||
read FArrowWidth write SetFArrowWidth default 1;
|
read FArrowWidth write SetArrowWidth default 1;
|
||||||
property Caption: string read FCaption write SetFCaption;
|
property Caption: string
|
||||||
|
read FCaption write SetCaption;
|
||||||
property CaptionColor: TColor
|
property CaptionColor: TColor
|
||||||
read FCaptionColor write SetFCaptionColor default clBlack;
|
read FCaptionColor write SetCaptionColor default clBlack;
|
||||||
property CaptionFont: TFont
|
property CaptionFont: TFont
|
||||||
read FCaptionFont write SetCaptionFont;
|
read FCaptionFont write SetCaptionFont;
|
||||||
property CenterColor: TColor
|
property CenterColor: TColor
|
||||||
read FCenterColor write SetFCenterColor default clDkGray;
|
read FCenterColor write SetCenterColor default clDkGray;
|
||||||
property CenterRadius: Integer
|
property CenterRadius: Integer
|
||||||
read FCenterRadius write SetFCenterRadius default 8;
|
read FCenterRadius write SetCenterRadius default 8;
|
||||||
property CircleColor: TColor
|
property CircleColor: TColor
|
||||||
read FCircleColor write SetFCircleColor default clBlue;
|
read FCircleColor write SetCircleColor default clBlue;
|
||||||
property CircleRadius: Integer
|
property CircleRadius: Integer
|
||||||
read FCircleRadius write SetFCircleRadius default 3;
|
read FCircleRadius write SetCircleRadius default 3;
|
||||||
property FaceColor: TColor
|
property FaceColor: TColor
|
||||||
read FFaceColor write SetFFaceColor default clBtnFace;
|
read FFaceColor write SetFaceColor default clBtnFace;
|
||||||
property FaceOptions: TFaceOptions
|
property FaceOptions: TFaceOptions
|
||||||
read FFaceOptions write SetFFaceOptions default DEFAULT_FACE_OPTIONS;
|
read FFaceOptions write SetFaceOptions default DEFAULT_FACE_OPTIONS;
|
||||||
property FrameColor: TColor
|
property FrameColor: TColor
|
||||||
read FFrameColor write SetFramecolor default clBtnShadow;
|
read FFrameColor write SetFramecolor default clBtnShadow;
|
||||||
property IndMaximum: Integer
|
property IndMaximum: Integer
|
||||||
read FMaximum write SetFMaximum default 80;
|
read FMaximum write SetMaximum default 80;
|
||||||
property IndMinimum: Integer
|
property IndMinimum: Integer
|
||||||
read FMinimum write SetFMinimum default 20;
|
read FMinimum write SetMinimum default 20;
|
||||||
property LengthMainTicks: Integer
|
property LengthMainTicks: Integer
|
||||||
read FLengthMainTicks write SetFLengthMainTicks default 15;
|
read FLengthMainTicks write SetLengthMainTicks default 15;
|
||||||
property LengthSubTicks: Integer
|
property LengthSubTicks: Integer
|
||||||
read FLengthSubTicks write SetFLengthSubTicks default 8;
|
read FLengthSubTicks write SetLengthSubTicks default 8;
|
||||||
property Margin: Integer
|
property Margin: Integer
|
||||||
read FMargin write SetFMargin default 10;
|
read FMargin write SetMargin default 10;
|
||||||
property MarginColor: TColor
|
property MarginColor: TColor
|
||||||
read FMarginColor write SetFMarginColor default clSilver;
|
read FMarginColor write SetMarginColor default clSilver;
|
||||||
property MaxColor: TColor
|
property MaxColor: TColor
|
||||||
read FMaxColor write SetFMaxColor default clRed;
|
read FMaxColor write SetMaxColor default clRed;
|
||||||
property MidColor: TColor
|
property MidColor: TColor
|
||||||
read FMidColor write SetFMidColor default clYellow;
|
read FMidColor write SetMidColor default clYellow;
|
||||||
property MinColor: TColor
|
property MinColor: TColor
|
||||||
read FMinColor write SetFMinColor default clGreen;
|
read FMinColor write SetMinColor default clGreen;
|
||||||
property NumberMainTicks: Integer
|
property NumberMainTicks: Integer
|
||||||
read FNumMainTicks write SetFNumMainTicks default 5;
|
read FNumMainTicks write SetNumMainTicks default 5;
|
||||||
property Position: Single read FPosition write SetFPosition;
|
property Position: Single
|
||||||
|
read FPosition write SetPosition;
|
||||||
property Scale: Integer
|
property Scale: Integer
|
||||||
read FScaleValue write SetFScaleValue default 100;
|
read FScaleValue write SetScaleValue default 100;
|
||||||
property Style: TStyle
|
property Style: TStyle
|
||||||
read FStyle write SetFStyle default agsCenterStyle;
|
read FStyle write SetStyle default agsCenterStyle;
|
||||||
property TicksColor: TColor
|
property TicksColor: TColor
|
||||||
read FTicksColor write SetFTicksColor default clBlack;
|
read FTicksColor write SetTicksColor default clBlack;
|
||||||
property ValueColor: TColor
|
property ValueColor: TColor
|
||||||
read FValueColor write SetFValueColor default clBlack;
|
read FValueColor write SetValueColor default clBlack;
|
||||||
property OnOverMax: TNotifyEvent read FOverMax write FOverMax;
|
property OnOverMax: TNotifyEvent read FOverMax write FOverMax;
|
||||||
property OnOverMin: TNotifyEvent read FOverMin write FOverMin;
|
property OnOverMin: TNotifyEvent read FOverMin write FOverMin;
|
||||||
{$IFDEF TICKER}
|
{$IFDEF TICKER}
|
||||||
@ -211,12 +203,8 @@ type
|
|||||||
|
|
||||||
property Align;
|
property Align;
|
||||||
property Anchors;
|
property Anchors;
|
||||||
{$IFDEF LCL}
|
|
||||||
property BorderSpacing;
|
property BorderSpacing;
|
||||||
{$ENDIF}
|
|
||||||
property Font;
|
property Font;
|
||||||
property Height default 180;
|
|
||||||
property Width default 225;
|
|
||||||
end;
|
end;
|
||||||
|
|
||||||
procedure Register;
|
procedure Register;
|
||||||
@ -224,18 +212,9 @@ procedure Register;
|
|||||||
implementation
|
implementation
|
||||||
|
|
||||||
uses
|
uses
|
||||||
{$IFDEF LCL}
|
|
||||||
IntfGraphics, fpimage,
|
IntfGraphics, fpimage,
|
||||||
{$ENDIF}
|
|
||||||
Math;
|
Math;
|
||||||
|
|
||||||
{$IFNDEF LCL}
|
|
||||||
function GetTickCount64: Int64;
|
|
||||||
begin
|
|
||||||
Result := GetTickCount;
|
|
||||||
end;
|
|
||||||
{$ENDIF}
|
|
||||||
|
|
||||||
|
|
||||||
{ TA3nalogGauge }
|
{ TA3nalogGauge }
|
||||||
|
|
||||||
@ -248,20 +227,13 @@ begin
|
|||||||
FFaceBitmap := TBitmap.Create;
|
FFaceBitmap := TBitmap.Create;
|
||||||
FAABitmap := nil;
|
FAABitmap := nil;
|
||||||
//*****************************defaults:****************************************
|
//*****************************defaults:****************************************
|
||||||
(*
|
|
||||||
{$IFDEF LCL}
|
|
||||||
with GetControlClassDefaultSize do begin
|
with GetControlClassDefaultSize do begin
|
||||||
SetInitialBounds(0, 0, CX, CY);
|
SetInitialBounds(0, 0, CX, CY);
|
||||||
w := CX;
|
w := CX;
|
||||||
h := CY;
|
h := CY;
|
||||||
end;
|
end;
|
||||||
{$ELSE}
|
|
||||||
*)
|
|
||||||
w := 225;
|
|
||||||
h := 180;
|
|
||||||
Width := w;
|
Width := w;
|
||||||
Height := h;
|
Height := h;
|
||||||
// {$ENDIF}
|
|
||||||
FBackBitmap.Width := w;
|
FBackBitmap.Width := w;
|
||||||
FBackBitmap.Height := h;
|
FBackBitmap.Height := h;
|
||||||
FBackBitmap.Canvas.Brush.Style := bsClear;
|
FBackBitmap.Canvas.Brush.Style := bsClear;
|
||||||
@ -314,29 +286,13 @@ begin
|
|||||||
FCaptionFont.Free;
|
FCaptionFont.Free;
|
||||||
inherited;
|
inherited;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
{ ------------------------------------------------------------------------- }
|
{ ------------------------------------------------------------------------- }
|
||||||
|
|
||||||
procedure SetPenStyles(Pen: TPen; Width: Integer; Color: TColor);
|
procedure SetPenStyles(Pen: TPen; Width: Integer; Color: TColor);
|
||||||
{$IFNDEF LCL}
|
|
||||||
var
|
|
||||||
HP: HPen;
|
|
||||||
LB: TLOGBRUSH;
|
|
||||||
{$IFEND}
|
|
||||||
begin
|
begin
|
||||||
{$IFDEF LCL}
|
|
||||||
Pen.Width := Width;
|
Pen.Width := Width;
|
||||||
Pen.Color := Color;
|
Pen.Color := Color;
|
||||||
{$ELSE}
|
|
||||||
LB.lbStyle := BS_SOLID;
|
|
||||||
LB.lbColor := Color;
|
|
||||||
LB.lbHatch := 0;
|
|
||||||
HP := ExtCreatePen(PS_GEOMETRIC or PS_SOLID or PS_ENDCAP_FLAT or
|
|
||||||
PS_JOIN_ROUND, Width, LB, 0, nil);
|
|
||||||
if HP = 0 then begin
|
|
||||||
Pen.Width := Width;
|
|
||||||
Pen.Color := Color
|
|
||||||
end else
|
|
||||||
Pen.Handle := HP;
|
|
||||||
{$IFEND}
|
|
||||||
end;
|
end;
|
||||||
|
|
||||||
procedure TA3nalogGauge.CaptionFontChanged(Sender: TObject);
|
procedure TA3nalogGauge.CaptionFontChanged(Sender: TObject);
|
||||||
@ -650,9 +606,8 @@ begin
|
|||||||
if Assigned(FOnFrames) then FOnFrames(Self)
|
if Assigned(FOnFrames) then FOnFrames(Self)
|
||||||
end;
|
end;
|
||||||
FTicker := -1;
|
FTicker := -1;
|
||||||
|
|
||||||
Invalidate;
|
|
||||||
{$ENDIF}
|
{$ENDIF}
|
||||||
|
Invalidate;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
procedure TA3nalogGauge.RedrawScale;
|
procedure TA3nalogGauge.RedrawScale;
|
||||||
@ -665,12 +620,9 @@ begin
|
|||||||
{$ENDIF}
|
{$ENDIF}
|
||||||
DrawScale(FBackBitmap, GetAAMultiplier);
|
DrawScale(FBackBitmap, GetAAMultiplier);
|
||||||
RedrawArrow;
|
RedrawArrow;
|
||||||
{$IFDEF LCL}
|
|
||||||
FBitmapsValid := true;
|
FBitmapsValid := true;
|
||||||
{$ENDIF}
|
|
||||||
end;
|
end;
|
||||||
|
|
||||||
{$IFDEF LCL}
|
|
||||||
procedure TA3nalogGauge.FastAntiAliasPicture;
|
procedure TA3nalogGauge.FastAntiAliasPicture;
|
||||||
var
|
var
|
||||||
intfImgAA: TLazIntfImage;
|
intfImgAA: TLazIntfImage;
|
||||||
@ -804,95 +756,17 @@ begin
|
|||||||
end;
|
end;
|
||||||
end;
|
end;
|
||||||
}
|
}
|
||||||
{$ELSE}
|
|
||||||
const
|
|
||||||
MaxPixelCount = MaxInt div SizeOf(TRGBTriple);
|
|
||||||
|
|
||||||
type
|
|
||||||
PRGBArray = ^TRGBArray;
|
|
||||||
TRGBArray = array[0..MaxPixelCount-1] of TRGBTriple;
|
|
||||||
|
|
||||||
procedure TA3nalogGauge.FastAntiAliasPicture;
|
|
||||||
var
|
|
||||||
x, y, cx, cy, cxi: Integer;
|
|
||||||
totr, totg, totb: Integer;
|
|
||||||
Row1, Row2, Row3, Row4, DestRow: PRGBArray;
|
|
||||||
i, k: Integer;
|
|
||||||
begin
|
|
||||||
// For each row
|
|
||||||
K := GetAAMultiplier;
|
|
||||||
Row2 := nil;
|
|
||||||
Row3 := nil;
|
|
||||||
Row4 := nil;
|
|
||||||
for Y := 0 to FAABitmap.Height - 1 do begin
|
|
||||||
// We compute samples of K x K pixels
|
|
||||||
cy := y*K;
|
|
||||||
// Get pointers to actual, previous and next rows in supersampled bitmap
|
|
||||||
Row1 := FFaceBitmap.ScanLine[cy];
|
|
||||||
if K > 1 then Row2 := FFaceBitmap.ScanLine[cy+1];
|
|
||||||
if K > 2 then Row3 := FFaceBitmap.ScanLine[cy+2];
|
|
||||||
if K > 3 then Row4 := FFaceBitmap.ScanLine[cy+3];
|
|
||||||
// Get a pointer to destination row in output bitmap
|
|
||||||
DestRow := FAABitmap.ScanLine[y];
|
|
||||||
// For each column...
|
|
||||||
for x := 0 to FAABitmap.Width - 1 do begin
|
|
||||||
// We compute samples of 3 x 3 pixels
|
|
||||||
cx := x*K;
|
|
||||||
// Initialize result color
|
|
||||||
totr := 0; totg := 0; totb := 0;
|
|
||||||
if K > 3 then begin
|
|
||||||
for i := 0 to 3 do begin
|
|
||||||
cxi := cx + i;
|
|
||||||
totr := totr + Row1[cxi].rgbtRed + Row2[cxi].rgbtRed + Row3[cxi].rgbtRed + Row4[cxi].rgbtRed;
|
|
||||||
totg := totg + Row1[cxi].rgbtGreen + Row2[cxi].rgbtGreen + Row3[cxi].rgbtGreen + Row4[cxi].rgbtGreen;
|
|
||||||
totb := totb + Row1[cxi].rgbtBlue + Row2[cxi].rgbtBlue + Row3[cxi].rgbtBlue + Row4[cxi].rgbtBlue;
|
|
||||||
end;
|
|
||||||
DestRow[x].rgbtRed := totr div 16;
|
|
||||||
DestRow[x].rgbtGreen := totg div 16;
|
|
||||||
DestRow[x].rgbtBlue := totb div 16;
|
|
||||||
end else if K > 2 then begin
|
|
||||||
for i := 0 to 2 do begin
|
|
||||||
cxi := cx + i;
|
|
||||||
totr := totr + Row1[cxi].rgbtRed + Row2[cxi].rgbtRed + Row3[cxi].rgbtRed;
|
|
||||||
totg := totg + Row1[cxi].rgbtGreen + Row2[cxi].rgbtGreen + Row3[cxi].rgbtGreen;
|
|
||||||
totb := totb + Row1[cxi].rgbtBlue + Row2[cxi].rgbtBlue + Row3[cxi].rgbtBlue;
|
|
||||||
end;
|
|
||||||
DestRow[x].rgbtRed := totr div 9;
|
|
||||||
DestRow[x].rgbtGreen := totg div 9;
|
|
||||||
DestRow[x].rgbtBlue := totb div 9;
|
|
||||||
end else if K > 1 then begin
|
|
||||||
for i := 0 to 1 do begin
|
|
||||||
cxi := cx + i;
|
|
||||||
totr := totr + Row1[cxi].rgbtRed + Row2[cxi].rgbtRed;
|
|
||||||
totg := totg + Row1[cxi].rgbtGreen + Row2[cxi].rgbtGreen;
|
|
||||||
totb := totb + Row1[cxi].rgbtBlue + Row2[cxi].rgbtBlue;
|
|
||||||
end;
|
|
||||||
DestRow[x].rgbtRed := totr div 4;
|
|
||||||
DestRow[x].rgbtGreen := totg div 4;
|
|
||||||
DestRow[x].rgbtBlue := totb div 4;
|
|
||||||
end else begin
|
|
||||||
DestRow[x].rgbtRed := Row1[cx].rgbtRed;
|
|
||||||
DestRow[x].rgbtGreen := Row1[cx].rgbtGreen;
|
|
||||||
DestRow[x].rgbtBlue := Row1[cx].rgbtBlue;
|
|
||||||
end;
|
|
||||||
end;
|
|
||||||
end;
|
|
||||||
end;
|
|
||||||
{$ENDIF}
|
|
||||||
|
|
||||||
procedure TA3nalogGauge.Loaded;
|
procedure TA3nalogGauge.Loaded;
|
||||||
begin
|
begin
|
||||||
inherited;
|
inherited;
|
||||||
RedrawScale;
|
RedrawScale;
|
||||||
//Invalidate;
|
|
||||||
end;
|
end;
|
||||||
|
|
||||||
procedure TA3nalogGauge.Paint;
|
procedure TA3nalogGauge.Paint;
|
||||||
begin
|
begin
|
||||||
{$IFDEF LCL}
|
|
||||||
if not FBitmapsValid then
|
if not FBitmapsValid then
|
||||||
RedrawScale;
|
RedrawScale;
|
||||||
{$ENDIF}
|
|
||||||
|
|
||||||
if FAntiAliased = aaNone then
|
if FAntiAliased = aaNone then
|
||||||
Canvas.Draw(0, 0, FFaceBitmap)
|
Canvas.Draw(0, 0, FFaceBitmap)
|
||||||
@ -900,44 +774,6 @@ begin
|
|||||||
Canvas.Draw(0, 0, FAABitmap);
|
Canvas.Draw(0, 0, FAABitmap);
|
||||||
end;
|
end;
|
||||||
|
|
||||||
{$IFNDEF LCL} (*
|
|
||||||
procedure TA3nalogGauge.WMSize(var Message: TWMSize);
|
|
||||||
var
|
|
||||||
K: Integer;
|
|
||||||
begin
|
|
||||||
if Width < 60 then Width := 60;
|
|
||||||
if Height < 50 then Height := 50;
|
|
||||||
if FAntiAliased = aaNone then begin
|
|
||||||
FBackBitmap.Width := Width;
|
|
||||||
FBackBitmap.Height := Height;
|
|
||||||
FFaceBitmap.Width := Width;
|
|
||||||
FFaceBitmap.Height := Height;
|
|
||||||
end else begin
|
|
||||||
K := GetAAMultiplier;
|
|
||||||
FBackBitmap.Width := Width * K;
|
|
||||||
FBackBitmap.Height := Height * K;
|
|
||||||
FFaceBitmap.Width := Width * K;
|
|
||||||
FFaceBitmap.Height := Height * K;
|
|
||||||
FAABitmap.Width := Width;
|
|
||||||
FAABitmap.Height := Height;
|
|
||||||
end;
|
|
||||||
RedrawScale;
|
|
||||||
inherited;
|
|
||||||
end;
|
|
||||||
*)
|
|
||||||
|
|
||||||
procedure TA3nalogGauge.CMFontChanged(var Msg: TMessage);
|
|
||||||
begin
|
|
||||||
RedrawScale;
|
|
||||||
end;
|
|
||||||
|
|
||||||
procedure TA3nalogGauge.WMEraseBkGnd(var Msg: TMessage);
|
|
||||||
begin
|
|
||||||
Msg.Result := 1;
|
|
||||||
end;
|
|
||||||
{$ENDIF}
|
|
||||||
|
|
||||||
{$IFDEF LCL}
|
|
||||||
procedure TA3nalogGauge.FontChanged(Sender: TObject);
|
procedure TA3nalogGauge.FontChanged(Sender: TObject);
|
||||||
begin
|
begin
|
||||||
inherited;
|
inherited;
|
||||||
@ -946,10 +782,9 @@ end;
|
|||||||
|
|
||||||
class function TA3nalogGauge.GetControlClassDefaultSize: TSize;
|
class function TA3nalogGauge.GetControlClassDefaultSize: TSize;
|
||||||
begin
|
begin
|
||||||
Result.CX := 225;
|
Result.CX := 280;
|
||||||
Result.CY := 180;
|
Result.CY := 180;
|
||||||
end;
|
end;
|
||||||
{$ENDIF}
|
|
||||||
|
|
||||||
procedure TA3nalogGauge.Resize;
|
procedure TA3nalogGauge.Resize;
|
||||||
var
|
var
|
||||||
@ -974,14 +809,9 @@ begin
|
|||||||
FAABitmap.Width := Width;
|
FAABitmap.Width := Width;
|
||||||
FAABitmap.Height := Height;
|
FAABitmap.Height := Height;
|
||||||
end;
|
end;
|
||||||
{$IFDEF LCL}
|
|
||||||
FBitmapsValid := false;
|
FBitmapsValid := false;
|
||||||
{$ELSE}
|
|
||||||
RedrawScale;
|
|
||||||
{$ENDIF}
|
|
||||||
inherited;
|
inherited;
|
||||||
end;
|
end;
|
||||||
//{$ENDIF}
|
|
||||||
|
|
||||||
procedure TA3nalogGauge.SetCaptionFont(AValue: TFont);
|
procedure TA3nalogGauge.SetCaptionFont(AValue: TFont);
|
||||||
begin
|
begin
|
||||||
@ -996,7 +826,7 @@ begin
|
|||||||
end;
|
end;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
procedure TA3nalogGauge.SetFMinColor(C: TColor);
|
procedure TA3nalogGauge.SetMinColor(C: TColor);
|
||||||
begin
|
begin
|
||||||
if C <> FMinColor then begin
|
if C <> FMinColor then begin
|
||||||
FMinColor := C;
|
FMinColor := C;
|
||||||
@ -1004,7 +834,7 @@ begin
|
|||||||
end;
|
end;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
procedure TA3nalogGauge.SetFMidColor(C: TColor);
|
procedure TA3nalogGauge.SetMidColor(C: TColor);
|
||||||
begin
|
begin
|
||||||
if C <> FMidColor then begin
|
if C <> FMidColor then begin
|
||||||
FMidColor := C;
|
FMidColor := C;
|
||||||
@ -1012,7 +842,7 @@ begin
|
|||||||
end;
|
end;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
procedure TA3nalogGauge.SetFMaxColor(C: TColor);
|
procedure TA3nalogGauge.SetMaxColor(C: TColor);
|
||||||
begin
|
begin
|
||||||
if C <> FMaxColor then begin
|
if C <> FMaxColor then begin
|
||||||
FMaxColor := C;
|
FMaxColor := C;
|
||||||
@ -1020,7 +850,7 @@ begin
|
|||||||
end;
|
end;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
procedure TA3nalogGauge.SetFFaceColor(C: TColor);
|
procedure TA3nalogGauge.SetFaceColor(C: TColor);
|
||||||
begin
|
begin
|
||||||
if C <> FFaceColor then begin
|
if C <> FFaceColor then begin
|
||||||
FFaceColor := C;
|
FFaceColor := C;
|
||||||
@ -1028,7 +858,7 @@ begin
|
|||||||
end;
|
end;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
procedure TA3nalogGauge.SetFTicksColor(C: TColor);
|
procedure TA3nalogGauge.SetTicksColor(C: TColor);
|
||||||
begin
|
begin
|
||||||
if C <> FTicksColor then begin
|
if C <> FTicksColor then begin
|
||||||
FTicksColor := C;
|
FTicksColor := C;
|
||||||
@ -1036,7 +866,7 @@ begin
|
|||||||
end;
|
end;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
procedure TA3nalogGauge.SetFValueColor(C: TColor);
|
procedure TA3nalogGauge.SetValueColor(C: TColor);
|
||||||
begin
|
begin
|
||||||
if C <> FValueColor then begin
|
if C <> FValueColor then begin
|
||||||
FValueColor := C;
|
FValueColor := C;
|
||||||
@ -1044,7 +874,7 @@ begin
|
|||||||
end;
|
end;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
procedure TA3nalogGauge.SetFCaptionColor(C: TColor);
|
procedure TA3nalogGauge.SetCaptionColor(C: TColor);
|
||||||
begin
|
begin
|
||||||
if C <> FCaptionColor then begin
|
if C <> FCaptionColor then begin
|
||||||
FCaptionColor := C;
|
FCaptionColor := C;
|
||||||
@ -1052,7 +882,7 @@ begin
|
|||||||
end;
|
end;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
procedure TA3nalogGauge.SetFArrowColor(C: TColor);
|
procedure TA3nalogGauge.SetArrowColor(C: TColor);
|
||||||
begin
|
begin
|
||||||
if C <> FArrowColor then begin
|
if C <> FArrowColor then begin
|
||||||
FArrowColor := C;
|
FArrowColor := C;
|
||||||
@ -1060,7 +890,7 @@ begin
|
|||||||
end;
|
end;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
procedure TA3nalogGauge.SetFMarginColor(C: TColor);
|
procedure TA3nalogGauge.SetMarginColor(C: TColor);
|
||||||
begin
|
begin
|
||||||
if C <> FMarginColor then begin
|
if C <> FMarginColor then begin
|
||||||
FMarginColor := C;
|
FMarginColor := C;
|
||||||
@ -1068,7 +898,7 @@ begin
|
|||||||
end;
|
end;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
procedure TA3nalogGauge.SetFCenterColor(C: TColor);
|
procedure TA3nalogGauge.SetCenterColor(C: TColor);
|
||||||
begin
|
begin
|
||||||
if C <> FCenterColor then begin
|
if C <> FCenterColor then begin
|
||||||
FCenterColor := C;
|
FCenterColor := C;
|
||||||
@ -1076,7 +906,7 @@ begin
|
|||||||
end;
|
end;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
procedure TA3nalogGauge.SetFCircleColor(C: TColor);
|
procedure TA3nalogGauge.SetCircleColor(C: TColor);
|
||||||
begin
|
begin
|
||||||
if C <> FCircleColor then begin
|
if C <> FCircleColor then begin
|
||||||
FCircleColor := C;
|
FCircleColor := C;
|
||||||
@ -1084,7 +914,7 @@ begin
|
|||||||
end;
|
end;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
procedure TA3nalogGauge.SetFCenterRadius(I: Integer);
|
procedure TA3nalogGauge.SetCenterRadius(I: Integer);
|
||||||
begin
|
begin
|
||||||
if I <> FCenterRadius then begin
|
if I <> FCenterRadius then begin
|
||||||
FCenterRadius := I;
|
FCenterRadius := I;
|
||||||
@ -1092,7 +922,7 @@ begin
|
|||||||
end;
|
end;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
procedure TA3nalogGauge.SetFCircleRadius(I: Integer);
|
procedure TA3nalogGauge.SetCircleRadius(I: Integer);
|
||||||
begin
|
begin
|
||||||
if I <> FCircleRadius then begin
|
if I <> FCircleRadius then begin
|
||||||
FCircleRadius := I;
|
FCircleRadius := I;
|
||||||
@ -1100,7 +930,7 @@ begin
|
|||||||
end
|
end
|
||||||
end;
|
end;
|
||||||
|
|
||||||
procedure TA3nalogGauge.SetFScaleAngle(I: Integer);
|
procedure TA3nalogGauge.SetScaleAngle(I: Integer);
|
||||||
begin
|
begin
|
||||||
if I <> FScaleAngle then begin
|
if I <> FScaleAngle then begin
|
||||||
if (I > 10) and (I <= 360) then
|
if (I > 10) and (I <= 360) then
|
||||||
@ -1109,7 +939,7 @@ begin
|
|||||||
end;
|
end;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
procedure TA3nalogGauge.SetFMargin(I: Integer);
|
procedure TA3nalogGauge.SetMargin(I: Integer);
|
||||||
begin
|
begin
|
||||||
if I <> FMargin then begin
|
if I <> FMargin then begin
|
||||||
FMargin := I;
|
FMargin := I;
|
||||||
@ -1117,7 +947,7 @@ begin
|
|||||||
end;
|
end;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
procedure TA3nalogGauge.SetFStyle(S: TStyle);
|
procedure TA3nalogGauge.SetStyle(S: TStyle);
|
||||||
begin
|
begin
|
||||||
if S <> FStyle then begin
|
if S <> FStyle then begin
|
||||||
FStyle := S;
|
FStyle := S;
|
||||||
@ -1125,7 +955,7 @@ begin
|
|||||||
end;
|
end;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
procedure TA3nalogGauge.SetFArrowWidth(I: Integer);
|
procedure TA3nalogGauge.SetArrowWidth(I: Integer);
|
||||||
begin
|
begin
|
||||||
if I <> FArrowWidth then begin
|
if I <> FArrowWidth then begin
|
||||||
if I < 1 then
|
if I < 1 then
|
||||||
@ -1139,7 +969,7 @@ begin
|
|||||||
end
|
end
|
||||||
end;
|
end;
|
||||||
|
|
||||||
procedure TA3nalogGauge.SetFNumMainTicks(I: Integer);
|
procedure TA3nalogGauge.SetNumMainTicks(I: Integer);
|
||||||
begin
|
begin
|
||||||
if I <> FNumMainTicks then begin
|
if I <> FNumMainTicks then begin
|
||||||
FNumMainTicks := I;
|
FNumMainTicks := I;
|
||||||
@ -1147,7 +977,7 @@ begin
|
|||||||
end;
|
end;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
procedure TA3nalogGauge.SetFLengthMainTicks(I: Integer);
|
procedure TA3nalogGauge.SetLengthMainTicks(I: Integer);
|
||||||
begin
|
begin
|
||||||
if I <> FLengthMainTicks then begin
|
if I <> FLengthMainTicks then begin
|
||||||
FLengthMainTicks := I;
|
FLengthMainTicks := I;
|
||||||
@ -1155,7 +985,7 @@ begin
|
|||||||
end;
|
end;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
procedure TA3nalogGauge.SetFLengthSubTicks(I: Integer);
|
procedure TA3nalogGauge.SetLengthSubTicks(I: Integer);
|
||||||
begin
|
begin
|
||||||
if I <> FLengthSubTicks then begin
|
if I <> FLengthSubTicks then begin
|
||||||
FLengthSubTicks := I;
|
FLengthSubTicks := I;
|
||||||
@ -1163,7 +993,7 @@ begin
|
|||||||
end;
|
end;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
procedure TA3nalogGauge.SetFFaceOptions(O: TFaceOptions);
|
procedure TA3nalogGauge.SetFaceOptions(O: TFaceOptions);
|
||||||
begin
|
begin
|
||||||
if O <> FFaceOptions then begin
|
if O <> FFaceOptions then begin
|
||||||
FFaceOptions := O;
|
FFaceOptions := O;
|
||||||
@ -1171,7 +1001,7 @@ begin
|
|||||||
end;
|
end;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
procedure TA3nalogGauge.SetFPosition(V: Single);
|
procedure TA3nalogGauge.SetPosition(V: Single);
|
||||||
begin
|
begin
|
||||||
if V <> FPosition then begin
|
if V <> FPosition then begin
|
||||||
FPosition := V;
|
FPosition := V;
|
||||||
@ -1181,7 +1011,7 @@ begin
|
|||||||
end
|
end
|
||||||
end;
|
end;
|
||||||
|
|
||||||
procedure TA3nalogGauge.SetFScaleValue(I: Integer);
|
procedure TA3nalogGauge.SetScaleValue(I: Integer);
|
||||||
begin
|
begin
|
||||||
if I <> FScaleValue then begin
|
if I <> FScaleValue then begin
|
||||||
if I > 1 then begin
|
if I > 1 then begin
|
||||||
@ -1193,7 +1023,7 @@ begin
|
|||||||
end;
|
end;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
procedure TA3nalogGauge.SetFMaximum(I: Integer);
|
procedure TA3nalogGauge.SetMaximum(I: Integer);
|
||||||
begin
|
begin
|
||||||
if I <> FMaximum then begin
|
if I <> FMaximum then begin
|
||||||
if (I > 0) and (I < FScaleValue) then
|
if (I > 0) and (I < FScaleValue) then
|
||||||
@ -1202,7 +1032,7 @@ begin
|
|||||||
end;
|
end;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
procedure TA3nalogGauge.SetFMinimum(I: Integer);
|
procedure TA3nalogGauge.SetMinimum(I: Integer);
|
||||||
begin
|
begin
|
||||||
if I <> FMinimum then begin
|
if I <> FMinimum then begin
|
||||||
if (I > 0) and (I < FScaleValue) then
|
if (I > 0) and (I < FScaleValue) then
|
||||||
@ -1211,7 +1041,7 @@ begin
|
|||||||
end
|
end
|
||||||
end;
|
end;
|
||||||
|
|
||||||
procedure TA3nalogGauge.SetFCaption(const S: string);
|
procedure TA3nalogGauge.SetCaption(const S: string);
|
||||||
begin
|
begin
|
||||||
if S <> FCaption then begin
|
if S <> FCaption then begin
|
||||||
Canvas.Font := Font;
|
Canvas.Font := Font;
|
||||||
@ -1220,7 +1050,7 @@ begin
|
|||||||
end
|
end
|
||||||
end;
|
end;
|
||||||
|
|
||||||
procedure TA3nalogGauge.SetFAntiAliased(V: TAntialiased);
|
procedure TA3nalogGauge.SetAntiAliased(V: TAntialiased);
|
||||||
var
|
var
|
||||||
K: Integer;
|
K: Integer;
|
||||||
begin
|
begin
|
||||||
@ -1257,14 +1087,6 @@ end;
|
|||||||
function TA3nalogGauge.GetAAMultiplier: Integer;
|
function TA3nalogGauge.GetAAMultiplier: Integer;
|
||||||
begin
|
begin
|
||||||
Result := ord(FAntiAliased) + 1;
|
Result := ord(FAntiAliased) + 1;
|
||||||
{
|
|
||||||
case FAntiAliased of
|
|
||||||
aaBiline : Result := 2;
|
|
||||||
aaTriline : Result := 3;
|
|
||||||
aaQuadral : Result := 4;
|
|
||||||
else Result := 1
|
|
||||||
end
|
|
||||||
}
|
|
||||||
end;
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
@ -23,7 +23,8 @@ unit indGnouMeter;
|
|||||||
interface
|
interface
|
||||||
|
|
||||||
uses
|
uses
|
||||||
Classes, Controls, Graphics, SysUtils, Messages, LMessages, Types, LCLType, LCLIntf;
|
Classes, Controls, Graphics, SysUtils, //Messages,
|
||||||
|
LMessages, Types, LCLType, LCLIntf;
|
||||||
|
|
||||||
type
|
type
|
||||||
TindGnouMeter = class(TGraphicControl)
|
TindGnouMeter = class(TGraphicControl)
|
||||||
@ -74,7 +75,7 @@ type
|
|||||||
procedure DrawMarker;
|
procedure DrawMarker;
|
||||||
protected
|
protected
|
||||||
procedure Paint; override;
|
procedure Paint; override;
|
||||||
procedure CMTextChanged(var Message: TMessage); message CM_TEXTCHANGED;
|
procedure CMTextChanged(var Message: TLMessage); message CM_TEXTCHANGED;
|
||||||
public
|
public
|
||||||
constructor Create(AOwner: TComponent); override;
|
constructor Create(AOwner: TComponent); override;
|
||||||
destructor Destroy; override;
|
destructor Destroy; override;
|
||||||
@ -132,7 +133,7 @@ begin
|
|||||||
inherited Destroy;
|
inherited Destroy;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
procedure TindGnouMeter.CMTextChanged(var Message: TMessage);
|
procedure TindGnouMeter.CMTextChanged(var Message: TLMessage);
|
||||||
begin
|
begin
|
||||||
Invalidate;
|
Invalidate;
|
||||||
end;
|
end;
|
||||||
|
Binary file not shown.
@ -48,10 +48,11 @@ unit MKnob;
|
|||||||
interface
|
interface
|
||||||
|
|
||||||
uses
|
uses
|
||||||
LclIntf, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, math, ComCtrls;
|
LclIntf, Types, SysUtils, Classes, Graphics, Math,
|
||||||
|
Controls, Forms, Dialogs, ComCtrls;
|
||||||
|
|
||||||
const
|
const
|
||||||
DEFAULT_KNOB_FACE_COLOR = $00B5CCBD;
|
DEFAULT_KNOB_FACE_COLOR = clSilver; //$00B5CCBD;
|
||||||
DEFAULT_KNOB_MARK_SIZE = 6;
|
DEFAULT_KNOB_MARK_SIZE = 6;
|
||||||
|
|
||||||
type
|
type
|
||||||
@ -95,6 +96,7 @@ type
|
|||||||
procedure UpdatePosition(X, Y: Integer);
|
procedure UpdatePosition(X, Y: Integer);
|
||||||
|
|
||||||
protected { Protected declarations }
|
protected { Protected declarations }
|
||||||
|
class function GetControlClassDefaultSize: TSize; override;
|
||||||
procedure KnobChange;
|
procedure KnobChange;
|
||||||
procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
|
procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
|
||||||
procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
|
procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
|
||||||
@ -142,9 +144,9 @@ end;
|
|||||||
constructor TmKnob.Create(AOwner : TComponent);
|
constructor TmKnob.Create(AOwner : TComponent);
|
||||||
begin
|
begin
|
||||||
inherited Create(AOwner);
|
inherited Create(AOwner);
|
||||||
|
with GetControlClassDefaultSize do
|
||||||
|
SetInitialBounds(0, 0, CX, CY);
|
||||||
ControlStyle := ControlStyle + [csOpaque];
|
ControlStyle := ControlStyle + [csOpaque];
|
||||||
Width := 60;
|
|
||||||
Height := 60;
|
|
||||||
FMaxValue := 100;
|
FMaxValue := 100;
|
||||||
FMinValue := 0;
|
FMinValue := 0;
|
||||||
FCurValue := 0;
|
FCurValue := 0;
|
||||||
@ -183,6 +185,12 @@ begin
|
|||||||
Result := DegToRad(ANGLE[FAngleRange]);
|
Result := DegToRad(ANGLE[FAngleRange]);
|
||||||
end;
|
end;
|
||||||
|
|
||||||
|
class function TmKnob.GetControlClassDefaultSize: TSize;
|
||||||
|
begin
|
||||||
|
Result.CX := 60;
|
||||||
|
Result.CY := 60;
|
||||||
|
end;
|
||||||
|
|
||||||
procedure TmKnob.KnobChange;
|
procedure TmKnob.KnobChange;
|
||||||
begin
|
begin
|
||||||
if Assigned(FOnChange) then
|
if Assigned(FOnChange) then
|
||||||
@ -528,24 +536,11 @@ end;
|
|||||||
procedure TmKnob.UpdatePosition(X, Y: Integer);
|
procedure TmKnob.UpdatePosition(X, Y: Integer);
|
||||||
var
|
var
|
||||||
CX, CY: integer;
|
CX, CY: integer;
|
||||||
R: double;
|
|
||||||
Angle: double;
|
Angle: double;
|
||||||
begin
|
begin
|
||||||
CX := Width div 2;
|
CX := Width div 2;
|
||||||
CY := Height div 2;
|
CY := Height div 2;
|
||||||
R := Round(sqrt(sqr(CX-X) + sqr(CY-Y)));
|
Angle := -ArcTan2(CX-X, CY-Y);
|
||||||
if R = 0 then R := 0.0001;
|
|
||||||
|
|
||||||
if Y < CY then
|
|
||||||
Angle := arcsin((X-CX)/R)
|
|
||||||
else
|
|
||||||
begin
|
|
||||||
Angle := arcsin((CX-X)/R);
|
|
||||||
if X > CX then
|
|
||||||
Angle := Angle + Pi
|
|
||||||
else
|
|
||||||
Angle := Angle - Pi;
|
|
||||||
end;
|
|
||||||
Position := Round((Angle - GetAngleOrigin) * (Max - Min) / GetAngleRange + (Min + Max) / 2);
|
Position := Round((Angle - GetAngleOrigin) * (Max - Min) / GetAngleRange + (Min + Max) / 2);
|
||||||
Refresh;
|
Refresh;
|
||||||
end;
|
end;
|
||||||
|
Reference in New Issue
Block a user