Форум: "Основная";
Текущий архив: 2002.08.08;
Скачать: [xml.tar.bz2];

Вниз

файлы по таймеру   Найти похожие ветки 

← →
zetta   (2002-07-24 19:03) [0]

значит так: спрашиваю имя файла откуда, имя файла куда, открываю их, включаю таймер и в таймерной процедуре вызываю bgproc, которая читает строку из файла, обрабатывает и запихивает в выходной файл, увеличивает progressbar и когда все, выставляет флажок eoff когда все. запускаю, спрашивает имена одного файла, другого и потом просто отрисовывает окошко формы и - молчок. ни винтом не дрыгает, ни индикатором. что не так? сильно не ругайте - в делфи я недавно.

unit Unit2;

interface

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
ExtCtrls, StdCtrls, ComCtrls;

type
TForm1 = class(TForm)
OpenDialog1: TOpenDialog;
SaveDialog1: TSaveDialog;
ProgressBar1: TProgressBar;
Label1: TLabel;
Timer1: TTimer;
procedure FormCreate(Sender: TObject);
procedure FormActivate(Sender: TObject);
procedure Timer1Timer(Sender: TObject);

private
{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;ok:boolean;

implementation

{$R *.DFM}

const max = 30000;
bars = 200;dpin = 2400;

type buf = array[1..max] of char;
pbuf = ^buf;
var
total1, totread, breaking, breakst, fsz: longint;
f1, f2: file;
i,a, c, pix, pixst, rsp, wsn1, wsp1: word;
rdBuf, wrBuf1: buf;
b2,b1:integer;
outname,s,tr_n, ar_n: string;
eoff,binheader,tr: boolean;

procedure err(m:string);
begin
MessageDlg(m+". Program terminated.", mtConfirmation, [mbok], 0);
halt;
end;

procedure TForm1.FormCreate(Sender: TObject);
var l,n,m:word;
begin
ok:=false;
if not opendialog1.execute then exit;
s:=opendialog1.filename;
n:=length(s);l:=n;m:=0;
while (n>0) and (m=0) do begin if s[n]="." then m:=n;n:=n-1; end;
outname:=s;if m<>0 then setlength(outname,m-1);
outname:=outname+" 2400dpi";
if m<>0 then
for n:=m to l do outname:=outname+s[n];
savedialog1.filename:=outname;
if not savedialog1.execute then exit;
outname:=savedialog1.filename;
ok:=true;
a := max;
b1 := 0;

rsp := 0;
wsn1 := 1;
wsp1 := 1;

assignfile(f1,s);
reset(f1,1);
if inoutres<>0 then err("Can""t open file "+s);

i:=0;
fsz:=filesize(f1);
totread := 0;
checkfile;

filemode:=1;
assignfile(f2,outname);
rewrite(f2,1);
if inoutres<>0 then err("Can""t create file "+outname);
total1 := 0;
a := 0;
pix := 0;
if fsz > bars then
begin
pixst := 1;
breakst := fsz div bars;
end
else
begin
breakst := 1;
pixst := fsz div bars;
end;
breaking := breakst - 1;
progressbar1.position:=0;timer1.enabled:=true;
end;

procedure TForm1.FormActivate(Sender: TObject);
begin
if not ok then application.terminate;
end;

procedure TForm1.Timer1Timer(Sender: TObject);
begin
bgproc; timer1.enabled:=false;if eoff then application.Terminate;
end;

end.

program Project222;

uses mydata,Windows,
Messages,
SysUtils,
Classes,
Graphics,
Controls,
Forms,
Dialogs,
Unit2 in "Unit2.pas" {Form1};

{$R *.RES}

begin
Application.Initialize;
Application.CreateForm(TForm1, Form1);
Application.Run;
if b1 <> 0 then begin c:=b1;
BlockwRite(f2,wrbuf1,b1,b1);end;
Closefile(f2);
Closefile(f1);
end.




---

← →
Anatoly Podgoretsky   (2002-07-24 19:31) [1]

У тебя ощибка в bgproc

---

← →
zetta   (2002-07-24 19:52) [2]

bgproc читает 1 строку из файла, обрабатывает и пишет в выходной файл. в досе работает.

---

← →
Anatoly Podgoretsky   (2002-07-24 19:58) [3]

Ну тогда у тебя все в порядке

---

← →
zetta   (2002-07-24 20:00) [4]

так где ж в порядке, когда такие симптомы: запускаю, спрашивает имена одного файла, другого и потом просто отрисовывает окошко формы и - молчок. ни винтом не дрыгает, ни индикатором. что не так? как побороть?

---

← →
Anatoly Podgoretsky   (2002-07-24 20:02) [5]

У тебя ощибка в bgproc

---

← →
zetta   (2002-07-24 20:13) [6]

где?


procedure readstr;
var cc: char;
tot:integer;
begin
if eoff then
exit;
application.ProcessMessages;
s := "";
c := 0;
repeat
if a = total1 then
begin
total1 := fsz - totread;
if total1 < 1 then
begin
eoff := true;
exit;
end
else if total1 > max then
total1 := max;
tot:=total1;
BlockRead(f1,rdbuf, tot, tot);total1:=tot;
a := 0;
end;
a := a + 1;
totread := totread + 1;
cc := rdbuf[a];
if (cc <> chr(10)) and (cc <> chr(13)) then
begin
c := c + 1;
if c=256 then begin
err("error: Line is too long");end;
s:= s+cc;
end;
until cc = chr(13); application.ProcessMessages;
end;

procedure wrstr1;
var c: integer;
procedure wrc (cc: char);
begin
if b1=max then begin
blockwrite(f2,wrbuf1,max,b1);b1:=0;
end;
b1 := b1 + 1;
wrbuf1[b1] := cc;
end;
begin application.ProcessMessages;
for c := 1 to length(s) do
wrc(s[c]);
wrc(chr(13));application.ProcessMessages;
end;

procedure BGProc; //readstr и wrstr1 работают через буфер
var ll:word;
begin
readstr; //зачитывает строку в s
if eoff then
begin
exit;
end;
if s="" then begin wrstr1;exit;end;
if s[1] = "%" then
begin
if not tr then
begin
if findL("%AI5_TargetResolution:") then
begin
s := tr_n;
wrstr1;
tr := true;
end
else
wrstr1; //забрасывает строку s в выходной файл
end
else
wrstr1;
end
else
begin
ll := length(s);
if ll > 3 then
begin
if (s[ll] = "r") and (s[ll - 1] = "A") then
begin
s := ar_n;
wrstr1;
end
else
wrstr1
end
else
wrstr1;
end;

if totread > breaking then
begin
while totread >= breaking do
begin
breaking := breaking + breakst;
pix := pix + pixst;
end;
form1.progressbar1.position:=pix;

end;
end;


---

← →
Viewer   (2002-07-24 20:15) [7]

Так попробуй
procedure TForm1.Timer1Timer(Sender: TObject);
begin
timer1.enabled:=false;
bgproc;
if eoff then application.Terminate;
end;

---

← →
zetta   (2002-07-24 20:34) [8]

viewer, не помогло.
может, проблема в реализации blockwrite/blockread?

---

← →
zetta   (2002-07-24 20:37) [9]

и так не помогло:

procedure TForm1.Timer1Timer(Sender: TObject);
begin
bgproc;
if eoff then application.Terminate;
end;

---

← →
RV   (2002-07-24 20:41) [10]

procedure TForm1.Timer1Timer(Sender: TObject);
begin
bgproc;
timer1.enabled:=false;
if eoff then application.Terminate;
timer1.enabled:=true; //а так если? (сам правда уже не въезжаю
end;

---

← →
zetta   (2002-07-24 20:48) [11]

RV: не помогло

---

← →
RV   (2002-07-24 20:57) [12]

по F7 и слева нехилый список переменных
:)

