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

Industrial/LCDDisplay: Complete CharDefs editor, based on bobby100's design.

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@8315 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
2022-06-19 14:47:36 +00:00
parent e29501d0e7
commit 51b7fa33bf
5 changed files with 478 additions and 194 deletions
Download Patch File Download Diff File Expand all files Collapse all files

77
components/industrialstuff/industrial.lpk
View File

@ -38,82 +38,83 @@
- Multislider"/>
<License Value="MPL + GPL + modified LGPL (see unit headers)."/>
<Version Minor="5"/>
<Files>
<Item>
<Files Count="17">
<Item1>
<Filename Value="source\indled.pas"/>
<UnitName Value="IndLed"/>
</Item>
<Item>
</Item1>
<Item2>
<Filename Value="source\sensors.pas"/>
<UnitName Value="Sensors"/>
</Item>
<Item>
</Item2>
<Item3>
<Filename Value="source\AllIndustrialRegister.pas"/>
<HasRegisterProc Value="True"/>
<UnitName Value="AllIndustrialRegister"/>
</Item>
<Item>
</Item3>
<Item4>
<Filename Value="source\lednumber.pas"/>
<UnitName Value="LedNumber"/>
</Item>
<Item>
</Item4>
<Item5>
<Filename Value="source\indgnoumeter.pas"/>
<UnitName Value="indGnouMeter"/>
</Item>
<Item>
</Item5>
<Item6>
<Filename Value="source\AdvLed.pas"/>
<UnitName Value="AdvLed"/>
</Item>
<Item>
</Item6>
<Item7>
<Filename Value="source\indcyBaseLed.pas"/>
<UnitName Value="indcyBaseLed"/>
</Item>
<Item>
</Item7>
<Item8>
<Filename Value="source\indcyClasses.pas"/>
<UnitName Value="indcyClasses"/>
</Item>
<Item>
</Item8>
<Item9>
<Filename Value="source\indcyGraphics.pas"/>
<UnitName Value="indcyGraphics"/>
</Item>
<Item>
</Item9>
<Item10>
<Filename Value="source\indcyTypes.pas"/>
<UnitName Value="indcyTypes"/>
</Item>
<Item>
</Item10>
<Item11>
<Filename Value="source\a3naloggauge.pas"/>
<UnitName Value="A3nalogGauge"/>
</Item>
<Item>
</Item11>
<Item12>
<Filename Value="source\mknob.pas"/>
<UnitName Value="MKnob"/>
</Item>
<Item>
</Item12>
<Item13>
<Filename Value="source\switches.pas"/>
<UnitName Value="switches"/>
</Item>
<Item>
</Item13>
<Item14>
<Filename Value="source\indsliders.pas"/>
<UnitName Value="indSliders"/>
</Item>
<Item>
</Item14>
<Item15>
<Filename Value="source\indlcddisplay.pas"/>
<UnitName Value="indLCDDisplay"/>
</Item>
<Item>
</Item15>
<Item16>
<Filename Value="source\indlcddisplay_editor.pas"/>
<UnitName Value="indlcddisplay_editor"/>
</Item>
<Item>
</Item16>
<Item17>
<Filename Value="source\indlcddisplay_editorform.pas"/>
<UnitName Value="indLCDDisplay_EditorForm"/>
</Item>
</Item17>
</Files>
<CompatibilityMode Value="True"/>
<LazDoc Paths="D:\Prog_Lazarus\svn\lazarus-ccr\components\industrialstuff\fpdoc"/>
<RequiredPkgs>
<Item>
<RequiredPkgs Count="1">
<Item1>
<PackageName Value="IDEIntf"/>
</Item>
</Item1>
</RequiredPkgs>
<UsageOptions>
<UnitPath Value="$(PkgOutDir)"/>

2
components/industrialstuff/industrial.pas
View File

