lazarus-ccr/components/industrialstuff/source/indlcddisplay.pas

{
 *****************************************************************************
  See the file COPYING.modifiedLGPL.txt, included in your Lazarus installation
  for details about the license.
 *****************************************************************************
 Based on LCDLine by Yuriy Tereshchenko
 Initial Lazarus port and multi-line extension: Boban Spasic (spasic@gmail.com)
 Further optimizations and extensions: Werner Pamler
}
unit indLCDDisplay;

interface

uses
  SysUtils, Classes, Controls, fgl, Graphics, LCLIntf, 
  laz2_dom, laz2_xmlwrite, laz2_xmlread;

type
  TFrameStyle = (fsRelief, fsNone, fsLowered, fsRaised);
  TFrameColorStyle = (stWindows, stColor);
  TFrameHeight = (fhDouble, fhSingle);
  TDotShape = (stSquare, stRound);
  TColorScheme = (csCustom, csBlue, csGreen, csInvGreen);

type
  TLCDDisplay = class;
  
  TDotRow = integer;
  TDotRows = array of TDotRow;
  TDotMatrixList = specialize TFPGMap<string, TDotRows>;
  
  TCharDefs = class(TPersistent)
  private
    FLCDDisplay: TLCDDisplay;
    FCharList: TDotMatrixList;
    FColCount: Integer;
    FRowCount: Integer;
    function GetCharByIndex(AIndex: Integer): String;
    function GetCount: Integer;
    function GetDotRows(AChar: String): TDotRows;
    function GetDotRowsByIndex(AIndex: Integer): TDotRows;
    procedure SetColCount(AValue: Integer);
    procedure SetDotRows(AChar: String; const AValue: TDotRows);
    procedure SetRowCount(AValue: Integer);
    function EmptyRows: TDotRows;
    procedure ReadCharDefs(Reader: TReader);
    procedure WriteCharDefs(Writer: TWriter);
  protected
    procedure DefineProperties(Filer: TFiler); override;
  public
    constructor Create(ADisplay: TLCDDisplay);
    destructor Destroy; override;
    procedure Add(AChar: String; ADotRows: TDotRows);
    procedure Assign(ASource: TPersistent); override;
    procedure Clear;
    procedure Delete(AChar: String);
    procedure LoadFromFile(const AFileName: String);
    function SameDotRows(const AChar: String; const ADotRows: TDotRows): Boolean;
    procedure SaveToFile(const AFileName: String);
    property Count: Integer read GetCount;
    property CharByIndex[AIndex: Integer]: String read GetCharByIndex;
    property DotRows[AChar: String]: TDotRows read GetDotRows write SetDotRows;
    property DotRowsByIndex[AIndex: Integer]: TDotRows read GetDotRowsByIndex;
  published
    property ColCount: Integer read FColCount write SetColCount;
    property RowCount: Integer read FRowCount write SetRowCount;
  end;

  TLCDDisplay = class(TGraphicControl)
  private
    FBitmap: TBitMap;
    {
    one char consists of Col x Row of dots
    dots have size and space between dots
    }
    FDotSize: integer;  // dot size in pixels
    FDotsSpace: integer; // inter-dots space in pixels
    FCharCount: integer;
    FGlobalDotColsCount: integer;
    FCharWidth: integer;

    FFrameSize: integer;
    FBoardWidth: integer;
    FBoardHeight: integer;
    FLEDWidth: integer;
    FLEDHeight: integer;

    FFrameColor: TColor;
    FBoardColor: TColor;
    FDotColorOn: TColor;
    FDotColorOff: TColor;

    FLenText: integer;
    FDisplayLineCount: integer;
    FDisplayCharCount: integer;
    FLines: TStringList;
    FCharSpace: boolean;
    FColorScheme: TColorScheme;
    FCountOn: integer;
    FFrameStyle: TFrameStyle;
    FFrameHeight: TFrameHeight;
    FFrameColorStyle: TFrameColorStyle;
    FDotShape: TDotShape;

    FCharDefs: TCharDefs;

    function GetDotColCount: Integer;
    function GetDotRowCount: INteger;
    procedure SetDotColCount(AValue: Integer);
    procedure SetDotRowCount(AValue: Integer);
    
    procedure SetDotShape(const Value: TDotShape);
    procedure SetFrameColorStyle(const Value: TFrameColorStyle);
    procedure SetFrameHeight(const Value: TFrameHeight);
    procedure SetFrameStyle(const Value: TFrameStyle);
    procedure SetCharSpace(const Value: boolean);
    procedure SetColorScheme(const Value: TColorScheme);

    function GetCharCount: longint;
    function GetGlobalDotColsCount: longint;
    procedure SetDisplayLineCount(const Value: integer);
    procedure SetDisplayCharCount(const Value: integer);
    procedure SetLines(const Value: TStringList);
    procedure SetDotColorOff(const Value: TColor);
    procedure SetDotColorOn(const Value: TColor);
    procedure SetBoardColor(const Value: TColor);
    procedure SetFrameColor(const Value: TColor);
    procedure SetFrameSize(const Value: integer);
    procedure SetDotSize(const Value: integer);
    procedure SetDotsSpace(const Value: integer);

    function CalcCharCount: integer;
    procedure InitCharDefs(ACharDefs: TCharDefs; AHorDots, AVertDots: integer);
    function IsCharDefsStored: Boolean;
    
    //calculate widths and heights of the display matrix, background border and frame
    procedure Prepare();
    //draw frame
    procedure DrawBorder();
    //background grid of dots that are off
    procedure DrawGrid();
    //space between chars
    procedure DrawSpace();
    //call DrawChar for every char
    procedure DrawText();
    //call DrawDot for every dot that is on
    procedure DrawChar(Row, Col, NChar: integer);
    procedure DrawDot(Row, Col: integer; DotColor: TColor);
    //draw frame shadow
    procedure DrawShadow(StartP, EndP: TPoint; LineColor1, LineColor2: TColor);
    procedure DrawBitmapToCanvas();
    
  protected
    // Basic method of auto-size calculation
    procedure CalculatePreferredSize(var PreferredWidth, PreferredHeight: integer;
    {%H-}WithThemeSpace: boolean); override;
    // Takes care of high-dpi scaling
    procedure DoAutoAdjustLayout(const AMode: TLayoutAdjustmentPolicy;
      const AXProportion, AYProportion: double); override;
    // inherited painting routine
    procedure Paint; override;
    // Recalculates the geometry if a related property has been changed.
    procedure UpdateSize;

  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;

    // Adds a user-defined character and its dot matrix.
    procedure AddCharDef(AChar: string; const Dots: TDotRows);

    property CharCount: longint read GetCharCount;
    property DotColCount: integer read GetDotColCount;
    property DotRowCount: integer read GetDotRowCount;
    property GlobalDotColsCount: longint read GetGlobalDotColsCount;

  published
    property AutoSize default true;
    property BorderSpacing;
    property ShowHint;
    property Visible;
    property OnClick;
    property OnDblClick;
    property OnMouseDown;
    property OnMouseMove;
    property OnMouseUp;

    property CharDefs: TCharDefs read FCharDefs write FCharDefs stored IsCharDefsStored;
    
    property DotSize: integer read FDotSize write SetDotSize default 4;
    property DotsSpace: integer read FDotsSpace write SetDotsSpace default 1;
    property FrameSize: integer read FFrameSize write SetFrameSize default 8;

    property FrameColor: TColor read FFrameColor write SetFrameColor default clBtnFace;
    // To use BoardColor, ColorScheme must be set to csCustom
    property BoardColor: TColor read FBoardColor write SetBoardColor default clBlack;
    // To use DotColorOn, ColorScheme must be set to csCustom
    property DotColorOn: TColor read FDotColorOn write SetDotColorOn default clSkyBlue;
    // To use DotColorOff, ColorScheme must be set to csCustom
    property DotColorOff: TColor read FDotColorOff write SetDotColorOff default clTeal;
    // Vertical screen size in chars
    // Without AutoSize, if the frame is too small
    // a part off the text will not be visible
    // e.g. frame is big enough for one line
    // and the text contains 3 lines
    // - just the middle line will be visible
    property DisplayLineCount: integer read FDisplayLineCount write SetDisplayLineCount default 2;
    // Horizontal screen size in chars
    // Set to <=0 (zero) to have a real AutoSize
    // Has no effect without AutoSize
    property DisplayCharCount: integer read FDisplayCharCount write SetDisplayCharCount default 10;
    // The text to display
    // It will be truncated according
    // to ScreenRowCount and ScreenColCount
    property Lines: TStringList read FLines write SetLines;
    // Insert one-dot space between chars
    property CharSpace: boolean read FCharSpace write SetCharSpace default False;
    // Pre-defined color schemes
    // Set to csCustom in order to use
    // the BoardColor, DotColorOn and DotColorOff
    property ColorScheme: TColorScheme
      read FColorScheme write SetColorScheme default csCustom;
    property FrameStyle: TFrameStyle
      read FFrameStyle write SetFrameStyle default fsRelief;
    property FrameHeight: TFrameHeight
      read FFrameHeight write SetFrameHeight default fhDouble;
    property FrameColorStyle: TFrameColorStyle
      read FFrameColorStyle write SetFrameColorStyle default stWindows;
    property DotShape: TDotShape read FDotShape write SetDotShape default stSquare;
  end;

