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

📄 qisevensegmentcharacter.pas

📁 iocopm3.04源码,一套很好的工控开发工具
💻 PAS
📖 第 1 页 / 共 3 页
字号:
{*******************************************************}
{                                                       }
{       TiSevenSegmentCharacter Component               }
{                                                       }
{       Copyright (c) 1997,2003 Iocomp Software         }
{                                                       }
{*******************************************************}
{$I iInclude.inc}

{$ifdef iVCL}unit  iSevenSegmentCharacter;{$endif}
{$ifdef iCLX}unit QiSevenSegmentCharacter;{$endif}

interface

uses
  {$I iIncludeUses.inc}
  {$IFDEF iVCL} iTypes,  iGPFunctions,  iMath,  iCustomComponent;{$ENDIF}
  {$IFDEF iCLX}QiTypes, QiGPFunctions, QiMath, QiCustomComponent;{$ENDIF}

type
  TSegment               = (segA, segB, segC, segD, segE, segF, segG);
  TSevenSegmentCharacter = (ssc0, ssc1, ssc2, ssc3, ssc4, ssc5, ssc6, ssc7, ssc8, ssc9, sscA, sscB, sscC, sscD, sscE, sscF,
                            sscPeriod, sscColon, sscPlus, sscMinus, sscBlank, sscLine, sscUpArrow, sscDownArrow, sscSemiColon, sscComma);
  TSegments = set of TSegment;

  TiSevenSegmentCharacter = class(TiCustomComponent)
  private
    FAutoSize            : Boolean;
    FSegmentMargin       : Integer;
    FShowOffSegments     : Boolean;
    FSegmentSeperation   : Integer;
    FSegmentSize         : Integer;
    FSegmentColor        : TColor;
    FValue               : TSevenSegmentCharacter;
    FPowerOff            : Boolean;
    FSegCOn              : Boolean;
    FSegDOn              : Boolean;
    FSegGOn              : Boolean;
    FSegAOn              : Boolean;
    FSegFOn              : Boolean;
    FSegBOn              : Boolean;
    FSegEOn              : Boolean;
    FUseSegmentBits      : Boolean;
    FAutoSegmentOffColor : Boolean;
    FSegmentOffColor     : TColor;
    FOnAutoSize          : TNotifyEvent;

    function  GetCharacter: Char;
    procedure DoAutoSize;
    procedure iSetAutoSize          (const Value: Boolean);
    procedure SetCharacter          (const AValue: Char);
    procedure SetSegmentMargin      (const Value: Integer);
    procedure SetSegmentSeperation  (const Value: Integer);
    procedure SetSegmentSize        (const Value: Integer);
    procedure SetSegmentColor       (const Value: TColor);
    procedure SetShowOffSegments    (const Value: Boolean);
    procedure SetValue              (const Value: TSevenSegmentCharacter);
    procedure SetPowerOff           (const Value: Boolean);
    procedure SetSegAOn             (const Value: Boolean);
    procedure SetSegBOn             (const Value: Boolean);
    procedure SetSegCOn             (const Value: Boolean);
    procedure SetSegDOn             (const Value: Boolean);
    procedure SetSegEOn             (const Value: Boolean);
    procedure SetSegFOn             (const Value: Boolean);
    procedure SetSegGOn             (const Value: Boolean);
    procedure SetUseSegmentBits     (const Value: Boolean);
    procedure SetAutoSegmentOffColor(const Value: Boolean);
    procedure SetSegmentOffColor    (const Value: TColor);
    function GetSegmentBits: Byte;
  protected
    procedure DrawSegments         (Canvas: TCanvas; OnColor, OffColor: TColor; Offset: TPoint; Segments: TSegments; AWidth, AHeight: Integer);
    procedure DrawSegmentA         (Canvas: TCanvas; Offset: TPoint; AColor: TColor; AWidth, AHeight: Integer);
    procedure DrawSegmentB         (Canvas: TCanvas; Offset: TPoint; AColor: TColor; AWidth, AHeight: Integer);
    procedure DrawSegmentC         (Canvas: TCanvas; Offset: TPoint; AColor: TColor; AWidth, AHeight: Integer);
    procedure DrawSegmentD         (Canvas: TCanvas; Offset: TPoint; AColor: TColor; AWidth, AHeight: Integer);
    procedure DrawSegmentE         (Canvas: TCanvas; Offset: TPoint; AColor: TColor; AWidth, AHeight: Integer);
    procedure DrawSegmentF         (Canvas: TCanvas; Offset: TPoint; AColor: TColor; AWidth, AHeight: Integer);
    procedure DrawSegmentG         (Canvas: TCanvas; Offset: TPoint; AColor: TColor; AWidth, AHeight: Integer);
    procedure DrawSegmentPeriod    (Canvas: TCanvas; Offset: TPoint; AColor: TColor; AWidth, AHeight: Integer);
    procedure DrawSegmentColon     (Canvas: TCanvas; Offset: TPoint; AColor: TColor; AWidth, AHeight: Integer);
    procedure DrawSegmentSemiColon (Canvas: TCanvas; Offset: TPoint; AColor: TColor; AWidth, AHeight: Integer);
    procedure DrawSegmentComma     (Canvas: TCanvas; Offset: TPoint; AColor: TColor; AWidth, AHeight: Integer);
    procedure DrawSegmentPlus      (Canvas: TCanvas; Offset: TPoint; AColor: TColor; AWidth, AHeight: Integer);
    procedure DrawSegmentMinus     (Canvas: TCanvas; Offset: TPoint; AColor: TColor; AWidth, AHeight: Integer);
    procedure DrawSegmentLine      (Canvas: TCanvas; Offset: TPoint; AColor: TColor; AWidth, AHeight: Integer);
    procedure DrawSegmentUpArrow   (Canvas: TCanvas; Offset: TPoint; AColor: TColor; AWidth, AHeight: Integer);
    procedure DrawSegmentDownArrow (Canvas: TCanvas; Offset: TPoint; AColor: TColor; AWidth, AHeight: Integer);
    procedure iPaintTo(Canvas: TCanvas);     override;
    procedure DoChange;
  public
    constructor Create(AOwner: TComponent);  override;
    procedure   Draw(Canvas: TCanvas; OffsetPoint: TPoint; AWidth, AHeight: Integer; AValue : TSevenSegmentCharacter);
    function    GetCharacterWidth  : Integer;
    function    GetCharacterHeight : Integer;
    function    ConvertCharacterToValue(AChar : Char): TSevenSegmentCharacter;
    procedure   SetSegmentBits(Value: Byte);
    property    OnAutoSize       : TNotifyEvent           read FOnAutoSize          write FOnAutoSize;
  published
    property AutoSize            : Boolean                read FAutoSize            write iSetAutoSize            default True;
    property Character           : Char                   read GetCharacter         write SetCharacter;
    property PowerOff            : Boolean                read FPowerOff            write SetPowerOff             default False;
    property SegmentColor        : TColor                 read FSegmentColor        write SetSegmentColor         default clLime;
    property SegmentMargin       : Integer                read FSegmentMargin       write SetSegmentMargin        default 2;
    property SegmentSeperation   : Integer                read FSegmentSeperation   write SetSegmentSeperation    default 1;
    property SegmentSize         : Integer                read FSegmentSize         write SetSegmentSize          default 1;
    property ShowOffSegments     : Boolean                read FShowOffSegments     write SetShowOffSegments      default True;
    property SegmentBits         : Byte                   read GetSegmentBits       write SetSegmentBits          default 0;
    property UseSegmentBits      : Boolean                read FUseSegmentBits      write SetUseSegmentBits       default False;
    property SegAOn              : Boolean                read FSegAOn              write SetSegAOn               default False;
    property SegBOn              : Boolean                read FSegBOn              write SetSegBOn               default False;
    property SegCOn              : Boolean                read FSegCOn              write SetSegCOn               default False;
    property SegDOn              : Boolean                read FSegDOn              write SetSegDOn               default False;
    property SegEOn              : Boolean                read FSegEOn              write SetSegEOn               default False;
    property SegFOn              : Boolean                read FSegFOn              write SetSegFOn               default False;
    property SegGOn              : Boolean                read FSegGOn              write SetSegGOn               default False;
    property Value               : TSevenSegmentCharacter read FValue               write SetValue;
    property SegmentOffColor     : TColor                 read FSegmentOffColor     write SetSegmentOffColor      default $00008000;
    property AutoSegmentOffColor : Boolean                read FAutoSegmentOffColor write SetAutoSegmentOffColor  default True;
    property BackGroundColor                                                                                      default clBlack;
    property Transparent;
  end;

