jvsegmentedleddisplay.pas

East make Tray Icon in delphi

{-----------------------------------------------------------------------------
The contents of this file are subject to the Mozilla Public License
Version 1.1 (the "License"); you may not use this file except in compliance
with the License. You may obtain a copy of the License at
http://www.mozilla.org/MPL/MPL-1.1.html

Software distributed under the License is distributed on an "AS IS" basis,
WITHOUT WARRANTY OF ANY KIND, either expressed or implied. See the License for
the specific language governing rights and limitations under the License.

The Original Code is: JvSegmentedLEDDisplay.pas, released on --.

The Initial Developer of the Original Code is Marcel Bestebroer
Portions created by Marcel Bestebroer are Copyright (C) 2002 - 2003 Marcel
Bestebroer
All Rights Reserved.

Contributor(s):
  Jay Dubal

You may retrieve the latest version of this file at the Project JEDI's JVCL home page,
located at http://jvcl.sourceforge.net

Known Issues:
  * Automatic unlit color calculation is not working properly. Maybe a function in JclGraphUtil
    can help out there.
-----------------------------------------------------------------------------}
// $Id: JvSegmentedLEDDisplay.pas,v 1.51 2005/02/17 10:20:52 marquardt Exp $

unit JvSegmentedLEDDisplay;

{$I jvcl.inc}

interface

uses
  {$IFDEF UNITVERSIONING}
  JclUnitVersioning,
  {$ENDIF UNITVERSIONING}
  {$IFDEF MSWINDOWS}
  Windows,
  {$ENDIF MSWINDOWS}
  Classes, Graphics, 
  {$IFDEF VisualCLX}
  QWindows,
  {$ENDIF VisualCLX}
  JclBase,
  JvComponent, JvTypes;

// Additional color values for unlit color settings (TUnlitColor type)
// asn: does this work with clx/linux?
const
  clDefaultBackground = TColor($20100001);
  clDefaultLitColor = TColor($20100002);
  {$IFDEF VCL}
  NullHandle = 0;
  {$ENDIF VCL}
  {$IFDEF VisualCLX}
  NullHandle = nil;
  {$ENDIF VisualCLX}
  
