Главная страница
    Top.Mail.Ru    Яндекс.Метрика
Форум: "Основная";
Текущий архив: 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.61 MB
Время: 0.028 c
3-23932
Андрусь
2002-07-17 19:16
2002.08.08
Проблема с редактированием 2х таблиц


14-24220
Anatoly Shkodin
2002-07-14 11:35
2002.08.08
Спонсор-рекламодатель


1-24103
URustam
2002-07-26 13:44
2002.08.08
Помогите!


1-24049
newUser
2002-07-25 13:26
2002.08.08
Lockfile


1-24017
Ksion
2002-07-28 22:08
2002.08.08
Как отредактировать строчку





Afrikaans Albanian Arabic Armenian Azerbaijani Basque Belarusian Bulgarian Catalan Chinese (Simplified) Chinese (Traditional) Croatian Czech Danish Dutch English Estonian Filipino Finnish French
Galician Georgian German Greek Haitian Creole Hebrew Hindi Hungarian Icelandic Indonesian Irish Italian Japanese Korean Latvian Lithuanian Macedonian Malay Maltese Norwegian
Persian Polish Portuguese Romanian Russian Serbian Slovak Slovenian Spanish Swahili Swedish Thai Turkish Ukrainian Urdu Vietnamese Welsh Yiddish Bengali Bosnian
Cebuano Esperanto Gujarati Hausa Hmong Igbo Javanese Kannada Khmer Lao Latin Maori Marathi Mongolian Nepali Punjabi Somali Tamil Telugu Yoruba
Zulu
Английский Французский Немецкий Итальянский Португальский Русский Испанский