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

2
components/industrialstuff/industrial.pas
View File

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

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

@ -54,6 +54,8 @@ type
procedure Assign(ASource: TPersistent); override; procedure Assign(ASource: TPersistent); override;
procedure Clear; procedure Clear;
procedure Delete(AChar: String); procedure Delete(AChar: String);
function DotRowsToString(AChar: String): String;
function Find(const AChar: String): Boolean;
procedure LoadFromFile(const AFileName: String); procedure LoadFromFile(const AFileName: String);
function SameDotRows(const AChar: String; const ADotRows: TDotRows): Boolean; function SameDotRows(const AChar: String; const ADotRows: TDotRows): Boolean;
procedure SaveToFile(const AFileName: String); procedure SaveToFile(const AFileName: String);
@ -103,6 +105,7 @@ type
FDotShape: TDotShape; FDotShape: TDotShape;
FCharDefs: TCharDefs; FCharDefs: TCharDefs;
FOnChange: TNotifyEvent;
function GetDotColCount: Integer; function GetDotColCount: Integer;
function GetDotRowCount: INteger; function GetDotRowCount: INteger;
@ -132,6 +135,7 @@ type
function CalcCharCount: integer; function CalcCharCount: integer;
procedure InitCharDefs(ACharDefs: TCharDefs; AHorDots, AVertDots: integer); procedure InitCharDefs(ACharDefs: TCharDefs; AHorDots, AVertDots: integer);
function IsCharDefsStored: Boolean; function IsCharDefsStored: Boolean;
procedure LinesChanged(Sender: TObject);
//calculate widths and heights of the display matrix, background border and frame //calculate widths and heights of the display matrix, background border and frame
procedure Prepare(); procedure Prepare();
@ -157,6 +161,7 @@ type
// Takes care of high-dpi scaling // Takes care of high-dpi scaling
procedure DoAutoAdjustLayout(const AMode: TLayoutAdjustmentPolicy; procedure DoAutoAdjustLayout(const AMode: TLayoutAdjustmentPolicy;
const AXProportion, AYProportion: double); override; const AXProportion, AYProportion: double); override;
procedure DoChange; virtual;
// inherited painting routine // inherited painting routine
procedure Paint; override; procedure Paint; override;
// Recalculates the geometry if a related property has been changed. // Recalculates the geometry if a related property has been changed.
@ -227,8 +232,12 @@ type
property FrameColorStyle: TFrameColorStyle property FrameColorStyle: TFrameColorStyle
read FFrameColorStyle write SetFrameColorStyle default stWindows; read FFrameColorStyle write SetFrameColorStyle default stWindows;
property DotShape: TDotShape read FDotShape write SetDotShape default stSquare; property DotShape: TDotShape read FDotShape write SetDotShape default stSquare;
property OnChange: TNotifyEvent read FOnChange write FOnChange;
end; end;
function CopyDotRows(const ADotRows: TDotRows): TDotRows;
implementation implementation
uses uses
@ -237,7 +246,19 @@ uses
const const
DEFAULT_DOT_COL_COUNT = 5; DEFAULT_DOT_COL_COUNT = 5;
DEFAULT_DOT_ROW_COUNT = 7; 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 } { TCharDefs }
constructor TCharDefs.Create(ADisplay: TLCDDisplay); constructor TCharDefs.Create(ADisplay: TLCDDisplay);
@ -259,7 +280,8 @@ procedure TCharDefs.Add(AChar: String; ADotRows: TDotRows);
begin begin
if Length(ADotRows) <> FRowCount then if Length(ADotRows) <> FRowCount then
raise Exception.Create('Incorrect number of rows.'); 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; end;
procedure TCharDefs.Assign(ASource: TPersistent); procedure TCharDefs.Assign(ASource: TPersistent);
@ -299,6 +321,18 @@ begin
FCharList.Delete(idx); FCharList.Delete(idx);
end; 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. } { Creates an empty row in which not dots are set. }
function TCharDefs.EmptyRows: TDotRows; function TCharDefs.EmptyRows: TDotRows;
var var
@ -338,6 +372,13 @@ begin
Result := FCharList.Data[AIndex]; Result := FCharList.Data[AIndex];
end; 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 { 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 are stored in the LFM as a comma-separated list beginning with the character
name. } name. }
@ -546,9 +587,8 @@ var
idx: Integer; idx: Integer;
begin begin
if FCharList.Find(AChar, idx) then if FCharList.Find(AChar, idx) then
FCharList.Data[idx] := AValue Delete(AChar);
else Add(AChar, AValue);
Add(AChar, AValue);
end; end;
{ Returns the number of rows of the dot matrix. } { Returns the number of rows of the dot matrix. }
@ -615,6 +655,7 @@ begin
FCountOn := 255; FCountOn := 255;
FLines := TStringList.Create; FLines := TStringList.Create;
FLines.OnChange := @LinesChanged;
AutoSize := true; AutoSize := true;
end; end;
@ -674,6 +715,11 @@ begin
end; end;
end; end;
procedure TLCDDisplay.DoChange;
begin
if Assigned(FOnChange) then FOnChange(Self);
end;
procedure TLCDDisplay.Prepare(); procedure TLCDDisplay.Prepare();
var var
nDotCols: Integer; nDotCols: Integer;
@ -1276,7 +1322,7 @@ begin
else else
FLines.Add(' '); FLines.Add(' ');
end; end;
UpdateSize; LinesChanged(self);
end; end;
function TLCDDisplay.GetCharCount: longint; function TLCDDisplay.GetCharCount: longint;
@ -1317,6 +1363,12 @@ begin
UpdateSize; UpdateSize;
end; end;
procedure TLCDDisplay.LinesChanged(Sender: TObject);
begin
UpdateSize;
DoChange;
end;
procedure TLCDDisplay.UpdateSize; procedure TLCDDisplay.UpdateSize;
begin begin
if AutoSize then if AutoSize then

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