type
  TJvCustomSegmentedLEDDisplay = class;
  TJvSegmentedLEDDigits = class;
  TJvCustomSegmentedLEDDigit = class;
  TJvSegmentedLEDCharacterMapper = class;

  TJvSegmentedLEDDigitClass = class of TJvCustomSegmentedLEDDigit;

  TJvSegmentedLEDDigitClassName = type string;
  TUnlitColor = type TColor;
  TSlantAngle = 0 .. 44;
  TSLDHitInfo = (shiNowhere, shiDigit, shiDigitSegment, shiClientArea);
  TCharSet = set of Char;
  TSegCharMapHeader = record
    ID: array[0..11] of Char;
    MappedChars: TCharSet;
    Flags: Longint;
  end;

  TSegmentRenderType = (srtNone, srtPolygon, srtRect, srtCircle);
  TPointArray = array of TPoint;

  TSegmentRenderInfo = record
    RenderType: TSegmentRenderType;
    Points: TPointArray;
  end;
  TSegmentRenderInfoArray = array of TSegmentRenderInfo;

  EJVCLSegmentedLEDException = class(EJVCLException);

  TJvCustomSegmentedLEDDisplay = class(TJvGraphicControl)
  private
    FCharacterMapper: TJvSegmentedLEDCharacterMapper;
    FDigitClass: TJvSegmentedLEDDigitClass;
    FDigits: TJvSegmentedLEDDigits;
    FDotSize: Integer;
    FDigitHeight: Integer;
    FDigitSpacing: Integer;
    FDigitWidth: Integer;
    FMaxBaseTop: Integer;
    FSegmentLitColor: TColor;
    FSegmentSpacing: Integer;
    FSegmentThickness: Integer;
    FSegmentUnlitColor: TUnlitColor;
    FSlant: TSlantAngle;
    FText: string;
    {$IFDEF VisualCLX}
    FAutoSize: Boolean;
    procedure SetAutoSize(Value: Boolean);
    {$ENDIF VisualCLX}
  protected
    procedure DefineProperties(Filer: TFiler); override;
    procedure Loaded; override;
    procedure Paint; override;
    function GetText: string;
    procedure SetText(Value: string);
    procedure SetDigitHeight(Value: Integer);
    procedure SetDigits(Value: TJvSegmentedLEDDigits);
    procedure SetDigitSpacing(Value: Integer);
    procedure SetDigitWidth(Value: Integer);
    procedure SetDigitClass(Value: TJvSegmentedLEDDigitClass);
    procedure SetDotSize(Value: Integer);
    procedure SetSegmentLitColor(Value: TColor);
    procedure SetSegmentSpacing(Value: Integer);
    procedure SetSegmentThickness(Value: Integer);
    procedure SetSegmentUnlitColor(Value: TUnlitColor);
    procedure SetSlant(Value: TSlantAngle);
    function GetDigitClassName: TJvSegmentedLEDDigitClassName;
    procedure SetDigitClassName(Value: TJvSegmentedLEDDigitClassName);
    function GetRealUnlitColor: TColor;
    function CalcRealUnlitColorBackground: TColor;
    function CalcRealUnlitColorLitColor: TColor;
    procedure PrimSetText(Value: string);
    procedure BaseTopChanged;
    procedure HeightChanged;
    procedure UpdateDigitsPositions;
    procedure InvalidateDigits;
    procedure InvalidateView;
    procedure UpdateText;
    procedure UpdateBounds;
    {$IFDEF VCL}
    property AutoSize default True;
    {$ENDIF VCL}
    {$IFDEF VisualCLX}
    property AutoSize: Boolean read FAutoSize write SetAutoSize default True;
    {$ENDIF VisualCLX}
    property CharacterMapper: TJvSegmentedLEDCharacterMapper read FCharacterMapper;
    property DigitClass: TJvSegmentedLEDDigitClass read FDigitClass write SetDigitClass;
    // Solely needed for design time support of DigitClass
    property DigitClassName: TJvSegmentedLEDDigitClassName read GetDigitClassName write SetDigitClassName;
    property DigitHeight: Integer read FDigitHeight write SetDigitHeight default 30;
    property Digits: TJvSegmentedLEDDigits read FDigits write SetDigits;
    property DigitSpacing: Integer read FDigitSpacing write SetDigitSpacing default 2;
    property DigitWidth: Integer read FDigitWidth write SetDigitWidth default 20;
    property DotSize: Integer read FDotSize write SetDotSize default 4;
    property SegmentLitColor: TColor read FSegmentLitColor write SetSegmentLitColor default clWindowText;
    property SegmentSpacing: Integer read FSegmentSpacing write SetSegmentSpacing default 2;
    property SegmentThickness: Integer read FSegmentThickness write SetSegmentThickness default 2;
    property SegmentUnlitColor: TUnlitColor read FSegmentUnlitColor write SetSegmentUnlitColor default clDefaultLitColor;
    property Slant: TSlantAngle read FSlant write SetSlant default 0;
    property Text: string read GetText write SetText;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure RemapText;
    function GetHitInfo(X, Y: Integer): TSLDHitInfo; overload;
    function GetHitInfo(X, Y: Integer; out Digit: TJvCustomSegmentedLEDDigit;
      out SegmentIndex: Integer): TSLDHitInfo; overload;
  end;

  TJvSegmentedLEDDisplay = class(TJvCustomSegmentedLEDDisplay)
  public
    property DigitClass;
  published
    property Align;
    property Anchors;
    property AutoSize;
    property Color;
    property DigitClassName;
    property DigitHeight;
    property Digits;
    property DigitSpacing;
    property DigitWidth;
    property DotSize;
    property ParentColor;
    property PopupMenu;
    property SegmentLitColor;
    property SegmentSpacing;
    property SegmentThickness;
    property SegmentUnlitColor;
    property Slant;
    property Text;
    property OnClick;
    property OnContextPopup;
    property OnDblClick;
    property OnMouseDown;
    property OnMouseMove;
    property OnMouseUp;
  end;

  TJvSegmentedLEDDigits = class(TOwnedCollection)
  protected
    function GetItem(Index: Integer): TJvCustomSegmentedLEDDigit;
    procedure SetItem(Index: Integer; Value: TJvCustomSegmentedLEDDigit);
    function Display: TJvCustomSegmentedLEDDisplay;
    procedure Update(Item: TCollectionItem); override;
  public
    constructor Create(AOwner: TPersistent);
    property Items[Index: Integer]: TJvCustomSegmentedLEDDigit read GetItem write SetItem; default;
  end;

  TJvCustomSegmentedLEDDigit = class(TCollectionItem)
  private
    FLeft: Integer;
    FRecalcNeeded: Boolean;
    FVertAdjust: Integer;
    FSegmentStates: Int64;
    FSegmentRenderInfo: TSegmentRenderInfoArray;
    FText: string;
  protected
    // Quick access to Display specified values (slant angle, digit spacing, etc)
    DotSize: Integer;
    SegmentWidth: Integer;
    SlantAngle: Integer;
    Spacing: Integer;
    MaxSlantDif: Integer;
    function GetBaseTop: Integer; virtual;
    procedure SetBaseTop(Value: Integer); virtual;
    function GetHeight: Integer; virtual;
    function GetVertAdjust: Integer;
    procedure SetVertAdjust(Value: Integer);
    procedure SetIndex(Value: Integer); override;
    function GetLeft: Integer;
    procedure SetLeft(Value: Integer);
    function GetWidth: Integer; virtual;
    procedure SetText(Value: string); virtual;

    procedure EnableAllSegs; dynamic;
    function GetSegmentRenderInfo(Index: Integer; out RenderType: TSegmentRenderType;
      out Points: TPointArray): Boolean;
    procedure SetSegmentRenderInfo(Index: Integer; RenderType: TSegmentRenderType;
      Points: array of TPoint);
    function GetSegmentState(Index: Integer): Boolean;
    procedure SetSegmentState(Index: Integer; Value: Boolean);
    procedure SetSegmentStates(Value: Int64);
    procedure UpdateText(Value: string);
    procedure RecalcRefPoints; virtual; abstract;
    procedure RecalcSegments; virtual; abstract;
    function GetLitSegColor(Index: Integer): TColor; virtual;
    function GetUnlitSegColor(Index: Integer): TColor; virtual;
    function GetSegmentColor(Index: Integer): TColor;
    function Display: TJvCustomSegmentedLEDDisplay;
    procedure Invalidate;
    procedure InvalidateStates;
    procedure InvalidateRefPoints; virtual;
    function NeedsPainting: Boolean;
    procedure Paint;
    procedure PaintSegment(Index: Integer);

    class function MapperFileID: string; virtual;

    property BaseTop: Integer read GetBaseTop;
    property Height: Integer read GetHeight;
    property Left: Integer read GetLeft;
    property VertAdjust: Integer read GetVertAdjust;
    property Width: Integer read GetWidth;
    property Text: string read FText write SetText stored False;

    property RecalcNeeded: Boolean read FRecalcNeeded;
  public
    constructor Create(Collection: TCollection); override;
    function GetHitInfo(X, Y: Integer): TSLDHitInfo; overload;
    function GetHitInfo(X, Y: Integer; out SegmentIndex: Integer): TSLDHitInfo; overload;
    function PtInSegment(SegmentIndex: Integer; Pt: TPoint): Boolean; virtual;
    class function SegmentCount: Integer; virtual;
    class function GetSegmentName(Index: Integer): string; virtual;
    class function GetSegmentIndex(Name: string): Integer; virtual;
    function GetSegmentStates: Int64;
    function GetSegmentString: string; virtual; abstract;
  end;

  TJvBaseSegmentedLEDDigit = class(TJvCustomSegmentedLEDDigit)
  private
    FDPWidth: Integer;
    FUseDP: Boolean;
  protected
    // Reference points coordinates. Protected fields allows easier read/write access in descendants.
    FRefLeft: Integer;
    FRefCenterX: Integer;
    FRefRight: Integer;
    FRefTop: Integer;
    FRefCenterY: Integer;
    FRefBottom: Integer;
    procedure EnableAllSegs; override;
    procedure SetUseDP(Value: Boolean); virtual;
    function GetDPWidth: Integer;
    procedure SetDPWidth(Value: Integer);
    procedure UpdateDPWidth; virtual;
    procedure CalcASeg(Index: Integer); virtual;
    procedure CalcBSeg(Index: Integer); virtual;
    procedure CalcCSeg(Index: Integer); virtual;
    procedure CalcDSeg(Index: Integer); virtual;
    procedure CalcESeg(Index: Integer); virtual;
    procedure CalcFSeg(Index: Integer); virtual;
    procedure CalcGSeg(Index: Integer); virtual;
    procedure CalcDPSeg(Index: Integer); virtual;
    function GetWidth: Integer; override;
    procedure InvalidateRefPoints; override;
    procedure RecalcRefPoints; override;
    procedure RecalcSegments; override;

    property DPWidth: Integer read GetDPWidth write SetDPWidth;
    property UseDP: Boolean read FUseDP write SetUseDP;
  public
    class function SegmentCount: Integer; override;
    class function GetSegmentName(Index: Integer): string; override;
    class function GetSegmentIndex(Name: string): Integer; override;
    function GetSegmentString: string; override;
  end;

  TJvSegmentedLEDCharacterMapper = class(TPersistent)
  private
    FCurDigit: TJvCustomSegmentedLEDDigit;
    FTextForDigit: string;
    FSegMapRemoves: Boolean;
    FActiveMapping: array[Char] of Int64;
    FMappingChanged: Boolean;
    FDisplay: TJvCustomSegmentedLEDDisplay;
  protected
    function GetCharMapping(Chr: Char): Int64;
    procedure SetCharMapping(Chr: Char; Value: Int64);
    function MaxSegments: Integer; dynamic;
    function MapToSeparators: Boolean; dynamic;
    procedure PrimReadMapping(const HdrInfo: TSegCharMapHeader; Stream: TStream); dynamic;
    function UpdateStates(var Segments: Int64; SegMask: Int64): Boolean;
    procedure HandleDecimalSeparator(var Text: PChar; var Segments: Int64); virtual;
    function CharToSegments(Ch: Char; var Segments: Int64): Boolean; virtual;
    procedure ControlItemToSegments(var ControlItem: PChar; var Segments: Int64); virtual;
    procedure MapControlItems(var Text: PChar; var Segments: Int64); virtual;
    procedure MapSimpleText(var Text: PChar; var Segments: Int64); virtual;
    procedure MapSegNamesToSegments(var Text: PChar; var Segments: Int64); virtual;
    procedure PrimMapText(var Text: PChar; var Segments: Int64); virtual;
    procedure Modified;

    property CurDigit: TJvCustomSegmentedLEDDigit read FCurDigit;
    property Display: TJvCustomSegmentedLEDDisplay read FDisplay;
    property SegMapRemoves: Boolean read FSegMapRemoves write FSegMapRemoves;
    property TextForDigit: string read FTextForDigit write FTextForDigit;
    property MappingChanged: Boolean read FMappingChanged;
  public
    constructor Create(ADisplay: TJvCustomSegmentedLEDDisplay);
    procedure MapText(var Text: PChar; ADigit: TJvCustomSegmentedLEDDigit);
    procedure Clear;
    procedure LoadDefaultMapping; dynamic;
    procedure LoadFromFile(const FileName: string);
    procedure LoadFromStream(Stream: TStream);
    procedure SaveToFile(const FileName: string);
    procedure SaveToStream(Stream: TStream); dynamic;

    property CharMapping[Chr: Char]: Int64 read GetCharMapping write SetCharMapping;
  end;

  // 7-segmented digit
  T7SegColonUsage = (scuNone, scuLowOnly, scuFull, scuColonOnly);
  TJv7SegmentedLEDDigit = class(TJvBaseSegmentedLEDDigit)
  private
    FUseColon: T7SegColonUsage;
  protected
    procedure EnableAllSegs; override;
    function GetUseColon: T7SegColonUsage;
    procedure SetUseColon(Value: T7SegColonUsage);
    procedure RecalcSegments; override;
    class function MapperFileID: string; override;
    procedure CalcCHSeg(Index: Integer); virtual;
    procedure CalcCLSeg(Index: Integer); virtual;
  public
    class function SegmentCount: Integer; override;
    class function GetSegmentName(Index: Integer): string; override;
    class function GetSegmentIndex(Name: string): Integer; override;
  published
    property UseDP;
    property UseColon: T7SegColonUsage read GetUseColon write SetUseColon;
    property Text;
  end;