---

← →
nick_sniper   (2002-07-25 00:34) [13]

2Zetta (Диме):
Немножко прога хромает. Т.е. получается что при срабатывании таймера зачитывается+записывается строка, прогрессбар сдвигается на 100/(кол. строк в файле). Если в файле строк больше чем 100 то прогресс просто останется на нуле. После этого таймер отрубается (timer1.enabled:=false;) и обработка дальше не идет. А вообще это садизм - обрабатывать одну строку по вызову таймера. Т.е. если он установлен на 1 сек (по умолчанию) то файл на 600 строчек (рассказ) будет обрабатываться 10 минут.

IMHO, лучше прогу переписать полность с нуля и вообще не использовать таймер. Он там просто не нужен. И обрабатывать ошибки лучше секциями try..except.end или try..finally..end.
Это к тому, что после Application.Run; писать какой-то код - не слишком удачный стиль.

2ALL:
Ну и зчем над парнем так издеваться? :)

---

← →
IlyaA   (2002-07-25 07:48) [14]

На сколько я понял zetta хочет, чтобы операции с файлом не приостанавливали прогу.

>Zetta Советую выполнять их (чтение/запись в файл) в новом потоке. Для ентого посмотри в хелпе ф-ю CreateThread. Тогда и прога не будет остонавливаться и файл будет обробатываться.

---

← →
zetta   (2002-07-25 13:01) [15]

а можно ли так:
begin
Application.Initialize;
Application.CreateForm(TForm1, Form1);
while not eoff do bgproc;
application.terminate;
if b1 <> 0 then begin c:=b1;
BlockwRite(f2,wrbuf1,b1,b1);end;
Closefile(f2);
Closefile(f1);
end.

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
if MessageDlg("Terminate program?", mtwarning, [mbyes,mbno], 0)=mryes then eoff:=true;
end;


как сделать, чтобы форма была видна?

---

← →
zetta   (2002-07-25 13:02) [16]

readstr и wrstr1 вызывают application.ProcessMessages

---

Страницы: 1 вся ветка

Форум: "Основная";
Текущий архив: 2002.08.08;
Скачать: [xml.tar.bz2];

Наверх

Память: 0.49 MB
Время: 0.006 c