implementation
//****************************************************************************************************************************************************
constructor TiSevenSegmentCharacter.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);

  FSegmentColor        := clLime;
  FSegmentOffColor     := $00008000;
  FAutoSegmentOffColor := True;

  BackGroundColor      := clBlack;

  FAutoSize            := True;
  FShowOffSegments     := True;
  FSegmentMargin       := 2;
  FSegmentSize         := 1;
  FSegmentSeperation   := 1;
  DoAutoSize;
end;
//****************************************************************************************************************************************************
procedure TiSevenSegmentCharacter.DoChange;
begin
  if Assigned(OnChangeProtected) then OnChangeProtected(Self, 'Value');
end;
//****************************************************************************************************************************************************
procedure TiSevenSegmentCharacter.SetSegAOn             (const Value:Boolean);begin SetBooleanProperty(Value,FSegAOn,             irtInvalidate);end;
procedure TiSevenSegmentCharacter.SetSegBOn             (const Value:Boolean);begin SetBooleanProperty(Value,FSegBOn,             irtInvalidate);end;
procedure TiSevenSegmentCharacter.SetSegCOn             (const Value:Boolean);begin SetBooleanProperty(Value,FSegCOn,             irtInvalidate);end;
procedure TiSevenSegmentCharacter.SetSegDOn             (const Value:Boolean);begin SetBooleanProperty(Value,FSegDOn,             irtInvalidate);end;
procedure TiSevenSegmentCharacter.SetSegEOn             (const Value:Boolean);begin SetBooleanProperty(Value,FSegEOn,             irtInvalidate);end;
procedure TiSevenSegmentCharacter.SetSegFOn             (const Value:Boolean);begin SetBooleanProperty(Value,FSegFOn,             irtInvalidate);end;
procedure TiSevenSegmentCharacter.SetSegGOn             (const Value:Boolean);begin SetBooleanProperty(Value,FSegGOn,             irtInvalidate);end;
procedure TiSevenSegmentCharacter.SetUseSegmentBits     (const Value:Boolean);begin SetBooleanProperty(Value,FUseSegmentBits,     irtInvalidate);end;
procedure TiSevenSegmentCharacter.SetAutoSegmentOffColor(const Value:Boolean);begin SetBooleanProperty(Value,FAutoSegmentOffColor,irtInvalidate);end;
procedure TiSevenSegmentCharacter.SetShowOffSegments    (const Value:Boolean);begin SetBooleanProperty(Value,FShowOffSegments,    irtInvalidate);end;
procedure TiSevenSegmentCharacter.SetPowerOff           (const Value:Boolean);begin SetBooleanProperty(Value,FPowerOff,           irtInvalidate);end;
procedure TiSevenSegmentCharacter.SetSegmentOffColor    (const Value:TColor );begin SetColorProperty  (Value,FSegmentOffColor,    irtInvalidate);end;
procedure TiSevenSegmentCharacter.SetSegmentColor       (const Value:TColor );begin SetColorProperty  (Value,FSegmentColor,       irtInvalidate);end;
//****************************************************************************************************************************************************
function TiSevenSegmentCharacter.GetCharacterWidth : Integer;
begin
  case FValue of
    sscPeriod    : Result := 2*FSegmentMargin + FSegmentSize * 2;
    sscColon     : Result := 2*FSegmentMargin + FSegmentSize * 2;
    sscSemiColon : Result := 2*FSegmentMargin + FSegmentSize * 2;
    sscComma     : Result := 2*FSegmentMargin + FSegmentSize * 2;
    else           Result := 2*FSegmentMargin + FSegmentSize * 10;
  end;
