{ ***************************************************************************** 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; 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: TStringList; 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: 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; 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: 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; 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; { 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; 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: 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; 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.