TRichEdit.Lines中可存多少行文本?(50分)

  • 主题发起人 主题发起人 mjself
  • 开始时间 开始时间
M

mjself

Unregistered / Unconfirmed
GUEST, unregistred user!
我要从一个query中生成一个 EXCEL CSV文件(实际上就是一个逗号分隔的文本文件)
下面这段程序中当query1中的记录数不多时,程序通过
当query1中的记录数达500左右时,出现 TRichEdit插入错误
是不是TRichedit.lines可存入的文本行数有限制?
怎么才能去掉这个限制?

mem := TRichEdit.Create(Self);
mem.PlainText := True;
mem.parent := self;
try
while not Query1.EOF do
with Query1 do
begin
Price:= FieldByName('PRICE').ASFloat*(100-FieldByName('DISCOUNT').AsFloat)/100;
Qty:=FieldByName('SBQTY').AsInteger;
LineStr := Trim(FieldByName('CoCode').AsString)+','; // 1
LineStr := LineStr + FieldByName('SBNO').AsString+','; //2
LineStr := LineStr + DateToStr(FieldByName('SBDATE').AsDateTime)+',';//3
LineStr := LineStr + 'FALSE,,,';//4
LineStr := LineStr + 'FALSE,,,,,,,,';//7
LineStr := LineStr + FieldByName('COINV').AsString+',,,'; //15
LineStr := LineStr + FieldByName('COINV').AsString+','; //18=#15+30 ???
LineStr := LineStr + '0'+','; //19
LineStr := LineStr + DateToStr(FieldByName('SBDATE').AsDateTime)+',,,';//20=#3
LineStr := LineStr + Trim(Ed_AR.Text)+',,,,,,'; // 23
LineStr := LineStr + FieldByName('BOITEM').AsString+',,'; //29
LineStr := LineStr + IntToStr(Qty)+',,'; //31
LineStr := LineStr + FieldByName('PMODEL').AsString+',,,'; //33
LineStr := LineStr + Trim(Ed_GL.Text)+','; // 36
LineStr := LineStr + FormatFloat('0.00',Price)+','; // 37
LineStr := LineStr + '1'+','; //38
LineStr := LineStr + '-'+FormatFloat('0.00',Price*Qty)+',,,'; // 39
LineStr := LineStr + Trim(Ed_Period.Text)+','; // 42
LineStr := LineStr + IntToStr(ID); //43
mem.Lines.Append(LineStr);
ID:=ID+1;
Query1.Next;
ProgressBar.Position := ProgressBar.Position + 1;
end;
mem.Lines.SaveToFile(DpsOutDir + '/SBOUT.CSV');
Mem.Free;
StatusBar.SimpleText := 'ok';
except
mem.Lines.Clear;
StatusBar.SimpleText := 'fail';
end;
 
这是我以前看过的一个程序
var i:integer;
str:string;
strlist:tstringlist;
begin
try
with table1 do
begin
first;
disablecontrols;
while not eof do
begin
str:='';
for i:=0 to fieldcount-1 do
begin
str:=str+fields.asstring+#19;//#9
strlist.add(str);
next;
end;
strlist.savetofile('c:/aa.xls');
enablecontrols;
end;
finally
strlist.free;
end;
end;
 
richedit里好像只有64k大小。大一点的东西就粘不进去了!
 
9x的richedit就是64K的。死心了吧。win2k和xp的好像大些,多少也不清楚了
 
没错,< 64K
 
没必要通过RICHEDIT来过渡,直接写文件不就可以了。

function GetLeftWordCSV(var ASentence:string):string;
begin
Result:='';
ASentence:=Trim(ASentence);// remove spaces and strange chars in CSV
if Length(ASentence)=0 then exit;
if ASentence[1]='"' then begin
Delete(ASentence,1,1);
Result:=GetLeftWord(ASentence,'"');
GetLeftWord(ASentence,',');//get rid of comma
end else Result:=GetLeftWord(ASentence,',');
end;

function GetLeftWord(var ASentence:string; ADelimiter:char):string;
var i:integer;
begin
Result := '';
i := Pos(ADelimiter,ASentence);
if i = 0 then begin
Result := Trim(ASentence);
ASentence := '';
end else begin
Result:=trim(Copy(ASentence,1,i-1));
Delete(ASentence,1,i);
end;
end;

