the source code of this page may not appear correctly in certain browsers
due to special characters. Have a look at the source of this HTML page
with notepad instead
Based on the TMapwin, this component has a crude frame
around the plot.
It allows labels for the axis and range values as shown :
Above, the complex plot type is shown.
{
provides a frame around a plotwindow,
create:
gw:=TGridWin.create(image1); // assumes image1 exists
gw.xlow:=0; gw.xhigh:=pi;
gw.ylow:=-1.1; gw.yhigh:=1.1;
gw.hlabel:='X axis';
gw.vlabel:='Y axis';
gw.clear;
gw.drawframe;
gw.drawgrid;
plot :
procedure TForm1.Button2Click(Sender: TObject);
var x,y:integer;
sx,sy:single;
begin
for x:=gw.left to gw.left+gw.width do begin
sx:=gw.getX(x);
sy:=sin(sx);
gw.putpixel(sx,sy,clred);
end;
end;
a cursor : // set as cross in the image1, a label :mouselabel exists
procedure TForm1.Image1MouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
var xs,ys:float;
begin
gw.screentofloat(x,y,xs,ys);
mouselabel.caption:=format('%5.5g,%5.5g',[xs,ys]);
end;
}
unit GridWin;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
extctrls,ComplexRec,Plotwin;
type
TGridWin = class(TMapWin)
private
{ Private declarations }
flborder,frborder,ftborder,fbborder:integer;
fhlabel,fvlabel:string;
protected
{ Protected declarations }
procedure setleftborder(i:integer);
procedure setrightborder(i:integer);
procedure settopborder(i:integer);
procedure setbottomborder(i:integer);
procedure sethlabel(s:string);
procedure setvlabel(s:string);
function significantdigits(a,b:extended):integer;
public
{ Public declarations }
constructor create(image:TImage);
destructor destroy;
procedure drawframe;
procedure drawgrid;
published
{ Published declarations }
property leftborder:integer read flborder write setleftborder;
property rightborder:integer read frborder write setrightborder;
property topborder:integer read ftborder write settopborder;
property bottomborder:integer read fbborder write setbottomborder;
property hlabel:string read fhlabel write sethlabel;
property vlabel:string read fvlabel write setvlabel;
end;
cwmodetype=(saAP,saRI); // real/imag or abs/phase
TComplexGridWin=class(TObject)
private
{ Private declarations }
fimage:TImage;
fmw1,fmw2:TMapWin;
flborder,frborder,ftborder,fbborder:integer;
fhlabel,fvlabel:string;
ftlx,ftly,fbrx,fbry,fwidth,fheight:integer;
fflow,ffhigh,fmina,fmaxa:float;
fmode:cwmodetype;
fxlog:boolean;
protected
{ Protected declarations }
procedure setleftborder(i:integer);
procedure setrightborder(i:integer);
procedure settopborder(i:integer);
procedure setbottomborder(i:integer);
procedure sethlabel(s:string);
procedure setvlabel(s:string);
function significantdigits(a,b:extended):integer;
procedure setimage(i:TImage);
procedure setTLX(u:integer);
procedure setTLY(u:integer);
procedure setWidth(u:integer);
procedure setHeight(u:integer);
procedure setflow(f:float);
procedure setfhigh(f:float);
procedure setmina(a:float);
procedure setmaxa(a:float);
procedure setxlog(b:boolean);
public
{ Public declarations }
constructor create(image:TImage);
destructor destroy;
procedure drawframe;
procedure drawgrid;
procedure ComplexToScreen(z:Complex;f:float;var xs,ya,yp:integer); virtual;
procedure ScreenToFloat(xs,ys:integer;var xf,yf:float); virtual;
procedure clear;
procedure putpixel(z:Complex;f:float;color:TColor); virtual;
procedure VLine(f:float;color:TColor); virtual; //vertical line
procedure HALine(f:float;color:TColor); virtual; // horizontal line amplitude
procedure HPLine(f:float;color:TColor); virtual; // horizontal line phase
function getX(i:integer):float; // i:=0..width-1
published
{ Published declarations }
property image:TImage read fimage write setimage;
property left:integer read ftlx write setTLX; // with respect to image
property top:integer read ftly write setTLY; // with respect to image
property width:integer read fwidth write setWidth; // with respect to image
property height:integer read fheight write setHeight; // with respect to image
property mode:cwmodetype read fmode write fmode;
property flow:float read fflow write setflow; // frequency
property fhigh:float read ffhigh write setfhigh; // frequency
property mina:float read fmina write setmina; // absolute value
property maxa:float read fmaxa write setmaxa; // absolute value
property leftborder:integer read flborder write setleftborder;
property rightborder:integer read frborder write setrightborder;
property topborder:integer read ftborder write settopborder;
property bottomborder:integer read fbborder write setbottomborder;
property hlabel:string read fhlabel write sethlabel;
property vlabel:string read fvlabel write setvlabel;
property xlog:boolean read fxlog write setxlog;
end;
procedure Register;
implementation
uses math;
const
defaultleftborder=30;
defaultrightborder=0;
defaulttopborder=0;
defaultbottomborder=20;
constructor TGridWin.create(image:TImage);
begin
inherited create(image);
flborder:=defaultleftborder;
frborder:=defaultrightborder;
ftborder:=defaulttopborder;
fbborder:=defaultbottomborder;
top:=defaulttopborder;
left:=defaultleftborder;
width:=image.width-defaultleftborder-defaultrightborder;
height:=image.height-defaulttopborder-defaultbottomborder;
fhlabel:='';
fvlabel:='';
end;
destructor TGridWin.destroy;
begin
inherited destroy;
end;
procedure TGridWin.setleftborder(i:integer);
begin
left:=i;
width:=image.width-i-frborder;
flborder:=i;
end;
procedure TGridWin.setrightborder(i:integer);
begin
frborder:=i;
width:=image.width-flborder-frborder;
end;
procedure TGridWin.settopborder(i:integer);
begin
top:=i;
ftborder:=i;
height:=image.height-ftborder-fbborder;
end;
procedure TGridWin.setbottomborder(i:integer);
begin
fbborder:=i;
height:=image.height-ftborder-fbborder;
end;
procedure TGridWin.sethlabel(s:string);
begin
fhlabel:=s;
end;
procedure TGridWin.setvlabel(s:string);
begin
fvlabel:=s;
end;
function TGridWin.significantdigits(a,b:extended):integer;
var r:extended;
astr,bstr:string;
begin
if abs(a)<1e-60 then result:=2
else
if abs(b)<1e-60 then result:=2
else
begin
r:=abs(a-b)/abs(a);
if r<1 then r:=1/r;
result:=2;
while (r<1.1)do
begin
r:=10*(r-1); inc(result);
end;
end;
end;
procedure TGridWin.drawframe;
var x1,x2,y1,y2:integer;
var ex:TSize;
st,n:integer;
num:string;
tmpF : HFONT;
tmpL : TLogFont;
oldFont : HFONT;
tmpTFont : TFont;
offSetX : integer;
begin
if leftborder<>0 then x1:=flborder-1 else x1:=0;
if rightborder<>0 then x2:=image.width-frborder+1 else x2:=image.width-1;
if topborder<>0 then y1:=topborder-1 else y1:=0;
if bottomborder<>0 then y2:=image.height-fbborder+1 else y2:=image.height-1;
image.canvas.pen.color:=clblack;
if leftborder<>0 then begin
image.canvas.moveto(x1,y1);
image.canvas.lineto(x1,y2);
end;
if bottomborder<>0 then begin
image.canvas.moveto(x1,y2);
image.canvas.lineto(x2,y2);
end;
if rightborder<>0 then begin
image.canvas.moveto(x2,y2);
image.canvas.lineto(x2,y1);
end;
if topborder<>0 then begin
image.canvas.moveto(x2,y1);
image.canvas.lineto(x1,y1);
end;
if (bottomborder<>0)and(hlabel<>'') then begin
image.canvas.font.name:='MS Sans Serif';
image.canvas.Font.Size:=8;
{ the units }
n:=significantdigits(xlow,xhigh);
num:=format('%'+inttostr(n)+'g',[xlow]);
image.canvas.textout(leftborder,image.height-12,num);
num:=format('%'+inttostr(n+1)+'.'+inttostr(n)+'g',[xhigh]);
ex:=image.Canvas.TextExtent(num);
image.canvas.textout(image.width-ex.cx,image.height-12,num);
{ the label }
//canvas.font.style.[fsItalic]:=true;
ex:=image.Canvas.TextExtent(fhlabel);
st:=(width-ex.cx)div 2;
image.canvas.TextOut(st,image.height-12,fhlabel);
end;
if (leftborder<>0)and(vlabel<>'') then begin
image.canvas.font.name:='Courier New';
image.canvas.Font.Size:=8;
{ the units }
n:=significantdigits(ylow,yhigh);
num:=format('%'+inttostr(n)+'g',[ylow]);
image.canvas.textout(1,image.height-bottomborder-12,num);
num:=format('%'+inttostr(n)+'g',[yhigh]);
ex:=image.Canvas.TextExtent(num);
image.canvas.textout(1,0,num);
{ the label }
//canvas.font.style.[fsItalic]:=true;
//ex:=Canvas.TextExtent(fvaxislabel);
//st:=(height-ex.cx)div 2;
//canvas.TextOut(1,st,fvaxislabel);
tmpTFont := TFont.Create;
tmpTFont.Assign( image.canvas.font );
GetObject( image.canvas.Font.Handle,SizeOf(TLogFont),@tmpL);
tmpL.lfEscapement := 900;
tmpL.lfOrientation := 900;
tmpF := CreateFontIndirect(tmpL);
image.canvas.Font.Handle := tmpF;
SetBkMode( image.canvas.Handle, windows.TRANSPARENT );
Windows.TextOut( image.canvas.handle, 2 , Height div 2 ,pChar(vlabel), length(vlabel) );
SetBkMode( image.canvas.Handle, OPAQUE );
image.canvas.Font.assign(tmpTFont);
DeleteObject(tmpF);
tmpTFont.Free;
end;
end;
procedure TGridWin.drawgrid;
var d:float;
i:integer;
begin
// is zero part of it ?
if (not xlog)and(xlow<=0)and(xhigh>=0) then vline(0,clred);
if (not ylog)and(ylow<=0)and(yhigh>=0) then hline(0,clred);
// log grid
if (xlog) then begin
for i:=-20 to 20 do begin
d:=intpower(10,i);
if (d>=xlow)and(d<=xhigh) then
vline(d,clgray);
end;
end;
if (ylog) then begin
for i:=-20 to 20 do begin
d:=intpower(10,i);
if (d>=ylow)and(d<=yhigh) then
hline(d,clgray);
end;
end;
end;
//#############################################################
procedure TComplexGridWin.setimage(i:TImage);
begin
fimage:=i;
fmw1.image:=i;
fmw2.image:=i;
end;
procedure TComplexGridWin.setTLX(u:integer);
begin ftlx:=u; end;
procedure TComplexGridWin.setTLY(u:integer);
begin ftly:=u; end;
procedure TComplexGridWin.setWidth(u:integer);
begin fbrx:=ftlx+u; fwidth:=u; end;
procedure TComplexGridWin.setHeight(u:integer);
begin fbry:=ftly+u; fheight:=u; end;
procedure TComplexGridWin.setflow(f:float);
begin
fflow:=f;
fmw1.xlow:=f;
fmw2.xlow:=f;
end;
procedure TComplexGridWin.setfhigh(f:float);
begin
ffhigh:=f;
fmw1.xhigh:=f;
fmw2.xhigh:=f;
end;
procedure TComplexGridWin.setmina(a:float);
begin
fmina:=a;
fmw1.ylow:=a;
end;
procedure TComplexGridWin.setmaxa(a:float);
begin
fmaxa:=a;
fmw1.yhigh:=a;
end;
procedure TComplexGridWin.setxlog(b:boolean);
begin
fmw1.xlog:=b;
fmw2.xlog:=b;
fxlog:=b;
end;
procedure TComplexGridWin.setleftborder(i:integer);
begin
left:=i;
width:=image.width-i-frborder;
flborder:=i;
end;
procedure TComplexGridWin.setrightborder(i:integer);
begin
frborder:=i;
width:=image.width-flborder-frborder;
end;
procedure TComplexGridWin.settopborder(i:integer);
begin
top:=i;
ftborder:=i;
height:=image.height-ftborder-fbborder;
end;
procedure TComplexGridWin.setbottomborder(i:integer);
begin
fbborder:=i;
height:=image.height-ftborder-fbborder;
end;
procedure TComplexGridWin.sethlabel(s:string);
begin
fhlabel:=s;
end;
procedure TComplexGridWin.setvlabel(s:string);
begin
fvlabel:=s;
end;
function TComplexGridWin.significantdigits(a,b:extended):integer;
var r:extended;
astr,bstr:string;
begin
if abs(a)<1e-60 then result:=2
else
if abs(b)<1e-60 then result:=2
else
begin
r:=abs(a-b)/abs(a);
if r<1 then r:=1/r;
result:=2;
{ while (r<1.1)do
begin
r:=10*(r-1); inc(result);
end; }
end;
end;
constructor TComplexGridWin.create(image:TImage);
begin
inherited create;
fimage:=image;
fmw1:=TMapWin.create(image);
fmw2:=TMapWin.create(image);
flborder:=defaultleftborder;
frborder:=defaultrightborder;
ftborder:=defaulttopborder;
fbborder:=defaultbottomborder;
fmw1.top:=defaulttopborder;
fmw1.left:=defaultleftborder;
fmw2.top:=(image.height-defaulttopborder-defaultbottomborder) div 2;
fmw2.left:=defaultleftborder;
fmw1.width:=image.width-defaultleftborder-defaultrightborder;
fmw2.width:=fmw1.width;
fmw1.height:=(image.height-defaulttopborder-defaultbottomborder)div 2;
fmw2.height:=fmw1.height;
fheight:=(image.height-defaulttopborder-defaultbottomborder);
fhlabel:='frequency';
fvlabel:='amplitude';
flow:=0.1; fhigh:=100;
fmina:=1e-9; fmaxa:=1;
fmw1.xlow:=flow; fmw2.xlow:=flow;
fmw1.xhigh:=fhigh; fmw2.xhigh:=fhigh;
fmw1.YLow:=fmina; fmw2.YLow:=-pi;
fmw1.YHigh:=fmaxa; fmw2.YHigh:=pi;
fmw1.xlog:=true; fmw2.xlog:=true;
fmw1.ylog:=true; fmw2.ylog:=false;
fmw1.protectlog:=true;
end;
destructor TComplexGridWin.destroy;
begin
fmw1.destroy;
fmw2.destroy;
inherited destroy;
end;
procedure TComplexGridWin.ComplexToScreen(z:Complex;f:float;var xs,ya,yp:integer);
var ax,ay,bx,by:integer;
begin
if fmode=saAP then begin // z:=a,p
fmw1.floattoscreen(f,z.a,ax,ay);
fmw2.floattoscreen(f,z.b,bx,by);
xs:=ax; ya:=ay; yp:=by;
end;
end;
procedure TComplexGridWin.ScreenToFloat(xs,ys:integer;var xf,yf:float);
begin
if fmode=saAP then begin
if (ys>=fheight div 2) then // in the phase part
fmw2.ScreenToFloat(xs,ys{-(fheight div 2)},xf,yf)
else // absolute part
fmw1.ScreenToFloat(xs,ys,xf,yf);
end;
end;
procedure TComplexGridWin.clear;
begin
if assigned(fimage) then begin
fimage.canvas.Pen.color:=clWhite;
fimage.canvas.brush.color:=clWhite;
fimage.canvas.rectangle(0,0,fimage.width-1,fimage.height-1);
fimage.canvas.Pen.color:=clblack;
fimage.canvas.moveto(0,fimage.height div 2);
//fimage.canvas.lineto(fimage.width,fimage.height div 2);
fimage.canvas.Pen.color:=clWhite;
end;
end;
procedure TComplexGridWin.putpixel(z:Complex;f:float;color:TColor);
begin
fmw1.putpixel(f,z.a,color);
fmw2.putpixel(f,z.b,color);
end;
procedure TComplexGridWin.VLine(f:float;color:TColor);
begin
fmw1.VLine(f,color);
fmw2.VLine(f,color);
end;
procedure TComplexGridWin.HALine(f:float;color:TColor);
begin
fmw1.HLine(f,color);
end;
procedure TComplexGridWin.HPLine(f:float;color:TColor);
begin
fmw2.HLine(f,color);
end;
function TComplexGridWin.getX(i:integer):float; // i:=0..width-1
begin
result:=fmw1.getx(i);
end;
procedure TComplexGridWin.drawframe;
var x1,x2,y1,y2:integer;
var ex:TSize;
st,n:integer;
num,s:string;
tmpF : HFONT;
tmpL : TLogFont;
oldFont : HFONT;
tmpTFont : TFont;
offSetX : integer;
begin
if leftborder<>0 then x1:=flborder-1 else x1:=0;
if rightborder<>0 then x2:=fimage.width-frborder+1 else x2:=fimage.width-1;
if topborder<>0 then y1:=topborder-1 else y1:=0;
if bottomborder<>0 then y2:=fimage.height-fbborder+1 else y2:=fimage.height-1;
fimage.canvas.pen.color:=clblack;
if leftborder<>0 then begin
fimage.canvas.moveto(x1,y1);
fimage.canvas.lineto(x1,y2);
end;
if bottomborder<>0 then begin
fimage.canvas.moveto(x1,y2);
fimage.canvas.lineto(x2,y2);
end;
if rightborder<>0 then begin
fimage.canvas.moveto(x2,y2);
fimage.canvas.lineto(x2,y1);
end;
if topborder<>0 then begin
fimage.canvas.moveto(x2,y1);
fimage.canvas.lineto(x1,y1);
end;
//y1:=(fimage.height-ftborder-fbborder)div 2;
//fimage.canvas.moveto(x1,y1);
//fimage.canvas.lineto(x2,y1);
if (bottomborder<>0)and(hlabel<>'') then begin
fimage.canvas.font.name:='MS Sans Serif';
fimage.canvas.Font.Size:=8;
{ the units }
n:=significantdigits(flow,fhigh);
num:=format('%'+inttostr(n)+'g',[flow]);
fimage.canvas.textout(leftborder,fimage.height-12,num);
num:=format('%'+inttostr(n+1)+'.'+inttostr(n)+'g',[fhigh]);
ex:=fimage.Canvas.TextExtent(num);
fimage.canvas.textout(image.width-ex.cx,image.height-12,num);
{ the label }
//canvas.font.style.[fsItalic]:=true;
ex:=fimage.Canvas.TextExtent(fhlabel);
st:=(fimage.width-ex.cx)div 2;
fimage.canvas.TextOut(st,fimage.height-12,fhlabel);
end;
if (leftborder<>0)and(vlabel<>'') then begin
fimage.canvas.font.name:='Courier New';
fimage.canvas.Font.Size:=8;
{ the units }
n:=significantdigits(mina,maxa);
num:=format('%'+inttostr(n)+'g',[mina]);
fimage.canvas.textout(1,(fimage.height-bottomborder) div 2-12,num);
num:=format('%'+inttostr(n)+'g',[maxa]);
ex:=fimage.Canvas.TextExtent(num);
fimage.canvas.textout(1,0,num);
fimage.canvas.textout(1,(fimage.height-bottomborder) div 2,'pi');
fimage.canvas.textout(1,(fimage.height-bottomborder)-12,'-pi');
{ the label }
//canvas.font.style.[fsItalic]:=true;
//ex:=Canvas.TextExtent(fvaxislabel);
//st:=(height-ex.cx)div 2;
//canvas.TextOut(1,st,fvaxislabel);
tmpTFont := TFont.Create;
tmpTFont.Assign( fimage.canvas.font );
GetObject( fimage.canvas.Font.Handle,SizeOf(TLogFont),@tmpL);
tmpL.lfEscapement := 900;
tmpL.lfOrientation := 900;
tmpF := CreateFontIndirect(tmpL);
image.canvas.Font.Handle := tmpF;
SetBkMode( fimage.canvas.Handle, windows.TRANSPARENT );
y1:=(fimage.height-bottomborder)div 4;
y2:=3*(fimage.height-bottomborder)div 4;
s:='abs '+vlabel;
ex:=fimage.Canvas.TextExtent(s);
Windows.TextOut( fimage.canvas.handle, 2 , y1+ex.cx div 2 ,pChar(s), length(s) );
s:='arg '+vlabel;
ex:=fimage.Canvas.TextExtent(s);
Windows.TextOut( fimage.canvas.handle, 2 , y2+ex.cx div 2 ,pChar(s), length(s) );
SetBkMode( fimage.canvas.Handle, OPAQUE );
fimage.canvas.Font.assign(tmpTFont);
DeleteObject(tmpF);
tmpTFont.Free;
end;
end;
procedure TComplexGridWin.drawgrid;
var d:float;
i:integer;
begin
// is zero part of it ?
if (not fmw1.xlog)and(flow<=0)and(fhigh>=0) then vline(0,clred);
if (not fmw1.ylog)and(mina<=0)and(maxa>=0) then haline(0,clred);
if (not fmw2.xlog)and(flow<=0)and(fhigh>=0) then vline(0,clred);
if (not fmw2.ylog) then hpline(0,clgray);
// log grid
if (fmw1.xlog) then begin
for i:=-20 to 20 do begin
d:=intpower(10,i);
if (d>=flow)and(d<=fhigh) then
fmw1.vline(d,clgray);
end;
end;
if (fmw1.ylog) then begin
for i:=-20 to 20 do begin
d:=intpower(10,i);
if (d>=mina)and(d<=maxa) then
fmw1.hline(d,clgray);
end;
end;
if (fmw2.xlog) then begin
for i:=-20 to 20 do begin
d:=intpower(10,i);
if (d>=flow)and(d<=fhigh) then
fmw2.vline(d,clgray);
end;
end;
if (fmw2.ylog) then begin
for i:=-20 to 20 do begin
d:=intpower(10,i);
if (d>=mina)and(d<=maxa) then
fmw2.hline(d,clgray);
end;
end;
end;
procedure Register;
begin
// RegisterComponents('Samples', [TGridWin]);
end;
end.