@ -1,68 +1,17 @@
object LCDCharDefsEditor: TLCDCharDefsEditor object LCDCharDefsEditor: TLCDCharDefsEditor
Left = 415 Left = 899
Height = 338 Height = 276
Top = 175 Top = 168
Width = 506 Width = 273
AutoSize = True AutoSize = True
Caption = 'LCDCharDefsEditor' BorderStyle = bsDialog
ClientHeight = 338 Caption = 'LCD Dot Matrix Editor'
ClientWidth = 506 ClientHeight = 276
ClientWidth = 273
OnActivate = FormActivate OnActivate = FormActivate
OnCloseQuery = FormCloseQuery OnCloseQuery = FormCloseQuery
OnDestroy = FormDestroy OnDestroy = FormDestroy
LCLVersion = '2.3.0.0' 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 object Label1: TLabel
AnchorSideLeft.Control = Owner AnchorSideLeft.Control = Owner
AnchorSideTop.Control = Owner AnchorSideTop.Control = Owner
@ -73,23 +22,201 @@ object LCDCharDefsEditor: TLCDCharDefsEditor
BorderSpacing.Left = 12 BorderSpacing.Left = 12
BorderSpacing.Top = 12 BorderSpacing.Top = 12
Caption = 'Available characters' Caption = 'Available characters'
Color = clDefault
ParentColor = False
end end
object cbCharSelector: TComboBox object cbCharSelector: TComboBox
AnchorSideLeft.Control = Label1 AnchorSideLeft.Control = Label1
AnchorSideTop.Control = Label1 AnchorSideTop.Control = Label1
AnchorSideTop.Side = asrBottom AnchorSideTop.Side = asrBottom
AnchorSideRight.Control = dgDotMatrix
AnchorSideRight.Side = asrBottom
Left = 12 Left = 12
Height = 23 Height = 23
Top = 29 Top = 29
Width = 114 Width = 159
AutoCompleteText = [cbactEndOfLineComplete, cbactSearchCaseSensitive, cbactSearchAscending] Anchors = [akTop, akLeft, akRight]
AutoComplete = True
AutoCompleteText = [cbactEnabled, cbactEndOfLineComplete, cbactSearchCaseSensitive, cbactSearchAscending]
BorderSpacing.Top = 2 BorderSpacing.Top = 2
ItemHeight = 15 ItemHeight = 15
MaxLength = 1 MaxLength = 1
OnChange = cbCharSelectorChange OnChange = cbCharSelectorChange
OnKeyDown = cbCharSelectorKeyDown
OnKeyUp = cbCharSelectorKeyUp
TabOrder = 0 TabOrder = 0
Text = 'cbCharSelector' Text = 'cbCharSelector'
end 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 end

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