implementation

uses
  Dialogs, LazUTF8, LazUnicode;

const
  DEFAULT_DOT_COL_COUNT = 5;
  DEFAULT_DOT_ROW_COUNT = 7;
  
{ TCharDefs }

constructor TCharDefs.Create(ADisplay: TLCDDisplay);
begin
  inherited Create;
  FLCDDisplay := ADisplay;
  FCharList := TDotMatrixList.Create;
  FCharList.Sorted := True;
end;

destructor TCharDefs.Destroy;
begin
  FCharList.Free;
  inherited;
end;

{ Adds a new character dot matrix. }
procedure TCharDefs.Add(AChar: String; ADotRows: TDotRows);
begin
  if Length(ADotRows) <> FRowCount then
    raise Exception.Create('Incorrect number of rows.');
  FCharList.Add(AChar, ADotRows);
end;

procedure TCharDefs.Assign(ASource: TPersistent);
var
  i: Integer;
begin
  if (ASource is TCharDefs) then
  begin
    FColCount := TCharDefs(ASource).ColCount;
    FRowCount := TCharDefs(ASource).RowCount;
    Clear;
    for i := 0 to TCharDefs(ASource).Count-1 do
      Add(TCharDefs(ASource).CharByIndex[i], TCharDefs(ASource).DotRowsByIndex[i]);
  end else
    inherited;
end;
    
{ Clears all characters and their dot matrices. }
procedure TCharDefs.Clear;
begin
  FCharList.Clear;
end;

{ Prepares streaming of the dot matrices }
procedure TCharDefs.DefineProperties(Filer: TFiler); 
begin
  inherited DefineProperties(Filer);
  Filer.DefineProperty('CharDefs',  @ReadCharDefs,  @WriteCharDefs, true);
end;

{ Deletes the specified character and its dot matrix from the list. }
procedure TCharDefs.Delete(AChar: String);
var
  idx: Integer;
begin
  if FCharList.Find(AChar, idx) then
    FCharList.Delete(idx);
end;

{ Creates an empty row in which not dots are set. }
function TCharDefs.EmptyRows: TDotRows;
var
  row: Integer;
begin
  Result := nil;
  SetLength(Result, FRowCount);
  for row := 0 to FRowCount-1 do
    Result[row] := 0;
end;

function TCharDefs.GetCharByIndex(AIndex: Integer): String;
begin
  Result := FCharList.Keys[AIndex];
end;

{ Returns the number of characters contained. }
function TCharDefs.GetCount: Integer;
begin
  Result := FCharList.Count;
end;

{ Returns the dot matrix rows for the specified character. Each row is an 
  integer in which each bit is interpreted as a dot. }
