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.