@ -10,7 +10,7 @@ interface
uses
IndLed, Sensors, AllIndustrialRegister, LedNumber, indGnouMeter, AdvLed,
indcyBaseLed, indcyClasses, indcyGraphics, indcyTypes, A3nalogGauge, MKnob,
switches, indSliders, indLCDDisplay, indlcddisplay_editor,
switches, indSliders, indLCDDisplay, indLCDDisplay_Editor,
indLCDDisplay_EditorForm, LazarusPackageIntf;
implementation

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

@ -54,6 +54,8 @@ type
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);
@ -103,6 +105,7 @@ type
FDotShape: TDotShape;
FCharDefs: TCharDefs;
FOnChange: TNotifyEvent;
function GetDotColCount: Integer;
function GetDotRowCount: INteger;
@ -132,6 +135,7 @@ type
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();
@ -157,6 +161,7 @@ type
// 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.
@ -227,8 +232,12 @@ type
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: TDotRows): TDotRows;
implementation
uses
@ -237,7 +246,19 @@ uses
const
DEFAULT_DOT_COL_COUNT = 5;
DEFAULT_DOT_ROW_COUNT = 7;
{ Create a "real" copy to avoid reference counter issues. }
function CopyDotRows(const ADotRows: TDotRows): 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);
@ -259,7 +280,8 @@ procedure TCharDefs.Add(AChar: String; ADotRows: TDotRows);
begin
if Length(ADotRows) <> FRowCount then
raise Exception.Create('Incorrect number of rows.');
FCharList.Add(AChar, ADotRows);
// Make sure to reset the reference counter --> use a local copy of ADotRows!
FCharList.Add(AChar, CopyDotRows(ADotRows));
end;
procedure TCharDefs.Assign(ASource: TPersistent);
@ -299,6 +321,18 @@ begin
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
@ -338,6 +372,13 @@ 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. }
@ -546,9 +587,8 @@ var
idx: Integer;
begin
if FCharList.Find(AChar, idx) then
FCharList.Data[idx] := AValue
else
Add(AChar, AValue);
Delete(AChar);
Add(AChar, AValue);
end;
{ Returns the number of rows of the dot matrix. }
@ -615,6 +655,7 @@ begin
FCountOn := 255;
FLines := TStringList.Create;
FLines.OnChange := @LinesChanged;
AutoSize := true;
end;
@ -674,6 +715,11 @@ begin
end;
end;
procedure TLCDDisplay.DoChange;
begin
if Assigned(FOnChange) then FOnChange(Self);
end;
procedure TLCDDisplay.Prepare();
var
nDotCols: Integer;
@ -1276,7 +1322,7 @@ begin
else
FLines.Add(' ');
end;
UpdateSize;
LinesChanged(self);
end;
function TLCDDisplay.GetCharCount: longint;
@ -1317,6 +1363,12 @@ begin
UpdateSize;
end;
procedure TLCDDisplay.LinesChanged(Sender: TObject);
begin
UpdateSize;
DoChange;
end;
procedure TLCDDisplay.UpdateSize;
begin
if AutoSize then

253
components/industrialstuff/source/indlcddisplay_editorform.lfm
View File

