u_commonmodule.pas

   1 {
   2   Feeding Origin 2 is software that supports calculation of nutrient requirement of livestock
   3   and feed design based on Japanese feeding standard.
   4   Copyright (C) 2017,  Syuichiro Fukagawa.
   5
   6   This program is free software; you can redistribute it and/or modify it under the terms of
   7   the GNU General Public License as published by the Free Software Foundation; either version 3
   8   of the License, or (at your option) any later version.
   9   This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY;
  10   without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
  11   See the GNU General Public License for more details.
  12   You should have received a copy of the GNU General Public License along with this program.
  13   If not, see <http://www.gnu.org/licenses/>.
  14
  15
  16   Feeding Origin 2は、日本飼養標準に基づいた家畜の養分要求量の計算および飼料設計を支援するソフ
  17   トウェアです.
  18   Copyright (C) 2017,　深川修一郎.
  19
  20   　このプログラムはフリーソフトウェアです。あなたはこれを、フリーソフトウェア財団によって
  21   発行されたGNU一般公衆利用許諾書(バージョン3か、それ以降のバージョンのうちどれか)が定める
  22   条件の下で再頒布または改変することができます。
  23   このプログラムは有用であることを願って頒布されますが、*全くの無保証* です。商業可能性の保証
  24   や特定目的への適合性は、言外に示されたものも含め、全く存在しません。詳しくはGNU一般公衆利用
  25   許諾書をご覧ください。
  26   　あなたはこのプログラムと共に、GNU一般公衆利用許諾書のコピーを一部 受け取っているはずです。
  27   もし受け取っていなければ、<http://www.gnu.org/licenses/> をご覧ください。
  28
  29   *本日本語訳は、FSFより2007年6月29日に発行されたGNU GPL v3の原文から、八田真行氏が翻訳した
  30    ものを基にしています。 ＜ https://mag.osdn.jp/07/09/02/130237 ＞
  31 }
  32
  33 unit u_CommonModule;
  34
  35 {$mode objfpc}{$H+}
  36
  37 interface
  38
  39 uses
  40   Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs,
  41   ExtCtrls, StrUtils, LCLType ;
  42
  43 procedure ComEditKeyPress(SForm: TForm; Sender: TObject; var Key: char);
  44 procedure ComEditKeyDown(SForm: TForm; Sender: TObject; var Key: Word; Shift: TShiftState);
  45 procedure ComRGKeyDown(Sender: TObject; var Key: Word; NextCtrl: TObject);
  46 procedure ComCBKeyDown(SForm: TForm; Sender: TObject; var Key: Word);
  47
  48 function LengthEdit(sSL : String; iL : Integer) : String ;
  49 function KanjiLength( sSource : String ) : Integer  ;
  50 function FloatEdit( dOrg : Double ;  iSS, iLL : Integer ) : String ;
  51
  52 implementation
  53
  54 procedure ComEditKeyPress(SForm: TForm; Sender: TObject; var Key: char);
  55 begin
  56     if Key = chr(VK_RETURN) then
  57        begin
  58          SForm.SelectNext(Sender as TWinControl, True, True );  // フォーカス移動（前進）
  59        end
  60     else
  61        begin
  62           if (Key <> chr(VK_TAB))    and
  63              (Key <> chr(VK_SHIFT))  and
  64              (Key <> chr(VK_DELETE)) and
  65              (Key <> chr(VK_BACK))   and
  66              (Key <> '0')  and
  67              (Key <> '1')  and
  68              (Key <> '2')  and
  69              (Key <> '3')  and
  70              (Key <> '4')  and
  71              (Key <> '5')  and
  72              (Key <> '6')  and
  73              (Key <> '7')  and
  74              (Key <> '8')  and
  75              (Key <> '9')  and
  76              (Key <> '.')  then
  77                  Key := #0;
  78        end;
  79 end;
  80
  81 procedure ComEditKeyDown(SForm: TForm; Sender: TObject; var Key: Word; Shift: TShiftState);
  82 begin
  83     case Key of
  84         96 .. 105, 110, 8, 9, 16, 37, 39, 46 : // 0～9,.,BS,Tab,Shift,<,>,Delete
  85             ;
  86         13 :                                   // Enter
  87             begin
  88               if ( Shift = [ssShift] )  then
  89                   SForm.SelectNext(Sender as TWinControl, False, True )  // フォーカス移動（後進）
  90               else
  91                   SForm.SelectNext(Sender as TWinControl, True, True );  // フォーカス移動（前進）
  92               Key := 0 ;
  93             end;
  94         else
  95             Key := 0;
  96     end;
  97 end;
  98
  99 procedure ComRGKeyDown(Sender: TObject; var Key: Word; NextCtrl: TObject );
 100 var
 101     WinCtrl : TWinControl;
 102 begin
 103     if ( Key = 13 )  then  // Enter
 104       begin
 105         WinCtrl := NextCtrl as TWinControl ;
 106         WinCtrl.SetFocus;
 107         Key := 9 ;
 108       end;
 109 end;
 110
 111 procedure ComCBKeyDown(SForm: TForm; Sender: TObject; var Key: Word);
 112 begin
 113     if ( Key = 13 )  then                        // Enter
 114       begin
 115         Key := 9 ;
 116         SForm.SelectNext(Sender as TWinControl, True, True )  // フォーカス移動（前進）}
 117       end
 118     else if  (Key >= 37) and (Key <= 40)  then   // <, ^, >, v
 119        Key := 0 ;
 120 end;
 121
 122 function LengthEdit(sSL : String; iL : Integer) : String ;
 123 var
 124     iSC, iCN, i : Integer ;
 125 begin
 126     iSC := KanjiLength( sSL ) ;
 127
 128     if ( iSC < iL )  then
 129       begin
 130         iCN := iL - iSC ;
 131         for i :=1 to iCN do
 132           sSL := sSL + ' ' ;
 133       end;
 134
 135     LengthEdit := sSL ;
 136 end;
 137
 138 function KanjiLength( sSource : String ) : Integer  ;
 139 var
 140     iCNo, iNo, iCCode, iKCL  : Integer;
 141     wsConv, wsC1  : WideString;
 142 begin
 143     iKCL    := 0 ;
 144     wsConv  := UTF8Decode( sSource ) ;
 145     iCNo    := Length( wsConv ) ;
 146
 147     iNo := 1;
 148     while iNo <= iCNo do
 149       begin
 150          wsC1   := MidStr( wsConv, iNo, 1 ) ;
 151          iCCode := Ord(wsC1[1]) ;
 152          if ((iCCode >= $0020) and (iCCode <= $00DF)) or ((iCCode >= $FF61) and (iCCode <= $FF9F))  then
 153              iKCL := iKCL +  1    //半角文字です
 154          else
 155              iKCL := iKCL +  2 ;  //全角文字です
 156          iNo := iNo + 1 ;
 157       end;
 158     KanjiLength := iKCL ;
 159 end;
 160
 161 function FloatEdit( dOrg : Double ;  iSS, iLL : Integer ) : String ;
 162 var
 163     iCN, iNo, i  :  Integer ;
 164     sFD, sWk  :  String ;
 165 begin
 166     case ( iSS ) of
 167         0 :
 168             begin
 169               sWk := FormatFloat( '#,##0', dOrg ) ;
 170                 iCN := Length( sWk ) ;
 171             end;
 172         1 :
 173             begin
 174                 sWk := FormatFloat( '#,##0.0', dOrg ) ;
 175                 iCN := Pos( '.', sWk ) - 1 ;
 176             end;
 177         2 :
 178             begin
 179                 sWk := FormatFloat( '#,##0.00', dOrg ) ;
 180                 iCN := Pos( '.', sWk ) - 1 ;
 181             end;
 182         3 :
 183             begin
 184                 sWk := FormatFloat( '#,##0.000', dOrg ) ;
 185                 iCN := Pos( '.', sWk ) - 1 ;
 186             end;
 187         4 :
 188             begin
 189                 sWk := FormatFloat( '#,##0.0000', dOrg ) ;
 190                 iCN := Pos( '.', sWk ) - 1 ;
 191             end;
 192         else
 193             begin
 194                 sWk := FormatFloat( '#,##0.00', dOrg ) ;
 195                 iCN := Pos( '.', sWk ) - 1 ;
 196             end;
 197     end;
 198
 199     sFD := '' ;
 200     if ( iCN < iLL )  then
 201       begin
 202         iNo := iLL - iCN ;
 203         for i := 1 to iNo do
 204             sFD := sFD + ' ' ;
 205         sFD := sFD + sWk ;
 206       end
 207     else
 208         sFD := sWk ;
 209
 210     FloatEdit := sFD ;
 211 end;
 212
 213
 214 end.
 215