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:
wp_xxyyzz
parent
608f9770b9
commit
21f4237f04
@ -66,6 +66,12 @@
|
||||
</Win32>
|
||||
</Options>
|
||||
</Linking>
|
||||
<Other>
|
||||
<CustomOptions Value="-dTICKER"/>
|
||||
<OtherDefines Count="1">
|
||||
<Define0 Value="TICKER"/>
|
||||
</OtherDefines>
|
||||
</Other>
|
||||
</CompilerOptions>
|
||||
<Debugging>
|
||||
<Exceptions Count="3">
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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.
|
||||
|
||||
@ -13,6 +13,7 @@ object MainForm: TMainForm
|
||||
Height = 96
|
||||
Top = 200
|
||||
Width = 88
|
||||
TickColor = clCream
|
||||
Position = 0
|
||||
MarkStyle = msCircle
|
||||
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}
|
||||
|
||||
{$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;
|
||||
|
||||
|
||||
|
||||
@ -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;
|
||||
|
||||
Binary file not shown.
@ -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;
|
||||
|
||||
Loading…
Reference in New Issue
Block a user