@ -1,68 +1,17 @@
object LCDCharDefsEditor: TLCDCharDefsEditor
Left = 415
Height = 338
Top = 175
Width = 506
Left = 899
Height = 276
Top = 168
Width = 273
AutoSize = True
Caption = 'LCDCharDefsEditor'
ClientHeight = 338
ClientWidth = 506
BorderStyle = bsDialog
Caption = 'LCD Dot Matrix Editor'
ClientHeight = 276
ClientWidth = 273
OnActivate = FormActivate
OnCloseQuery = FormCloseQuery
OnDestroy = FormDestroy
LCLVersion = '2.3.0.0'
object ButtonPanel: TButtonPanel
Left = 6
Height = 34
Top = 298
Width = 494
OKButton.Name = 'OKButton'
OKButton.DefaultCaption = True
HelpButton.Name = 'HelpButton'
HelpButton.DefaultCaption = True
CloseButton.Name = 'CloseButton'
CloseButton.DefaultCaption = True
CancelButton.Name = 'CancelButton'
CancelButton.DefaultCaption = True
TabOrder = 3
ShowButtons = [pbOK, pbCancel]
end
object btnDelete: TButton
AnchorSideLeft.Control = dgEditor
AnchorSideLeft.Side = asrBottom
AnchorSideTop.Control = dgEditor
Left = 224
Height = 25
Top = 64
Width = 75
BorderSpacing.Left = 12
BorderSpacing.Right = 12
Caption = 'Delete'
OnClick = btnDeleteClick
TabOrder = 2
end
object dgEditor: TDrawGrid
AnchorSideLeft.Control = Owner
AnchorSideTop.Control = cbCharSelector
AnchorSideTop.Side = asrBottom
Left = 12
Height = 192
Top = 64
Width = 200
BorderSpacing.Left = 12
BorderSpacing.Top = 12
BorderSpacing.Bottom = 6
BorderStyle = bsNone
ColCount = 1
DefaultColWidth = 22
ExtendedSelect = False
FixedCols = 0
FixedRows = 0
RowCount = 1
ScrollBars = ssNone
TabOrder = 1
OnPrepareCanvas = dgEditorPrepareCanvas
end
object Label1: TLabel
AnchorSideLeft.Control = Owner
AnchorSideTop.Control = Owner
@ -73,23 +22,201 @@ object LCDCharDefsEditor: TLCDCharDefsEditor
BorderSpacing.Left = 12
BorderSpacing.Top = 12
Caption = 'Available characters'
Color = clDefault
ParentColor = False
end
object cbCharSelector: TComboBox
AnchorSideLeft.Control = Label1
AnchorSideTop.Control = Label1
AnchorSideTop.Side = asrBottom
AnchorSideRight.Control = dgDotMatrix
AnchorSideRight.Side = asrBottom
Left = 12
Height = 23
Top = 29
Width = 114
AutoCompleteText = [cbactEndOfLineComplete, cbactSearchCaseSensitive, cbactSearchAscending]
Width = 159
Anchors = [akTop, akLeft, akRight]
AutoComplete = True
AutoCompleteText = [cbactEnabled, cbactEndOfLineComplete, cbactSearchCaseSensitive, cbactSearchAscending]
BorderSpacing.Top = 2
ItemHeight = 15
MaxLength = 1
OnChange = cbCharSelectorChange
OnKeyDown = cbCharSelectorKeyDown
OnKeyUp = cbCharSelectorKeyUp
TabOrder = 0
Text = 'cbCharSelector'
end
object pnOKCancel: TPanel
AnchorSideLeft.Control = Owner
AnchorSideTop.Control = dgDotMatrix
AnchorSideTop.Side = asrBottom
AnchorSideRight.Control = Owner
AnchorSideRight.Side = asrBottom
Left = 12
Height = 26
Top = 212
Width = 249
Anchors = [akTop, akLeft, akRight]
AutoSize = True
BorderSpacing.Left = 12
BorderSpacing.Top = 10
BorderSpacing.Right = 12
BorderSpacing.Bottom = 12
BevelOuter = bvNone
ClientHeight = 26
ClientWidth = 249
TabOrder = 1
object btOK: TBitBtn
AnchorSideLeft.Control = pnOKCancel
AnchorSideTop.Control = pnOKCancel
AnchorSideTop.Side = asrCenter
Left = 0
Height = 26
Top = 0
Width = 62
AutoSize = True
Default = True
DefaultCaption = True
Kind = bkOK
ModalResult = 1
TabOrder = 0
end
object btCancel: TBitBtn
AnchorSideTop.Control = pnOKCancel
AnchorSideTop.Side = asrCenter
AnchorSideRight.Control = pnOKCancel
AnchorSideRight.Side = asrBottom
Left = 167
Height = 26
Top = 0
Width = 82
Anchors = [akTop, akRight]
AutoSize = True
Cancel = True
DefaultCaption = True
Kind = bkCancel
ModalResult = 2
TabOrder = 1
end
end
object pnButtons: TPanel
AnchorSideLeft.Control = dgDotMatrix
AnchorSideLeft.Side = asrBottom
AnchorSideTop.Control = dgDotMatrix
Left = 176
Height = 88
Top = 57
Width = 87
AutoSize = True
BorderSpacing.Left = 5
BorderSpacing.Right = 12
BevelOuter = bvNone
ClientHeight = 88
ClientWidth = 87
TabOrder = 2
object btReplace: TBitBtn
AnchorSideLeft.Control = pnButtons
AnchorSideTop.Control = btAdd
AnchorSideTop.Side = asrBottom
Left = 0
Height = 26
Top = 31
Width = 87
AutoSize = True
BorderSpacing.Top = 5
Caption = 'Replace'
Margin = 6
Images = ImageList1
ImageIndex = 1
OnClick = btReplaceClick
Spacing = 6
TabOrder = 0
end
object btDelete: TBitBtn
AnchorSideLeft.Control = pnButtons
AnchorSideTop.Control = btReplace
AnchorSideTop.Side = asrBottom
AnchorSideRight.Control = btReplace
AnchorSideRight.Side = asrBottom
Left = 0
Height = 26
Top = 62
Width = 87
Anchors = [akTop, akLeft, akRight]
AutoSize = True
BorderSpacing.Top = 5
Caption = 'Delete'
Margin = 6
Images = ImageList1
ImageIndex = 3
OnClick = btDeleteClick
Spacing = 6
TabOrder = 1
end
object btAdd: TBitBtn
AnchorSideLeft.Control = pnButtons
AnchorSideTop.Control = pnButtons
AnchorSideRight.Control = btReplace
AnchorSideRight.Side = asrBottom
Left = 0
Height = 26
Top = 0
Width = 87
Anchors = [akTop, akLeft, akRight]
AutoSize = True
Caption = 'Add as...'
Margin = 6
Images = ImageList1
ImageIndex = 2
OnClick = btAddClick
Spacing = 6
TabOrder = 2
end
end
object dgDotMatrix: TDrawGrid
AnchorSideLeft.Control = Label1
AnchorSideTop.Control = cbCharSelector
AnchorSideTop.Side = asrBottom
Left = 12
Height = 145
Top = 57
Width = 159
BorderSpacing.Top = 5
BorderStyle = bsNone
DefaultColWidth = 22
ExtendedSelect = False
FixedCols = 0
FixedRows = 0
ScrollBars = ssNone
TabOrder = 3
OnMouseDown = dgDotMatrixMouseDown
OnPrepareCanvas = dgDotMatrixPrepareCanvas
end
object ImageList1: TImageList
Left = 208
Top = 8
Bitmap = {
4C7A040000001000000010000000990200000000000078DAED934B6F524114C7
4984B65C5EE5B6B5696929D0C2454A2BB8D6785DFAEAD20FE0CA0FE0A2E5D54B
91BA706781F2EA23AE75E34A3F84317E89C6C4B0D0C45445FD7BE6DE4B432D8F
3BC5184C9CE49F4C66E637FF3367CE319986778CF8EDF288CF2E9F979DCE5FC1
C55C1C16CE3B2C8CDD26361FC3542E86C9EC6558166C321F1BC7D4A31826B656
212A2B10335198FBDC31D262B7E398646C6E15EEEC0AC633CB70A52370A52230
7B05B9E77B996FBE8DDD5C86337D098E64188E840467228C0B5DEE680DE1C6B4
226E11AB68AC3D29C1726D42319A3F2BF1EE6C14AE4C04F69404211182F9AA68
9C9789DF8CAADE36F2B66E04F979CA9933453C795BD797B878E13AF1698A3F49
6FA79C09EB416E5E247E3C19A19C8761DB08C1C2C1FF1FFA3F5A2599E93CAC20
48B224ED2314DA83D51A92F97CC3C41E12BB8F60B04EAA1ABE43105AEC0171FB
585CAC2110A8C0EF2F636C2C281B630F75B64E6C153E5F190B0B2552B1EB1DDA
7B0FC0C4D8A5A53D62EBC456E0F5EE627EBE482AA81A1DED1D8728AE291A5B55
D9B9B9221C8E5B86EBD7ED5E53FCFE2AC55B26BF123C9E02F13739F8BBC4574E
BC67677760B7F3F07714966FAFB7447C0133334FB9F9406097F8A2CAF3FA8BE2
6DE24B943F2DE71ECF0ED7FBFFE6003064FA4E3A363D4BDFC7EB7246159BB335
6DAF1FDF247D3231EEFD9B57AAD89CAD01DFF4333FBBF832F633A9D181FFA0EF
7DED12C7B149F360E78E3AF047FADE47FDEC69BEFDBD4CEF5ED64E78366FDFD3
F2719A6FF7EB272D9E3FCB0F1A3FF045CF5FA347FE1AFA99E301FEAFD9A78E7A
D54F73E0FAFD3174FD369CFD5F7B78CFF4E2F103556CCEDBFF8C7BFBFC892A36
E7EDFFB33C5FFF9FE5F9FABF97FE85FEE78DFFF7FEEF9C3FE3FDDFFDFF8CF57F
E7FA690E5CBFC3D6FFBF005C61B822
}
end
end

