--- /dev/null
+<?xml version="1.0" encoding="UTF-8"?>
+<CONFIG>
+ <ProjectOptions>
+ <Version Value="9"/>
+ <PathDelim Value="\"/>
+ <General>
+ <SessionStorage Value="InProjectDir"/>
+ <MainUnit Value="0"/>
+ <Title Value="SeichoKyokusen"/>
+ <ResourceType Value="res"/>
+ <UseXPManifest Value="True"/>
+ <Icon Value="0"/>
+ </General>
+ <i18n>
+ <EnableI18N LFM="False"/>
+ </i18n>
+ <VersionInfo>
+ <StringTable ProductVersion=""/>
+ </VersionInfo>
+ <BuildModes Count="1">
+ <Item1 Name="Default" Default="True"/>
+ </BuildModes>
+ <PublishOptions>
+ <Version Value="2"/>
+ </PublishOptions>
+ <RunParams>
+ <local>
+ <FormatVersion Value="1"/>
+ </local>
+ </RunParams>
+ <RequiredPackages Count="1">
+ <Item1>
+ <PackageName Value="LCL"/>
+ </Item1>
+ </RequiredPackages>
+ <Units Count="2">
+ <Unit0>
+ <Filename Value="SeichoKyokusen.lpr"/>
+ <IsPartOfProject Value="True"/>
+ <UnitName Value="SeichoKyokusen"/>
+ </Unit0>
+ <Unit1>
+ <Filename Value="u_seichokyokusen1.pas"/>
+ <IsPartOfProject Value="True"/>
+ <ComponentName Value="Form1"/>
+ <HasResources Value="True"/>
+ <ResourceBaseClass Value="Form"/>
+ <UnitName Value="u_SeichoKyokusen1"/>
+ </Unit1>
+ </Units>
+ </ProjectOptions>
+ <CompilerOptions>
+ <Version Value="11"/>
+ <PathDelim Value="\"/>
+ <Target>
+ <Filename Value="SeichoKyokusen"/>
+ </Target>
+ <SearchPaths>
+ <IncludeFiles Value="$(ProjOutDir)"/>
+ <UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/>
+ </SearchPaths>
+ <Linking>
+ <Options>
+ <Win32>
+ <GraphicApplication Value="True"/>
+ </Win32>
+ </Options>
+ </Linking>
+ <Other>
+ <CompilerMessages>
+ <MsgFileName Value=""/>
+ </CompilerMessages>
+ <CompilerPath Value="$(CompPath)"/>
+ </Other>
+ </CompilerOptions>
+ <Debugging>
+ <Exceptions Count="3">
+ <Item1>
+ <Name Value="EAbort"/>
+ </Item1>
+ <Item2>
+ <Name Value="ECodetoolError"/>
+ </Item2>
+ <Item3>
+ <Name Value="EFOpenError"/>
+ </Item3>
+ </Exceptions>
+ </Debugging>
+</CONFIG>
--- /dev/null
+{
+ Feeding Origin 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は、日本飼養標準に基づいた家畜の養分要求量の計算および飼料設計を支援するソフ
+ トウェアです.
+ 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 ＞
+}
+
+program SeichoKyokusen;
+
+{$mode objfpc}{$H+}
+
+uses
+ {$IFDEF UNIX}{$IFDEF UseCThreads}
+ cthreads,
+ {$ENDIF}{$ENDIF}
+ Interfaces, // this includes the LCL widgetset
+ Forms, u_SeichoKyokusen1
+ { you can add units after this };
+
+{$R *.res}
+
+begin
+ RequireDerivedFormResource := True;
+ Application.Initialize;
+ Application.CreateForm(TForm1, Form1);
+ Application.Run;
+end.
+
--- /dev/null
+unit u_SeichoKyokusen1;
+
+{
+ 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 ＞
+}
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+ Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, ExtCtrls, Math,
+ StdCtrls;
+
+type
+
+ { TForm1 }
+
+ TForm1 = class(TForm)
+ Button1: TButton;
+ Button2: TButton;
+ LabeledEdit1: TLabeledEdit;
+ Memo1: TMemo;
+ Memo2: TMemo;
+ Panel1: TPanel;
+ Splitter1: TSplitter;
+ procedure Button1Click(Sender: TObject);
+ procedure Button2Click(Sender: TObject);
+ procedure FormShow(Sender: TObject);
+ procedure LabeledEdit1KeyDown(Sender: TObject; var Key: Word;
+ Shift: TShiftState);
+ private
+ { private declarations }
+ public
+ { public declarations }
+ procedure Display2Memo1(dNR, dTJ, dSH, dZT : Double; sMS : String);
+ procedure Display2Memo2(sTj, sNz : String);
+ end;
+
+var
+ Form1: TForm1;
+
+implementation
+
+{$R *.lfm}
+
+{ TForm1 }
+
+procedure TForm1.Button1Click(Sender: TObject);
+var
+ dY : Double ; //体重
+ dA : Double ; //日齢
+ usM : String ;
+begin
+//計算
+{***********************************************************************
+ A：日齢
+ Y：体重（Kg）
+ G：妊娠日数
+
+・0～50日齢まで
+ Y=43.17+0.05105*A+0.01388*A^2-7.666*10^-5*A^3
+
+・51日齢以降
+ 成長部分 Y=707.1277309*(1-0.9517559*exp(-0.0018804*A))^1.1439116
+ 妊娠部分 +0.233001*G+4.945*10^-4*G^2
+***********************************************************************}
+
+ dA := StrToFloat(LabeledEdit1.Text);
+
+ if(dA < 51) then // 0～50日齢まで
+ dY := 43.17 + 0.05105 * dA + 0.01388 * Power( dA, 2) - 7.666 * (0.00001*Power(dA,3))
+ else // 51日齢以降
+ dY := 707.1277309 * Power(1 - 0.9517559 * exp(-0.0018804 * dA), 1.1439116);
+
+ usM := '生後' + FloatToStrF(dA, ffNumber, 4, 0) + '日目： ' + FloatToStrF(dY, ffNumber, 4, 2) + ' kg';
+ Memo1.Lines.Add( '' );
+ Memo1.Lines.Add( usM );
+ Memo1.Height:=Form1.ClientHeight - (Form1.Panel1.Height + Form1.Splitter1.Height + 1);
+end;
+
+procedure TForm1.Button2Click(Sender: TObject);
+var
+ dY : Double; //体重
+ dA : Double; //日齢
+ dOld : Double; //前回の体重
+ dI : Double; //日増体重
+ iK : Integer; //体重区画
+ iWrk : Integer;
+ iNo : Integer;
+ i : Integer;
+ dT : Double;
+ dAVG : Double; //日増体重区間平均
+ iKKan : array[0..1] of Integer; //日増体重区間
+ usA, usAVG, usOldAVG : String;
+begin
+ // 0～4000日齢までの体重を通し計算する
+ dOld := 43.07797; //前回の体重
+ iK := 40; //体重区画
+ iNo := 0;
+ dT := 0.00;
+ iKKan[0] := 40;
+ usOldAVG := '0.0';
+
+ Memo1.Lines.Add(' 日齢 体重(四捨五入) 一日増体重');
+ Memo1.Lines.Add('------------------------------------------------------------------------');
+
+ Display2Memo2( ' 体重(kg)', '１日増体重(kg)' ) ;
+ Memo2.Lines.Add('--------------------------');
+
+ for i := 1 to 4000 do
+ begin
+ dA := i;
+
+ if (dA < 51) then // 0～50日齢まで
+ dY := 43.17 + 0.05105 * dA + 0.01388 * Power( dA, 2) - 7.666 * (0.00001 * Power(dA,3))
+ else // 51日齢以降
+ dY := 707.1277309 * Power(1 - 0.9517559 * exp(-0.0018804 * dA), 1.1439116);
+
+ dI := dY - dOld ; // 日増体重
+
+ iWrk := StrToInt(FloatToStrF(dY, ffNumber, 10, 0));
+ if ( iWrk = iK ) then
+ begin
+ dT += dI ;
+ iNo += 1;
+ usA := '';
+ end
+ else
+ begin
+ if (iNo = 0) then
+ usAVG := '0.0'
+ else
+ begin
+ dAVG := dT / iNo ;
+ usAVG := FloatToStrF(dAVG, ffNumber, 10, 1);
+ end;
+
+ if ( usAVG <> usOldAVG ) then
+ begin
+ iKKan[1] := iK-1;
+ if( iKKan[0] <> iKKan[1] ) then
+ Display2Memo2( IntToStr(iKKan[0])+'～'+IntToStr(iKKan[1]), usOldAVG )
+ else
+ Display2Memo2( IntToStr(iKKan[0]), usOldAVG ) ;
+
+ iKKan[0] := iWrk-1;
+ usOldAVG := usAVG;
+ end;
+
+ usA := ' 体重 ' + IntToStr(iK) + ' kgの一日増体重は： ' + usAVG + ' kg';
+
+ iNo := 1;
+ dT := dI;
+ iK := iWrk;
+ end;
+
+ Display2Memo1( dA, dY, dY, dI, usA );
+
+ dOld := dY;
+ end;
+
+ iKKan[1] := iK;
+ if( iKKan[0] <> iKKan[1] ) then
+ Display2Memo2( IntToStr(iKKan[0])+'～'+IntToStr(iKKan[1]), usOldAVG )
+ else
+ Display2Memo2( IntToStr(iKKan[0]), usOldAVG ) ;
+
+ //----
+ Form1.Memo1.Height:= 0;
+
+
+end;
+
+procedure TForm1.FormShow(Sender: TObject);
+begin
+ Memo1.Height:= ClientHeight - Panel1.Height - Splitter1.Height;
+end;
+
+procedure TForm1.LabeledEdit1KeyDown(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
+ Form1.SelectNext(Sender as TWinControl, False, True ) // フォーカス移動（後進）
+ else
+ Form1.SelectNext(Sender as TWinControl, True, True ); // フォーカス移動（前進）
+ Key := 0 ;
+ end;
+ else
+ Key := 0;
+ end;
+end;
+
+procedure TForm1.Display2Memo1(dNR, dTJ, dSH, dZT : Double; sMS : String);
+var
+ sS1, sS2, sS3, sS4, sS5, sLin : String;
+begin
+ sS1 := RightStr(' ' + FloatToStrF(dNR, ffNumber, 4, 0), 5);
+ sS2 := RightStr(' ' + FloatToStrF(dTJ, ffNumber, 10, 4), 10);
+ sS3 := RightStr(' (' + FloatToStrF(dSH, ffNumber, 10, 0), 6) + ')';
+ sS4 := RightStr(' ' + FloatToStrF(dZT, ffNumber, 10, 4), 10);
+ sS5 := ' ' + sMS ;
+ sLin := sS1 + sS2 + sS3 + sS4 + sS5 ;
+ Memo1.Lines.Add( sLin );
+end;
+
+procedure TForm1.Display2Memo2(sTj, sNz : String);
+var
+ iL, iP : Integer;
+ sWk, sLin : String;
+begin
+ iL := Length(sTj);
+ iP := Length(sNz);
+ case iL of
+ 2 : sWk := ' ';
+ 6 : sWk := ' ';
+ 7 : sWk := ' ';
+ 8 : sWk := ' ';
+ 9 : sWk := ' ';
+ end;
+
+ if iL = 2 then
+ sLin := RightStr((' '+sTj+sWk), 11)
+ else
+ sLin := RightStr((' '+sTj+sWk), 12);
+
+ if iP > 4 then
+ sLin += ' ' + sNz
+ else
+ sLin += ' ' + sNz ;
+
+ Memo2.Lines.Add( sLin );
+end;
+
+end.
+
OSDN Git Service