function TCharDefs.GetDotRows(AChar: String): TDotRows;
var
  idx: Integer;
begin
  if FCharList.Find(AChar, idx) then
    Result := FCharList.Data[idx]
  else
    Result := EmptyRows;
end;

function TCharDefs.GetDotRowsByIndex(AIndex: Integer): TDotRows;
begin
  Result := FCharList.Data[AIndex];
end;

{ Reads the list of character name and dot matrices from the LFM file. The data
  are stored in the LFM as a comma-separated list beginning with the character 
  name. }
procedure TCharDefs.ReadCharDefs(Reader: TReader);
var
  i: Integer;
  s: String;
  ch: String;
  sa: TStringArray;
  rows: TDotRows = nil;
begin
  Clear;
  Reader.ReadListBegin;
  while not Reader.EndOfList do
  begin
    s := Reader.ReadString;
    if s[1] = ',' then
    begin
      ch := ',';
      System.Delete(s, 1, 2);
    end else
    begin
      i := pos(',', s);
      ch := copy(s, 1, i-1);
      System.Delete(s, 1, i);
    end;
    sa := s.Split(',');
    SetLength(rows, Length(sa));
    for i := 0 to High(sa) do
      rows[i] := StrToInt(sa[i]);
    Add(ch, rows);
  end;
  Reader.ReadListEnd;
end;
  
function TCharDefs.SameDotRows(const AChar: String; const ADotRows: TDotRows): Boolean;
var
  i: Integer;
  lDotRows: TDotRows;
begin
  Result := false;
  lDotRows := DotRows[AChar];
  if (Length(lDotRows) <> Length(ADotRows)) then
    exit;
  for i := 0 to High(lDotRows) do
    if lDotRows[i] <> ADotRows[i] then exit;
  Result := true;
end;
  
function DotRowsToStr(ADotRows: TDotRows): String;
var
  i: Integer;
begin
  Result := IntToStr(ADotRows[0]);
  for i := 1 to High(ADotRows) do
    Result := Result + ',' + IntToStr(ADotRows[i]);
end;

function StrToDotRows(AString: String): TDotRows;
var
  sa: TStringArray;
  i: Integer;
begin
  Result := nil;
  sa := AString.Split(',');
  SetLength(Result, Length(sa));
  for i := 0 to High(sa) do
    Result[i] := StrToInt(sa[i]);
end;
  
procedure TCharDefs.LoadFromFile(const AFileName: String);
var
  doc: TXMLDocument = nil;
  rootNode, parentNode, node, childNode: TDOMNode;
  nodeName: String;
  s: String;
  ch: String;
  dots: TDotRows;
begin
  FCharList.Clear;
  
  try
    ReadXMLFile(doc, AFileName);
    rootNode := doc.DocumentElement;
    parentNode := rootNode.FirstChild;
    while Assigned(parentNode) do
    begin
      nodeName := parentNode.NodeName;
      if nodeName = 'DotColCount' then 
      begin
        s := TDOMElement(parentNode).GetAttribute('Value');
        if s <> '' then
          FColCount := StrToInt(s)
        else
          raise Exception.Create('DotColCount missing');
      end else
      if nodeName = 'DotRowCount' then
      begin
        s := TDOMElement(parentNode).GetAttribute('Value');
        if s <> '' then
          FRowCount := StrToInt(s)
        else
          raise Exception.Create('DotRowCount missing');
      end else
      if nodeName = 'Chars' then begin
        node := parentNode.FirstChild;
        while Assigned(node) do begin
          childnode := node.FirstChild;
          ch := '';
          dots := nil;
          while Assigned(childnode) do
          begin
            nodeName := childNode.NodeName;
            if nodeName = 'Name' then
              ch := childNode.TextContent
            else
            if nodeName = 'DotRows' then
            begin
              s := childNode.TextContent;
              dots := StrToDotRows(s);
            end;
            childNode := childNode.NextSibling;
          end;
          if ch = '' then
            raise Exception.Create('Char "Name" missing.');
          if dots = nil then
            raise Exception.Create('Char "DotRows" missing.');
          Add(ch, dots);
          node := node.NextSibling;
        end;
      end;
      parentNode := parentNode.NextSibling;
    end;
    
    with FLCDDisplay do
    begin
      if AutoSize then
      begin
        InvalidatePreferredSize;
        AdjustSize;
      end;
      Invalidate;
    end;
    
  finally
    doc.Free;
  end;
end;
  
{ Saves the list (character plus dot matrix for each) to an xml file. }
procedure TCharDefs.SaveToFile(const AFileName: String);
var
  doc: TXMLDocument;
  rootNode, parentNode, node, childNode, textNode: TDOMNode;
  i: Integer;
begin
  doc := TXMLDocument.Create;
  try
    rootNode := doc.CreateElement('LCD-CharDefs');
    doc.AppendChild(rootNode);
    
    rootNode := doc.DocumentElement;
    node := doc.CreateElement('DotColCount');
    TDOMElement(node).SetAttribute('Value', IntToStr(ColCount));
    rootNode.AppendChild(node);
    
    node := doc.CreateElement('DotRowCount');
    TDOMElement(node).SetAttribute('Value', IntToStr(RowCount));
    rootNode.AppendChild(node);
    
    parentNode := doc.CreateElement('Chars');
    rootNode.AppendChild(parentNode);
    
    for i := 0 to Count-1 do
    begin
      node := doc.CreateElement('Char');
      parentNode.AppendChild(node);
      childNode := doc.CreateElement('Name');
      node.AppendChild(childNode);
      textNode := doc.CreateTextNode(CharByIndex[i]);
      childnode.AppendChild(textNode);
      childNode := doc.CreateElement('DotRows');
      node.AppendChild(childNode);
      textNode := doc.CreateTextNode(DotRowsToStr(DotRowsByIndex[i]));
      childNode.Appendchild(textNode);
    end;
    
    WriteXMLFile(doc, AFileName);
  finally
    doc.Free;
  end;
end;

