unit LangManDlg;

//***************************************************************************
//**  LangMan - Localization components for Delphi (Support UNICODE)       **
//***************************************************************************
//**                                                                       **
//**  File:      LangManDlg.pas                                            **
//**                                                                       **
//**  Version:   1.2.0                                                     **
//**                                                                       **
//**  Date:      18.1.2012                                                 **
//**                                                                       **
//**  Author:    Ing. Tomas Halabala - REGULACE.ORG                        **
//**                                                                       **
//**  License:   This components set is free for personal use.             **
//**             Comercial use is not allowed without author permission!   **
//**                                                                       **
//**             Tato sada komponent je zdarma pro nekomerční použití.     **
//**             Komerční využití konzultujte s autorem!                   **
//**                                                                       **
//**             Šíření je dovoleno pouze v nezměněné podobě.              **
//**             Autor neodpovídá za žádné případné škody způsobené        **
//**             používáním této komponenty.                               **
//**                                                                       **
//**             Tento zdrojový kód je chráněn autorským zákonem.          **
//**                                                                       **
//**  Disclaimer:THE SOFTWARE AND ANY RELATED DOCUMENTATION IS PROVIDED    **
//**             "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESS OR   **
//**             IMPLIED, INCLUDING, WITHOUT LIMITATION, THE IMPLIED       **
//**             WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR   **
//**             PURPOSE, OR NONINFRINGEMENT. AUTHOR DOES NOT WARRANT,     **
//**             GUARANTEE, OR MAKE ANY REPRESENTATIONS REGARDING THE USE, **
//**             OR THE RESULTS OF THE USE, OF THE SOFTWARE IN TERMS OF    **
//**             CORRECTNESS, ACCURACY, RELIABILITY, OR OTHERWISE.         **
//**             THE ENTIRE RISK ARISING OUT OF USE OR PERFORMANCE         **
//**             OF THE SOFTWARE REMAINS WITH YOU.                         **
//**                                                                       **
//**  Copyright: Copyright © 2009-2012 by Ing.Tomas Halabala.              **
//**                                                                       **
//**  E-mail:    tomas.halabala@regulace.org                               **
//**                                                                       **
//**  Webpages:  http://www.regulace.org                                   **
//**                                                                       **
//***************************************************************************

interface

uses Windows, Classes, Graphics, Forms, Controls, Buttons, Dialogs, DesignEditors,
     DesignIntf, StdCtrls, ExtCtrls, ComCtrls, Menus, ActnPopup, Grids, ValEdit;

