mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-08-09 19:35:57 +02:00
TLedNumber: implemented properties Transparent and BorderStyle.
git-svn-id: trunk@45034 -
This commit is contained in:
parent
6f127abb9e
commit
b305990772
@ -38,8 +38,16 @@ uses
|
|||||||
|
|
||||||
type
|
type
|
||||||
TSegmentSize = 2..10;
|
TSegmentSize = 2..10;
|
||||||
|
TLedNumberBorderStyle = (lnbNone, lnbSingle, lnbSunken, lnbRaised);
|
||||||
|
|
||||||
|
{ TCustomLEDNumber }
|
||||||
|
|
||||||
TCustomLEDNumber = class(TGraphicControl)
|
TCustomLEDNumber = class(TGraphicControl)
|
||||||
|
private
|
||||||
|
FBorderStyle: TLedNumberBorderStyle;
|
||||||
|
FTransparent: boolean;
|
||||||
|
procedure SetBorderStyle(AValue: TLedNumberBorderStyle);
|
||||||
|
procedure SetTransparent(AValue: boolean);
|
||||||
protected{private}
|
protected{private}
|
||||||
FBgColor : TColor;
|
FBgColor : TColor;
|
||||||
FOffColor : TColor;
|
FOffColor : TColor;
|
||||||
@ -72,12 +80,14 @@ type
|
|||||||
destructor Destroy; override;
|
destructor Destroy; 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 Columns: Integer read FColumns write SetColumns default 10;
|
property Columns: Integer read FColumns write SetColumns default 10;
|
||||||
property Rows: Integer read FRows write SetRows default 1;
|
property Rows: Integer read FRows write SetRows default 1;
|
||||||
property BgColor: TColor read FbgColor write SetbgColor default clBlack;
|
property BgColor: TColor read FbgColor write SetbgColor default clBlack;
|
||||||
property OffColor: TColor read FOffColor write SetOffColor default $00104E4A;
|
property OffColor: TColor read FOffColor write SetOffColor default $00104E4A;
|
||||||
property OnColor: TColor read FOnColor write SetOnColor default clYellow;
|
property OnColor: TColor read FOnColor write SetOnColor default clYellow;
|
||||||
property Size: TSegmentSize read FSize write SetSize default 2;
|
property Size: TSegmentSize read FSize write SetSize default 2;
|
||||||
|
property Transparent: boolean read FTransparent write SetTransparent default false; {Draws segments with transparent background.BgColor is used as mask color.}
|
||||||
{Inherited properties}
|
{Inherited properties}
|
||||||
property Caption;
|
property Caption;
|
||||||
property OnClick;
|
property OnClick;
|
||||||
@ -97,6 +107,7 @@ type
|
|||||||
TLEDNumber = class(TCustomLEDNumber)
|
TLEDNumber = class(TCustomLEDNumber)
|
||||||
published
|
published
|
||||||
property Version;
|
property Version;
|
||||||
|
property BorderStyle;
|
||||||
property Caption;
|
property Caption;
|
||||||
property Columns;
|
property Columns;
|
||||||
property Rows;
|
property Rows;
|
||||||
@ -115,6 +126,7 @@ type
|
|||||||
property PopupMenu;
|
property PopupMenu;
|
||||||
property Size;
|
property Size;
|
||||||
property ShowHint;
|
property ShowHint;
|
||||||
|
property Transparent;
|
||||||
property Visible;
|
property Visible;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
@ -231,12 +243,13 @@ const
|
|||||||
constructor TCustomLEDNumber.Create(AOwner:TComponent);
|
constructor TCustomLEDNumber.Create(AOwner:TComponent);
|
||||||
begin
|
begin
|
||||||
inherited Create(AOwner);
|
inherited Create(AOwner);
|
||||||
|
FTransparent := False;
|
||||||
|
FBorderStyle := lnbNone;
|
||||||
ControlStyle := [csCaptureMouse,
|
ControlStyle := [csCaptureMouse,
|
||||||
csOpaque,
|
csOpaque,
|
||||||
csSetCaption,
|
csSetCaption,
|
||||||
csClickEvents,
|
csClickEvents,
|
||||||
csDoubleClicks];
|
csDoubleClicks];
|
||||||
lbDrawBmp := TBitmap.Create;
|
|
||||||
Width := 170;
|
Width := 170;
|
||||||
Height := 30;
|
Height := 30;
|
||||||
FOnColor := clLime;
|
FOnColor := clLime;
|
||||||
@ -246,6 +259,7 @@ begin
|
|||||||
FRows := 1;
|
FRows := 1;
|
||||||
FColumns := 10;
|
FColumns := 10;
|
||||||
Caption := 'LED-LABEL';
|
Caption := 'LED-LABEL';
|
||||||
|
lbDrawBmp := TBitmap.Create;
|
||||||
end;
|
end;
|
||||||
{=====}
|
{=====}
|
||||||
|
|
||||||
@ -269,6 +283,22 @@ begin
|
|||||||
end;
|
end;
|
||||||
{=====}
|
{=====}
|
||||||
|
|
||||||
|
procedure TCustomLEDNumber.SetTransparent(AValue: boolean);
|
||||||
|
begin
|
||||||
|
if FTransparent=AValue then Exit;
|
||||||
|
FTransparent:=AValue;
|
||||||
|
lbDrawBmp.Transparent := FTransparent;
|
||||||
|
lbDrawBmp.TransparentColor := FBgColor;
|
||||||
|
Invalidate;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TCustomLEDNumber.SetBorderStyle(AValue: TLedNumberBorderStyle);
|
||||||
|
begin
|
||||||
|
if FBorderStyle=AValue then Exit;
|
||||||
|
FBorderStyle:=AValue;
|
||||||
|
Invalidate;
|
||||||
|
end;
|
||||||
|
|
||||||
procedure TCustomLEDNumber.CMTextChanged(var Message: TLMessage);
|
procedure TCustomLEDNumber.CMTextChanged(var Message: TLMessage);
|
||||||
begin
|
begin
|
||||||
inherited;
|
inherited;
|
||||||
@ -287,7 +317,7 @@ begin
|
|||||||
end;
|
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
|
||||||
newOffset := oldOffset + 17 * (FSize - 1)
|
newOffset := oldOffset + 17 * (FSize - 1)
|
||||||
@ -299,6 +329,7 @@ end;
|
|||||||
procedure TCustomLEDNumber.Paint;
|
procedure TCustomLEDNumber.Paint;
|
||||||
var
|
var
|
||||||
Points: array[0..MAX_POINTS] of TPoint;
|
Points: array[0..MAX_POINTS] of TPoint;
|
||||||
|
ARect: TRect;
|
||||||
begin
|
begin
|
||||||
lbDrawBMP.Width := Width;
|
lbDrawBMP.Width := Width;
|
||||||
lbDrawBMP.Height := Height;
|
lbDrawBMP.Height := Height;
|
||||||
@ -309,7 +340,25 @@ begin
|
|||||||
ProcessCaption(Points);
|
ProcessCaption(Points);
|
||||||
|
|
||||||
Canvas.CopyMode := cmSrcCopy;
|
Canvas.CopyMode := cmSrcCopy;
|
||||||
Canvas.Draw(0, 0, lbDrawBMP);
|
if BorderStyle <> lnbNone then
|
||||||
|
begin
|
||||||
|
ARect := ClientRect;
|
||||||
|
case BorderStyle of
|
||||||
|
lnbSingle:
|
||||||
|
begin
|
||||||
|
Canvas.Pen.Color := cl3DDkShadow;
|
||||||
|
Canvas.Frame(ARect);
|
||||||
|
end;
|
||||||
|
lnbSunken: Canvas.Frame3D(ARect, cl3DDkShadow, clBtnHiLight, 1);
|
||||||
|
lnbRaised: Canvas.Frame3D(ARect, clBtnHiLight, cl3DDkShadow, 1);
|
||||||
|
end;
|
||||||
|
inc(ARect.Left, 1);
|
||||||
|
inc(ARect.Top, 1);
|
||||||
|
inc(ARect.Right, 1);
|
||||||
|
inc(ARect.Bottom, 1);
|
||||||
|
Canvas.StretchDraw(ARect, lbDrawBMP);
|
||||||
|
end else
|
||||||
|
Canvas.Draw(0, 0, lbDrawBMP);
|
||||||
end;
|
end;
|
||||||
{=====}
|
{=====}
|
||||||
|
|
||||||
@ -330,8 +379,8 @@ begin
|
|||||||
end;
|
end;
|
||||||
{=====}
|
{=====}
|
||||||
|
|
||||||
procedure TCustomLEDNumber.SelectSegments(Segment: word; Points: array of TPoint;
|
procedure TCustomLEDNumber.SelectSegments(Segment: Word;
|
||||||
OffsetX, OffsetY: Integer);
|
Points: array of TPoint; OffsetX, OffsetY: Integer);
|
||||||
var
|
var
|
||||||
I : integer;
|
I : integer;
|
||||||
Bit : word;
|
Bit : word;
|
||||||
@ -475,7 +524,7 @@ begin
|
|||||||
end;
|
end;
|
||||||
{=====}
|
{=====}
|
||||||
|
|
||||||
procedure TCustomLEDNumber.SetBgColor(Value:TColor);
|
procedure TCustomLEDNumber.SetbgColor(Value: TColor);
|
||||||
begin
|
begin
|
||||||
if FBgColor <> Value then begin
|
if FBgColor <> Value then begin
|
||||||
FBgColor := Value;
|
FBgColor := Value;
|
||||||
|
Loading…
Reference in New Issue
Block a user