{ Returns the number of columns of the dot matrix. }
procedure TCharDefs.SetColCount(AValue: Integer);
begin
  if FColCount = AValue then
    exit;
  FColCount := AValue;
  FCharList.Clear;
end;

{ Sets the dot matrix for the specified character }
procedure TCharDefs.SetDotRows(AChar: String; const AValue: TDotRows);
var
  idx: Integer;
begin
  if FCharList.Find(AChar, idx) then
    FCharList.Data[idx] := AValue
  else
    Add(AChar, AValue);
end;

{ Returns the number of rows of the dot matrix. }
procedure TCharDefs.SetRowCount(AValue: Integer);
begin
  if FRowCount = AValue then
    exit;
  FRowCount := AValue;
  FCharList.Clear;
end;

{ Write the character and its dot matrix to the LFM. Each character is stored
  as a comma-separated list of character and dotrow values. }
procedure TCharDefs.WriteCharDefs(Writer: TWriter);
var
  i, j: Integer;
  ch: String;
  rows: TDotRows;
  s: String;
begin
  Writer.WriteListBegin;
  for i := 0 to Count-1 do
  begin
    ch := FCharList.Keys[i];
    rows := DotRows[ch];
    s := ch;
    for j := 0 to FRowCount-1 do
      s := s + ',' + IntToStr(rows[j]);
    Writer.WriteString(s);
  end;
  Writer.WriteListEnd;
end;


{ TLCDDisplay}

constructor TLCDDisplay.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  ControlStyle := ControlStyle + [csOpaque];

  Width := 156;
  Height := 76;
  
  FDisplayLineCount := 2;
  FDisplayCharCount := 10;

  FCharDefs := TCharDefs.Create(self);
  FCharDefs.ColCount := DEFAULT_DOT_COL_COUNT;
  FCharDefs.RowCount := DEFAULT_DOT_ROW_COUNT;
  InitCharDefs(FCharDefs, DotColCount, DotRowCount);

  FDotSize := 4;
  FDotsSpace := 1;
  FFrameSize := 8;
  FBoardWidth := 4;

  FFrameColor := clBtnFace;
  FBoardColor := clBlack;
  FDotColorOn := clSkyBlue;
  FDotColorOff := clTeal;

  FBitmap := TBitMap.Create;
  FCountOn := 255;

  FLines := TStringList.Create;
  AutoSize := true;
end;

destructor TLCDDisplay.Destroy;
begin
  FBitmap.Free;
  FCharDefs.Free;
  FLines.Free;
  inherited Destroy;
end;

procedure TLCDDisplay.AddCharDef(AChar: string; const Dots: TDotRows);
begin
  FCharDefs.Add(AChar, Dots);
end;

procedure TLCDDisplay.CalculatePreferredSize(var PreferredWidth, PreferredHeight: integer;
  WithThemeSpace: boolean);
var
  nDotCols: Integer;
  nDotRows: Integer;
begin
  nDotCols := DotColCount;
  nDotRows := DotRowCount;
  
  FCharWidth := (DotSize * nDotCols) + (DotsSpace * (nDotCols + 1)); //pixels
  FCharCount := CalcCharCount;
  FGlobalDotColsCount := (FCharCount * nDotCols) + (FCharCount - 1);      //dots

  // total matrix width
  FLEDWidth := (FGlobalDotColsCount * DotSize) + ((FGlobalDotColsCount - 1) * DotsSpace);
  // total matrix height
  FLEDHeight := (FDisplayLineCount * nDotRows * (DotSize + DotsSpace)) +
    ((FDisplayLineCount - 1) * (DotSize + DotsSpace));
  if FCharSpace then
    FLEDHeight := FLEDHeight + ((FDisplayLineCount - 1) * DotsSpace);

  //background around text matrix - left/right pixels
  FBoardWidth := DotSize + DotsSpace;
  //background around text matrix - up/down pixels
  FBoardHeight := DotSize + DotsSpace;

  //Total size incl. frame
  PreferredWidth := FLEDWidth + (2 * FrameSize) + (2 * FBoardWidth);
  PreferredHeight := FLEDHeight + (2 * FrameSize) + (2 * FBoardWidth);
end;

procedure TLCDDisplay.DoAutoAdjustLayout(const AMode: TLayoutAdjustmentPolicy;
  const AXProportion, AYProportion: double);
begin
  inherited;
  if AMode in [lapAutoAdjustWithoutHorizontalScrolling, lapAutoAdjustForDPI] then
  begin
    FDotSize := round(FDotSize * AXProportion);
    FDotsSpace := round(FDotsSpace * AXProportion);
    FFrameSize := round(FFrameSize * AXProportion);
  end;
end;

procedure TLCDDisplay.Prepare();
var
  nDotCols: Integer;
  nDotRows: Integer;
begin
  nDotCols := DotColCount;
  nDotRows := DotRowCount;

  FCharWidth := (DotSize * nDotCols) + (DotsSpace * (nDotCols + 1)); //pixels
  FCharCount := ((Width - (2 * FrameSize)) + DotSize) div (FCharWidth + DotSize);
  FGlobalDotColsCount := (FCharCount * nDotCols) + (FCharCount - 1);      //dots

  // total matrix width
  FLEDWidth := (FGlobalDotColsCount * DotSize) + ((FGlobalDotColsCount - 1) * DotsSpace);
  // total matrix height
  FLEDHeight := (FDisplayLineCount * nDotRows * (DotSize + DotsSpace)) +
    ((FDisplayLineCount - 1) * (DotSize + DotsSpace));
  if FCharSpace then
    FLEDHeight := FLEDHeight + ((FDisplayLineCount - 1) * DotsSpace);

  FBoardWidth := (Width - 2 * FrameSize - FLEDWidth) div 2;
  FBoardHeight := (Height - 2 * FrameSize - FLEDHeight) div 2;

  FBitmap.Width := Width;
  FBitmap.Height := Height;
end;

procedure TLCDDisplay.DrawBorder();
var
  FStart, FEnd: TPoint;
  BStart, BEnd: TPoint;
  Color1, Color2, Color3, Color4: TColor;
  C: longint;
  R, G, B: integer;
