unit oscilogramm;
interface
uses windows, sysutils, math, extctrls, graphics, controls, classes;

type
tOSC_mode=(auto, normal, accumulate);
tOSC=class(tobject)
private
bmp:tbitmap;
paintbox:tpaintbox;
data:array of smallint;
old_data:array of smallint;
cursor_x, cursor_y:integer;

procedure SlowFFTPaintBoxMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
procedure SlowFFTPaintBoxMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
procedure SlowFFTPaintBoxMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);

public
line_color:tcolor;
x_mult:integer;
data_window:integer;
mode:tOSC_mode;
stop:boolean;

constructor create(v_paintbox:tpaintbox; size:integer);
destructor destroy;override;
procedure add_data(v_data:psmallint; count:integer);
procedure draw;
end;

implementation
uses hsv2rgb;

constructor tosc.create;
begin
inherited create;
paintbox := v_paintbox;

bmp := tbitmap.create;
bmp.Width := paintbox.Width;
bmp.Height := paintbox.Height;

setlength(data, size);
fillchar(data[0], length(data)*sizeof(data[0]), 0);
setlength(old_data, size);

x_mult := 1;
line_color := rgb(0,255,0);
data_window := length(data);
mode := normal;

paintbox.OnMouseDown:=Self.SlowFFTPaintBoxMouseDown;
paintbox.OnMouseMove:=Self.SlowFFTPaintBoxMouseMove;
// paintbox.OnMouseUp:=Self.SlowFFTPaintBoxMouseUp;
end;

destructor tosc.destroy;
begin
bmp.Free; bmp:=nil;
setlength(data,0);

inherited destroy;
end;

procedure tosc.add_data(v_data:psmallint; count:integer);
begin
if self=nil then exit;
if length(data)=0 then exit;
if stop then exit;

count:=min(length(data), count);
if count<length(data) then
move(data[count], data[0], (length(data)-count)*sizeof(data[0]));
move(v_data^, data[length(data)-count], count*sizeof(data[0]));
end;

procedure _inf(var v);
begin
end;

//САМА ПРОЦЕДУРА СТАБИЛИЗАЦИИ!!! <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
function find_sync(etalon, where_find:psmallint; count:integer):integer; //САМА ПРОЦЕДУРА СТАБИЛИЗАЦИИ!!! <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<

function array_mult(a,b:psmallint; count:integer):double;
begin
result:=0.0;
while count>0 do
begin
result:=result+integer(a^)*integer(b^);

inc(a);
inc(;
dec(count);
end;
end;

function array_max_pos(a:pdouble;count:integer):integer;
var
max_val:double;
pos:integer;
begin
pos:=0;
result:=0;
max_val:=MinDouble;
while count>0 do
begin
if a^>max_val then
begin
result:=pos;
max_val:=a^;
end;
inc(a);
inc(pos);
dec(count);
end;
end;

var
results:array of double;
k:integer;
begin
setlength(results, count);

for k:=0 to count-1 do
begin
results[k]:=array_mult(etalon, where_find, count);
dec(where_find);
end;

result:=array_max_pos(@(results[0]), count);

setlength(results, 0);
end;

procedure tosc.draw;
var
maxx,maxy:integer;
pos:integer;
getx:integer;
xadd:integer;
scale:double;
midle:integer;

function gety:integer;
begin
gety:=0;
getx:=getx+xadd;

if pos<0 then exit;
if pos>=length(data) then exit;

gety:=round(midle-scale*data[pos]);
inc(pos);
end;

var
k,r,g,b:integer;
s:string;
line_cnt:integer;
line_pos:integer;
color_cnt:integer;
color_pos:integer;
begin
if self=nil then exit;
if length(data)=0 then exit;
if paintbox=nil then exit;

maxx := paintbox.Width;
maxy := paintbox.Height;
pos := 0;
xadd := min(maxx, max(1, x_mult));
getx := -xadd;
midle := maxy div 2;
scale := (1/(1 shl (8*sizeof(data[0])-1)))*midle*((midle-2)/midle);

bmp.Canvas.Brush.Color := rgb(0,0,0);
bmp.Canvas.Brush.Style := bsSolid;
bmp.Canvas.Pen.Color := rgb(0,0,0);
bmp.Canvas.Pen.Style := psSolid;
bmp.Canvas.Rectangle(-1, -1, maxx+1, maxy+1);


bmp.Canvas.Pen.Color:=rgb(64,64,64);
bmp.Canvas.Pen.Style:=psSolid;
bmp.Canvas.MoveTo(0, midle);
bmp.Canvas.LineTo(maxx, midle);

bmp.Canvas.Pen.Color:=rgb(50, 50, 100);
bmp.Canvas.Pen.Style:=psSolid;
bmp.Canvas.Font.Name:='Courier New';
bmp.Canvas.Font.Size:=12;
bmp.Canvas.Font.color:=rgb(128,128,128);

bmp.Canvas.MoveTo(0, cursor_y);
bmp.Canvas.LineTo(maxx, cursor_y);
bmp.Canvas.MoveTo(cursor_x, 0);
bmp.Canvas.LineTo(cursor_x, maxy);
s:='';
if mode=Normal then s:=s+'Stab';
if mode=Auto then s:=s+'Free';
if mode=accumulate then s:=s+'Summ';
s:=s+' ';
bmp.Canvas.TextOut(maxx-bmp.Canvas.TextWidth(s),0, s);
s:=' '+inttostr(cursor_x)+':'+inttostr(round((midle-cursor_y)/scale));
if cursor_x<>-1 then
bmp.Canvas.TextOut(0, 0, s);

if (mode=normal) or (mode=Auto) then
begin
pos := max(0, length(data)-1-(maxx div xadd));
if mode=normal then
begin
pos := pos - find_sync(@old_data[0], @data[pos], (maxx div xadd)+1);
if pos<0 then pos:=0;
for k:=0 to maxx div xadd do
old_data[k]:=round(old_data[k]*0.9+0.1*data[pos+k]);

//move(data[pos], old_data[0], (maxx div xadd)+1);
end;

bmp.Canvas.MoveTo(0, midle);
bmp.Canvas.Pen.Color:=line_color;
bmp.Canvas.Pen.Style:=psSolid;

bmp.Canvas.MoveTo(getx, gety);
while getx<=maxx do
bmp.Canvas.LineTo(getx, gety);
end;

if mode=accumulate then
begin
line_cnt := maxx div xadd;
color_cnt := length(data) div line_cnt;

for color_pos:=0 to color_cnt-1 do
begin
{ if mode=spectr then
HSVToRGB(1-color_pos/color_cnt, 1, round(255*(color_pos/color_cnt)), r, g,
else}
begin
r:=round(256*(color_pos/color_cnt));
b:=r;
g:=r;
end;
bmp.Canvas.MoveTo(0, midle);
bmp.Canvas.Pen.Color:=rgb(r,g,;
bmp.Canvas.Pen.Style:=psSolid;
pos:=line_cnt*color_pos;

bmp.Canvas.MoveTo(0, gety);
for line_pos:=1 to line_cnt-1 do
bmp.Canvas.LineTo(line_pos*xadd, gety);
end;
end;

paintbox.Canvas.Draw(0,0, bmp);
end;

procedure tosc.SlowFFTPaintBoxMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
cursor_x:=-1;
cursor_y:=-1;
end;

procedure tosc.SlowFFTPaintBoxMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
if ssmiddle in Shift then
stop:=not stop;
if not (ssright in Shift) then exit;

if mode=normal then mode:=auto else
if mode=auto then mode:=accumulate else
if mode=accumulate then mode:=normal;
end;

procedure tosc.SlowFFTPaintBoxMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
begin
if ssleft in Shift then
begin
cursor_x:=x;
cursor_y:=y;
end
else
begin
cursor_x:=-1;
cursor_y:=-1;
end;

end;

end.