Top.Mail.Ru
Мастера DELPHI, Delphi programming community Титульная страница Поиск, карта сайта Написать письмо 
| Новости | Поиск | FAQ | Статьи | Книги | Новости VCL |
| Форумы ЧАТ | Орешник | KOL и MCK |
Форумы -» Основная («Начинающим»)/ Базы / WinAPI / Компоненты / Сети / Media / Игры / Corba и COM / KOL / FreePascal / .Net / Прочее / RSDN.ORG

« предыдущая ветвь | форум | следующая ветвь »

Как объявить процедуру, универсальную для разных объектов?


Aleksandr ©   (2002-06-28 13:50:00) 

Например, несколько потоков по ходу работы пишут в лог и на странички PageControl. В принципе, у них отличаются только имена файлов лога и номера страничек. Как объявить процедуру, которая бы вызывалась внутри каждого без утомительных упоминаний имен файлов каждый раз и выполняла общие для всех действия?


Aleksandr   (2002-06-28 16:00:00) [1]

Мда... нет, я не тормоз, я другой... Спасибо.


panov   (2002-06-28 14:25:00) [2]

в коде CS - это глобальная TCriticalSection.


panov   (2002-06-28 14:24:00) [3]

Я пользуюсь вот таким способом.
Создаю поток (а их можно создать склоько угодно для разных журналов) и в любом месте программы вызываю метод Write:

unit utLog;
interface
uses
classes,Sysutils, windows,FileCtrl;
type

TLog = class(TThread)
private
FName: String;
FHandle: Integer;
FMaxSize: Integer;
procedure Open;
procedure Arhive;
public
constructor Create(aMaxSize:Integer);
destructor Destroy; override;
procedure Execute; override;
procedure Write(s: String);
end;


implementation
uses
ufMain;

constructor TLog.Create(aMaxSize:Integer);
begin
inherited Create(True);
FName := AnsiUpperCase(ParamStr(0));
FName := StringReplace(FName,".EXE",".LOG",[]);
FMaxSize := aMaxSize;
Open;
FreeOnTerminate := True;
Resume;
end;

procedure TLog.Open;
begin
if not FileExists(FName) then
begin
try
FHandle := FileCreate(FName);
finally
FileClose(FHandle);
end;
end;
FHandle := FileOpen(FName,fmOpenReadWrite+fmShareDenyNone);
if FileSeek(FHandle,0,2)>1024*FMaxSize then
begin
FileClose(FHandle);
Arhive;
Open;
end;
end;

procedure TLog.Arhive;
var
fNameAr: String;
begin
try
if not DirectoryExists(ExtractFilePath(ParamStr(0))+"ArchLog") then
begin
ForceDirectories(ExtractFilePath(ParamStr(0))+"ArchLog");
end;
fNameAr := FormatDateTime("ddmm_hhnnss.ar",now);
CopyFile(PChar(FName),PChar(ExtractFilePath(ParamStr(0))+"ArchLog\"+FNameAr),False);
DeleteFile(PChar(FName));
except
end;
end;

procedure TLog.Write(s: String);
var
ps: String;
begin
cs.Enter;
ps := FormatDateTime("dd.mm.yyyy hh:nn:ss ",now) + s+Chr(13)+Chr(10);
FileWrite(FHandle,ps[1],Length(ps));
if FileSeek(FHandle,0,2)>1024*1024 then
begin
FileClose(FHandle);
Arhive;
Open;
end;
cs.Leave;
end;

procedure TLog.Execute;
begin
while not Terminated do
begin
Sleep(1);
end;
end;

destructor TLog.Destroy;
begin
FileClose(FHandle);
inherited;
end;
end.


Skier   (2002-06-28 13:53:00) [4]

> Aleksandr
Общий класс-предок ?


Наверх

Титульная страница Поиск, карта сайта Написать письмо