diff --git a/components/industrialstuff/Example/A3nalogGaugeSample/demo.lpi b/components/industrialstuff/Example/A3nalogGaugeSample/demo.lpi index 14cdb4514..457992e1d 100644 --- a/components/industrialstuff/Example/A3nalogGaugeSample/demo.lpi +++ b/components/industrialstuff/Example/A3nalogGaugeSample/demo.lpi @@ -66,6 +66,12 @@ + + + + + + diff --git a/components/industrialstuff/Example/A3nalogGaugeSample/main.lfm b/components/industrialstuff/Example/A3nalogGaugeSample/main.lfm index af205f8b4..f6dfcf94e 100644 --- a/components/industrialstuff/Example/A3nalogGaugeSample/main.lfm +++ b/components/industrialstuff/Example/A3nalogGaugeSample/main.lfm @@ -10,7 +10,7 @@ object MainForm: TMainForm Font.Color = clWindowText OnCreate = FormCreate Position = poDefaultPosOnly - LCLVersion = '1.9.0.0' + LCLVersion = '2.1.0.0' Scaled = False object Panel1: TPanel Left = 0 @@ -543,10 +543,10 @@ object MainForm: TMainForm TabOrder = 0 end object AboutLabel: TLabel - Left = 96 + Left = 199 Height = 40 Top = 0 - Width = 682 + Width = 579 Alignment = taCenter Anchors = [akLeft, akRight, akBottom] AutoSize = False @@ -556,6 +556,15 @@ object MainForm: TMainForm OnClick = AboutLabelClick OnMouseMove = AboutLabelMouseMove end + object StartStopButton: TButton + Left = 104 + Height = 25 + Top = 8 + Width = 75 + Caption = 'Stop' + OnClick = StartStopButtonClick + TabOrder = 1 + end end object Panel3: TPanel Left = 0 diff --git a/components/industrialstuff/Example/A3nalogGaugeSample/main.pas b/components/industrialstuff/Example/A3nalogGaugeSample/main.pas index 3bc18bcab..a7a15d7b2 100644 --- a/components/industrialstuff/Example/A3nalogGaugeSample/main.pas +++ b/components/industrialstuff/Example/A3nalogGaugeSample/main.pas @@ -1,6 +1,6 @@ unit main; -{$DEFINE TICKER} +//{$DEFINE TICKER} {$IFDEF LCL} {$MODE DELPHI} @@ -10,7 +10,12 @@ unit main; interface 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; type @@ -18,6 +23,7 @@ type { TMainForm } TMainForm = class(TForm) + StartStopButton: TButton; Panel1: TPanel; Panel2: TPanel; Panel3: TPanel; @@ -81,6 +87,7 @@ type AAModeBox: TComboBox; AAModeLabel: TLabel; procedure FormCreate(Sender: TObject); + procedure StartStopButtonClick(Sender: TObject); procedure StyleBoxChange(Sender: TObject); procedure TimerTimer(Sender: TObject); {$IFDEF TICKER} @@ -133,6 +140,7 @@ type AnalogGauge2: TA3nalogGauge; AnalogGauge3: TA3nalogGauge; FDelta: Double; + FStartTime: TDateTime; end; var @@ -147,6 +155,9 @@ implementation {$DEFINE TICKER} {$ENDIF} +const + BASE_CAPTION = 'AntiAliased Analog Gauge demo'; + procedure TMainForm.FormCreate(Sender: TObject); begin AnalogGauge1 := TA3nalogGauge.Create(self); @@ -217,6 +228,21 @@ begin {$IFDEF TICKER} AnalogGauge1.OnFrames := FramesChanged; {$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; procedure TMainForm.StyleBoxChange(Sender: TObject); @@ -658,14 +684,22 @@ begin Control := Sender as TLabel; if (X > 0) and (X < Control.Width) and (Y > 0) and (Y < Control.Height) then begin + {$IFDEF LCL} + Screen.Cursor := crHandPoint + {$ELSE} Control.Font.Style := Control.Font.Style + [fsUnderLine]; Control.Cursor := crHandPoint; Windows.SetCursor(Screen.Cursors[Control.Cursor]); SetCaptureControl(Control); + {$ENDIF} end else begin + {$IFDEF LCL} + Screen.Cursor := crDefault; + {$ELSE} Control.Font.Style := Control.Font.Style - [fsUnderLine]; Control.Cursor := crDefault; SetCaptureControl(nil); + {$ENDIF} end; end; @@ -677,7 +711,11 @@ begin Control := Sender as TLabel; Control.Font.Style := Control.Font.Style - [fsUnderLine]; Control.Cursor := crDefault; SetCaptureControl(nil); + {$IFDEF LCL} + OpenURL('http://irnis.net/'); + {$ELSE} ShellExecute(0, nil, PChar('http://www.irnis.net/'), nil, nil, SW_SHOWDEFAULT); + {$ENDIF} end; end. diff --git a/components/industrialstuff/Example/OnOffSwitch_Knob_Sample/main.lfm b/components/industrialstuff/Example/OnOffSwitch_Knob_Sample/main.lfm index 787f0103c..b571b5498 100644 --- a/components/industrialstuff/Example/OnOffSwitch_Knob_Sample/main.lfm +++ b/components/industrialstuff/Example/OnOffSwitch_Knob_Sample/main.lfm @@ -13,6 +13,7 @@ object MainForm: TMainForm Height = 96 Top = 200 Width = 88 + TickColor = clCream Position = 0 MarkStyle = msCircle OnChange = KnobChange diff --git a/components/industrialstuff/resources/tmknob.png b/components/industrialstuff/resources/tmknob.png index f954fba9e..9f4a32195 100644 Binary files a/components/industrialstuff/resources/tmknob.png and b/components/industrialstuff/resources/tmknob.png differ diff --git a/components/industrialstuff/resources/tmknob_150.png b/components/industrialstuff/resources/tmknob_150.png index ae8361b73..8a01e9170 100644 Binary files a/components/industrialstuff/resources/tmknob_150.png and b/components/industrialstuff/resources/tmknob_150.png differ diff --git a/components/industrialstuff/resources/tmknob_200.png b/components/industrialstuff/resources/tmknob_200.png index c9f4dc6d9..54dec7d9f 100644 Binary files a/components/industrialstuff/resources/tmknob_200.png and b/components/industrialstuff/resources/tmknob_200.png differ diff --git a/components/industrialstuff/source/a3naloggauge.pas b/components/industrialstuff/source/a3naloggauge.pas index 76153ad58..edddff37f 100644 --- a/components/industrialstuff/source/a3naloggauge.pas +++ b/components/industrialstuff/source/a3naloggauge.pas @@ -2,22 +2,17 @@ unit A3nalogGauge; {.$DEFINE TICKER} -{$IFDEF FPC} - {$MODE DELPHI} - {$IFNDEF WINDOWS} - {$UNDEF TICKER} - {$ENDIF} +{$MODE DELPHI} + +{$IFNDEF WINDOWS} + {$UNDEF TICKER} {$ENDIF} interface uses - {$IFDEF LCL} LCLIntf, LCLType, LCLProc, Types, {$IFDEF TICKER} Windows,{$ENDIF} // for QueryPerformanceCounter - {$ELSE} - Windows, Messages, - {$ENDIF} SysUtils, Classes, Graphics, Controls; type @@ -81,9 +76,7 @@ type FBackBitmap: TBitmap; FFaceBitmap: TBitmap; FAABitmap: TBitmap; - {$IFDEF LCL} FBitmapsValid: Boolean; - {$ENDIF} {$IFDEF TICKER} // performance tracking FTicker: Int64; @@ -93,33 +86,33 @@ type {$ENDIF} // set properties procedure SetFrameColor(C: TColor); - procedure SetFMinColor(C: TColor); - procedure SetFMidColor(C: TColor); - procedure SetFMaxColor(C: TColor); - procedure SetFFaceColor(C: TColor); - procedure SetFTicksColor(C: TColor); - procedure SetFValueColor(C: TColor); - procedure SetFCaptionColor(C: TColor); - procedure SetFArrowColor(C: TColor); - procedure SetFMarginColor(C: TColor); - procedure SetFCenterColor(C: TColor); - procedure SetFCircleColor(C: TColor); - procedure SetFCenterRadius(I: Integer); - procedure SetFCircleRadius(I: Integer); - procedure SetFScaleAngle(I: Integer); - procedure SetFMargin(I: Integer); - procedure SetFStyle(S: TStyle); - procedure SetFArrowWidth(I: Integer); - procedure SetFNumMainTicks(I: Integer); - procedure SetFLengthMainTicks(I: Integer); - procedure SetFLengthSubTicks(I: Integer); - procedure SetFFaceOptions(O: TFaceOptions); - procedure SetFPosition(V: Single); - procedure SetFScaleValue(I: Integer); - procedure SetFMaximum(I: Integer); - procedure SetFMinimum(I: Integer); - procedure SetFCaption(const S: string); - procedure SetFAntiAliased(V: TAntialiased); + procedure SetMinColor(C: TColor); + procedure SetMidColor(C: TColor); + procedure SetMaxColor(C: TColor); + procedure SetFaceColor(C: TColor); + procedure SetTicksColor(C: TColor); + procedure SetValueColor(C: TColor); + procedure SetCaptionColor(C: TColor); + procedure SetArrowColor(C: TColor); + procedure SetMarginColor(C: TColor); + procedure SetCenterColor(C: TColor); + procedure SetCircleColor(C: TColor); + procedure SetCenterRadius(I: Integer); + procedure SetCircleRadius(I: Integer); + procedure SetScaleAngle(I: Integer); + procedure SetMargin(I: Integer); + procedure SetStyle(S: TStyle); + procedure SetArrowWidth(I: Integer); + procedure SetNumMainTicks(I: Integer); + procedure SetLengthMainTicks(I: Integer); + procedure SetLengthSubTicks(I: Integer); + procedure SetFaceOptions(O: TFaceOptions); + procedure SetPosition(V: Single); + procedure SetScaleValue(I: Integer); + procedure SetMaximum(I: Integer); + procedure SetMinimum(I: Integer); + procedure SetCaption(const S: string); + procedure SetAntiAliased(V: TAntialiased); procedure SetCaptionFont(AValue: TFont); function GetAAMultiplier: Integer; @@ -133,13 +126,10 @@ type procedure RedrawScale; procedure Paint; override; procedure Resize; override; - {$IFDEF LCL} procedure FontChanged(Sender: TObject); override; class function GetControlClassDefaultSize: TSize; override; - {$ELSE} - procedure CMFontChanged(var Msg: TMessage); message CM_FontChanged; - procedure WMEraseBkGnd(var Msg: TMessage); message WM_ERASEBKGND; - {$ENDIF} + //procedure CMFontChanged(var Msg: TMessage); message CM_FontChanged; + //procedure WMEraseBkGnd(var Msg: TMessage); message WM_ERASEBKGND; public constructor Create(AOwner: TComponent); override; @@ -147,61 +137,63 @@ type published property Angle: Integer - read FScaleAngle write SetFScaleAngle default 120; + read FScaleAngle write SetScaleAngle default 120; property AntiAliased: TAntialiased - read FAntiAliased write SetFAntiAliased default aaNone; + read FAntiAliased write SetAntiAliased default aaNone; property ArrowColor: TColor - read FArrowColor write SetFArrowColor default clBlack; + read FArrowColor write SetArrowColor default clBlack; property ArrowWidth: Integer - read FArrowWidth write SetFArrowWidth default 1; - property Caption: string read FCaption write SetFCaption; + read FArrowWidth write SetArrowWidth default 1; + property Caption: string + read FCaption write SetCaption; property CaptionColor: TColor - read FCaptionColor write SetFCaptionColor default clBlack; + read FCaptionColor write SetCaptionColor default clBlack; property CaptionFont: TFont read FCaptionFont write SetCaptionFont; property CenterColor: TColor - read FCenterColor write SetFCenterColor default clDkGray; + read FCenterColor write SetCenterColor default clDkGray; property CenterRadius: Integer - read FCenterRadius write SetFCenterRadius default 8; + read FCenterRadius write SetCenterRadius default 8; property CircleColor: TColor - read FCircleColor write SetFCircleColor default clBlue; + read FCircleColor write SetCircleColor default clBlue; property CircleRadius: Integer - read FCircleRadius write SetFCircleRadius default 3; + read FCircleRadius write SetCircleRadius default 3; property FaceColor: TColor - read FFaceColor write SetFFaceColor default clBtnFace; + read FFaceColor write SetFaceColor default clBtnFace; property FaceOptions: TFaceOptions - read FFaceOptions write SetFFaceOptions default DEFAULT_FACE_OPTIONS; + read FFaceOptions write SetFaceOptions default DEFAULT_FACE_OPTIONS; property FrameColor: TColor read FFrameColor write SetFramecolor default clBtnShadow; property IndMaximum: Integer - read FMaximum write SetFMaximum default 80; + read FMaximum write SetMaximum default 80; property IndMinimum: Integer - read FMinimum write SetFMinimum default 20; + read FMinimum write SetMinimum default 20; property LengthMainTicks: Integer - read FLengthMainTicks write SetFLengthMainTicks default 15; + read FLengthMainTicks write SetLengthMainTicks default 15; property LengthSubTicks: Integer - read FLengthSubTicks write SetFLengthSubTicks default 8; + read FLengthSubTicks write SetLengthSubTicks default 8; property Margin: Integer - read FMargin write SetFMargin default 10; + read FMargin write SetMargin default 10; property MarginColor: TColor - read FMarginColor write SetFMarginColor default clSilver; + read FMarginColor write SetMarginColor default clSilver; property MaxColor: TColor - read FMaxColor write SetFMaxColor default clRed; + read FMaxColor write SetMaxColor default clRed; property MidColor: TColor - read FMidColor write SetFMidColor default clYellow; + read FMidColor write SetMidColor default clYellow; property MinColor: TColor - read FMinColor write SetFMinColor default clGreen; + read FMinColor write SetMinColor default clGreen; property NumberMainTicks: Integer - read FNumMainTicks write SetFNumMainTicks default 5; - property Position: Single read FPosition write SetFPosition; + read FNumMainTicks write SetNumMainTicks default 5; + property Position: Single + read FPosition write SetPosition; property Scale: Integer - read FScaleValue write SetFScaleValue default 100; + read FScaleValue write SetScaleValue default 100; property Style: TStyle - read FStyle write SetFStyle default agsCenterStyle; + read FStyle write SetStyle default agsCenterStyle; property TicksColor: TColor - read FTicksColor write SetFTicksColor default clBlack; + read FTicksColor write SetTicksColor default clBlack; property ValueColor: TColor - read FValueColor write SetFValueColor default clBlack; + read FValueColor write SetValueColor default clBlack; property OnOverMax: TNotifyEvent read FOverMax write FOverMax; property OnOverMin: TNotifyEvent read FOverMin write FOverMin; {$IFDEF TICKER} @@ -211,12 +203,8 @@ type property Align; property Anchors; - {$IFDEF LCL} property BorderSpacing; - {$ENDIF} property Font; - property Height default 180; - property Width default 225; end; procedure Register; @@ -224,18 +212,9 @@ procedure Register; implementation uses - {$IFDEF LCL} IntfGraphics, fpimage, - {$ENDIF} Math; -{$IFNDEF LCL} -function GetTickCount64: Int64; -begin - Result := GetTickCount; -end; -{$ENDIF} - { TA3nalogGauge } @@ -248,20 +227,13 @@ begin FFaceBitmap := TBitmap.Create; FAABitmap := nil; //*****************************defaults:**************************************** - (* - {$IFDEF LCL} with GetControlClassDefaultSize do begin SetInitialBounds(0, 0, CX, CY); w := CX; h := CY; end; - {$ELSE} - *) - w := 225; - h := 180; Width := w; Height := h; -// {$ENDIF} FBackBitmap.Width := w; FBackBitmap.Height := h; FBackBitmap.Canvas.Brush.Style := bsClear; @@ -314,29 +286,13 @@ begin FCaptionFont.Free; inherited; end; + { ------------------------------------------------------------------------- } + procedure SetPenStyles(Pen: TPen; Width: Integer; Color: TColor); -{$IFNDEF LCL} -var - HP: HPen; - LB: TLOGBRUSH; -{$IFEND} begin - {$IFDEF LCL} Pen.Width := Width; 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; procedure TA3nalogGauge.CaptionFontChanged(Sender: TObject); @@ -650,9 +606,8 @@ begin if Assigned(FOnFrames) then FOnFrames(Self) end; FTicker := -1; - - Invalidate; {$ENDIF} + Invalidate; end; procedure TA3nalogGauge.RedrawScale; @@ -665,12 +620,9 @@ begin {$ENDIF} DrawScale(FBackBitmap, GetAAMultiplier); RedrawArrow; - {$IFDEF LCL} FBitmapsValid := true; - {$ENDIF} end; -{$IFDEF LCL} procedure TA3nalogGauge.FastAntiAliasPicture; var intfImgAA: TLazIntfImage; @@ -804,95 +756,17 @@ begin 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; begin inherited; RedrawScale; - //Invalidate; end; procedure TA3nalogGauge.Paint; begin - {$IFDEF LCL} if not FBitmapsValid then RedrawScale; - {$ENDIF} if FAntiAliased = aaNone then Canvas.Draw(0, 0, FFaceBitmap) @@ -900,44 +774,6 @@ begin Canvas.Draw(0, 0, FAABitmap); 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); begin inherited; @@ -946,10 +782,9 @@ end; class function TA3nalogGauge.GetControlClassDefaultSize: TSize; begin - Result.CX := 225; + Result.CX := 280; Result.CY := 180; end; -{$ENDIF} procedure TA3nalogGauge.Resize; var @@ -974,14 +809,9 @@ begin FAABitmap.Width := Width; FAABitmap.Height := Height; end; - {$IFDEF LCL} FBitmapsValid := false; - {$ELSE} - RedrawScale; - {$ENDIF} inherited; end; -//{$ENDIF} procedure TA3nalogGauge.SetCaptionFont(AValue: TFont); begin @@ -996,7 +826,7 @@ begin end; end; -procedure TA3nalogGauge.SetFMinColor(C: TColor); +procedure TA3nalogGauge.SetMinColor(C: TColor); begin if C <> FMinColor then begin FMinColor := C; @@ -1004,7 +834,7 @@ begin end; end; -procedure TA3nalogGauge.SetFMidColor(C: TColor); +procedure TA3nalogGauge.SetMidColor(C: TColor); begin if C <> FMidColor then begin FMidColor := C; @@ -1012,7 +842,7 @@ begin end; end; -procedure TA3nalogGauge.SetFMaxColor(C: TColor); +procedure TA3nalogGauge.SetMaxColor(C: TColor); begin if C <> FMaxColor then begin FMaxColor := C; @@ -1020,7 +850,7 @@ begin end; end; -procedure TA3nalogGauge.SetFFaceColor(C: TColor); +procedure TA3nalogGauge.SetFaceColor(C: TColor); begin if C <> FFaceColor then begin FFaceColor := C; @@ -1028,7 +858,7 @@ begin end; end; -procedure TA3nalogGauge.SetFTicksColor(C: TColor); +procedure TA3nalogGauge.SetTicksColor(C: TColor); begin if C <> FTicksColor then begin FTicksColor := C; @@ -1036,7 +866,7 @@ begin end; end; -procedure TA3nalogGauge.SetFValueColor(C: TColor); +procedure TA3nalogGauge.SetValueColor(C: TColor); begin if C <> FValueColor then begin FValueColor := C; @@ -1044,7 +874,7 @@ begin end; end; -procedure TA3nalogGauge.SetFCaptionColor(C: TColor); +procedure TA3nalogGauge.SetCaptionColor(C: TColor); begin if C <> FCaptionColor then begin FCaptionColor := C; @@ -1052,7 +882,7 @@ begin end; end; -procedure TA3nalogGauge.SetFArrowColor(C: TColor); +procedure TA3nalogGauge.SetArrowColor(C: TColor); begin if C <> FArrowColor then begin FArrowColor := C; @@ -1060,7 +890,7 @@ begin end; end; -procedure TA3nalogGauge.SetFMarginColor(C: TColor); +procedure TA3nalogGauge.SetMarginColor(C: TColor); begin if C <> FMarginColor then begin FMarginColor := C; @@ -1068,7 +898,7 @@ begin end; end; -procedure TA3nalogGauge.SetFCenterColor(C: TColor); +procedure TA3nalogGauge.SetCenterColor(C: TColor); begin if C <> FCenterColor then begin FCenterColor := C; @@ -1076,7 +906,7 @@ begin end; end; -procedure TA3nalogGauge.SetFCircleColor(C: TColor); +procedure TA3nalogGauge.SetCircleColor(C: TColor); begin if C <> FCircleColor then begin FCircleColor := C; @@ -1084,7 +914,7 @@ begin end; end; -procedure TA3nalogGauge.SetFCenterRadius(I: Integer); +procedure TA3nalogGauge.SetCenterRadius(I: Integer); begin if I <> FCenterRadius then begin FCenterRadius := I; @@ -1092,7 +922,7 @@ begin end; end; -procedure TA3nalogGauge.SetFCircleRadius(I: Integer); +procedure TA3nalogGauge.SetCircleRadius(I: Integer); begin if I <> FCircleRadius then begin FCircleRadius := I; @@ -1100,7 +930,7 @@ begin end end; -procedure TA3nalogGauge.SetFScaleAngle(I: Integer); +procedure TA3nalogGauge.SetScaleAngle(I: Integer); begin if I <> FScaleAngle then begin if (I > 10) and (I <= 360) then @@ -1109,7 +939,7 @@ begin end; end; -procedure TA3nalogGauge.SetFMargin(I: Integer); +procedure TA3nalogGauge.SetMargin(I: Integer); begin if I <> FMargin then begin FMargin := I; @@ -1117,7 +947,7 @@ begin end; end; -procedure TA3nalogGauge.SetFStyle(S: TStyle); +procedure TA3nalogGauge.SetStyle(S: TStyle); begin if S <> FStyle then begin FStyle := S; @@ -1125,7 +955,7 @@ begin end; end; -procedure TA3nalogGauge.SetFArrowWidth(I: Integer); +procedure TA3nalogGauge.SetArrowWidth(I: Integer); begin if I <> FArrowWidth then begin if I < 1 then @@ -1139,7 +969,7 @@ begin end end; -procedure TA3nalogGauge.SetFNumMainTicks(I: Integer); +procedure TA3nalogGauge.SetNumMainTicks(I: Integer); begin if I <> FNumMainTicks then begin FNumMainTicks := I; @@ -1147,7 +977,7 @@ begin end; end; -procedure TA3nalogGauge.SetFLengthMainTicks(I: Integer); +procedure TA3nalogGauge.SetLengthMainTicks(I: Integer); begin if I <> FLengthMainTicks then begin FLengthMainTicks := I; @@ -1155,7 +985,7 @@ begin end; end; -procedure TA3nalogGauge.SetFLengthSubTicks(I: Integer); +procedure TA3nalogGauge.SetLengthSubTicks(I: Integer); begin if I <> FLengthSubTicks then begin FLengthSubTicks := I; @@ -1163,7 +993,7 @@ begin end; end; -procedure TA3nalogGauge.SetFFaceOptions(O: TFaceOptions); +procedure TA3nalogGauge.SetFaceOptions(O: TFaceOptions); begin if O <> FFaceOptions then begin FFaceOptions := O; @@ -1171,7 +1001,7 @@ begin end; end; -procedure TA3nalogGauge.SetFPosition(V: Single); +procedure TA3nalogGauge.SetPosition(V: Single); begin if V <> FPosition then begin FPosition := V; @@ -1181,7 +1011,7 @@ begin end end; -procedure TA3nalogGauge.SetFScaleValue(I: Integer); +procedure TA3nalogGauge.SetScaleValue(I: Integer); begin if I <> FScaleValue then begin if I > 1 then begin @@ -1193,7 +1023,7 @@ begin end; end; -procedure TA3nalogGauge.SetFMaximum(I: Integer); +procedure TA3nalogGauge.SetMaximum(I: Integer); begin if I <> FMaximum then begin if (I > 0) and (I < FScaleValue) then @@ -1202,7 +1032,7 @@ begin end; end; -procedure TA3nalogGauge.SetFMinimum(I: Integer); +procedure TA3nalogGauge.SetMinimum(I: Integer); begin if I <> FMinimum then begin if (I > 0) and (I < FScaleValue) then @@ -1211,7 +1041,7 @@ begin end end; -procedure TA3nalogGauge.SetFCaption(const S: string); +procedure TA3nalogGauge.SetCaption(const S: string); begin if S <> FCaption then begin Canvas.Font := Font; @@ -1220,7 +1050,7 @@ begin end end; -procedure TA3nalogGauge.SetFAntiAliased(V: TAntialiased); +procedure TA3nalogGauge.SetAntiAliased(V: TAntialiased); var K: Integer; begin @@ -1257,14 +1087,6 @@ end; function TA3nalogGauge.GetAAMultiplier: Integer; begin Result := ord(FAntiAliased) + 1; - { - case FAntiAliased of - aaBiline : Result := 2; - aaTriline : Result := 3; - aaQuadral : Result := 4; - else Result := 1 - end - } end; diff --git a/components/industrialstuff/source/indgnoumeter.pas b/components/industrialstuff/source/indgnoumeter.pas index 9906c6ad9..bfa38e816 100644 --- a/components/industrialstuff/source/indgnoumeter.pas +++ b/components/industrialstuff/source/indgnoumeter.pas @@ -23,7 +23,8 @@ unit indGnouMeter; interface uses - Classes, Controls, Graphics, SysUtils, Messages, LMessages, Types, LCLType, LCLIntf; + Classes, Controls, Graphics, SysUtils, //Messages, + LMessages, Types, LCLType, LCLIntf; type TindGnouMeter = class(TGraphicControl) @@ -74,7 +75,7 @@ type procedure DrawMarker; protected procedure Paint; override; - procedure CMTextChanged(var Message: TMessage); message CM_TEXTCHANGED; + procedure CMTextChanged(var Message: TLMessage); message CM_TEXTCHANGED; public constructor Create(AOwner: TComponent); override; destructor Destroy; override; @@ -132,7 +133,7 @@ begin inherited Destroy; end; -procedure TindGnouMeter.CMTextChanged(var Message: TMessage); +procedure TindGnouMeter.CMTextChanged(var Message: TLMessage); begin Invalidate; end; diff --git a/components/industrialstuff/source/industrial_icons.res b/components/industrialstuff/source/industrial_icons.res index dac10c4ce..a0da19f5f 100644 Binary files a/components/industrialstuff/source/industrial_icons.res and b/components/industrialstuff/source/industrial_icons.res differ diff --git a/components/industrialstuff/source/mknob.pas b/components/industrialstuff/source/mknob.pas index 9784c1884..6c13b140c 100644 --- a/components/industrialstuff/source/mknob.pas +++ b/components/industrialstuff/source/mknob.pas @@ -48,10 +48,11 @@ unit MKnob; interface uses - LclIntf, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, math, ComCtrls; + LclIntf, Types, SysUtils, Classes, Graphics, Math, + Controls, Forms, Dialogs, ComCtrls; const - DEFAULT_KNOB_FACE_COLOR = $00B5CCBD; + DEFAULT_KNOB_FACE_COLOR = clSilver; //$00B5CCBD; DEFAULT_KNOB_MARK_SIZE = 6; type @@ -95,6 +96,7 @@ type procedure UpdatePosition(X, Y: Integer); protected { Protected declarations } + class function GetControlClassDefaultSize: TSize; override; procedure KnobChange; procedure MouseDown(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); begin inherited Create(AOwner); + with GetControlClassDefaultSize do + SetInitialBounds(0, 0, CX, CY); ControlStyle := ControlStyle + [csOpaque]; - Width := 60; - Height := 60; FMaxValue := 100; FMinValue := 0; FCurValue := 0; @@ -183,6 +185,12 @@ begin Result := DegToRad(ANGLE[FAngleRange]); end; +class function TmKnob.GetControlClassDefaultSize: TSize; +begin + Result.CX := 60; + Result.CY := 60; +end; + procedure TmKnob.KnobChange; begin if Assigned(FOnChange) then @@ -528,24 +536,11 @@ end; procedure TmKnob.UpdatePosition(X, Y: Integer); var CX, CY: integer; - R: double; Angle: double; begin CX := Width div 2; CY := Height div 2; - R := Round(sqrt(sqr(CX-X) + sqr(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; + Angle := -ArcTan2(CX-X, CY-Y); Position := Round((Angle - GetAngleOrigin) * (Max - Min) / GetAngleRange + (Min + Max) / 2); Refresh; end;