type
  TStringsEditor = class(TForm)
    OpenDialog: TOpenDialog;
    SaveDialog: TSaveDialog;
    Panel1: TPanel;
    Panel2: TPanel;
    OKButton: TButton;
    CancelButton: TButton;
    ExportBtn: TButton;
    ImportBtn: TButton;
    ValueListEditor: TValueListEditor;
    Panel3: TPanel;
    LItemsCountLabel: TLabel;
    LItemsCount: TLabel;
    LRegulace: TLabel;
    procedure FileOpen(Sender: TObject);
    procedure FileSave(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure ValueListEditorKeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure ValueListEditorStringsChange(Sender: TObject);
    procedure ValueListEditorKeyUp(Sender: TObject; var Key: Word;
      Shift: TShiftState);
  private
    Items: TStringList;
    DelRow: Integer;
    ClearNot: boolean;
    LexiconMode: boolean;
    procedure UpdateStatus;
  protected
    function GetLines: TStrings; virtual;
    procedure SetLines(const Value: TStrings); virtual;
    procedure RefreshEditor(SelItem: Boolean; Nr: Integer); virtual;
  public
    property Lines: TStrings read GetLines write SetLines;
  end;

  TStringsProperty = class(TClassProperty)
  protected
    function EditDialog: TStringsEditor; virtual;
    function GetStrings: TStrings; virtual;
    procedure SetStrings(const Value: TStrings); virtual;
  public
    function GetAttributes: TPropertyAttributes; override;
    procedure Edit; override;
  end;

  TLexiconStringsProperty = class(TStringsProperty)
    function EditDialog: TStringsEditor; override;
  end;

  TNamedRowsProperty = class(TLexiconStringsProperty)
    function EditDialog: TStringsEditor; override;
  end;

  TValueListEditorFree = class(TValueListEditor)
  public
    property EditList;
  end;

implementation

{$R *.dfm}

uses SysUtils, Messages, DesignConst, ToolsAPI, TypInfo;

const TO_ITEM = true;
      TO_ROW = false;

var StoredWidth, StoredHeight, StoredLeft, StoredTop, StoredRow: Integer;

function TStringsProperty.EditDialog: TStringsEditor;
begin
  Result := TStringsEditor.Create(Application);
end;

function TStringsProperty.GetStrings: TStrings;
begin
  Result := TStrings(GetOrdValue);
end;

procedure TStringsProperty.SetStrings(const Value: TStrings);
begin
  SetOrdValue(Longint(Value));
end;

function TStringsProperty.GetAttributes: TPropertyAttributes;
begin
  Result := inherited GetAttributes + [paDialog] - [paSubProperties];
end;

procedure TStringsProperty.Edit;
begin
  with EditDialog do try
    Lines := GetStrings;
    if ShowModal = mrOK then SetStrings(Lines);
  finally
    Free;
  end;
end;

function TLexiconStringsProperty.EditDialog: TStringsEditor;
begin
  Result := inherited EditDialog;
  Result.LexiconMode := true;
  Result.Caption := 'Language Manager - Lexicon Editor';
end;

function TNamedRowsProperty.EditDialog: TStringsEditor;
begin
  Result := inherited EditDialog;
  Result.Caption := 'Rows Editor';
end;

procedure TStringsEditor.FileOpen(Sender: TObject);
begin
  if OpenDialog.Execute then Lines.LoadFromFile(OpenDialog.FileName);
end;

procedure TStringsEditor.FileSave(Sender: TObject);
begin
  SaveDialog.FileName := OpenDialog.FileName;
  if SaveDialog.Execute then Lines.SaveToFile(SaveDialog.FileName);
end;

procedure TStringsEditor.ValueListEditorKeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
var SelectedItem: Integer;
begin
  with ValueListEditor do case Key of
    VK_RETURN: if LexiconMode then begin
                 if Cells[0,Row] <> '' then SelectedItem := StrToInt(Cells[0,Row])
                                       else SelectedItem := 0;
                 if (SelectedItem + 1) = Items.Count then Items.Add('');
                 RefreshEditor(TO_ITEM,SelectedItem + 1);
               end else begin
                 if Row = (RowCount-1) then begin
                   Items.Add('');
                   RefreshEditor(TO_ROW,Row+1);
                 end else Row := Row + 1;
               end;
    VK_DELETE,
    VK_BACK  : if (Cells[1,Row] = '') then DelRow := Row
                                      else DelRow := 0;
    VK_INSERT: if LexiconMode then begin
                 if Cells[0,Row] <> '' then SelectedItem := StrToInt(Cells[0,Row])
                                       else SelectedItem := 0;
                 if SelectedItem > 0 then RefreshEditor(TO_ITEM,SelectedItem - 1);
               end else begin
                 Items.Insert(Row-1,'');
                 RefreshEditor(TO_ROW,Row);
               end;
    VK_RIGHT: SendMessage(TValueListEditorFree(ValueListEditor).EditList.Handle, EM_SETSEL, -1, -1);
  end;
end;

procedure TStringsEditor.ValueListEditorKeyUp(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
  with ValueListEditor do case Key of
    VK_DELETE,
    VK_BACK  : if DelRow > 0 then begin
                 if NOT LexiconMode then Items.Delete(DelRow-1);
                 if (Row > 1) and (Key = VK_BACK) and (Row < (RowCount-1))
                   then RefreshEditor(TO_ROW,Row - 1)
                   else RefreshEditor(TO_ROW,Row);
               end;
  end;
end;

procedure TStringsEditor.ValueListEditorStringsChange(Sender: TObject);
begin
  with ValueListEditor do begin
    if (Row > 0) and (Row <= Items.Count) and
       ((Cells[1,Row] <> '') or (NOT ClearNot)) then begin
      if LexiconMode then if Cells[0,Row] = '' then Items.Strings[0] := Cells[1,Row]
                                               else Items.Strings[StrToInt(Cells[0,Row])] := Cells[1,Row]
                     else Items.Strings[Row-1] := Cells[1,Row];
      UpdateStatus;
    end;
  end;
end;

procedure TStringsEditor.UpdateStatus;
var II, ICount: Integer;
begin
  if (Items.Count = 1) and (Items.Strings[0] = '') then LItemsCount.Caption := '0'
                                                   else if LexiconMode then begin
    ICount := 0;
    for II := 0 to Items.Count - 1 do if Items.Strings[II] <> '' then Inc(ICount);
    LItemsCount.Caption := IntToStr(ICount);
  end else LItemsCount.Caption := IntToStr(Items.Count);
end;

function TStringsEditor.GetLines: TStrings;
begin
  if (Items.Count = 0) and (Items.Strings[0] = '') then Items.Clear;
  Result := Items;
end;

procedure TStringsEditor.SetLines(const Value: TStrings);
begin
  Items.Assign(Value);
  if Items.Count = 0 then Items.Add('');
  if (StoredRow > 0) and ((StoredRow-1) < Items.Count) and
     ((NOT LexiconMode) or (Items.Strings[StoredRow-1] <> ''))
    then RefreshEditor(TO_ROW,StoredRow)
    else RefreshEditor(TO_ROW,1);
end;

procedure TStringsEditor.RefreshEditor(SelItem: Boolean; Nr: Integer);
var II,RowInd,ItemRow: Integer;
begin
  ClearNot := true;
  ValueListEditor.Strings.Clear;
  ClearNot := false;
  RowInd := 0;
  ItemRow := 0;
  if Items.Count > 0 then begin
    for II := 0 to Items.Count - 1 do begin
      if (NOT LexiconMode) or (Items.Strings[II] <> '') or (SelItem and (II = Nr)) then begin
        Inc(RowInd);
        ValueListEditor.InsertRow(IntToStr(II),Items.Strings[II],true);
        if (SelItem and (II = Nr)) then ItemRow := RowInd;
      end;
    end;
  end else Items.Add('');
  if LexiconMode and (ValueListEditor.Cells[0,1] = '') then ValueListEditor.InsertRow('0','',true);
  if ItemRow > 0 then ValueListEditor.Row := ItemRow
                 else if Nr < ValueListEditor.RowCount
                        then ValueListEditor.Row := Nr
                        else ValueListEditor.Row := ValueListEditor.RowCount - 1;
  UpdateStatus;
end;

procedure TStringsEditor.FormCreate(Sender: TObject);
begin
  Items := TStringList.Create;
  LexiconMode := false;
end;

procedure TStringsEditor.FormDestroy(Sender: TObject);
begin
  StoredWidth := Width;
  StoredHeight := Height;
  StoredLeft := Left;
  StoredTop := Top;
  StoredRow := ValueListEditor.Row;
  Items.Free;
end;

procedure TStringsEditor.FormShow(Sender: TObject);
begin
  if Scaled AND (PixelsPerInch <> 96) then begin
    ValueListEditor.DefaultRowHeight := Round(PixelsPerInch * ValueListEditor.DefaultRowHeight / 96);
  end;
  if StoredWidth <> 0 then Width := StoredWidth;
  if StoredHeight <> 0 then Height := StoredHeight;
  if StoredLeft <> 0 then Left := StoredLeft
                     else Left := (Screen.Width - Width) div 2;
  if StoredTop <> 0 then Top := StoredTop
                    else Top := (Screen.Height - Height) div 2;
end;

end.
