mirror of
https://github.com/Laex/Delphi-OpenCV.git
synced 2024-11-15 15:55:53 +01:00
78 lines
2.3 KiB
ObjectPascal
78 lines
2.3 KiB
ObjectPascal
program uCompressHaar;
|
|
|
|
{$APPTYPE CONSOLE}
|
|
{$R *.res}
|
|
|
|
uses
|
|
System.SysUtils,
|
|
System.Classes,
|
|
System.Character,
|
|
System.ZLib;
|
|
|
|
Const
|
|
Path = '.\facedetectxml\';
|
|
|
|
function CreateResourceName(const FileName: String): string;
|
|
begin
|
|
Result := StringReplace(FileName, 'haarcascade', 'H', [rfIgnoreCase, rfReplaceAll]);
|
|
Result := StringReplace(Result, 'frontalface', 'FF', [rfIgnoreCase, rfReplaceAll]);
|
|
Result := StringReplace(Result, 'mcs', 'M', [rfIgnoreCase, rfReplaceAll]);
|
|
Result := StringReplace(Result, 'right', 'R', [rfIgnoreCase, rfReplaceAll]);
|
|
Result := StringReplace(Result, 'left', 'L', [rfIgnoreCase, rfReplaceAll]);
|
|
Result := StringReplace(Result, '.xml', '', [rfIgnoreCase, rfReplaceAll]);
|
|
Result := ToUpper(StringReplace(Result, '_', '', [rfIgnoreCase, rfReplaceAll]));
|
|
end;
|
|
|
|
Var
|
|
S: TSearchRec;
|
|
ZC: TZCompressionStream;
|
|
Fs, Fd: TFileStream;
|
|
S_rc: TStringList;
|
|
S_inc: TStringList;
|
|
iFileName, oFileName: string;
|
|
rName: String;
|
|
|
|
begin
|
|
try
|
|
S_rc := TStringList.Create;
|
|
S_rc.Add('// Created uCompressHaar.exe');
|
|
S_inc := TStringList.Create;
|
|
S_inc.Add('// Created uCompressHaar.exe');
|
|
S_inc.Add('const');
|
|
S_inc.Add('FrontalFaceXML: array [TocvHaarCascadeType] of TocvHaarCascadeRecord =');
|
|
S_inc.Add('(');
|
|
if FindFirst(Path + '*.xml', faAnyFile, S) = 0 then
|
|
repeat
|
|
iFileName := Path + S.Name;
|
|
oFileName := Path + S.Name + '.z';
|
|
Fs := TFileStream.Create(iFileName, fmOpenRead);
|
|
Fd := TFileStream.Create(oFileName, fmCreate);
|
|
ZC := TZCompressionStream.Create(clMax, Fd);
|
|
try
|
|
WriteLn(S.Size:8, ' ', S.Name);
|
|
ZC.CopyFrom(Fs, S.Size);
|
|
rName := CreateResourceName(S.Name);
|
|
S_rc.Add(rName + ' RCDATA "' + S.Name + '.z"');
|
|
S_inc.Add(Format('(Name: ''%s''; FileName: ''%s''),', [rName, S.Name]));
|
|
finally
|
|
ZC.Free;
|
|
Fs.Free;
|
|
Fd.Free;
|
|
end;
|
|
until FindNext(S) <> 0;
|
|
FindClose(S);
|
|
S_rc.SaveToFile(Path + 'haarcascade.rc');
|
|
rName := S_inc[S_inc.Count - 1];
|
|
Delete(rName, Length(rName), 1);
|
|
S_inc[S_inc.Count - 1] := rName;
|
|
S_inc.Add(');');
|
|
S_inc.SaveToFile(Path + 'haarcascade.inc');
|
|
S_rc.Free;
|
|
S_inc.Free;
|
|
except
|
|
on E: Exception do
|
|
WriteLn(E.ClassName, ': ', E.Message);
|
|
end;
|
|
|
|
end.
|