lazarus-ccr/components/industrialstuff/source/indlcddisplay_editorform.pas

unit indLCDDisplay_EditorForm;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, Forms, Controls, Graphics, Dialogs, StdCtrls,
  Grids, ExtCtrls, Buttons, indLCDDisplay, Types;

type

  { TLCDCharDefsEditor }

  TLCDCharDefsEditor = class(TForm)
    btAdd: TBitBtn;
    btReplace: TBitBtn;
    btDelete: TBitBtn;
    btOK: TBitBtn;
    btCancel: TBitBtn;
    cbCharSelector: TComboBox;
    dgDotMatrix: TDrawGrid;
    ImageList1: TImageList;
    Label1: TLabel;
    pnButtons: TPanel;
    pnOKCancel: TPanel;
    procedure btAddClick(Sender: TObject);
    procedure btDeleteClick(Sender: TObject);
    procedure btReplaceClick(Sender: TObject);
    procedure cbCharSelectorChange(Sender: TObject);
    procedure dgDotMatrixKeyDown(Sender: TObject; var Key: Word; 
      {%H-}Shift: TShiftState);
    procedure dgDotMatrixMouseDown(Sender: TObject; {%H-}Button: TMouseButton; 
      {%H-}Shift: TShiftState; X, Y: Integer);
    procedure dgDotMatrixMouseMove(Sender: TObject; 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 FormDestroy(Sender: TObject);
  private
    FLCDDisplay: TLCDDisplay;
    FModified: Boolean;
    FSavedCharDefs: TCharDefs;
    FSelectedChar: String;
    FTmpDotRows: TDotRows;
    FOldRow, FOldCol: Integer;
    procedure SetLCDDisplay(AValue: TLCDDisplay);
    procedure PopulateCharSelector;
    procedure SaveCharDefs;
    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;

  end;

var
  LCDCharDefsEditor: TLCDCharDefsEditor;

implementation

{$R *.lfm}

uses
  Math, ButtonPanel;

function CharInputBox(const ACaption, APrompt, ADefault: string): string;
var
  F: TForm;
  ed: TEdit;
  lbl: TLabel;
  bp: TButtonPanel;
begin
  F := TForm.CreateNew(nil);
  try
    F.Caption := ACaption;
    F.BorderStyle := bsDialog;
    lbl := TLabel.Create(F);
    lbl.AnchorSideTop.Control := F;
    lbl.AnchorSideLeft.Control := F;
    lbl.BorderSpacing.Top := F.Scale96ToFont(12);
    lbl.BorderSpacing.Bottom := F.Scale96ToFont(2);
    lbl.BorderSpacing.Left := F.Scale96ToFont(12);
    lbl.BorderSpacing.Right := F.Scale96ToFont(12);
    lbl.WordWrap := true;
    lbl.AutoSize := true;
    lbl.Caption := APrompt;
    lbl.Parent := F;
    lbl.AdjustSize;
    ed := TEdit.Create(F);
    ed.AnchorSideTop.Control := lbl;
    ed.AnchorSideTop.Side := asrBottom;
    ed.AnchorSideLeft.Control := F;
    ed.AnchorSideRight.Control := F;
    ed.AnchorSideRight.Side := asrRight;
    ed.Anchors := [akLeft, akTop, akRight];
    ed.BorderSpacing.Left := F.Scale96ToFont(12);
    ed.BorderSpacing.Right := F.Scale96ToFont(12);
    ed.BorderSpacing.Bottom := F.Scale96ToFont(18);
    ed.MaxLength := 1;
    ed.Text := ADefault;
    ed.Parent := F;
    ed.AdjustSize;
    bp := TButtonPanel.Create(F);
    bp.ShowButtons := [pbOK, pbCancel];
    bp.Parent := F;
    bp.AdjustSize;
    F.Constraints.MinHeight := ed.Top + ed.Height + ed.BorderSpacing.Bottom + bp.Height + 2*bp.BorderSpacing.Around;
    F.AutoSize := true;
    F.Position := poScreenCenter;
    if F.ShowModal = mrOK then
      Result := ed.Text
    else
      Result := ADefault;
  finally
    F.Free;
  end;
end;
  
procedure TLCDCharDefsEditor.PopulateCharSelector;
var
  i: integer;
begin
  cbCharSelector.DropdownCount := 24;
  cbCharSelector.Items.BeginUpdate;
  try
    cbCharSelector.Clear;
    for i := 0 to FLCDDisplay.CharDefs.Count - 1 do
      cbCharSelector.Items.Add(FLCDDisplay.CharDefs.CharByIndex[i]);
  finally
    cbCharSelector.Items.EndUpdate;
  end;
end;

procedure TLCDCharDefsEditor.btDeleteClick(Sender: TObject);
begin
  if FSelectedChar <> '' then
  begin
    FLCDDisplay.CharDefs.Delete(FSelectedChar);
    FLCDDisplay.Invalidate;
  end;
  PopulateCharSelector;
end;

procedure TLCDCharDefsEditor.btAddClick(Sender: TObject);
var
  newChar: String;
begin
  newChar := CharInputBox('Dot matrix for...', 'Character', '');
  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
  FSelectedChar := cbCharSelector.Text;
  if FSelectedChar <> '' then
    FTmpDotRows := FLCDDisplay.CharDefs.DotRows[FSelectedChar]
  else
    ClearEditorGrid;
  dgDotMatrix.Invalidate;
  FModified := false;
end;

procedure TLCDCharDefsEditor.dgDotMatrixKeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
var
  r, c: integer;
begin
  r := dgDotMatrix.Row;
  c := dgDotMatrix.Col;
  if Key = 32 then
  begin
    ToggleDot(c, r);
    dgDotMatrix.InvalidateCell(c, r);
    FModified := true;
  end;
end;

procedure TLCDCharDefsEditor.dgDotMatrixMouseDown(Sender: TObject; 
  Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
var
  r, c: Integer;
begin
  dgDotMatrix.MouseToCell(X,Y, c, r);
  ToggleDot(c, r);
  dgDotMatrix.InvalidateCell(c, r);
  FOldRow := r;
  FOldCol := c;
  FModified := true;
end;

procedure TLCDCharDefsEditor.dgDotMatrixMouseMove(Sender: TObject; 
  Shift: TShiftState; X, Y: Integer);
var
  r, c: Integer;
begin
  if Shift = [ssLeft] then 
  begin
    dgDotMatrix.MouseToCell(X,Y, c, r);
    if (c <> FOldCol) or (r <> FOldRow) then
    begin
      ToggleDot(c, r);
      dgDotMatrix.InvalidateCell(c, r);
      FOldRow := r;
      FOldCol := c;
      FModified := true;
    end;
  end;
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
  w := Max(btOK.Width, btCancel.Width);
  btOK.Constraints.MinWidth := w;
  btCancel.Constraints.MinWidth := w;
end;

procedure TLCDCharDefsEditor.FormCloseQuery(Sender: TObject; var CanClose: boolean);
const
  mrReplace = -20;
  mrAddAs = -21;
var
  res: Integer;
begin
  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;
  end;
end;

procedure TLCDCharDefsEditor.FormDestroy(Sender: TObject);
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
  FSavedCharDefs.Free;
  FSavedCharDefs := TCharDefs.Create(nil);
  FSavedCharDefs.Assign(FLCDDisplay.CharDefs);
end;

procedure TLCDCharDefsEditor.SetLCDDisplay(AValue: TLCDDisplay);
begin
  FLCDDisplay := AValue;
  SetLength(FTmpDotRows, FLCDDisplay.DotRowCount);
  SaveCharDefs;
  PopulateCharSelector;
  SetupEditorGrid;
end;

procedure TLCDCharDefsEditor.ClearEditorGrid;
var
  i: integer;
begin
  for i := 0 to High(FTmpDotRows) do
    FTmpDotRows[i] := 0;
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
  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.