unit main;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, Jpeg, ExtCtrls, Cyber;
const
TestPointsX = 40;
TestPointsY = 30;
SmallPath = '
F:\kram\pics\small\';
type
TRGB =
record
Blue: Byte;
Green: Byte;
Red: Byte;
end;
PRGB = ^TRGB;
TRefPoints =
array[0..TestPointsX-1, 0..TestPointsY-1]
of TRGB;
TPicInfoEntry =
record
FileLocation:
string;
RefPoints: TRefPoints;
end;
TCatalogue =
record
PicInfoList:
array of TPicInfoEntry;
Count: Integer;
end;
TfrmMain =
class(TForm)
btnOpenDb: TButton;
procedure btnOpenDbClick(Sender: TObject);
private
{ Private-Deklarationen }
public
procedure SaveDB(DbId: Byte);
procedure ReadFromStream(
const Stream: TStream; DbId: Byte);
procedure WriteToStream(
const Stream: TStream; DbId: Byte);
procedure CreateCatalog;
{ Public-Deklarationen }
end;
var
frmMain: TfrmMain;
Catalogs:
array[1..4]
of TCatalogue;
implementation
{$R *.dfm}
procedure TfrmMain.btnOpenDbClick(Sender: TObject);
var
s: TFileStream;
i: Byte;
begin
if not FileExists(ExtractFilePath(Application.ExeName) + '
PicDb1.dat')
then CreateCatalog
else
for i:=1
to 4
do
begin
s:=TFileStream.Create(ExtractFilePath(Application.ExeName) + '
PicDb' + IntToStr(i) + '
.dat', fmOpenRead);
try
ReadFromStream(s, i);
finally
s.Free;
end;
end;
//go on
end;
procedure TfrmMain.ReadFromStream(
const Stream: TStream; DbId: Byte);
var
i: integer;
BigBuf: Word;
begin
with Catalogs[DbId]
do
begin
Stream.
Read(Count, SizeOf(Count));
SetLength(PicInfoList, Count);
for i:=0
to Count-1
do
with PicInfoList[i]
do
begin
Stream.
Read(BigBuf, SizeOf(BigBuf));
SetLength(FileLocation, BigBuf);
Stream.
Read(FileLocation[1], BigBuf);
Stream.
Read(RefPoints, SizeOf(RefPoints));
end;
end;
end;
procedure TfrmMain.SaveDB(DbId: Byte);
var
s: TFileStream;
begin
s:=TFileStream.Create(ExtractFilePath(Application.ExeName) + '
PicDb' + IntToStr(DbId) + '
.dat', fmCreate);
try
WriteToStream(s, DbId);
finally
s.Free;
end;
end;
procedure TfrmMain.WriteToStream(
const Stream: TStream; DbId: Byte);
var
i: integer;
BigBuf: Word;
begin
with Catalogs[DbId]
do
begin
Stream.
Write(Count, SizeOf(Count));
for i:=0
to Count-1
do
with PicInfoList[i]
do
begin
BigBuf:=Length(FileLocation);
Stream.
Write(BigBuf, SizeOf(BigBuf));
Stream.
Write(FileLocation[1], BigBuf);
Stream.
Write(RefPoints, SizeOf(RefPoints));
end;
end;
end;
procedure TfrmMain.CreateCatalog;
var
i, j, k, l, ActDbNum: Integer;
P: PRGB;
B: TBitmap;
ImageList: TStringList;
begin
B:=TBitmap.Create;
ImageList:=TStringList.Create;
try //dateiliste laden
ImageList:=ListFilesRecursive(SmallPath, '
*.bmp', true);
for i:=1
to 4
do //4 db files
begin
if i<>4
then
begin
SetLength(Catalogs[i].PicInfoList, ImageList.Count
Div 4);
Catalogs[i].Count:=ImageList.Count
Div 4;
end
else
begin //letzte db file größe richtig setzen, falls nicht gerade durch 4 geteilt worden konnte
SetLength(Catalogs[4].PicInfoList, (ImageList.Count
Div 4) + (ImageList.Count
mod 4));
Catalogs[4].Count:=(ImageList.Count
Div 4) + (ImageList.Count
mod 4)
end;
ActDbNum:=0;
//j= dateilistenzähler (muss von 0 bis count durchgehen aber hängt von i ab)
for j:=( (ImageList.Count
Div 4) * (i-1) )
to ( (ImageList.Count
Div 4) * (i-1) + (Catalogs[i].Count)-1 )
do
begin
B.LoadFromFile(ImageList[j]);
B.PixelFormat:=pf24bit;
Catalogs[i].PicInfoList[ActDbNum].FileLocation:=ImageList[j];
for k:=0
to 29
do
begin
P:=B.ScanLine[k];
for l:=0
to 39
do
begin //zeitkritischste schleife da am öftesten durchlaufen
Catalogs[i].PicInfoList[ActDbNum].RefPoints[l, k]:=P^;
//asm?
Inc(p);
//asm ?
end;
end;
Inc(ActDbNum);
end;
SaveDb(i);
end;
finally
FreeAndNil(B);
FreeAndNil(ImageList);
end;
end;
end.