【例子介绍】
【相关图片】
【源码结构】
procedure TFrmM.BtnSaveClick(Sender: TObject); var i,j,k,jj:integer; r:real; sFn,ss,sSlp,s:string; Dt:TDateTime; Tm:TTime; begin sFn := AppPath Ed_fName.Text ; if Chk_SaveFileTo.Checked and (Application.MessageBox(PCHAR('保存数据到:' sFn ), '提示',MB_OKCANCEL) =2) then EXIT; sList.Clear; j := sListRec.Count; if (j=0)and(Memo1.Lines.Count >0) then begin sListRec.AddStrings(Memo1.Lines); j := sListRec.Count; end; k := 1; for i := 0 to j-1 do begin ss := sListRec[i] ; SlDataToList( ss , ListRs ); //ListRs if (ListRs[iXm4]<>'') and (ListRs[iRs2]<>'') then begin ss := ListRs[iRs2] ; while ss[1] in ['<','>','='] do delete(ss,1,1); r := Roundto( ( rFactor*StrToFloatDef(ss , 1) ),-2); ss := FloatToStr(r) ; if Chk_JHGS.Checked then sList.Add(Inttostr(k) ',' ListRs[iXm4] '=' ss) else sList.Add(ListRs[iBH1] ',' ListRs[iXm4] '=' ss ListRs[iDW5]); k:=k 1; end; end; Memo1.Lines.Clear; Memo1.Lines.AddStrings(sList); sList.SaveToFile(sFn); Dt := now; Tm := TimeOf(Dt); sList.SaveToFile(AppPath 'RecBak\' DateToStr(Dt) ' ' FloatToStr(Tm) '.TXT'); Application.ProcessMessages; // j := 0; k := 0; //j := GetToFile(sList,sFn) ; /// k := sList.Count ; Memo1.Lines.Add('收到:' IntToStr(j) '/' Inttostr(k) '个符合数据。' ); end;
评论