end;
//****************************************************************************************************************************************************
function TiSevenSegmentCharacter.GetCharacterHeight : Integer;
begin
  Result := 2*FSegmentMargin + FSegmentSize * 18;
end;
//****************************************************************************************************************************************************
procedure TiSevenSegmentCharacter.DoAutoSize;
begin
  if not Loading then
    begin
      if FAutoSize then
        begin
          Height := GetCharacterHeight + 1;
          Width  := GetCharacterWidth  + 1;

          if Assigned(FOnAutoSize) then FOnAutoSize(Self);
        end;
    end;
end;
//****************************************************************************************************************************************************
procedure TiSevenSegmentCharacter.iSetAutoSize(const Value: Boolean);
begin
  if FAutoSize <> Value then
    begin
      FAutoSize := Value;
      DoAutoSize;
      InvalidateChange;
    end;
end;
//****************************************************************************************************************************************************
procedure TiSevenSegmentCharacter.SetValue(const Value : TSevenSegmentCharacter);
var
  CanEdit : Boolean;
begin
  if FValue <> Value then
    begin
      CanEdit := True;
      if Assigned(OnRequestEditProtected) then OnRequestEditProtected(Self, 'Value', CanEdit);
      if CanEdit then
        begin
          FValue := Value;
          InvalidateChange;
          DoAutoSize;
          DoChange;
        end;
    end;
end;
//****************************************************************************************************************************************************
procedure TiSevenSegmentCharacter.SetSegmentSize(const Value : Integer);
begin
  if FSegmentSize <> Value then
    begin
      FSegmentSize := Value;
      if FSegmentSize < 1 then FSegmentSize := 1;
      DoAutoSize;

⌨️ 快捷键说明

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