procedure ExportDataSetToCSVFile(const aDataSet:TDataSet;
const aFileName:string);
var aTextFile:TextFile;
i:integer;
aValue,LineStr:string;
DataSetActive:boolean;
begin
DataSetActive := aDataSet.Active;
if not aDataSet.Active then aDataSet.Open;
aDataSet.DisableControls;
try
aDataSet.FieldDefs.Update;
if aDataSet.RecordCount=0 then exit;
try
AssignFile(aTextFile,aFileName);
Rewrite(aTextFile);
LineStr := '';
for i:=0 to aDataSet.FieldCount-1 do begin
aValue := aDataSet.Fields.DisplayName ;
if Pos(',',aValue) > 0 then aValue:='"' + aValue + '"';
LineStr := LineStr + aValue + ',';
end;
Delete(LineStr,length(LineStr),1);// remove extra ','
Writeln(aTextFile,LineStr);
aDataSet.First;
while not aDataSet.EOF do begin
LineStr := '';
for i := 0 to aDataSet.FieldCount-1 do begin
if aDataSet.Fields.IsBlob then begin
if aDataSet.Fields.DataType=ftMemo then
aValue :=StringReplace(aDataSet.Fields.AsString,#13+#10,'#',[rfReplaceAll]);
end else begin
aValue := aDataSet.Fields.AsString;
end;
if Pos(',',aValue) > 0 then aValue := '"' + aValue + '"';
LineStr := LineStr+aValue+',';
end;
Delete(LineStr,length(LineStr),1);// remove extra ','
Writeln(aTextFile,LineStr);
aDataSet.Next;
end;// while
finally
try
Flush(aTextFile);
CloseFile(aTextFile);
except
end;
end;
finally
aDataSet.EnableControls;
aDataset.Active := DataSetActive;
end;
end;

procedure ImportFromCSVFile(const AFileName:String;
const ADataSet:TDataSet);
const cMaxFields=1023;
var
aTextFile:TextFile;
i,j,HeaderCount:integer;
FldPtr:array[0..cMaxFields] of integer;
aColValue,aLineString,aValue:string;
HasCommonField,DataSetActive:boolean;
begin
if not FileExists(AFileName) then exit;
AssignFile(aTextFile,AFileName);
Reset(aTextFile);
try
{ first row must be headers }
Readln(aTextFile, ALineString);
HasCommonField:=False;
HeaderCount:=0;
DataSetActive:=ADataSet.Active;// save the status of the dataset
if not ADataset.Active then ADataset.Open; // open if closed
ADataSet.FieldDefs.Update;
while (length(ALineString) > 0) and (HeaderCount < cMaxFields) do begin
aColValue := GetLeftWordCSV(ALineString);
for i:=0 to ADataSet.FieldCount-1 do
if Trim(ADataSet.Fields.DisplayName)=trim(aColValue) then
begin
j :=i;
FldPtr[HeaderCount] := j;
if j > -1 then HasCommonField:=True;
inc(HeaderCount);
break;
end;
end;
if not HasCommonField then exit; // not a single field found on list
ADataSet.DisableControls;
try
while not EOF(aTextFile) do begin
Readln(aTextFile,ALineString);
j := -1;
ADataSet.Append;
while (length(ALineString) > 0) and (j < HeaderCount-1) do begin
aColValue := GetLeftWordCSV(ALineString);
inc(j);
if FldPtr[j] = -1 then continue; // skip unmatched columns
try
if Trim(aColValue)<>'' then
begin
if ADataSet.Fields[FldPtr[j]].DataType=ftMemo then
ADataSet.Fields[FldPtr[j]].AsString :=StringReplace(aColValue,'#',#13+#10,[rfReplaceAll])
else
ADataSet.Fields[FldPtr[j]].AsString := aColValue;
end;
except
// simply ignore all data conversion errors
// or handle it here as you wish
end;
end; // while (length(ALineString)...
ADataSet.Post;
end; // while not EOF(aTextFile)
finally
ADataSet.EnableControls;
ADataSet.Active := DataSetActive; // restore dataset status
end;
finally
CloseFile(aTextFile);
end;
end; // procedure
 
多谢各位!
虽然上来前问题已经解决(和wk_knife的方法一样)。
 
后退
顶部