⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 cledlbl.~pas

📁 cledlabel component let you add 7 segment edit box to your application. I added floatingpointformat
💻 ~PAS
📖 第 1 页 / 共 2 页
字号:
{
   TCLEDLabel Ver 0.97
   (c) Calibre Technologies
       By Tejasvi Hegde
       28-Sept-2000

   Purpose:
        Provides Multi Character 7 Segment LED Display

   Please Send me Feed back for improvements.
   tejasvi@calibretechnologies.com

   Thanks to
   Aaron Castro  for Adding Minus Sign and Decimal Degits

}

unit CLEDLbl;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, strutils;

type
  TOnOff     = (TofOff,TofOn);
  TTextAlign = (TTALeft,TTARight);
  TCharSegmentSet = set of 0{1}..7;
  TCharSegment = TCharSegmentSet;
  TCLEDLabel = class(TGraphicControl)
  private
    { Private declarations }
    FAllowDecimal: bool; {+AMC}
    fPoints   : array [1..6] of TPoint;
    fBorderGap : Integer;
    fSegmentThickness : Integer;
    fHorzMargine   : Integer;
    fVertMargine   : Integer;
    fOnColor       : TColor;
    fOffColor      : TColor;
    fPenColor      : TColor;
    fBackColor     : TColor;
    fText          : String;
    fNumChars      : Integer;
    fTextAlign     : TTextAlign;
  protected
    { Protected declarations }
    procedure Paint; override;
    procedure MakeSegments(dChar : Char;var dSegment : TCharSegment);
    procedure DrawSegments(dSegment : TCharSegment;SegmentRect : TRect);
    procedure DrawSegment(dSegNum : Integer;dState : TOnOff; const SegmentRect : TRect);
    procedure DispStr;


    procedure SetBorderGap(dVal : Integer);
    procedure SetSegmentThickness(dVal : Integer);
    procedure SetHorzMargine(dVal : Integer);
    procedure SetVertMargine(dVal : Integer);
    procedure SetOnColor(dVal : TColor);
    procedure SetOffColor(dVal : TColor);
    procedure SetPenColor(dVal : TColor);
    procedure SetBackColor(dVal : TColor);
    procedure SetText(dVal : String);
    procedure SetNumChars(dVal : Integer);
    procedure SetTextAlign(dVal : TTextAlign);
    procedure SetAllowDecimal(dVal: bool);
  public
    { Public declarations }
    constructor Create(AOwner: TComponent); override;
    destructor  Destroy; override;
    function FloatFormat(thefloat : single) : string;
  published
    { Published declarations }
    property Alignment       : TTextAlign read fTextAlign write SetTextAlign;
    property BorderGap : Integer read fBorderGap write SetBorderGap;
    property SegmentThickness : Integer read fSegmentThickness write SetSegmentThickness;
    property HorzMargine   : Integer read fHorzMargine write SetHorzMargine;
    property VertMargine   : Integer read fVertMargine write SetVertMargine;
    property OnColor       : TColor read fOnColor write SetOnColor;
    property BackGroundColor    : TColor read fBackColor write SetBackColor;
    property OffColor      : TColor read fOffColor write SetOffColor;
    property SegmentBorderColor : TColor read fPenColor write SetPenColor;
    property Text          : String read fText write SetText;
    property NumChars      : Integer read fNumChars write SetNumChars;
    property AllowDecimal  : bool read FAllowDecimal write SetAllowDecimal;

  end;

procedure Register;

implementation


procedure Register;
begin
  RegisterComponents('calibre', [TCLEDLabel]);
end;

function Padr(s : String;numPad : Integer) : String;
var
   i,l    : Integer;
begin
      l := numPad-Length(s);
      Result := s;
      for i := 1 to l do
          Result := Result+' ';
end;
function Padl(s : String;numPad : Integer) : String;
var
   i,l    : Integer;
begin
     Result := '';
      l := numPad-Length(s);
      for i := 1 to l do
          Result := Result+' ';
     Result := Result + s;
end;

constructor TCLedLabel.Create(AOwner: TComponent);
begin
    Inherited Create(AOwner);
    FAllowDecimal := True; {+AMC}
    fBorderGap := 1;
    fSegmentThickness  := 2;
    fHorzMargine   := 1;
    fVertMargine   := 2;
    fOnColor       := clRed;
    fOffColor      := clMaroon;
    fPenColor      := clRed;
    fText          := '8';
    fBackColor     := clBlack;
    fNumChars      := 1;
    fTextAlign     := TTARight;
    Height         := 34;
    Width          := 15;
end;

destructor TCLedLabel.Destroy;
begin

    Inherited Destroy;
