{
  Feeding Origin 2 is software that supports calculation of nutrient requirement of livestock
  and feed design based on Japanese feeding standard.
  Copyright (C) 2017,  Syuichiro Fukagawa.

  This program is free software; you can redistribute it and/or modify it under the terms of
  the GNU General Public License as published by the Free Software Foundation; either version 3
  of the License, or (at your option) any later version.
  This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY;
  without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
  See the GNU General Public License for more details.
  You should have received a copy of the GNU General Public License along with this program.
  If not, see <http://www.gnu.org/licenses/>.


  Feeding Origin 2は、日本飼養標準に基づいた家畜の養分要求量の計算および飼料設計を支援するソフ
  トウェアです.
  Copyright (C) 2017,　深川修一郎.

  　このプログラムはフリーソフトウェアです。あなたはこれを、フリーソフトウェア財団によって
  発行されたGNU一般公衆利用許諾書(バージョン3か、それ以降のバージョンのうちどれか)が定める
  条件の下で再頒布または改変することができます。
  このプログラムは有用であることを願って頒布されますが、*全くの無保証* です。商業可能性の保証
  や特定目的への適合性は、言外に示されたものも含め、全く存在しません。詳しくはGNU一般公衆利用
  許諾書をご覧ください。
  　あなたはこのプログラムと共に、GNU一般公衆利用許諾書のコピーを一部 受け取っているはずです。
  もし受け取っていなければ、<http://www.gnu.org/licenses/> をご覧ください。
  
  *本日本語訳は、FSFより2007年6月29日に発行されたGNU GPL v3の原文から、八田真行氏が翻訳した
   ものを基にしています。 ＜ https://mag.osdn.jp/07/09/02/130237 ＞
}

unit u_CommonModule;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs,
  ExtCtrls, StrUtils, LCLType ;

procedure ComEditKeyPress(SForm: TForm; Sender: TObject; var Key: char);
procedure ComEditKeyDown(SForm: TForm; Sender: TObject; var Key: Word; Shift: TShiftState);
procedure ComRGKeyDown(Sender: TObject; var Key: Word; NextCtrl: TObject);
procedure ComCBKeyDown(SForm: TForm; Sender: TObject; var Key: Word);

function LengthEdit(sSL : String; iL : Integer) : String ;
function KanjiLength( sSource : String ) : Integer  ;
function FloatEdit( dOrg : Double ;  iSS, iLL : Integer ) : String ;

implementation

procedure ComEditKeyPress(SForm: TForm; Sender: TObject; var Key: char);
begin
    if Key = chr(VK_RETURN) then
       begin
         SForm.SelectNext(Sender as TWinControl, True, True );  // フォーカス移動（前進）
       end
    else
       begin
          if (Key <> chr(VK_TAB))    and
             (Key <> chr(VK_SHIFT))  and
             (Key <> chr(VK_DELETE)) and
             (Key <> chr(VK_BACK))   and
             (Key <> '0')  and
             (Key <> '1')  and
             (Key <> '2')  and
             (Key <> '3')  and
             (Key <> '4')  and
             (Key <> '5')  and
             (Key <> '6')  and
             (Key <> '7')  and
             (Key <> '8')  and
             (Key <> '9')  and
             (Key <> '.')  then
                 Key := #0;
       end;
end;

procedure ComEditKeyDown(SForm: TForm; Sender: TObject; var Key: Word; Shift: TShiftState);
begin
    case Key of
        96 .. 105, 110, 8, 9, 16, 37, 39, 46 : // 0～9,.,BS,Tab,Shift,<,>,Delete
            ;
        13 :                                   // Enter
            begin
              if ( Shift = [ssShift] )  then
                  SForm.SelectNext(Sender as TWinControl, False, True )  // フォーカス移動（後進）
              else
                  SForm.SelectNext(Sender as TWinControl, True, True );  // フォーカス移動（前進）
              Key := 0 ;
            end;
        else
            Key := 0;
    end;
end;

procedure ComRGKeyDown(Sender: TObject; var Key: Word; NextCtrl: TObject );
var
    WinCtrl : TWinControl;
begin
    if ( Key = 13 )  then  // Enter
      begin
        WinCtrl := NextCtrl as TWinControl ;
        WinCtrl.SetFocus;
        Key := 9 ;
      end;
end;

procedure ComCBKeyDown(SForm: TForm; Sender: TObject; var Key: Word);
begin
    if ( Key = 13 )  then                        // Enter
      begin
        Key := 9 ;
        SForm.SelectNext(Sender as TWinControl, True, True )  // フォーカス移動（前進）}
      end
    else if  (Key >= 37) and (Key <= 40)  then   // <, ^, >, v
       Key := 0 ;
end;

function LengthEdit(sSL : String; iL : Integer) : String ;
var
    iSC, iCN, i : Integer ;
begin
    iSC := KanjiLength( sSL ) ;

    if ( iSC < iL )  then
      begin
        iCN := iL - iSC ;
        for i :=1 to iCN do
          sSL := sSL + ' ' ;
      end;

    LengthEdit := sSL ;
end;

function KanjiLength( sSource : String ) : Integer  ;
var
    iCNo, iNo, iCCode, iKCL  : Integer;
    wsConv, wsC1  : WideString;
begin
    iKCL    := 0 ;
    wsConv  := UTF8Decode( sSource ) ;
    iCNo    := Length( wsConv ) ;

    iNo := 1;
    while iNo <= iCNo do
      begin
         wsC1   := MidStr( wsConv, iNo, 1 ) ;
         iCCode := Ord(wsC1[1]) ;
         if ((iCCode >= $0020) and (iCCode <= $00DF)) or ((iCCode >= $FF61) and (iCCode <= $FF9F))  then
             iKCL := iKCL +  1    //半角文字です
         else
             iKCL := iKCL +  2 ;  //全角文字です
         iNo := iNo + 1 ;
      end;
    KanjiLength := iKCL ;
end;

function FloatEdit( dOrg : Double ;  iSS, iLL : Integer ) : String ;
var
    iCN, iNo, i  :  Integer ;
    sFD, sWk  :  String ;
begin
    case ( iSS ) of
        0 :
            begin
              sWk := FormatFloat( '#,##0', dOrg ) ;
                iCN := Length( sWk ) ;
            end;
        1 :
            begin
                sWk := FormatFloat( '#,##0.0', dOrg ) ;
                iCN := Pos( '.', sWk ) - 1 ;
            end;
        2 :
            begin
                sWk := FormatFloat( '#,##0.00', dOrg ) ;
                iCN := Pos( '.', sWk ) - 1 ;
            end;
        3 :
            begin
                sWk := FormatFloat( '#,##0.000', dOrg ) ;
                iCN := Pos( '.', sWk ) - 1 ;
            end;
        4 :
            begin
                sWk := FormatFloat( '#,##0.0000', dOrg ) ;
                iCN := Pos( '.', sWk ) - 1 ;
            end;
        else
            begin
                sWk := FormatFloat( '#,##0.00', dOrg ) ;
                iCN := Pos( '.', sWk ) - 1 ;
            end;
    end;

    sFD := '' ;
    if ( iCN < iLL )  then
      begin
    	iNo := iLL - iCN ;
        for i := 1 to iNo do
    	    sFD := sFD + ' ' ;
    	sFD := sFD + sWk ;
      end
    else
    	sFD := sWk ;

    FloatEdit := sFD ;
end;


end.

