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

1396 lines
40 KiB
ObjectPascal
Raw Normal View History

{
*****************************************************************************
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; const ADotRows: TDotRows);
procedure Assign(ASource: TPersistent); override;
procedure Clear;
procedure Delete(AChar: String);
function DotRowsToString(AChar: String): String;
function Find(const AChar: String): Boolean;
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: TStrings;
FCharSpace: boolean;
FColorScheme: TColorScheme;
FCountOn: integer;
FFrameStyle: TFrameStyle;
FFrameHeight: TFrameHeight;
FFrameColorStyle: TFrameColorStyle;
FDotShape: TDotShape;
FCharDefs: TCharDefs;
FOnChange: TNotifyEvent;
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: TStrings);
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;
procedure LinesChanged(Sender: TObject);
//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;
procedure DoChange; virtual;
// 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: TStrings 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;
property OnChange: TNotifyEvent read FOnChange write FOnChange;
end;
function CopyDotRows(const ADotRows: array of TDotRow): TDotRows;
implementation
uses
Dialogs, LazUTF8, LazUnicode;
const
DEFAULT_DOT_COL_COUNT = 5;
DEFAULT_DOT_ROW_COUNT = 7;
{ Create a "real" copy to avoid reference counter issues. }
function CopyDotRows(const ADotRows: Array of TDotRow): TDotRows;
var
i: Integer;
begin
Result := nil;
SetLength(Result, Length(ADotRows));
for i := 0 to High(ADotRows) do
Result[i] := ADotRows[i];
end;
{ 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; const ADotRows: TDotRows);
begin
if Length(ADotRows) <> FRowCount then
raise Exception.Create('Incorrect number of rows.');
// Make sure to reset the reference counter --> use a local copy of ADotRows!
FCharList.Add(AChar, CopyDotRows(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;
{ Display the elements of the RowDots as a string. For debugging purposes. }
function TCharDefs.DotRowsToString(AChar: String): String;
var
lDotRows: TDotRows;
i: Integer;
begin
lDotRows := DotRows[AChar];
Result := IntToStr(lDotRows[0]);
for i := 1 to High(lDotRows) do
Result := Result + ',' + IntToStr(lDotRows[i]);
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;
function TCharDefs.Find(const AChar: String): Boolean;
var
idx: Integer;
begin
Result := FCharList.Find(AChar, idx);
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
Delete(AChar);
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;
{ TLCDDisplayStrings }
type
TLCDDisplayStrings = class(TStrings)
private
FOnChange: TNotifyEvent;
public
property OnChange: TNotifyEvent read FOnChange write FOnChange;
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;
TStringList(FLines).OnChange := @LinesChanged;
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.DoChange;
begin
if Assigned(FOnChange) then FOnChange(Self);
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);
begin
ACharDefs.Clear;
if (AHorDots = DEFAULT_DOT_COL_COUNT) and (AVertDots = DEFAULT_DOT_ROW_COUNT) then
begin
// Note: Passing the array via CopyDotRows is for compilation with FPC before v3.2
ACharDefs.Add('!', CopyDotRows([4, 4, 4, 4, 4, 0, 4])); // #33
ACharDefs.Add('"', CopyDotRows([10, 10, 0, 0, 0, 0, 0])); // #34
ACharDefs.Add('#', CopyDotRows([0, 10, 31, 10, 31, 10, 0])); // #35
ACharDefs.Add('$', CopyDotRows([4, 15, 20, 14, 5, 30, 4])); // #36
ACharDefs.Add('%', CopyDotRows([25, 26, 2, 4, 8, 11, 19])); // #37
ACharDefs.Add('&', CopyDotRows([12, 18, 20, 8, 21, 18, 13])); // #38
ACharDefs.Add('''',CopyDotRows([4, 4, 0, 0, 0, 0, 0])); // #39
ACharDefs.Add('(', CopyDotRows([2, 4, 8, 8, 8, 4, 2])); // #40
ACharDefs.Add(')', CopyDotRows([8, 4, 2, 2, 2, 4, 8])); // #41
ACharDefs.Add('*', CopyDotRows([0, 4, 21, 14, 21, 4, 0])); // #42
ACharDefs.Add('+', CopyDotRows([0, 4, 4, 31, 4, 4, 0])); // #43
ACharDefs.Add(',', CopyDotRows([0, 0, 0, 0, 12, 4, 8])); // #44
ACharDefs.Add('-', CopyDotRows([0, 0, 0, 14, 0, 0, 0])); // #45
ACharDefs.Add('.', CopyDotRows([0, 0, 0, 0, 0, 12, 12])); // #46
ACharDefs.Add('/', CopyDotRows([1, 1, 2, 4, 8, 16, 16])); // #47
ACharDefs.Add('0', CopyDotRows([14, 17, 19, 21, 25, 17, 14])); // #48
ACharDefs.Add('1', CopyDotRows([4, 12, 4, 4, 4, 4, 14])); // #49
ACharDefs.Add('2', CopyDotRows([14, 17, 1, 2, 4, 8, 31])); // #50
ACharDefs.Add('3', CopyDotRows([14, 17, 1, 6, 1, 17, 14])); // #51
ACharDefs.Add('4', CopyDotRows([2, 6, 10, 18, 31, 2, 2])); // #52
ACharDefs.Add('5', CopyDotRows([31, 16, 30, 1, 1, 17, 14])); // #53
ACharDefs.Add('6', CopyDotRows([14, 17, 16, 30, 17, 17, 14])); // #54
ACharDefs.Add('7', CopyDotRows([31, 1, 1, 2, 4, 4, 4])); // #55
ACharDefs.Add('8', CopyDotRows([14, 17, 17, 14, 17, 17, 14])); // #56
ACharDefs.Add('9', CopyDotRows([14, 17, 17, 15, 1, 17, 14])); // #57
ACharDefs.Add(':', CopyDotRows([0, 12, 12, 0, 12, 12, 0])); // #58
ACharDefs.Add(';', CopyDotRows([0, 12, 12, 0, 12, 4, 8])); // #59
ACharDefs.Add('<', CopyDotRows([2, 4, 8, 16, 8, 4, 2])); // #60
ACharDefs.Add('=', CopyDotRows([0, 0, 31, 0, 31, 0, 0])); // #61
ACharDefs.Add('>', CopyDotRows([8, 4, 2, 1, 2, 4, 8])); // #62
ACharDefs.Add('?', CopyDotRows([14, 17, 1, 2, 4, 0, 4])); // #63
ACharDefs.Add('@', CopyDotRows([14, 17, 19, 21, 23, 16, 15])); // #64
ACharDefs.Add('A', CopyDotRows([14, 17, 17, 31, 17, 17, 17])); // #65
ACharDefs.Add('B', CopyDotRows([30, 17, 17, 30, 17, 17, 30])); // #66
ACharDefs.Add('C', CopyDotRows([14, 17, 16, 16, 16, 17, 14])); // #67
ACharDefs.Add('D', CopyDotRows([30, 17, 17, 17, 17, 17, 30])); // #68
ACharDefs.Add('E', CopyDotRows([31, 16, 16, 30, 16, 16, 31])); // #69
ACharDefs.Add('F', CopyDotRows([31, 16, 16, 30, 16, 16, 16])); // #70
ACharDefs.Add('G', CopyDotRows([14, 17, 16, 19, 17, 17, 14])); // #71
ACharDefs.Add('H', CopyDotRows([17, 17, 17, 31, 17, 17, 17])); // #72
ACharDefs.Add('I', CopyDotRows([14, 4, 4, 4, 4, 4, 14])); // #73
ACharDefs.Add('J', CopyDotRows([1, 1, 1, 1, 17, 17, 14])); // #74
ACharDefs.Add('K', CopyDotRows([17, 18, 20, 24, 20, 18, 17])); // #75
ACharDefs.Add('L', CopyDotRows([16, 16, 16, 16, 16, 16, 31])); // #76
ACharDefs.Add('M', CopyDotRows([17, 27, 21, 21, 17, 17, 17])); // #77
ACharDefs.Add('N', CopyDotRows([17, 25, 21, 19, 17, 17, 17])); // #78
ACharDefs.Add('O', CopyDotRows([14, 17, 17, 17, 17, 17, 14])); // #79
ACharDefs.Add('P', CopyDotRows([30, 17, 17, 30, 16, 16, 16])); // #80
ACharDefs.Add('Q', CopyDotRows([14, 17, 17, 17, 17, 14, 1])); // #81
ACharDefs.Add('R', CopyDotRows([30, 17, 17, 30, 17, 17, 17])); // #82
ACharDefs.Add('S', CopyDotRows([14, 17, 16, 14, 1, 17, 14])); // #83
ACharDefs.Add('T', CopyDotRows([31, 4, 4, 4, 4, 4, 4])); // #84
ACharDefs.Add('U', CopyDotRows([17, 17, 17, 17, 17, 17, 14])); // #85
ACharDefs.Add('V', CopyDotRows([17, 17, 17, 17, 17, 10, 4])); // #86
ACharDefs.Add('W', CopyDotRows([17, 17, 17, 17, 21, 27, 17])); // #87
ACharDefs.Add('X', CopyDotRows([17, 10, 4, 4, 4, 10, 17])); // #88
ACharDefs.Add('Y', CopyDotRows([17, 17, 17, 10, 4, 4, 4])); // #89
ACharDefs.Add('Z', CopyDotRows([31, 1, 2, 4, 8, 16, 31])); // #90
ACharDefs.Add('[', CopyDotRows([12, 8, 8, 8, 8, 8, 12])); // #91
ACharDefs.Add('\', CopyDotRows([0, 16, 8, 4, 2, 1, 0])); // #92
ACharDefs.Add(']', CopyDotRows([6, 2, 2, 2, 2, 2, 6])); // #93
ACharDefs.Add('^', CopyDotRows([4, 10, 17, 0, 0, 0, 0])); // #94
ACharDefs.Add('_', CopyDotRows([0, 0, 0, 0, 0, 0, 31])); // #95
ACharDefs.Add('`', CopyDotRows([6, 4, 2, 0, 0, 0, 0])); // #96
ACharDefs.Add('a', CopyDotRows([0, 0, 14, 1, 15, 17, 15])); // #97
ACharDefs.Add('b', CopyDotRows([16, 16, 30, 17, 17, 17, 30])); // #98
ACharDefs.Add('c', CopyDotRows([0, 0, 15, 16, 16, 16, 15])); // #99
ACharDefs.Add('d', CopyDotRows([1, 1, 15, 17, 17, 17, 15])); // #100
ACharDefs.Add('e', CopyDotRows([0, 0, 14, 17, 31, 16, 14])); // #101
ACharDefs.Add('f', CopyDotRows([3, 4, 31, 4, 4, 4, 4])); // #102
ACharDefs.Add('g', CopyDotRows([0, 0, 15, 17, 15, 1, 14])); // #103
ACharDefs.Add('h', CopyDotRows([16, 16, 22, 25, 17, 17, 17]));// #104
ACharDefs.Add('i', CopyDotRows([4, 0, 12, 4, 4, 4, 14])); // #105
ACharDefs.Add('j', CopyDotRows([2, 0, 6, 2, 2, 18, 12])); // #106
ACharDefs.Add('k', CopyDotRows([16, 16, 18, 20, 24, 20, 18]));// #107
ACharDefs.Add('l', CopyDotRows([12, 4, 4, 4, 4, 4, 14])); // #108
ACharDefs.Add('m', CopyDotRows([0, 0, 26, 21, 21, 21, 21])); // #109
ACharDefs.Add('n', CopyDotRows([0, 0, 22, 25, 17, 17, 17])); // #110
ACharDefs.Add('o', CopyDotRows([0, 0, 14, 17, 17, 17, 14])); // #111
ACharDefs.Add('p', CopyDotRows([0, 0, 30, 17, 30, 16, 16])); // #112
ACharDefs.Add('q', CopyDotRows([0, 0, 15, 17, 15, 1, 1])); // #113
ACharDefs.Add('r', CopyDotRows([0, 0, 11, 12, 8, 8, 8])); // #114
ACharDefs.Add('s', CopyDotRows([0, 0, 14, 16, 14, 1, 30])); // #115
ACharDefs.Add('t', CopyDotRows([4, 4, 31, 4, 4, 4, 3])); // #116
ACharDefs.Add('u', CopyDotRows([0, 0, 17, 17, 17, 19, 13])); // #117
ACharDefs.Add('v', CopyDotRows([0, 0, 17, 17, 17, 10, 4])); // #118
ACharDefs.Add('w', CopyDotRows([0, 0, 17, 17, 21, 21, 10])); // #119
ACharDefs.Add('x', CopyDotRows([0, 0, 17, 10, 4, 10, 17])); // #120
ACharDefs.Add('y', CopyDotRows([0, 0, 17, 17, 15, 1, 14])); // #121
ACharDefs.Add('z', CopyDotRows([0, 0, 31, 2, 4, 8, 31])); // #122
ACharDefs.Add('{', CopyDotRows([3, 4, 4, 8, 4, 4, 3])); // #123
ACharDefs.Add('|', CopyDotRows([4, 4, 4, 4, 4, 4, 4])); // #124
ACharDefs.Add('}', CopyDotRows([24, 4, 4, 2, 4, 4, 24])); // #125
ACharDefs.Add('~', CopyDotRows([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: 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) and (FColorScheme <> csCustom) 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: TStrings);
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;
LinesChanged(self);
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.LinesChanged(Sender: TObject);
begin
UpdateSize;
DoChange;
end;
procedure TLCDDisplay.UpdateSize;
begin
if AutoSize then
begin
InvalidatePreferredSize;
AdjustSize;
end;
Invalidate;
end;
end.