end;

procedure TCLedLabel.DrawSegment(dSegNum : Integer;dState : TOnOff; const SegmentRect : TRect);
var
   Ht,Wt                 : Integer;
   Lt,Rt,Tp,Bt           : Integer;
   VertCentre            : Integer;
//   HorzCentre            : Integer;
   SegHalf               : Integer;
begin

        Wt := SegmentRect.Right - SegmentRect.Left;
        Ht := SegmentRect.Bottom - SegmentRect.Top;

        Lt := SegmentRect.Left+fBorderGap;
        if (not FAllowDecimal) {+AMC}
            then Rt := SegmentRect.Right-fBorderGap-1
            else Rt := SegmentRect.Right-fBorderGap - 1 - (fSegmentThickness * 2); //move in a seg and a half
//        Rt := SegmentRect.Right-fBorderGap-1;
        Tp := SegmentRect.Top+fBorderGap;
        Bt := Ht-fBorderGap-1;

        VertCentre := ((Bt - Tp) div 2);
//        HorzCentre := (Rt - Lt) div 2;
        SegHalf    := (fSegmentThickness div 2);

     if dState = TofOn then
     begin
        canvas.Brush.Color := fOnColor;
        canvas.Pen.Color := fPenColor;
     end
     else
     begin
          canvas.Brush.Color := fOffColor;
          canvas.Pen.Color := fOffColor;
     end;

     case dSegNum of
          0 :
            begin
                 fPoints[1].x := Rt + fSegmentThickness{SegHalf};
                 fPoints[1].y := Bt - (VertCentre div 2);// - (fSegmentThickness * 2);

                 fPoints[2].x := Rt + SegHalf + fSegmentThickness * 2;// - (SegHalf + fSegmentThickness);
                 fPoints[2].y := Bt;

                 Canvas.Ellipse(fPoints[1].x, fPoints[1].y, fPoints[2].x, fPoints[2].y);
            end;
          3 :
            begin
                 fPoints[1].x := Lt + fHorzMargine;
                 fPoints[1].y := Tp;

                 fPoints[2].x := Rt - fHorzMargine;
                 fPoints[2].y := Tp;

                 fPoints[3].x := fPoints[2].x - fSegmentThickness;
                 fPoints[3].y := fPoints[2].y + fSegmentThickness;

                 fPoints[4].x := fPoints[1].x + fSegmentThickness;
                 fPoints[4].y := fPoints[1].y + fSegmentThickness;

                 Canvas.Polygon(Slice(fPoints,4));
            end;

           4 :
            begin
                 fPoints[1].x := Lt ;
                 fPoints[1].y := Tp+fVertMargine;

                 fPoints[2].x := Lt;
                 fPoints[2].y := Tp+VertCentre-fVertMargine;

                 fPoints[3].x := fPoints[2].x + fSegmentThickness;
                 fPoints[3].y := fPoints[2].y - fSegmentThickness;

                 fPoints[4].x := fPoints[1].x + fSegmentThickness;
                 fPoints[4].y := fPoints[1].y + fSegmentThickness;

                 Canvas.Polygon(Slice(fPoints,4));
            end;

            5:
             begin
                  fPoints[1].x := Lt ;
                  fPoints[1].y := Tp+fVertMargine+VertCentre;

                  fPoints[2].x := Lt;
                  fPoints[2].y := Tp+VertCentre-fVertMargine+VertCentre;

                  fPoints[3].x := fPoints[2].x + fSegmentThickness;
                  fPoints[3].y := fPoints[2].y - fSegmentThickness;

                  fPoints[4].x := fPoints[1].x + fSegmentThickness;
                  fPoints[4].y := fPoints[1].y + fSegmentThickness;

                  Canvas.Polygon(Slice(fPoints,4));
             end;

             6:
              begin
                   fPoints[1].x := Lt + fHorzMargine;
                   fPoints[1].y := Tp+VertCentre+VertCentre;

                   fPoints[2].x := Rt - fHorzMargine;
                   fPoints[2].y := fPoints[1].y;

                   fPoints[3].x := fPoints[2].x - fSegmentThickness;
                   fPoints[3].y := fPoints[2].y - fSegmentThickness;

                   fPoints[4].x := fPoints[1].x + fSegmentThickness;
                   fPoints[4].y := fPoints[1].y - fSegmentThickness;

                   Canvas.Polygon(Slice(fPoints,4));
              end;

              2:
               begin

                    fPoints[1].x := Rt;
                    fPoints[1].y := Tp+fVertMargine;

                    fPoints[2].x := fPoints[1].x;
                    fPoints[2].y := Tp+VertCentre-fVertMargine;

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -