unit DiffBild;
//++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
//+
//++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
interface
uses
Windows, SysUtils, Classes, Controls, ExtCtrls, Graphics, EB_Mathe;
type
TFarbScala =
record
von :
string;
bis :
string;
Text:
string;
r : integer;
g : integer;
b : integer;
i : integer;
end;
// TMatrix = array of array of single;
TDiffMat =record
PixHeight : integer;
PixWidth : integer;
PixSize : single;
SizeHeight : single;
SizeWidth : single;
Dat : TMatrix;
//array of array of single;
farbe : TkMatrix;
end;
TDiffBild =
class(TPaintBox)
private
wSize, hSize : single;
cF : integer;
privPlan : TDiffMat;
privFilm : TDiffMat;
privDiff : TDiffMat;
privGlobDiff : TDiffMat;
privLokDiff : TDiffMat;
privGlobGamma: TDiffMat;
privLokGamma : TDiffMat;
privVX : integer;
privVY : integer;
privMaximum : single;
function getPixHoch : integer;
procedure setPixHoch(Wert:integer);
function getPixWeit : integer;
procedure setPixWeit(Wert:integer);
function getSizeHoch : single;
procedure setSizeHoch(Wert:single);
function getSizeWeit : single;
procedure setSizeWeit(Wert:single);
function getPixSize : single;
procedure setPixSize(Wert:single);
function getPlan : TDiffMat;
procedure setPlan(Wert:TDiffMat);
function getFilm : TDiffMat;
procedure setFilm(Wert:TDiffMat);
function getLokDiff : TDiffMat;
procedure setLokDiff(Wert:TDiffMat);
function getGlobDiff : TDiffMat;
procedure setGlobDiff(Wert:TDiffMat);
function getLokGamma : TDiffMat;
procedure setLokGamma(Wert:TDiffMat);
function getGlobGamma : TDiffMat;
procedure setGlobGamma(Wert:TDiffMat);
protected
public
dPlan : TDiffMat;
dFilm : TDiffMat;
fs:
array[0..17]
of TFarbScala;
published
property rPixHoch : integer
Read GetPixHoch
Write SetPixHoch;
property rPixWeit : integer
Read GetPixWeit
Write SetPixWeit;
property rSizeHoch : single
Read GetSizeHoch
Write SetSizeHoch;
property rSizeWeit : single
Read GetSizeWeit
Write SetSizeWeit;
property rPixSize : single
Read GetPixSize
Write SetPixSize;
property Plan : TDiffMat
Read GetPlan
Write SetPlan;
property Film : TDiffMat
Read GetFilm
Write SetFilm;
property globalDiff : TDiffMat
Read GetGlobDiff
Write SetGlobDiff;
property lokalDiff : TDiffMat
Read GetLokDiff
Write SetLokDiff;
property globalGamma : TDiffMat
Read GetGlobGamma
Write SetGlobGamma;
property lokalGamma : TDiffMat
Read GetLokGamma
Write SetLokGamma;
procedure Initialisieren(PixWeit,PixHoch : integer; SizeWeit, SizeHoch, PixSize:single);
procedure Bild(vx,vy:integer;Schwelle:single);
procedure globDiffBild(Schwelle:single);
end;
procedure Register;
//##############################################################################
implementation
//++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
function TDiffBild.getPixHoch : integer;
begin
Result:=privPlan.PixHeight;
end;
procedure TDiffBild.setPixHoch(Wert:integer);
begin
privPlan.PixHeight:=Wert;
privFilm.PixHeight:=Wert;
end;
//++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
function TDiffBild.getPixWeit : integer;
begin
Result:=privPlan.PixWidth;
end;
procedure TDiffBild.setPixWeit(Wert:integer);
begin
privPlan.PixWidth:=Wert;
privFilm.PixWidth:=Wert;
end;
//++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
function TDiffBild.getSizeHoch : single;
begin
Result:=privPlan.SizeHeight;
end;
procedure TDiffBild.setSizeHoch(Wert:single);
begin
privPlan.SizeHeight:=Wert;
privFilm.SizeHeight:=Wert;
end;
//++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
function TDiffBild.getSizeWeit : single;
begin
Result:=privPlan.SizeWidth;
end;
procedure TDiffBild.setSizeWeit(Wert:single);
begin
privPlan.SizeWidth:= Wert;
privFilm.SizeWidth:= Wert;
end;
//++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
function TDiffBild.getPixSize : single;
begin
Result:=privPlan.PixSize;
end;
procedure TDiffBild.setPixSize(Wert:single);
begin
privPlan.PixSize:=Wert;
privFilm.PixSize:=Wert;
end;
//++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
function TDiffBild.getPlan : TDiffMat;
begin
Result.Dat:=privPlan.Dat;
end;
procedure TDiffBild.setPlan(Wert:TDiffMat);
begin
privPlan.Dat:=Wert.Dat;
end;
//++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
function TDiffBild.getFilm : TDiffMat;
begin
Result.Dat:=privFilm.Dat;
end;
procedure TDiffBild.setFilm(Wert:TDiffMat);
begin
privFilm.Dat:=Wert.Dat;
end;
//++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
function TDiffBild.getGlobDiff : TDiffMat;
begin
Result.Dat:=privGlobDiff.Dat;
end;
procedure TDiffBild.setGlobDiff(Wert:TDiffMat);
begin
privGlobDiff.Dat:=Wert.Dat;
end;
//++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
function TDiffBild.getLokDiff : TDiffMat;
begin
Result.Dat:=PrivLokDiff.Dat;
end;
procedure TDiffBild.setLokDiff(Wert:TDiffMat);
begin
privLokDiff.Dat:=Wert.Dat;
end;
//++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
function TDiffBild.getGlobGamma : TDiffMat;
begin
Result.Dat:=privGlobGamma.Dat;
end;
procedure TDiffBild.setGlobGamma(Wert:TDiffMat);
begin
privGlobGamma.Dat:=Wert.Dat;
end;
//++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
function TDiffBild.getLokGamma : TDiffMat;
begin
Result.Dat:=privLokGamma.Dat;
end;
procedure TDiffBild.setLokGamma(Wert:TDiffMat);
begin
privLokGamma.Dat:=Wert.Dat;
end;
//++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
procedure TDiffBild.Initialisieren(PixWeit,PixHoch : integer; SizeWeit, SizeHoch, PixSize:single);
var
i : integer;
zwischen : single;
//++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
begin
cF := 1 + 256 + 256*256;
// Pixelgröße und Pixellage bestimmen
PixSize:=(SizeWeit/PixWeit+SizeHoch/PixHoch)/2;
// das sind die Abmessungen der Filmenmatrix
privPlan.PixHeight := PixHoch;
privPlan.PixWidth := PixWeit;
privPlan.PixSize := PixSize;
privPlan.SizeHeight:= SizeHoch;
privPlan.SizeWidth := SizeWeit;
privPlan.PixSize := PixSize;
SetLength(privPlan.Dat,PixWeit+3,PixHoch+3);
SetLength(privPlan.farbe,PixWeit+3,PixHoch+3);
// das sind die Abmessungen der Filmenmatrix
privFilm.PixHeight := PixHoch;
privFilm.PixWidth := PixWeit;
privFilm.PixSize := PixSize;
privFilm.SizeHeight:= SizeHoch;
privFilm.SizeWidth := SizeWeit;
privFilm.PixSize := PixSize;
SetLength(privFilm.Dat,PixWeit+3,PixHoch+3);
SetLength(privFilm.farbe,PixWeit+3,PixHoch+3);
// das sind die Abmessungen der lokDiff
privLokDiff.PixHeight := PixHoch;
privLokDiff.PixWidth := PixWeit;
privLokDiff.PixSize := PixSize;
privLokDiff.SizeHeight:= SizeHoch;
privLokDiff.SizeWidth := SizeWeit;
privLokDiff.PixSize := PixSize;
SetLength(privLokDiff.Dat,PixWeit+3,PixHoch+3);
SetLength(privLokDiff.farbe,PixWeit+3,PixHoch+3);
// das sind die Abmessungen der globDiff
privGlobDiff.PixHeight := PixHoch;
privGlobDiff.PixWidth := PixWeit;
privGlobDiff.PixSize := PixSize;
privGlobDiff.SizeHeight:= SizeHoch;
privGlobDiff.SizeWidth := SizeWeit;
privGlobDiff.PixSize := PixSize;
SetLength(privGlobDiff.Dat,PixWeit+3,PixHoch+3);
// * hier werden die
SetLength(privGlobDiff.farbe,PixWeit+3,PixHoch+3);
// einzelnen Arrays
// längendimensioniert
// das sind die Abmessungen der lokDiff
privLokGamma.PixHeight := PixHoch;
privLokGamma.PixWidth := PixWeit;
privLokGamma.PixSize := PixSize;
privLokGamma.SizeHeight:= SizeHoch;
privLokGamma.SizeWidth := SizeWeit;
privLokGamma.PixSize := PixSize;
SetLength(privLokGamma.Dat,PixWeit+3,PixHoch+3);
SetLength(privLokGamma.farbe,PixWeit+3,PixHoch+3);
// das sind die Abmessungen der globDiff
privGlobGamma.PixHeight := PixHoch;
privGlobGamma.PixWidth := PixWeit;
privGlobGamma.PixSize := PixSize;
privGlobGamma.SizeHeight:= SizeHoch;
privGlobGamma.SizeWidth := SizeWeit;
privGlobGamma.PixSize := PixSize;
SetLength(privGlobGamma.Dat,PixWeit+3,PixHoch+3);
SetLength(privGlobGamma.farbe,PixWeit+3,PixHoch+3);
end;
//++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
procedure TDiffBild.Bild(vx,vy:integer;Schwelle:single);
var
i, j, k : integer;
zwischen : single;
//++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
begin
privVx:=vx;
privVy:=vy;
// * hier funktioniert noch alles
canvas.Pen.Mode:=pmCopy;
// wunderbar
// Max vom Plan bestimmen
privMaximum:= MatrixMax(privPlan.PixWidth,privPlan.PixHeight,privPlan.Dat);
// BildMalen
setlength(privGlobDiff.farbe,555,555);
for j := 1
to privPlan.PixHeight
do
begin
for i := 1
to privPlan.PixWidth
do
begin
if (i-vx<1)
or (i-vx>privPlan.PixWidth)
or (j+vy<1)
or (j+vy>privPlan.PixHeight)
then
begin
zwischen :=0;
end
else
zwischen :=(privFilm.Dat[i-vx,j+vy]-privPlan.Dat[i,j])/privMaximum*100;
if zwischen < StrToFloat(fs[17].bis)
then k := 17
else if zwischen < StrToFloat(fs[16].bis)
then k := 16
else if zwischen < StrToFloat(fs[15].bis)
then k := 15
else if zwischen < StrToFloat(fs[14].bis)
then k := 14
else if zwischen < StrToFloat(fs[13].bis)
then k := 13
else if zwischen < StrToFloat(fs[12].bis)
then k := 12
else if zwischen < StrToFloat(fs[11].bis)
then k := 11
else if zwischen < StrToFloat(fs[10].bis)
then k := 10
else if zwischen < StrToFloat(fs[9].bis)
then k := 9
else if zwischen < StrToFloat(fs[8].bis)
then k := 8
else if zwischen < StrToFloat(fs[7].bis)
then k := 7
else if zwischen < StrToFloat(fs[6].bis)
then k := 6
else if zwischen < StrToFloat(fs[5].bis)
then k := 5
else if zwischen < StrToFloat(fs[4].bis)
then k := 4
else if zwischen < StrToFloat(fs[3].bis)
then k := 3
else if zwischen < StrToFloat(fs[2].bis)
then k := 2
else if zwischen < StrToFloat(fs[1].bis)
then k := 1;
if Plan.Dat[i,j]<Schwelle
then
begin
k :=0;
privGlobDiff.Dat[i,j]:=0;
end
else
begin
privGlobDiff.Dat[i,j]:=zwischen;
end;
privGlobDiff.farbe[i,j]:=k;
// * das Array
// privGlobDiff.farbe
// ist noch sauber
// definiert
Canvas.Pixels[i,j]:=
RGB(fs[k].r,fs[k].g,fs[k].b);
end;
end;
end;
//++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
procedure TDiffBild.globDiffBild(Schwelle:single);
// * dieses ist die
var // Problemprocedure !!!
i, j, k : integer;
zwischen : single;
//++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
begin
// setlength(privGlobDiff.farbe,555,555); // * nur hier läßt sich die
for j := 1
to 256
do // Längendimensionierung
begin // wieder herstellen
for i := 1
to 256
do // aber alle Zelleninhalte dann = 0
begin
privGlobDiff.farbe[2*i,2*j];
// * die Längendimensionierung
// von privGlobDiff.farbe
// ist verschwunden
Canvas.Pixels[i,j]:=
RGB(fs[k].r,fs[k].g,fs[k].b);
end;
end;
end;
//++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
procedure Register;
//++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
begin
RegisterComponents('
EB_Graph', [TDiffBild]);
end;
//++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
end.