@ -5,39 +5,52 @@ unit indLCDDisplay_EditorForm;
interface interface
uses uses
Classes, SysUtils, Forms, Controls, Graphics, Dialogs, StdCtrls, ButtonPanel, Classes, SysUtils, Forms, Controls, Graphics, Dialogs, StdCtrls,
Grids, indLCDDisplay; Grids, ExtCtrls, Buttons, indLCDDisplay, Types;
type type
{ TLCDCharDefsEditor } { TLCDCharDefsEditor }
TLCDCharDefsEditor = class(TForm) TLCDCharDefsEditor = class(TForm)
btnDelete: TButton; btAdd: TBitBtn;
ButtonPanel: TButtonPanel; btReplace: TBitBtn;
btDelete: TBitBtn;
btOK: TBitBtn;
btCancel: TBitBtn;
cbCharSelector: TComboBox; cbCharSelector: TComboBox;
dgEditor: TDrawGrid; dgDotMatrix: TDrawGrid;
ImageList1: TImageList;
Label1: TLabel; 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 cbCharSelectorChange(Sender: TObject);
procedure cbCharSelectorKeyDown(Sender: TObject; var Key: Word; procedure dgDotMatrixMouseDown(Sender: TObject; {%H-}Button: TMouseButton;
Shift: TShiftState); {%H-}Shift: TShiftState; X, Y: Integer);
procedure cbCharSelectorKeyUp(Sender: TObject; var Key: Word; procedure dgDotMatrixPrepareCanvas({%H-}sender: TObject; aCol, aRow: Integer;
Shift: TShiftState); {%H-}aState: TGridDrawState);
procedure dgEditorPrepareCanvas(sender: TObject; aCol, aRow: Integer;
aState: TGridDrawState);
procedure FormActivate(Sender: TObject); procedure FormActivate(Sender: TObject);
procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean); procedure FormCloseQuery(Sender: TObject; var CanClose: boolean);
procedure FormDestroy(Sender: TObject); procedure FormDestroy(Sender: TObject);
private private
FLCDDisplay: TLCDDisplay; FLCDDisplay: TLCDDisplay;
FModified: Boolean;
FSavedCharDefs: TCharDefs; FSavedCharDefs: TCharDefs;
FSelectedChar: String;
FTmpDotRows: TDotRows;
procedure SetLCDDisplay(AValue: TLCDDisplay); procedure SetLCDDisplay(AValue: TLCDDisplay);
procedure PopulateCharSelector; procedure PopulateCharSelector;
procedure SaveCharDefs; procedure SaveCharDefs;
function SelectedChar: String; procedure ClearEditorGrid;
function SelectedDotMatrix: TDotRows;
procedure SetupEditorGrid; procedure SetupEditorGrid;
function GetDotMatrix: TDotRows;
function DotSet(ACol, ARow: Integer): Boolean;
procedure SetDot(ACol, ARow: Integer; AValue: Boolean);
procedure ToggleDot(ACol, ARow: Integer);
public public
property LCDDisplay: TLCDDisplay read FLCDDisplay write SetLCDDisplay; property LCDDisplay: TLCDDisplay read FLCDDisplay write SetLCDDisplay;
@ -56,82 +69,143 @@ uses
procedure TLCDCharDefsEditor.PopulateCharSelector; procedure TLCDCharDefsEditor.PopulateCharSelector;
var var
i: Integer; i: integer;
begin begin
cbCharSelector.DropdownCount := 24; cbCharSelector.DropdownCount := 24;
cbCharSelector.Items.BeginUpdate; cbCharSelector.Items.BeginUpdate;
try try
cbCharSelector.Clear; 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]); cbCharSelector.Items.Add(FLCDDisplay.CharDefs.CharByIndex[i]);
finally finally
cbCharSelector.Items.EndUpdate; cbCharSelector.Items.EndUpdate;
end; end;
end; end;
{ This is just a sample allowing me to test the property editor... } procedure TLCDCharDefsEditor.btDeleteClick(Sender: TObject);
procedure TLCDCharDefsEditor.btnDeleteClick(Sender: TObject);
var
ch: String;
begin begin
ch := SelectedChar; if FSelectedChar <> '' then
if ch <> '' then
begin begin
FLCDDisplay.CharDefs.Delete(ch); FLCDDisplay.CharDefs.Delete(FSelectedChar);
FLCDDisplay.Invalidate; FLCDDisplay.Invalidate;
end; 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; end;
procedure TLCDCharDefsEditor.cbCharSelectorChange(Sender: TObject); procedure TLCDCharDefsEditor.cbCharSelectorChange(Sender: TObject);
begin begin
dgEditor.Invalidate; FSelectedChar := cbCharSelector.Text;
if FSelectedChar <> '' then
FTmpDotRows := FLCDDisplay.CharDefs.DotRows[FSelectedChar]
else
ClearEditorGrid;
dgDotMatrix.Invalidate;
FModified := false;
end; end;
procedure TLCDCharDefsEditor.cbCharSelectorKeyDown(Sender: TObject; procedure TLCDCharDefsEditor.dgDotMatrixMouseDown(Sender: TObject;
var Key: Word; Shift: TShiftState); Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
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);
var var
dotrows: TDotRows;
r, c: Integer; r, c: Integer;
dotSet: Boolean;
begin begin
dotRows := SelectedDotMatrix; dgDotMatrix.MouseToCell(X,Y, c, r);
if dotRows = nil then ToggleDot(c, r);
exit; dgDotMatrix.InvalidateCell(c, r);
FModified := true;
r := ARow; end;
c := dgEditor.ColCount - 1 - ACol;
dotSet := dotRows[r] and (1 shl c) <> 0; procedure TLCDCharDefsEditor.dgDotMatrixPrepareCanvas(sender: TObject; aCol,
if dotSet then aRow: Integer; aState: TGridDrawState);
dgEditor.Canvas.Brush.Color := clBlack; begin
if DotSet(ACol, ARow) then
dgDotMatrix.Canvas.Brush.Color := clBlack
else
dgDotMatrix.Canvas.Brush.Color := clWhite;
end; end;
procedure TLCDCharDefsEditor.FormActivate(Sender: TObject); procedure TLCDCharDefsEditor.FormActivate(Sender: TObject);
var
w: Integer;
begin begin
Constraints.MinHeight := dgEditor.Top + dgEditor.Height + ButtonPanel.Height + 2*ButtonPanel.BorderSpacing.Around; w := Max(btOK.Width, btCancel.Width);
Constraints.MinWidth := Max( btOK.Constraints.MinWidth := w;
ButtonPanel.OKButton.Left + ButtonPanel.OKButton.Width + ButtonPanel.BorderSpacing.Around, btCancel.Constraints.MinWidth := w;
btnDelete.Left + btnDelete.Width + btnDelete.BorderSpacing.Right
);
end; end;
{ When the form is not closed by the OK button, we must restored the saved, procedure TLCDCharDefsEditor.FormCloseQuery(Sender: TObject; var CanClose: boolean);
original char defs of the FLCDDisplay. } const
procedure TLCDCharDefsEditor.FormCloseQuery(Sender: TObject; mrReplace = -20;
var CanClose: Boolean); mrAddAs = -21;
var
res: Integer;
begin 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 begin
FLCDDisplay.CharDefs.Assign(FSavedCharDefs); FLCDDisplay.CharDefs.Assign(FSavedCharDefs);
FLCDDisplay.Invalidate; FLCDDisplay.Invalidate;
@ -143,6 +217,44 @@ begin
FreeAndNil(FSavedCharDefs); FreeAndNil(FSavedCharDefs);
end; 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. } { Save the char defs so that they can be restored if the form is not closed by OK. }
procedure TLCDCharDefsEditor.SaveCharDefs; procedure TLCDCharDefsEditor.SaveCharDefs;
begin begin
@ -151,42 +263,34 @@ begin
FSavedCharDefs.Assign(FLCDDisplay.CharDefs); FSavedCharDefs.Assign(FLCDDisplay.CharDefs);
end; 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); procedure TLCDCharDefsEditor.SetLCDDisplay(AValue: TLCDDisplay);
begin begin
FLCDDisplay := AValue; FLCDDisplay := AValue;
SetLength(FTmpDotRows, FLCDDisplay.DotRowCount);
SaveCharDefs; SaveCharDefs;
PopulateCharSelector; PopulateCharSelector;
SetupEditorGrid; SetupEditorGrid;
end; 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 { Reads the size of the dot matrix from FLCDDisplay and use it to define the
number of rows and columns in the editor grid. } number of rows and columns in the editor grid. }
procedure TLCDCharDefsEditor.SetupEditorGrid; procedure TLCDCharDefsEditor.SetupEditorGrid;
begin begin
dgEditor.RowCount := FLCDDisplay.DotRowCount; dgDotMatrix.RowCount := FLCDDisplay.DotRowCount;
dgEditor.ColCount := FLCDDisplay.DotColCount; ClearEditorGrid;
dgEditor.ClientWidth := dgEditor.ColCount * dgEditor.DefaultColWidth; dgDotmatrix.ClientWidth := dgDotMatrix.ColCount * dgDotMatrix.DefaultColWidth;
dgEditor.ClientHeight := dgEditor.RowCount * dgEditor.DefaultRowHeight; dgDotMatrix.ClientHeight := dgDotMatrix.RowCount * dgDotMatrix.DefaultRowHeight;
dgEditor.Constraints.MinWidth := dgEditor.Width; dgDotMatrix.Constraints.MinWidth := dgDotMatrix.Width;
dgEditor.Constraints.MinHeight := dgEditor.Height; dgDotMatrix.Constraints.MinHeight := dgDotMatrix.Height;
end; end;
end.
end.