pascal/lazarus-ccr
1
0
Fork 0
Code Issues Releases Activity

Industrial/LCDDisplay: Save/load char defs (char and dotmatrix) to/from xml file.

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@8305 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
2022-06-15 20:50:14 +00:00
parent b5847cda91
commit 7df4e35f13
3 changed files with 192 additions and 7 deletions
Download Patch File Download Diff File Expand all files Collapse all files

20
components/industrialstuff/Example/LCDDisplay/untmain.lfm
View File

@ -334,4 +334,24 @@ object frmMain: TfrmMain
Color = clDefault
ParentColor = False
end
object btnSaveCharDefs: TButton
Left = 24
Height = 25
Top = 452
Width = 101
AutoSize = True
Caption = 'Save char defs'
OnClick = btnSaveCharDefsClick
TabOrder = 15
end
object btnLoadCharDefs: TButton
Left = 24
Height = 25
Top = 480
Width = 103
AutoSize = True
Caption = 'Load char defs'
OnClick = btnLoadCharDefsClick
TabOrder = 16
end
end

14
components/industrialstuff/Example/LCDDisplay/untmain.pas
View File

@ -13,6 +13,8 @@ type
{ TfrmMain }
TfrmMain = class(TForm)
btnSaveCharDefs: TButton;
btnLoadCharDefs: TButton;
cbAutoSize: TCheckBox;
cbCharSpace: TCheckBox;
cbtFrameColor: TColorButton;
@ -41,6 +43,8 @@ type
seWidth: TSpinEdit;
seHeigth: TSpinEdit;
seDisplayLineCount: TSpinEdit;
procedure btnLoadCharDefsClick(Sender: TObject);
procedure btnSaveCharDefsClick(Sender: TObject);
procedure cbAutoSizeChange(Sender: TObject);
procedure cbCharSpaceChange(Sender: TObject);
procedure cbColorSchemesChange(Sender: TObject);
@ -150,6 +154,16 @@ begin
end;
end;
procedure TfrmMain.btnSaveCharDefsClick(Sender: TObject);
begin
LCDDisplay.CharDefs.SaveToFile('default.xml');
end;
procedure TfrmMain.btnLoadCharDefsClick(Sender: TObject);
begin
LCDDisplay.CharDefs.LoadFromFile('default.xml');
end;
procedure TfrmMain.cbCharSpaceChange(Sender: TObject);
begin
LCDDisplay.CharSpace := cbCharSpace.Checked;

165
components/industrialstuff/source/indlcddisplay.pas
View File

@ -12,7 +12,8 @@ unit indLCDDisplay;
interface
uses
SysUtils, Classes, Controls, fgl, Graphics, LResources, LCLIntf;
SysUtils, Classes, Controls, fgl, Graphics, LCLIntf,
laz2_dom, laz2_xmlwrite, laz2_xmlread;
type
TFrameStyle = (fsRelief, fsNone, fsLowered, fsRaised);
@ -22,12 +23,15 @@ type
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;
@ -44,12 +48,14 @@ type
protected
procedure DefineProperties(Filer: TFiler); override;
public
constructor Create;
constructor Create(ADisplay: TLCDDisplay);
destructor Destroy; override;
procedure Add(AChar: String; ADotRows: TDotRows);
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;
@ -126,7 +132,7 @@ type
procedure InitCharDefs(ACharDefs: TCharDefs; AHorDots, AVertDots: integer);
function IsCharDefsStored: Boolean;
//calculate widths and heigths of the char matrix, background border and frame
//calculate widths and heights of the display matrix, background border and frame
procedure Prepare();
//draw frame
procedure DrawBorder();
@ -231,9 +237,10 @@ const
{ TCharDefs }
constructor TCharDefs.Create;
constructor TCharDefs.Create(ADisplay: TLCDDisplay);
begin
inherited;
inherited Create;
FLCDDisplay := ADisplay;
FCharList := TDotMatrixList.Create;
FCharList.Sorted := True;
end;
@ -362,6 +369,150 @@ begin
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
@ -427,7 +578,7 @@ begin
FDisplayLineCount := 2;
FDisplayCharCount := 10;
FCharDefs := TCharDefs.Create;
FCharDefs := TCharDefs.Create(self);
FCharDefs.ColCount := DEFAULT_DOT_COL_COUNT;
FCharDefs.RowCount := DEFAULT_DOT_ROW_COUNT;
InitCharDefs(FCharDefs, DotColCount, DotRowCount);
@ -935,7 +1086,7 @@ begin
Result := true;
if (DotRowCount <> DEFAULT_DOT_ROW_COUNT) or (DotColCount <> DEFAULT_DOT_COL_COUNT) then
exit;
defs := TCharDefs.Create;
defs := TCharDefs.Create(self);
try
defs.ColCount := DEFAULT_DOT_COL_COUNT;
defs.RowCount := DEFAULT_DOT_ROW_COUNT;