unityarnls.pas.bak

纺织类 纤维强力测试中蠕变性能测试源码

unit UnitYarnLs;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, Buttons, ExtCtrls, ComCtrls, TeEngine, Series,Dateutils,
  TeeProcs, Chart, CPortCtl, printers,CPort, SkinCaption, WinSkinStore, WinSkinData,
  Menus, DB, ADODB,IniFiles, ToolWin, ImgList;

type
  TFormYarnLS = class(TForm)
    Chart1: TChart;
    Series1: TFastLineSeries;
    StatusBar1: TStatusBar;
    Panel1: TPanel;
    BitBtn1: TBitBtn;
    BitBtn2: TBitBtn;
    BitBtnLs: TBitBtn;
    BitBtn3: TBitBtn;
    BitBtn4: TBitBtn;
    BitBtn5: TBitBtn;
    Label14: TLabel;
    Label15: TLabel;
    Label13: TLabel;
    Label1: TLabel;
    Label16: TLabel;
    Label17: TLabel;
    ComPort1: TComPort;
    ComLed1: TComLed;
    Series2: TPointSeries;
    Button1: TButton;
    GroupBox1: TGroupBox;
    Label2: TLabel;
    Label3: TLabel;
    Label4: TLabel;
    Label5: TLabel;
    Label6: TLabel;
    Label7: TLabel;
    Label21: TLabel;
    Label22: TLabel;
    ComboBox2: TComboBox;
    ComboBox3: TComboBox;
    Edit2: TEdit;
    UpDown1: TUpDown;
    UpDown2: TUpDown;
    Edit3: TEdit;
    UpDown3: TUpDown;
    Edit4: TEdit;
    UpDown4: TUpDown;
    Edit5: TEdit;
    Edit10: TEdit;
    Edit11: TEdit;
    Label12: TLabel;
    Edit7: TEdit;
    SkinData1: TSkinData;
    SkinCaption1: TSkinCaption;
    MainMenu1: TMainMenu;
    N1: TMenuItem;
    N2: TMenuItem;
    N3: TMenuItem;
    N4: TMenuItem;
    N5: TMenuItem;
    N6: TMenuItem;
    N7: TMenuItem;
    N8: TMenuItem;
    N9: TMenuItem;
    N10: TMenuItem;
    N11: TMenuItem;
    N12: TMenuItem;
    N13: TMenuItem;
    PrintDialog1: TPrintDialog;
    N14: TMenuItem;
    N15: TMenuItem;
    N16: TMenuItem;
    ToolBar1: TToolBar;
    ToolButton1: TToolButton;
    ToolButton2: TToolButton;
    ToolButton3: TToolButton;
    ToolButton6: TToolButton;
    ToolButton7: TToolButton;
    ToolButton8: TToolButton;
    ToolButton9: TToolButton;
    ToolButton10: TToolButton;
    ToolButton11: TToolButton;
    ToolButton12: TToolButton;
    ToolButton13: TToolButton;
    ToolButton14: TToolButton;
    ToolButton15: TToolButton;
    ToolButton16: TToolButton;
    ToolButton17: TToolButton;
    ToolButton18: TToolButton;
    ImageList1: TImageList;
    GroupBox2: TGroupBox;
    Label9: TLabel;
    Label10: TLabel;
    Label19: TLabel;
    Label20: TLabel;
    Label11: TLabel;
    Label8: TLabel;
    ComboBox5: TComboBox;
    ComboBox6: TComboBox;
    Edit6: TEdit;
    UpDown7: TUpDown;
    Edit9: TEdit;
    ComboBox4: TComboBox;
    Edit1: TEdit;
    procedure ComPort1RxChar(Sender: TObject; Count: Integer);
    procedure BitBtn3Click(Sender: TObject);
    procedure ComPort1AfterClose(Sender: TObject);
    procedure ComPort1AfterOpen(Sender: TObject);
    procedure BitBtn1Click(Sender: TObject);
    procedure BitBtnLsClick(Sender: TObject);
    procedure BitBtn2Click(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure ComboBox2Exit(Sender: TObject);
    procedure ComboBox3Exit(Sender: TObject);
    procedure BitBtn4Click(Sender: TObject);
    procedure BitBtn5Click(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure FormDeactivate(Sender: TObject);
    procedure FormActivate(Sender: TObject);
    procedure N2Click(Sender: TObject);
    procedure N4Click(Sender: TObject);
    procedure N6Click(Sender: TObject);
    procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
    procedure N13Click(Sender: TObject);
    procedure N15Click(Sender: TObject);
    procedure N16Click(Sender: TObject);
     //function  fac(aa:real):real;
  private
    { Private declarations }

  public
    { Public declarations }
    procedure SetActiveLanguage(LanguageName:string);
  end;
type dd=record
     x,y:real;
     end;
var
  FormYarnLS: TFormYarnLS;
  j:integer=0; //放在这个地方不知道对不,每做完一次都得将此复原
  sum:real=0;
  dat:array[0..15] of byte;
  datB:array[0..15] of byte;
  hh1:string='';
  hh2:string='';
  tt:integer=0;
  LS:boolean=false;
  sj:string='';
  f:file of dd ;
  i:integer=0;
  wccs:integer=0;
  sycs:integer=0;
  df:dd;
  ff,ee:array[0..5000] of real;
implementation
uses  Datayarn, Unityarnlslook, UnitfiberPoint, UnitSJBF, UnitAbout;

{$R *.dfm}
//进行判断哪个语言处于激活状态
procedure TFormYarnLS.SetActiveLanguage(LanguageName:string);
const
  Translations='Translations';
  Messages='Messages';
var
  frmComponent:TComponent;
  i:Integer;
begin
  with TInifile.Create(ExtractFilePath(ParamStr(0))+LanguageName) do
  begin
    for i:=0 to ComponentCount-1 do { 遍历Form组件 }
    begin
      frmComponent:=Components[i];
      if frmComponent is TLabel then { 如果组件为TLabel型则当作TLabel处理，以下同 }
      begin
        (frmComponent as TLabel).Caption:=
	ReadString(Translations,frmComponent.Name+'.Caption',(frmComponent as TLabel).Caption);
      end;
      if frmComponent is TCheckBox then
      begin
        (frmComponent as TCheckBox).Caption:=
	ReadString(Translations,frmComponent.Name+'.Caption',(frmComponent as TCheckBox).Caption);        
      end;
      if frmComponent is TButton then
      begin
        (frmComponent as TButton).Caption:=
	ReadString(Translations,frmComponent.Name+'.Caption',(frmComponent as TButton).Caption);
        (frmComponent as TButton).Hint:=
	ReadString(Translations,frmComponent.Name+'.Hint',(frmComponent as TButton).Hint);
      end;
      if frmComponent is TMenuItem then
      begin
        (frmComponent as TMenuItem).Caption:=
	ReadString(Translations,frmComponent.Name+'.Caption',(frmComponent as TMenuItem).Caption);
      end;
      if frmComponent is TGroupbox then
      begin
        (frmComponent as TGroupbox ).Caption:=
	ReadString(Translations,frmComponent.Name+'.Caption',(frmComponent as TGroupbox).Caption);
      end;
    end;
    //M1:=ReadString(Messages,'M1',M1);
  end;
end;

 function  fac(aa:real):real;
 begin
 result:=round(aa*100)/100;
 end;

procedure TFormYarnLS.ComPort1RxChar(Sender: TObject; Count: Integer);
 var
  str,ss,sr:string;
  a,b,c:byte;
  xx,yy:real;
  df:dd;


   fn,lmm,BL,emm,BW,Ygd,Xkd,
   TriangleH,BF,Be,Wk,x,E,p,bp,
   min,max,pf,pe,p0,e0:real;
   i,y,n,t:integer;
   cc:array of real;
  k,ddmax,s,ppp,eee:real;
begin
  xx:=0;
  yy:=0;
  comport1.ReadStr(str,count);
//ls代表截余
   if str='QS' then exit;
   tt:=length(str);
   sr:=copy(str,tt-1,2);
if sr='WB' then
  begin
    i:=0;
    fn:=0;
    lmm:=0;
    n:=j-1;
 //计算断裂强力
   for i:=0 to n do
   begin
   if fn<=ff[i] then  fn:=ff[i];
   end;
  p:=fn/strtofloat(edit10.Text);
 //计算断裂功和断裂伸长
   Wk:=0;
   for i:=0 to n-1 do
    if fn=ff[i] then
     begin
       lmm:=ee[i];
       for y:=0 to i-1 do
       begin
       Ygd:=ff[y];
       Xkd:=ee[y+1]-ee[y];
       TriangleH:=ff[j+1]-ff[j];
       Wk:=wk+Xkd*Ygd+0.5*Xkd*TriangleH;
       end;
     end;

//计算断脱功
  BW:=0;
  for i:=0 to n-2 do
  begin
  Ygd:=ff[i];
  Xkd:=ee[i+1]-ee[i];
  TriangleH:=ff[i+1]-ff[i];
  BW:=wk+Xkd*Ygd+0.5*Xkd*TriangleH;
  end;
///////////////////////////////////////
//用点到直线的距离求屈服点应力应变  pf ,pe
    pf:=0;
    pe:=0;
 if lmm<>0 then
   k:=fn/lmm;
  x:=sqrt(1+k*k);

for i:=0 to n do
if fn=ff[i] then
    t:=i;
    t:=round(t*0.2);
 setlength(cc,n+1);
 for i:=0 to t do
  begin
  s:=abs(k*ee[i]-ff[i]);
  cc[i]:=s/x;
  end;
 ddmax:=0;
  for i:=0 to t do
  if cc[i]>ddmax then ddmax:=cc[i];
   for i:=0 to t do
    if cc[i]=ddmax then
    begin
    t:=i;
    pf:=ff[i];
    pe:=ee[i];
    break;
    end;

 //求初始模量 (最小二乘法)
 if pe<>0 then
  k:=pf/pe
  else
  k:=0;

  x:=sqrt(1+k*k);

 for i:=0 to t do
  begin
  s:=abs(k*ee[i]-ff[i]);
  cc[i]:=s/x;
  end;
 ddmax:=0;
 p0:=0;
 e0:=0;