const
  K1 = 4.637;
  K2 = 1.364;
  K3 = 1.372093;
  K4 = 2.088495;
begin

  BStart.X := FrameSize;
  BStart.Y := FrameSize;
  BEnd.X := Width - FrameSize;
  BEnd.Y := Height - FrameSize;

  with FBitmap.Canvas do
  begin
    Brush.Color := FrameColor;
    Pen.Color := FrameColor;
    Rectangle(0, 0, FBitmap.Width, FBitmap.Height);
    Brush.Color := FBoardColor;
    Pen.Color := FBoardColor;
    Rectangle(BStart.X, BStart.Y, BEnd.X, BEnd.Y);
  end;

  if FrameStyle = fsNone then
    Exit;

  if FrameColorStyle = stWindows then
    C := ColorToRGB(clBtnFace)
  else
    C := ColorToRGB(FrameColor);

  R := RED(C);
  G := GREEN(C);
  B := BLUE(C);

  if FrameColorStyle = stWindows then
    Color1 := clWhite
  else
    Color1 := RGBToColor(Round(R / K1 + 200), Round(G / K1 + 200), Round(B / K1 + 200));

  Color2 := RGBToColor(Round(R / K2 + 68), Round(G / K2 + 68), Round(B / K2 + 68));
  Color3 := RGBToColor(Round(R / K3), Round(G / K3), Round(B / K3));

  if FrameHeight = fhDouble then
    Color4 := RGBToColor(Round(R / K4), Round(G / K4), Round(B / K4))
  else
    Color4 := Color3;

  FStart.X := 0;
  FStart.Y := 0;
  FEnd.X := Width - 1;
  FEnd.Y := Height - 1;

  BStart.X := FrameSize;
  BStart.Y := FrameSize;
  BEnd.X := Width - FrameSize - 1;
  BEnd.Y := Height - FrameSize - 1;

  if (FrameStyle = fsRaised) or (FrameStyle = fsRelief) then
  begin
    DrawShadow(FStart, FEnd, Color1, Color4);

    if FrameHeight = fhDouble then
    begin
      FStart.X := FStart.X + 1;
      FStart.Y := FStart.Y + 1;
      FEnd.X := FEnd.X - 1;
      FEnd.Y := FEnd.Y - 1;
      DrawShadow(FStart, FEnd, Color2, Color3);
    end;
  end;

  if (FrameStyle = fsLowered) or (FrameStyle = fsRelief) then
  begin
    DrawShadow(BStart, BEnd, Color3, Color1);
    if FrameHeight = fhDouble then
    begin
      BStart.X := BStart.X + 1;
      BStart.Y := BStart.Y + 1;
      BEnd.X := BEnd.X - 1;
      BEnd.Y := BEnd.Y - 1;
      DrawShadow(BStart, BEnd, Color4, Color2);
    end;
  end;
end;

procedure TLCDDisplay.DrawShadow(StartP, EndP: TPoint; LineColor1, LineColor2: TColor);
begin
  with FBitmap.Canvas do
  begin
    Pen.Color := LineColor1;
    MoveTo(EndP.X, StartP.Y);
    LineTo(StartP.X, StartP.Y);
    LineTo(StartP.X, EndP.Y);

    Pen.Color := LineColor2;
    MoveTo(EndP.X, StartP.Y);
    LineTo(EndP.X, EndP.Y);
    LineTo(StartP.X - 1, EndP.Y);
  end;
end;

procedure TLCDDisplay.DrawGrid();
var
  y, x: integer;
  NRow, NCol: integer;
begin

  NRow := (DotRowCount + 1) * FDisplayLineCount - 1;
  NCol := (DotColCount + 1) * FCharCount - 1;

  for y := 0 to NRow - 1 do
    for x := 0 to NCol - 1 do
      DrawDot(y, x, FDotColorOff);

end;

procedure TLCDDisplay.DrawSpace();
var
  y, x: integer;
  NRow, NCol: integer;
  i, j, lc: integer;
begin
  //i - vertical spaces
  //j - horizontal spaces
  for lc := 0 to FDisplayLineCount - 1 do
  begin
    NRow := DotRowCount + 1;
    NCol := (DotColCount + 1) * FCharCount - 1;

    j := 0;
    for y := 0 to (NRow * (lc + 1)) do
    begin
      i := 0;
      for x := 0 to NCol - 1 do
      begin
        if ((i = 5) or (j = 7)) and (y < (NRow * (lc + 1))) then
        begin
          DrawDot(y, x, FBoardColor);
          i := 0;
        end
        else
          i := i + 1;
      end;
      if j = 7 then
      begin
        j := 0;
      end
      else
        j := j + 1;
    end;
  end;
end;

procedure TLCDDisplay.DrawText();
var
  x, y, c: integer;
  dots: TDotRows;
  dotRow: TDotRow;
  dotOn: boolean;
  i: integer;
  line: string;
  ch: string;
begin
  for i := 0 to FDisplayLineCount - 1 do
  begin
    if i < FLines.Count then
    begin
      line := FLines[i];
      FLenText := UTF8Length(line);

      c := 0;
      for ch in line do
      begin
        Inc(c);
        dots := FCharDefs.DotRows[ch];
        for y := 0 to DotRowCount - 1 do
        begin
          DotRow := dots[y];
          for x := 0 to 4 do
          begin
            DotOn := DotRow and (1 shl (5 - x - 1)) > 0;
            if DotOn then
              DrawChar(y + 8 * i, x, c);
          end; // for x
        end;  // for y
      end;  // for ch
    end;

    if CharSpace then
      DrawSpace();
  end;
end;


procedure TLCDDisplay.DrawChar(Row, Col, NChar: integer);
begin

  Col := Col + ((DotColCount + 1) * (NChar - 1));
  if Col > FGlobalDotColsCount - 1 then
    Exit;
  if Col < 0 then
    Exit;
  DrawDot(Row, Col, FDotColorOn);

end;

