industrial: LCL scaling of TLEDNumber should work now... Some cosmetic changes.

git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@7310 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
2020-01-21 10:13:43 +00:00
parent faec1f7501
commit fb6f07d8fa

View File

@ -64,14 +64,17 @@ type
procedure CMTextChanged(var Message: TLMessage); message CM_TEXTCHANGED; procedure CMTextChanged(var Message: TLMessage); message CM_TEXTCHANGED;
procedure DoAutoAdjustLayout(const AMode: TLayoutAdjustmentPolicy; procedure DoAutoAdjustLayout(const AMode: TLayoutAdjustmentPolicy;
const AXProportion, AYProportion: Double); override; const AXProportion, AYProportion: Double); override;
procedure SlantPoint(var P: TPoint; ABaseY: Integer; tanAlpha: Double);
procedure Initialize(out Points: array of TPoint); procedure Initialize(out Points: array of TPoint);
procedure Loaded; override;
function NewOffset(xOry: char; OldOffset: Integer): Integer; function NewOffset(xOry: char; OldOffset: Integer): Integer;
procedure ProcessCaption(Points: array of TPoint); procedure Paint; override;
procedure PaintSegment(Segment: Integer; TheColor: TColor; procedure PaintSegment(Segment: Integer; TheColor: TColor;
Points: array of TPoint; OffsetX, OffsetY: Integer); Points: array of TPoint; OffsetX, OffsetY: Integer);
procedure ResizeControl(Row, Col, ASize: Integer); procedure ProcessCaption(Points: array of TPoint);
procedure ResizeControl(ARows, ACols, ASize: Integer);
procedure SetParent(NewParent: TWinControl); override; procedure SetParent(NewParent: TWinControl); override;
procedure SlantPoint(var P: TPoint; RowHeight: Integer; tanAlpha: Double);
function GetAbout: string; function GetAbout: string;
function GetSlantAngle: Double; function GetSlantAngle: Double;
procedure SetAbout(const {%H-}Value: string); procedure SetAbout(const {%H-}Value: string);
@ -86,7 +89,6 @@ type
procedure SelectSegments(Segment: Word; Points: array of TPoint; procedure SelectSegments(Segment: Word; Points: array of TPoint;
OffsetX, OffsetY: Integer); OffsetX, OffsetY: Integer);
protected protected
procedure Paint; override;
{properties} {properties}
property Version: string read GetAbout write SetAbout stored False; property Version: string read GetAbout write SetAbout stored False;
property BorderStyle: TLedNumberBorderStyle read FBorderStyle write SetBorderStyle default lnbNone; {Draws border around segments.} property BorderStyle: TLedNumberBorderStyle read FBorderStyle write SetBorderStyle default lnbNone; {Draws border around segments.}
@ -96,10 +98,11 @@ type
property OffColor: TColor read FOffColor write SetOffColor default $000E3432; property OffColor: TColor read FOffColor write SetOffColor default $000E3432;
property OnColor: TColor read FOnColor write SetOnColor default clLime; property OnColor: TColor read FOnColor write SetOnColor default clLime;
property Size: TSegmentSize read FSize write SetSize default 2; property Size: TSegmentSize read FSize write SetSize default 2;
property SlantAngle: Integer read FSlantAngle write SetSlantAngle default 5; property SlantAngle: Integer read FSlantAngle write SetSlantAngle default 8;
property Slanted: Boolean read FSlanted write SetSlanted default false; property Slanted: Boolean read FSlanted write SetSlanted default false;
property Transparent: boolean read FTransparent write SetTransparent default false; {Draws segments with transparent background.BgColor is used as mask color.} property Transparent: boolean read FTransparent write SetTransparent default false; {Draws segments with transparent background.BgColor is used as mask color.}
property ZeroToO: Boolean read FZeroToO write SetZeroToO default false; property ZeroToO: Boolean read FZeroToO write SetZeroToO default false;
public public
constructor Create(AOwner:TComponent); override; constructor Create(AOwner:TComponent); override;
destructor Destroy; override; destructor Destroy; override;
@ -261,16 +264,15 @@ begin
csDoubleClicks]; csDoubleClicks];
FRows := 1; FRows := 1;
FColumns := 10; FColumns := 10;
FSize := 2;
Width := FColumns * BASE_WIDTH;
Height := FRows * BASE_HEIGHT;
FOnColor := clLime; FOnColor := clLime;
FOffColor := $000E3432; FOffColor := $000E3432;
FBgColor := clBlack; FBgColor := clBlack;
FSize := 2; FSlantAngle := 8;
FSlantAngle := 5;
Caption := 'LED-LABEL'; Caption := 'LED-LABEL';
lbDrawBmp := TBitmap.Create; lbDrawBmp := TBitmap.Create;
ResizeControl(FRows, FColumns, FSize);
end; end;
{=====} {=====}
@ -329,20 +331,15 @@ procedure TCustomLEDNumber.DoAutoAdjustLayout(
const AXProportion, AYProportion: Double); const AXProportion, AYProportion: Double);
begin begin
inherited; inherited;
FScalefactor := Font.PixelsPerInch / 96; FScaleFactor := Font.PixelsPerInch / 96;
end; ResizeControl(FRows, FColumns, FSize);
procedure TCustomLEDNumber.SlantPoint(var P: TPoint;
ABaseY: Integer; tanAlpha: Double);
begin
P.X += round(tanAlpha * (ABaseY - P.Y));
end; end;
procedure TCustomLEDNumber.Initialize(out Points: array of TPoint); procedure TCustomLEDNumber.Initialize(out Points: array of TPoint);
var var
I: Integer; I: Integer;
tanAlpha: Double; tanAlpha: Double;
baseY: Integer; rowHeight: Integer;
begin begin
for I := 0 to MAX_POINTS do begin for I := 0 to MAX_POINTS do begin
Points[i].X := round(FScaleFactor * (DigitPoints[i].X * (FSize - 1))); Points[i].X := round(FScaleFactor * (DigitPoints[i].X * (FSize - 1)));
@ -351,14 +348,20 @@ begin
if FSlanted and (FSlantAngle <> 0) then if FSlanted and (FSlantAngle <> 0) then
begin begin
rowHeight := round(FScaleFactor * BASE_HEIGHT * (FSize - 1));
tanAlpha := tan(GetSlantAngle); tanAlpha := tan(GetSlantAngle);
baseY := round(FScaleFactor * BASE_HEIGHT * (FSize - 1));
for i := 0 to MAX_POINTS do for i := 0 to MAX_POINTS do
SlantPoint(Points[i], baseY, tanAlpha); SlantPoint(Points[i], rowHeight, tanAlpha);
end; end;
end; end;
{=====} {=====}
procedure TCustomLEDNumber.Loaded;
begin
inherited;
ResizeControl(FRows, FColumns, FSize);
end;
function TCustomLEDNumber.NewOffset(xOry: char; OldOffset: Integer): Integer; function TCustomLEDNumber.NewOffset(xOry: char; OldOffset: Integer): Integer;
begin begin
if (xOry = 'x')then if (xOry = 'x')then
@ -451,7 +454,12 @@ begin
end; end;
end; end;
end; end;
{=====}
procedure TCustomLEDNumber.SlantPoint(var P: TPoint;
RowHeight: Integer; tanAlpha: Double);
begin
inc(P.X, round(tanAlpha * (RowHeight - P.Y)));
end;
procedure TCustomLEDNumber.ProcessCaption(Points: array of TPoint); procedure TCustomLEDNumber.ProcessCaption(Points: array of TPoint);
var var
@ -555,12 +563,12 @@ begin
end; end;
{=====} {=====}
procedure TCustomLEDNumber.ResizeControl(Row, Col, ASize: Integer); procedure TCustomLEDNumber.ResizeControl(ARows, ACols, ASize: Integer);
var var
w, h: Integer; w, h: Integer;
begin begin
FRows := Row; FRows := ARows;
FColumns := Col; FColumns := ACols;
FSize := ASize; FSize := ASize;
h := round(FScaleFactor * FRows * BASE_HEIGHT * (FSize - 1)); h := round(FScaleFactor * FRows * BASE_HEIGHT * (FSize - 1));
w := round(FScaleFactor * (FColumns * BASE_WIDTH * (FSize - 1))); w := round(FScaleFactor * (FColumns * BASE_WIDTH * (FSize - 1)));