ULogs.pas
Скачать (2.3 K) unit uLogs; interface uses Classes,Controls,StdCtrls,ComCtrls,Forms; {-------раздел для генерации сообщений----------} {всего одна процедура} procedure (Channel:byte;Mes:String); {номер канала (0 - 255) и текст сообщения} {----------раздел для обработки сообщений----------} Type TChannels = set of byte; TLog = class {абстрактный базовый класс} protected FChannels:TChannels; {множество обрабатываемых каналов} procedure (Channel:byte;Mes:String);virtual;abstract; {InternalToLog - для каждого наследника определяет способ обработки.} {Номер канала передается, чтобы его можно было учесть при обработке,} {например, при выводе диагностических сообщений менять цвет текста} {в зависимости от номера канала} public procedure (Channel:byte;Status:boolean); procedure (Channel:byte;Mes:String);{общий механизм проверки номера канала} constructor Create(AChannels:TChannels); {множество обрабатываемых каналов задается при создании лога} property Channels:TChannels read FChannels write FChannels; {множество обрабатываемых каналов доступно в процессе работы} end; TStringsLog = class(TLog) {добавление строки к содержимому любого наследника абстрактного базового класса TStrings} FStrings:TStrings; {ссылка на объект в который будет добавлена строка} procedure (Channel:byte;Mes:String);override; constructor Create(AChannels:TChannels;AStrings:TStrings); end; TFileLog = class(TLog) {добавление строки к содержимому файла} FFile:Text; {имя файла} procedure (Channel:byte;Mes:String);override; constructor Create(AChannels:TChannels;FileName:String); end; TCaptionLog = class(TLog) {вывод текста сообщения в Caption любого компонента - наследника TControl} FControl:TControl; {компонент для отображения} procedure (Channel:byte;Mes:String);override; constructor Create(AChannels:TChannels;AControl:TControl); end; TStatusBarLog = class(TLog){вывод текста сообщения в StatusPanel} FStatusPanel:TStatusPanel; procedure (Channel:byte;Mes:String);override; constructor Create(AChannels:TChannels;AStatusPanel:TStatusPanel); end; TMessageBoxLog = class(TLog) {вывод текста сообщения в MessageBox} fCaption:String; fFlags: Longint; procedure (Channel:byte;Mes:String);override; constructor Create(AChannels:TChannels;Caption:String;Flags: Longint); end; function (ALog:TLog):word; {Регистрация нового лога в списке} function (ALog:TLog;Name:string):integer; {Регистрация нового лога в списке под заданным именем, чтобы можно было его удалить} function (Name:string):integer; {Удаление из списка лога с заданным именем} implementation uses Windows; var LogList:TStrings; lLog:TLog; procedure ToLog(Channel:byte;Mes:String); var i:integer; Begin if LogList.Countthen exit; for i:=0 to LogList.Count-1 do TLog(LogList.Objects[i]).toLog(Channel,Mes); End; function SetLog(ALog:TLog):word;{Регистрация нового лога в списке} Begin result:=LogList.AddObject('',ALog); End; function SetNamedLog(ALog:TLog;Name:string):integer; {Регистрация нового лога в списке под заданным именем, чтобы можно было его удалить} var i:integer; Begin result:=-1; {лог под таким именем уже есть} i:=LogList.IndexOf(Name); if i=-1 then result:=LogList.AddObject(Name,ALog); End; function ReSetNamedLog(Name:string):integer; {Удаление из списка лога с заданным именем} var i:integer; Begin result:=LogList.IndexOf(Name); { -1 если лога под таким именем нет} if result<>-1 then LogList.Delete(result); End; { TLog } constructor TLog.Create(AChannels: TChannels); begin FChannels:=AChannels; end; procedure TLog.SetChannel(Channel: byte; Status: boolean); begin if status then FChannels:=FChannels+[channel] else FChannels:=FChannels-[channel]; end; procedure TLog.toLog(Channel: byte; Mes: String); begin if (Channel in FChannels) then InternalToLog(Channel,Mes); end; { TStringsLog } constructor TStringsLog.Create(AChannels: TChannels; AStrings: TStrings); begin inherited Create(AChannels); FStrings:=AStrings; end; procedure TStringsLog.InternalToLog(Channel: byte; Mes: String); begin FStrings.Add(Mes); end; { TFileLog } constructor TFileLog.Create(AChannels: TChannels; FileName: String); begin inherited Create(AChannels); AssignFile(FFile,FileName); Rewrite(FFile); Writeln(FFile, 'Log file start'); CloseFile(FFile); end; procedure TFileLog.InternalToLog(Channel: byte; Mes: String); begin Append(fFile); Writeln(fFile, mes); Flush(fFile); CloseFile(fFile); end; { TCaptionLog } constructor TCaptionLog.Create(AChannels: TChannels; AControl: TControl); begin inherited Create(AChannels); FControl:=AControl; end; procedure TCaptionLog.InternalToLog(Channel: byte; Mes: String); begin TLabel(FControl).Caption:=Mes; // FControl.Caption:=Mes; end; { TStatusBarLog } constructor TStatusBarLog.Create(AChannels: TChannels; AStatusPanel: TStatusPanel); begin inherited Create(AChannels); FStatusPanel:=AStatusPanel; end; procedure TStatusBarLog.InternalToLog(Channel: byte; Mes: String); begin FStatusPanel.text:=Mes; end; { TMassageBoxLog } constructor TMessageBoxLog.Create(AChannels: TChannels; Caption: String; Flags: Integer); begin inherited create(AChannels); fCaption:=Caption; fFlags:=Flags; end; procedure TMessageBoxLog.InternalToLog(Channel: byte; Mes: String); begin Application.MessageBox(PChar(Mes), PChar(fCaption), fFlags); end; initialization LogList:=TStringList.create; lLog:=TMessageBoxLog.Create([0..5],'Ошибка инициализации', MB_OK); // Каналы с 0 по 5 зарезервированы для ошибок инициализации модулей SetLog(lLog); finalization LogList.free; end.
