Сохранение данных Memo, ...в файл *.txt без SaveDialog Опции

[Jill]

Не получается

С SaveDialog получается, но...

Задача на потоки. В одном из потоков необходимо данные Memo сохранять в текстовый файл. Как?

[Jill]

ок просто код длинноват:

Исходный код

unit Unit1;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, Mask, ComCtrls, Buttons;

type
TForm1 = class(TForm)
Button1: TButton;
Button2: TButton;
ScrollBox1: TScrollBox;
Memo1: TMemo;
Label1: TLabel;
Label2: TLabel;
Label3: TLabel;
Label4: TLabel;
Label5: TLabel;
Label6: TLabel;
Label7: TLabel;
procedure FormShow(Sender: TObject);
procedure Button1Click(Sender : TObject);
procedure Button2Click(Sender : TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
type
TCreateRecord = class(TThread)
private
{ Private declarations }
protected
procedure DoWork;
procedure Execute; override;
end;

TSaveRecord = class(TThread)
private
{ Private declarations }
protected
procedure DoWork;
procedure Execute; override;
end;

var Form1: TForm1;
T1 : TCreateRecord;
T2 : TSaveRecord;

implementation

{$R *.dfm}

procedure TForm1.FormShow(Sender: TObject);
begin
Form1.Memo1.Clear;
end;

procedure TCreateRecord.Execute;
begin
{Пока процесс не прервали, выполняем DoWork}
while not Terminated do
Synchronize(DoWork);
end;

procedure TSaveRecord.Execute;
begin
{Пока процесс не прервали, выполняем DoWork}
while not Terminated do
Synchronize(DoWork);
end;

{Телефон абонента}
function GenerateTelAbon:string;
var
nom:integer;
begin
nom:=random(899999)+100000;
GenerateTelAbon:=' 8-375-16-'+IntToStr(nom);
end;

function GenerateTel:string;
var
k,ks,kg,nom:integer;
pr,pr1:string;
Kod:Array[1..2] of integer;
begin
Kod[1]:=8;
Kod[2]:=10;
k:=random(2)+1;
ks:=random(899)+100;
kg:=random(89)+10;
nom:=random(899999)+100000;
if Kod[k]=10 then
begin
pr:=' '; pr1:=' ';
end
else
begin
pr:=' '; pr1:=' ';
end;
GenerateTel:=' '+pr+IntToStr(Kod[k])+'-'+IntToStr(ks)+'-'+IntToStr(kg)+'-'+IntToStr(nom)+pr1;
end;

{Дата}
function GenerateDate:string;
var
d,m:integer;
day,month:string;
begin
m:=random(12);
if m=2 then d:=random(28);
if (m=1)or(m=3)or(m=5)or(m=7)or(m=8)or(m=10)or(m=12)
then d:=random(31) else d:=random(30);
day:=IntToStr(d);
if Length(day)=1 then day:='0'+day;
month:=IntToStr(m);
if Length(month)=1 then month:='0'+month;
GenerateDate:=day+'.'+month+'.'+'2006 ';
end;

{Начало и конец разговора}
function GenerateTimeStartFinish:string;
var
h,m:integer;
hour,minute:string;
begin
h:=random(24);
hour:=IntToStr(h);
if Length(hour)=1 then hour:='0'+hour;
if hour='24' then hour:='00';
m:=random(60);
minute:=IntToStr(m);
if Length(minute)=1 then minute:='0'+minute;
if hour='60' then minute:='00';
GenerateTimeStartFinish:=hour+':'+minute;
end;

{Продолжительность разговора}
function GetTime(start,finish:string):string;
var h1,h2,m1,m2,m:integer;
hour1,hour2,minute1,minute2,minute:string;
begin
hour1:=start[1]+start[2]; h1:=StrToInt(hour1);
h1:=h1*60;
minute1:=start[4]+start[5]; m1:=StrToInt(minute1);
m1:=m1+h1;

hour2:=finish[1]+finish[2]; h2:=StrToInt(hour2);
h2:=h2*60;
minute2:=finish[4]+finish[5]; m2:=StrToInt(minute2);
m2:=m2+h2;

m:=m2-m1;
if m<0 then m:=m+1440;
minute:=IntToStr(m);
if Length(minute)=1 then minute:=minute+' ';
if Length(minute)=2 then minute:=minute+' ';
if Length(minute)=3 then minute:=minute+' ';
if Length(minute)=4 then minute:=minute+' ';
GetTime:=minute;
end;

{Идентификатор линии}
function GenerateIdent:string;
var
i:integer;
id:Array[1..5] of string;
iden:string;
begin
id[1]:='C';
id[2]:='O';
id[3]:='I';
id[4]:='S';
id[5]:='R';
i:=random(5)+1;
iden:=id[i];
GenerateIdent:=iden;
end;

procedure TCreateRecord.DoWork;
var start,finish,s:string;
begin
s:=' ';
begin
start:=GenerateTimeStartFinish;
finish:=GenerateTimeStartFinish;
Form1.Memo1.SelText:=GenerateTelAbon+GenerateTel+GenerateDate+
Start+s+Finish+s+GetTime(start,finish)+s+GenerateIdent+#13#10;
end;

end;

procedure TSaveRecord.DoWork;
var
f:TextFile;
fName:string[80];
i:integer;
begin
fName:='CallRecord.txt';
AssignFile(f,fName);
Rewrite(f);
for i:=0 to Form1.Memo1.Lines.Count do begin
if i=0 then writeln(f,' '+Form1.Label1.Caption+' '
+Form1.Label2.Caption+' '+Form1.Label3.Caption+
' '+Form1.Label4.Caption+' '+Form1.Label5.Caption+
' '+Form1.Label6.Caption+' '+Form1.Label7.Caption) else
writeln(f,Form1.Memo1.Lines[i]); end;
CloseFile(f);
end;

procedure TForm1.Button1Click(Sender : TObject);
begin
Button1.Enabled:=False;
Button2.Enabled:=True;
T1:=TCreateRecord.Create(False);
T2:=TSaveRecord.Create(False);
end;

procedure TForm1.Button2Click(Sender : TObject);
begin
T1.Terminate;
T2.Terminate;
Button1.Enabled:=True;
Button2.Enabled:=False;
end;

end.

ууупс...можно же было порезать для удобочитаемости...

Сообщение отредактировано: volvo - 2.11.2006 20:33