// TUnlitColor support routines
function IdentToUnlitColor(const Ident: string; var Int: Longint): Boolean;
function UnlitColorToIdent(Int: Longint; var Ident: string): Boolean;
function StringToUnlitColor(const S: string): TUnlitColor;
function UnlitColorToString(const Color: TUnlitColor): string;
// DigitClass registration routines
function DigitClassList: TThreadList;
procedure RegisterSegmentedLEDDigitClass(DigitClass: TJvSegmentedLEDDigitClass);
procedure RegisterSegmentedLEDDigitClasses(DigitClasses: array of TJvSegmentedLEDDigitClass);
procedure UnregisterSegmentedLEDDigitClass(DigitClass: TJvSegmentedLEDDigitClass);
procedure UnregisterSegmentedLEDDigitClasses(DigitClasses: array of TJvSegmentedLEDDigitClass);
procedure UnregisterModuleSegmentedLEDDigitClasses(Module: HMODULE);

{$IFDEF UNITVERSIONING}
const
  UnitVersioning: TUnitVersionInfo = (
    RCSfile: '$RCSfile: JvSegmentedLEDDisplay.pas,v $';
    Revision: '$Revision: 1.51 $';
    Date: '$Date: 2005/02/17 10:20:52 $';
    LogPath: 'JVCL\run'
  );
{$ENDIF UNITVERSIONING}