procedure TLCDDisplay.DrawDot(Row, Col: integer; DotColor: TColor);
var
  DotR: TRect;
begin
  DotR.Left := FrameSize + FBoardWidth + (DotSize + DotsSpace) * Col;
  DotR.Top := FrameSize + FBoardHeight + (DotSize + DotsSpace) * Row;
  DotR.Right := DotR.Left + DotSize;
  DotR.Bottom := DotR.Top + DotSize;

  if FFrameHeight = fhSingle then
  begin
    if (DotR.Top <= FFrameSize) or (DotR.Bottom >= Height - FFrameSize) then
      exit;
    if (DotR.Left <= FFrameSize) or (DotR.Right >= Width - FFrameSize) then
      exit;
  end
  else
  begin
    if (DotR.Top <= FFrameSize + 1) or (DotR.Bottom >= Height - FFrameSize - 1) then
      exit;
    if (DotR.Left <= FFrameSize + 1) or (DotR.Right >= Width - FFrameSize - 1) then
      exit;
  end;

  with FBitmap.Canvas do
  begin
    Pen.Color := DotColor;
    Brush.Color := DotColor;

    if DotShape = stSquare then
      FillRect(DotR)
    else
      Ellipse(DotR.Left, DotR.Top, DotR.Right, DotR.Bottom);
  end;
end;

procedure TLCDDisplay.DrawBitmapToCanvas();
begin
  Canvas.Draw(0, 0, FBitmap);
end;

procedure TLCDDisplay.Paint();
begin
  Prepare();
  DrawBorder();
  DrawGrid();
  DrawText();
  DrawBitmapToCanvas();
end;

// Find the longest's line length
function TLCDDisplay.CalcCharCount: integer;
var
  len: integer;
  i, tmp: integer;
begin
  len := 1;
  if FDisplayCharCount > 0 then 
    Result := FDisplayCharCount
  else
  begin
    for i := 0 to FDisplayLineCount - 1 do
    begin
      if i < Lines.Count then
      begin
        tmp := UTF8Length(Lines[i]);
        if tmp > Len then Len := tmp;
      end;
    end;
    Result := Len;
  end;
end;

procedure TLCDDisplay.InitCharDefs(ACharDefs: TCharDefs; AHorDots, AVertDots: integer);
var
  i: integer;