276
components/industrialstuff/source/indlcddisplay_editorform.pas
View File

@ -5,39 +5,52 @@ unit indLCDDisplay_EditorForm;
interface
uses
Classes, SysUtils, Forms, Controls, Graphics, Dialogs, StdCtrls, ButtonPanel,
Grids, indLCDDisplay;
Classes, SysUtils, Forms, Controls, Graphics, Dialogs, StdCtrls,
Grids, ExtCtrls, Buttons, indLCDDisplay, Types;
type
{ TLCDCharDefsEditor }
TLCDCharDefsEditor = class(TForm)
btnDelete: TButton;
ButtonPanel: TButtonPanel;
btAdd: TBitBtn;
btReplace: TBitBtn;
btDelete: TBitBtn;
btOK: TBitBtn;
btCancel: TBitBtn;
cbCharSelector: TComboBox;
dgEditor: TDrawGrid;
dgDotMatrix: TDrawGrid;
ImageList1: TImageList;
Label1: TLabel;
procedure btnDeleteClick(Sender: TObject);
pnButtons: TPanel;
pnOKCancel: TPanel;
procedure btAddClick(Sender: TObject);
procedure btDeleteClick(Sender: TObject);
procedure btReplaceClick(Sender: TObject);
procedure cbCharSelectorChange(Sender: TObject);
procedure cbCharSelectorKeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
procedure cbCharSelectorKeyUp(Sender: TObject; var Key: Word;
Shift: TShiftState);
procedure dgEditorPrepareCanvas(sender: TObject; aCol, aRow: Integer;
aState: TGridDrawState);
procedure dgDotMatrixMouseDown(Sender: TObject; {%H-}Button: TMouseButton;
{%H-}Shift: TShiftState; X, Y: Integer);
procedure dgDotMatrixPrepareCanvas({%H-}sender: TObject; aCol, aRow: Integer;
{%H-}aState: TGridDrawState);
procedure FormActivate(Sender: TObject);
procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
procedure FormCloseQuery(Sender: TObject; var CanClose: boolean);
procedure FormDestroy(Sender: TObject);
private
FLCDDisplay: TLCDDisplay;
FModified: Boolean;
FSavedCharDefs: TCharDefs;
FSelectedChar: String;
FTmpDotRows: TDotRows;
procedure SetLCDDisplay(AValue: TLCDDisplay);
procedure PopulateCharSelector;
procedure SaveCharDefs;
function SelectedChar: String;
function SelectedDotMatrix: TDotRows;
procedure ClearEditorGrid;
procedure SetupEditorGrid;
function GetDotMatrix: TDotRows;
function DotSet(ACol, ARow: Integer): Boolean;
procedure SetDot(ACol, ARow: Integer; AValue: Boolean);
procedure ToggleDot(ACol, ARow: Integer);
public
property LCDDisplay: TLCDDisplay read FLCDDisplay write SetLCDDisplay;
@ -56,82 +69,143 @@ uses
procedure TLCDCharDefsEditor.PopulateCharSelector;
var
i: Integer;
i: integer;
begin
cbCharSelector.DropdownCount := 24;
cbCharSelector.Items.BeginUpdate;
try
cbCharSelector.Clear;
for i := 0 to FLCDDisplay.CharDefs.Count-1 do
for i := 0 to FLCDDisplay.CharDefs.Count - 1 do
cbCharSelector.Items.Add(FLCDDisplay.CharDefs.CharByIndex[i]);
finally
cbCharSelector.Items.EndUpdate;
end;
end;
{ This is just a sample allowing me to test the property editor... }
procedure TLCDCharDefsEditor.btnDeleteClick(Sender: TObject);
var
ch: String;
procedure TLCDCharDefsEditor.btDeleteClick(Sender: TObject);
begin
ch := SelectedChar;
if ch <> '' then
if FSelectedChar <> '' then
begin
FLCDDisplay.CharDefs.Delete(ch);
FLCDDisplay.CharDefs.Delete(FSelectedChar);
FLCDDisplay.Invalidate;
end;
PopulateCharSelector;
end;
procedure TLCDCharDefsEditor.btAddClick(Sender: TObject);
var
newChar: String;
perc, pix: Integer;
begin
// Query the name of the new character from an input box. Unfortunately, the
// width of the input box is too wide. We work around this by temporarily
// setting the global parameter cInputQueryEditSizePercents to 0
perc := cInputQueryEditSizePercents;
pix := cInputQueryEditSizePixels;
cInputQueryEditSizePercents := 0;
cInputQueryEditSizePixels := 200;
try
newChar := InputBox('Dotmatrix to be used for...', 'Character', '');
finally
cInputQueryEditSizePercents := perc;
cInputQueryEditSizePixels := pix;
end;
if newChar = '' then
exit;
// Check whether the new character already has a dot matrix.
if FLCDDisplay.CharDefs.Find(newChar) then
begin
MessageDlg(Format('Character "%s" already exists and cannot be added.', [newChar]),
mtError, [mbOK], 0);
exit;
end;
// Add new character and its dot matrix to the LCDDisplay...
FSelectedChar := newChar;
FLCDDisplay.CharDefs.Add(FSelectedChar, GetDotMatrix);
FLCDDisplay.Invalidate;
// ... and update the editor form
PopulateCharSelector;
cbCharSelector.ItemIndex := cbCharSelector.Items.IndexOf(FSelectedChar);
FModified := false;
end;
{ Replaces the dotmatrix of the currently loaded character by the dotmatrix in
the editor. }
procedure TLCDCharDefsEditor.btReplaceClick(Sender: TObject);
begin
if FSelectedChar <> '' then
begin
FLCDDisplay.CharDefs.DotRows[FSelectedChar] := GetDotMatrix;
FLCDDisplay.Invalidate;
FModified := false;
end;
end;
procedure TLCDCharDefsEditor.cbCharSelectorChange(Sender: TObject);
begin
dgEditor.Invalidate;
FSelectedChar := cbCharSelector.Text;
if FSelectedChar <> '' then
FTmpDotRows := FLCDDisplay.CharDefs.DotRows[FSelectedChar]
else
ClearEditorGrid;
dgDotMatrix.Invalidate;
FModified := false;
end;
procedure TLCDCharDefsEditor.cbCharSelectorKeyDown(Sender: TObject;
var Key: Word; Shift: TShiftState);
begin
// cbCharSelector.Text := '';
end;
procedure TLCDCharDefsEditor.cbCharSelectorKeyUp(Sender: TObject;
var Key: Word; Shift: TShiftState);
begin
cbCharSelector.SelectAll;
end;
procedure TLCDCharDefsEditor.dgEditorPrepareCanvas(sender: TObject;
aCol, aRow: Integer; aState: TGridDrawState);
procedure TLCDCharDefsEditor.dgDotMatrixMouseDown(Sender: TObject;
Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
var
dotrows: TDotRows;
r, c: Integer;
dotSet: Boolean;
begin
dotRows := SelectedDotMatrix;
if dotRows = nil then
exit;
r := ARow;
c := dgEditor.ColCount - 1 - ACol;
dotSet := dotRows[r] and (1 shl c) <> 0;
if dotSet then
dgEditor.Canvas.Brush.Color := clBlack;
dgDotMatrix.MouseToCell(X,Y, c, r);
ToggleDot(c, r);
dgDotMatrix.InvalidateCell(c, r);
FModified := true;
end;
procedure TLCDCharDefsEditor.dgDotMatrixPrepareCanvas(sender: TObject; aCol,
aRow: Integer; aState: TGridDrawState);
begin
if DotSet(ACol, ARow) then
dgDotMatrix.Canvas.Brush.Color := clBlack
else
dgDotMatrix.Canvas.Brush.Color := clWhite;
end;
procedure TLCDCharDefsEditor.FormActivate(Sender: TObject);
var
w: Integer;
begin
Constraints.MinHeight := dgEditor.Top + dgEditor.Height + ButtonPanel.Height + 2*ButtonPanel.BorderSpacing.Around;
Constraints.MinWidth := Max(
ButtonPanel.OKButton.Left + ButtonPanel.OKButton.Width + ButtonPanel.BorderSpacing.Around,
btnDelete.Left + btnDelete.Width + btnDelete.BorderSpacing.Right
);
w := Max(btOK.Width, btCancel.Width);
btOK.Constraints.MinWidth := w;
btCancel.Constraints.MinWidth := w;
end;
{ When the form is not closed by the OK button, we must restored the saved,
original char defs of the FLCDDisplay. }
procedure TLCDCharDefsEditor.FormCloseQuery(Sender: TObject;
var CanClose: Boolean);
procedure TLCDCharDefsEditor.FormCloseQuery(Sender: TObject; var CanClose: boolean);
const
mrReplace = -20;
mrAddAs = -21;
var
res: Integer;
begin
if CanClose and (ModalResult <> mrOK) then
if FModified and (ModalResult = mrOK) then
begin
res := QuestionDlg('Confirmation', 'Current dotmatrix of "' + FSelectedChar + '" has not yet been applied. What do you want to do?',
mtConfirmation, [mrReplace, 'Replace', mrAddAs, 'Add as...', 'isDefault', mrCancel, 'Cancel'], 0);
case res of
mrReplace:
btReplaceClick(nil);
mrAddAs:
btAddClick(nil);
mrCancel:
;
end;
CanClose := (res <> mrCancel) and (not FModified);
end;
if CanClose and (ModalResult <> mrOk) then
begin
FLCDDisplay.CharDefs.Assign(FSavedCharDefs);
FLCDDisplay.Invalidate;
@ -143,6 +217,44 @@ begin
FreeAndNil(FSavedCharDefs);
end;
function TLCDCharDefsEditor.GetDotMatrix: TDotRows;
begin
Result := FTmpDotRows;
end;
{ Tests whether the dot corresponding to the specified grid column and row is
set. Note that the low-bit is at the right! }
function TLCDCharDefsEditor.DotSet(ACol, ARow: Integer): Boolean;
var
c: Integer;
begin
c := dgDotMatrix.ColCount - 1 - ACol;
Result := FTmpDotRows[ARow] and (1 shl c) <> 0; // avoid integer helper to keep usability with old fpc versions
end;
{ Sets the dot in the specified grid column and row if AValue is true,
or clears it if AValue is false.
Note that the low-bit is at the right of the grid! }
procedure TLCDCharDefsEditor.SetDot(ACol, ARow: Integer; AValue: Boolean);
var
c: Integer;
lDotRows: TDotRows;
begin
c := dgDotMatrix.ColCount - 1 - ACol;
lDotRows := CopyDotRows(FTmpDotRows);
if AValue then
lDotRows[ARow] := lDotRows[ARow] or (1 shl c)
else
lDotRows[ARow] := lDotRows[ARow] and not (1 shl c); // avoid integer helper to keep usability with old fpc version
FTmpDotRows := CopyDotRows(lDotRows);
end;
{ Toggles the dot in the specified grid column/row }
procedure TLCDCharDefsEditor.ToggleDot(ACol, ARow: Integer);
begin
SetDot(ACol, ARow, not DotSet(ACol, ARow));
end;
{ Save the char defs so that they can be restored if the form is not closed by OK. }
procedure TLCDCharDefsEditor.SaveCharDefs;
begin
@ -151,42 +263,34 @@ begin
FSavedCharDefs.Assign(FLCDDisplay.CharDefs);
end;
{ Returns the currently selected character. Note that this is a string because
we have to deal with UTF8 where a code-point can consist of up to 4 bytes. }
function TLCDCharDefsEditor.SelectedChar: String;
begin
Result := cbCharSelector.Text;
end;
function TLCDCharDefsEditor.SelectedDotMatrix: TDotRows;
var
ch: String;
begin
ch := SelectedChar;
if ch <> '' then
Result := FLCDDisplay.CharDefs.DotRows[ch]
else
Result := nil;
end;
procedure TLCDCharDefsEditor.SetLCDDisplay(AValue: TLCDDisplay);
begin
FLCDDisplay := AValue;
SetLength(FTmpDotRows, FLCDDisplay.DotRowCount);
SaveCharDefs;
PopulateCharSelector;
SetupEditorGrid;
end;
procedure TLCDCharDefsEditor.ClearEditorGrid;
var
i, j: integer;
begin
for i := 0 to dgDotMatrix.ColCount - 1 do
for j := 0 to dgDotMatrix.RowCount - 1 do
FTmpDotRows[j].ClearBit(i);
end;
{ Reads the size of the dot matrix from FLCDDisplay and use it to define the
number of rows and columns in the editor grid. }
procedure TLCDCharDefsEditor.SetupEditorGrid;
begin
dgEditor.RowCount := FLCDDisplay.DotRowCount;
dgEditor.ColCount := FLCDDisplay.DotColCount;
dgEditor.ClientWidth := dgEditor.ColCount * dgEditor.DefaultColWidth;
dgEditor.ClientHeight := dgEditor.RowCount * dgEditor.DefaultRowHeight;
dgEditor.Constraints.MinWidth := dgEditor.Width;
dgEditor.Constraints.MinHeight := dgEditor.Height;
dgDotMatrix.RowCount := FLCDDisplay.DotRowCount;
ClearEditorGrid;
dgDotmatrix.ClientWidth := dgDotMatrix.ColCount * dgDotMatrix.DefaultColWidth;
dgDotMatrix.ClientHeight := dgDotMatrix.RowCount * dgDotMatrix.DefaultRowHeight;
dgDotMatrix.Constraints.MinWidth := dgDotMatrix.Width;
dgDotMatrix.Constraints.MinHeight := dgDotMatrix.Height;
end;
end.
end.