implementation

uses
  Controls, SysUtils,
  JclGraphUtils,
  JvThemes, JvConsts, JvResources;

{$IFDEF MSWINDOWS}
{$R ..\Resources\JvSegmentedLEDDisplay.res}
{$ENDIF MSWINDOWS}
{$IFDEF UNIX}
{$R ../Resources/JvSegmentedLEDDisplay.res}
{$ENDIF UNIX}

var
  GDigitClassList: TThreadList = nil;

//=== DigitClass registration routines =======================================

function DigitClassList: TThreadList;
begin
  if GDigitClassList = nil then
    GDigitClassList := TThreadList.Create;
  Result := GDigitClassList;
end;

procedure RegisterSegmentedLEDDigitClass(DigitClass: TJvSegmentedLEDDigitClass);
begin
  with DigitClassList.LockList do
  try
    if IndexOf(DigitClass) > -1 then
      raise EJVCLSegmentedLEDException.CreateRes(@RsEDuplicateDigitClass);
    Add(DigitClass);
    Classes.RegisterClass(DigitClass);
  finally
    DigitClassList.UnlockList;
  end;
end;

procedure RegisterSegmentedLEDDigitClasses(DigitClasses: array of TJvSegmentedLEDDigitClass);
var
  I: Integer;
begin
  for I := Low(DigitClasses) to High(DigitClasses) do
    RegisterSegmentedLEDDigitClass(DigitClasses[I]);
