You've already forked lazarus-ccr
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:
@ -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)));
|
||||||
|
Reference in New Issue
Block a user