【例子介绍】
【相关图片】
【源码结构】
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;



评论