end;

procedure UnregisterSegmentedLEDDigitClass(DigitClass: TJvSegmentedLEDDigitClass);
begin
  DigitClassList.Remove(DigitClass);
end;

procedure UnregisterSegmentedLEDDigitClasses(DigitClasses: array of TJvSegmentedLEDDigitClass);
var
  I: Integer;
begin
  for I := Low(DigitClasses) to High(DigitClasses) do
    UnregisterSegmentedLEDDigitClass(DigitClasses[I]);
end;

procedure UnregisterModuleSegmentedLEDDigitClasses(Module: HMODULE);
{$IFDEF UNIX}
begin
  // ?
end;
{$ENDIF UNIX}
{$IFDEF MSWINDOWS}
var
  I: Integer;
  M: TMemoryBasicInformation;
begin
  with DigitClassList.LockList do
  try
    for I := Count - 1 downto 0 do
    begin
      VirtualQuery(Items[I], M, SizeOf(M));
      if (Module = 0) or (HMODULE(M.AllocationBase) = Module) then
        Delete(I);
    end;
  finally
    DigitClassList.UnlockList;
  end;
end;
{$ENDIF MSWINDOWS}


//=== Helper routine: AngleAdjustPoint =======================================

function AngleAdjustPoint(X, Y, Angle: Integer): TPoint;