begin
  ACharDefs.Clear;
  if (AHorDots = DEFAULT_DOT_COL_COUNT) and (AVertDots = DEFAULT_DOT_ROW_COUNT) then
  begin
    ACharDefs.Add('!', [4, 4, 4, 4, 4, 0, 4]);        // #33
    ACharDefs.Add('"', [10, 10, 0, 0, 0, 0, 0]);      // #34
    ACharDefs.Add('#', [0, 10, 31, 10, 31, 10, 0]);   // #35
    ACharDefs.Add('$', [4, 15, 20, 14, 5, 30, 4]);    // #36
    ACharDefs.Add('%', [25, 26, 2, 4, 8, 11, 19]);    // #37
    ACharDefs.Add('&', [12, 18, 20, 8, 21, 18, 13]);  // #38
    ACharDefs.Add('''', [4, 4, 0, 0, 0, 0, 0]);       // #39
    ACharDefs.Add('(', [2, 4, 8, 8, 8, 4, 2]);        // #40
    ACharDefs.Add(')', [8, 4, 2, 2, 2, 4, 8]);        // #41
    ACharDefs.Add('*', [0, 4, 21, 14, 21, 4, 0]);     // #42
    ACharDefs.Add('+', [0, 4, 4, 31, 4, 4, 0]);       // #43
    ACharDefs.Add(',', [0, 0, 0, 0, 12, 4, 8]);       // #44
    ACharDefs.Add('-', [0, 0, 0, 14, 0, 0, 0]);       // #45
    ACharDefs.Add('.', [0, 0, 0, 0, 0, 12, 12]);      // #46
    ACharDefs.Add('/', [1, 1, 2, 4, 8, 16, 16]);      // #47
    ACharDefs.Add('0', [14, 17, 19, 21, 25, 17, 14]); // #48
    ACharDefs.Add('1', [4, 12, 4, 4, 4, 4, 14]);      // #49
    ACharDefs.Add('2', [14, 17, 1, 2, 4, 8, 31]);     // #50
    ACharDefs.Add('3', [14, 17, 1, 6, 1, 17, 14]);    // #51
    ACharDefs.Add('4', [2, 6, 10, 18, 31, 2, 2]);     // #52
    ACharDefs.Add('5', [31, 16, 30, 1, 1, 17, 14]);   // #53
    ACharDefs.Add('6', [14, 17, 16, 30, 17, 17, 14]); // #54
    ACharDefs.Add('7', [31, 1, 1, 2, 4, 4, 4]);       // #55
    ACharDefs.Add('8', [14, 17, 17, 14, 17, 17, 14]); // #56
    ACharDefs.Add('9', [14, 17, 17, 15, 1, 17, 14]);  // #57
    ACharDefs.Add(':', [0, 12, 12, 0, 12, 12, 0]);    // #58
    ACharDefs.Add(';', [0, 12, 12, 0, 12, 4, 8]);     // #59
    ACharDefs.Add('<', [2, 4, 8, 16, 8, 4, 2]);       // #60
    ACharDefs.Add('=', [0, 0, 31, 0, 31, 0, 0]);      // #61
    ACharDefs.Add('>', [8, 4, 2, 1, 2, 4, 8]);        // #62
    ACharDefs.Add('?', [14, 17, 1, 2, 4, 0, 4]);      // #63
    ACharDefs.Add('@', [14, 17, 19, 21, 23, 16, 15]); // #64
    ACharDefs.Add('A', [14, 17, 17, 31, 17, 17, 17]); // #65
    ACharDefs.Add('B', [30, 17, 17, 30, 17, 17, 30]); // #66
    ACharDefs.Add('C', [14, 17, 16, 16, 16, 17, 14]); // #67
    ACharDefs.Add('D', [30, 17, 17, 17, 17, 17, 30]); // #68
    ACharDefs.Add('E', [31, 16, 16, 30, 16, 16, 31]); // #69
    ACharDefs.Add('F', [31, 16, 16, 30, 16, 16, 16]); // #70
    ACharDefs.Add('G', [14, 17, 16, 19, 17, 17, 14]); // #71
    ACharDefs.Add('H', [17, 17, 17, 31, 17, 17, 17]); // #72
    ACharDefs.Add('I', [14, 4, 4, 4, 4, 4, 14]);      // #73
    ACharDefs.Add('J', [1, 1, 1, 1, 17, 17, 14]);     // #74
    ACharDefs.Add('K', [17, 18, 20, 24, 20, 18, 17]); // #75
    ACharDefs.Add('L', [16, 16, 16, 16, 16, 16, 31]); // #76
    ACharDefs.Add('M', [17, 27, 21, 21, 17, 17, 17]); // #77
    ACharDefs.Add('N', [17, 25, 21, 19, 17, 17, 17]); // #78
    ACharDefs.Add('O', [14, 17, 17, 17, 17, 17, 14]); // #79
    ACharDefs.Add('P', [30, 17, 17, 30, 16, 16, 16]); // #80
    ACharDefs.Add('Q', [14, 17, 17, 17, 17, 14, 1]);  // #81
    ACharDefs.Add('R', [30, 17, 17, 30, 17, 17, 17]); // #82
    ACharDefs.Add('S', [14, 17, 16, 14, 1, 17, 14]);  // #83
    ACharDefs.Add('T', [31, 4, 4, 4, 4, 4, 4]);       // #84
    ACharDefs.Add('U', [17, 17, 17, 17, 17, 17, 14]); // #85
    ACharDefs.Add('V', [17, 17, 17, 17, 17, 10, 4]);  // #86
    ACharDefs.Add('W', [17, 17, 17, 17, 21, 27, 17]); // #87
    ACharDefs.Add('X', [17, 10, 4, 4, 4, 10, 17]);    // #88
    ACharDefs.Add('Y', [17, 17, 17, 10, 4, 4, 4]);    // #89
    ACharDefs.Add('Z', [31, 1, 2, 4, 8, 16, 31]);     // #90
    ACharDefs.Add('[', [12, 8, 8, 8, 8, 8, 12]);      // #91
    ACharDefs.Add('\', [0, 16, 8, 4, 2, 1, 0]);       // #92
    ACharDefs.Add(']', [6, 2, 2, 2, 2, 2, 6]);        // #93
    ACharDefs.Add('^', [4, 10, 17, 0, 0, 0, 0]);      // #94
    ACharDefs.Add('_', [0, 0, 0, 0, 0, 0, 31]);       // #95
    ACharDefs.Add('`', [6, 4, 2, 0, 0, 0, 0]);        // #96
    ACharDefs.Add('a', [0, 0, 14, 1, 15, 17, 15]);    // #97
    ACharDefs.Add('b', [16, 16, 30, 17, 17, 17, 30]); // #98
    ACharDefs.Add('c', [0, 0, 15, 16, 16, 16, 15]);   // #99
    ACharDefs.Add('d', [1, 1, 15, 17, 17, 17, 15]);  // #100
    ACharDefs.Add('e', [0, 0, 14, 17, 31, 16, 14]);  // #101
    ACharDefs.Add('f', [3, 4, 31, 4, 4, 4, 4]);      // #102
    ACharDefs.Add('g', [0, 0, 15, 17, 15, 1, 14]);   // #103
    ACharDefs.Add('h', [16, 16, 22, 25, 17, 17, 17]);// #104
    ACharDefs.Add('i', [4, 0, 12, 4, 4, 4, 14]);     // #105
    ACharDefs.Add('j', [2, 0, 6, 2, 2, 18, 12]);     // #106
    ACharDefs.Add('k', [16, 16, 18, 20, 24, 20, 18]);// #107
    ACharDefs.Add('l', [12, 4, 4, 4, 4, 4, 14]);     // #108
    ACharDefs.Add('m', [0, 0, 26, 21, 21, 21, 21]);  // #109
    ACharDefs.Add('n', [0, 0, 22, 25, 17, 17, 17]);  // #110
    ACharDefs.Add('o', [0, 0, 14, 17, 17, 17, 14]);  // #111
    ACharDefs.Add('p', [0, 0, 30, 17, 30, 16, 16]);  // #112
    ACharDefs.Add('q', [0, 0, 15, 17, 15, 1, 1]);    // #113
    ACharDefs.Add('r', [0, 0, 11, 12, 8, 8, 8]);     // #114
    ACharDefs.Add('s', [0, 0, 14, 16, 14, 1, 30]);   // #115
    ACharDefs.Add('t', [4, 4, 31, 4, 4, 4, 3]);      // #116
    ACharDefs.Add('u', [0, 0, 17, 17, 17, 19, 13]);  // #117
    ACharDefs.Add('v', [0, 0, 17, 17, 17, 10, 4]);   // #118
    ACharDefs.Add('w', [0, 0, 17, 17, 21, 21, 10]);  // #119
    ACharDefs.Add('x', [0, 0, 17, 10, 4, 10, 17]);   // #120
    ACharDefs.Add('y', [0, 0, 17, 17, 15, 1, 14]);   // #121
    ACharDefs.Add('z', [0, 0, 31, 2, 4, 8, 31]);     // #122
    ACharDefs.Add('{', [3, 4, 4, 8, 4, 4, 3]);       // #123
    ACharDefs.Add('|', [4, 4, 4, 4, 4, 4, 4]);       // #124
    ACharDefs.Add('}', [24, 4, 4, 2, 4, 4, 24]);     // #125
    ACharDefs.Add('~', [8, 21, 2, 0, 0, 0, 0]);      // #126
  end;
end;

{ Determines whether the character definitons must be stored in the lfm file.
  They are NOT stored when the currently used defs are exactly the same as those
  generated by InitCharDefs. }
function TLCDDisplay.IsCharDefsStored: Boolean;
var
  defs: TCharDefs;
  i: Integer;
  ch1, ch2: String;
  dotRows1, dotRows2: TDotRows;
begin
  Result := true;
  if (DotRowCount <> DEFAULT_DOT_ROW_COUNT) or (DotColCount <> DEFAULT_DOT_COL_COUNT) then
    exit;
  defs := TCharDefs.Create(self);
  try
    defs.ColCount := DEFAULT_DOT_COL_COUNT;
    defs.RowCount := DEFAULT_DOT_ROW_COUNT;
    InitCharDefs(defs, defs.ColCount, defs.RowCount);
    if defs.Count <> FCharDefs.Count then
      exit;
    for i := 0 to defs.Count-1 do
    begin
      ch1 := defs.CharByIndex[i];
      ch2 := FCharDefs.CharByIndex[i];;
      if (ch1 <> ch2) then
        exit;
      dotRows1 := defs.DotRowsByIndex[i];
      if not FCharDefs.SameDotRows(ch1, dotRows1) then
        exit;
    end;
    Result := false;
  finally
    defs.Free;
  end;
end;
procedure TLCDDisplay.SetBoardColor(const Value: TColor);
begin
  if Value = FBoardColor then
    Exit;
  FBoardColor := Value;
  SetColorScheme(csCustom);
end;

procedure TLCDDisplay.SetDotColorOff(const Value: TColor);
begin
  if Value = FDotColorOff then
    Exit;
  FDotColorOff := Value;
  SetColorScheme(csCustom);
end;

procedure TLCDDisplay.SetDotColorOn(const Value: TColor);
begin
  if Value = FDotColorOn then
    Exit;
  FDotColorOn := Value;
  SetColorScheme(csCustom);
end;

procedure TLCDDisplay.SetDotSize(const Value: integer);
begin
  if Value = DotSize then
    Exit;
  FDotSize := Value;
  UpdateSize;
end;

procedure TLCDDisplay.SetDotsSpace(const Value: integer);
begin
  if Value = DotsSpace then
    Exit;
  FDotsSpace := Value;
  UpdateSize;
end;

procedure TLCDDisplay.SetDotShape(const Value: TDotShape);
begin
  if Value = DotShape then
    Exit;
  FDotShape := Value;
  Invalidate;
end;

procedure TLCDDisplay.SetFrameColor(const Value: TColor);
begin
  if Value = FrameColor then
    Exit;
  FFrameColor := Value;
  Invalidate;
end;

procedure TLCDDisplay.SetFrameColorStyle(const Value: TFrameColorStyle);
begin
  if Value = FrameColorStyle then
    Exit;
  FFrameColorStyle := Value;
  Invalidate;
end;

procedure TLCDDisplay.SetFrameHeight(const Value: TFrameHeight);
begin
  if Value = FrameHeight then
    Exit;
  FFrameHeight := Value;
  UpdateSize;
end;

procedure TLCDDisplay.SetFrameSize(const Value: integer);
begin
  if Value = FrameSize then
    Exit;
  FFrameSize := Value;
  UpdateSize;
end;

procedure TLCDDisplay.SetFrameStyle(const Value: TFrameStyle);
begin
  if Value = FrameStyle then
    Exit;
  FFrameStyle := Value;
  UpdateSize;
end;

procedure TLCDDisplay.SetCharSpace(const Value: boolean);
begin
  if Value = CharSpace then
    Exit;
  FCharSpace := Value;
  UpdateSize;   // wp: this should not be necessary because it only paints the cells between chars/rows in the board color.
//  Invalidate; // wp: Invalidate should be enough.
end;

procedure TLCDDisplay.SetColorScheme(const Value: TColorScheme);
begin
  if Value = FColorScheme then Exit;
  case Value of
    csBlue: begin
      FBoardColor := clBlack;
      FDotColorOff := clTeal;
      FDotColorOn := clSkyBlue;
    end;
    csGreen: begin
      FBoardColor := 5162664;
      FDotColorOff := 5162664;
      FDotColorOn := 2900284;
    end;
    csInvGreen: begin
      FBoardColor := clBlack;
      FDotColorOff := 2900284;
      FDotColorOn := 5162664;
    end;
    csCustom: begin
    end;
  end;
  FColorScheme := Value;
  Invalidate;
end;

procedure TLCDDisplay.SetDisplayLineCount(const Value: integer);
begin
  if Value = FDisplayLineCount then
    Exit;
  FDisplayLineCount := Value;
  UpdateSize;
end;

procedure TLCDDisplay.SetDisplayCharCount(const Value: integer);
begin
  if Value = FDisplayCharCount then
    Exit;
  FDisplayCharCount := Value;
  UpdateSize;
end;

procedure TLCDDisplay.SetLines(const Value: TStringList);
var
  i: integer;
begin
  FLines.Clear;
  for i := 0 to FDisplayLineCount - 1 do
  begin
    if i < Value.Count then
      FLines.Add(Value[i])
    else
      FLines.Add(' ');
  end;
  UpdateSize;
end;

function TLCDDisplay.GetCharCount: longint;
begin
  Prepare();
  Result := FCharCount;
end;

function TLCDDisplay.GetGlobalDotColsCount: longint;
begin
  Prepare();
  Result := FGlobalDotColsCount;
end;

function TLCDDisplay.GetDotColCount: Integer;
begin
  Result := FCharDefs.ColCount;
end;

function TLCDDisplay.GetDotRowCount: Integer;
begin
  Result := FCharDefs.RowCount;
end;
  
procedure TLCDDisplay.SetDotColCount(AValue: Integer);
begin
  if AValue = DotColCount then
    exit;
  FCharDefs.ColCount := AValue;
  UpdateSize;
end;

procedure TLCDDisplay.SetDotRowCount(AValue: Integer);
begin
  if AValue = DotRowCount then
    exit;
  FCharDefs.RowCount := AValue;
  UpdateSize;
end;

procedure TLCDDisplay.UpdateSize;
begin
  if AutoSize then
  begin
    InvalidatePreferredSize;
    AdjustSize;
  end;
  Invalidate;
end;

end.