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
be an existing image given :
var image1:TImage;
there is a class TMapwin, defined below, which does it all.
var mw1,mw2:TMapWin; // define two graphs
mw1:=TMapWin.create(image1); // create in the image1 context
mw1.left:=0; mw1.width:=image1.width; // use the whole width of the image
mw1.top:=0; mw1.height:=image1.height; // use the full height of the image
mw1.xlow:=0; mw1.xhigh:=2*pi; // define the world [0..2pi,-1.1..1.1]
mw1.ylow:=-1.1; mw1.yhigh:=1.1;
for i:=0 to image1.width-1 do begin // scan along X
x:=mw1.getx(i); // get the float of X
y:=sin(x); // calc the function
mw1.putpixel(x,y,clBlack); // display the point
end;
and now a second graph :
mw2:=TMapWin.create(image1); // create in the image1 context
mw2.left:=0; mw2.width:=image1.width; // again the full image
mw2.top:=0; mw2.height:=image1.height;
mw2.xlow:=1e-6; mw2.xhigh:=1; // a different world
mw2.ylow:=-14; mw2.yhigh:=0;
mw2.xlog:=true; // logarithmic in X
for i:=0 to image1.width-1 do begin // as above ...
x:=mw2.getx(i);
y:=ln(x);
mw2.putpixel(x,y,clred);
end;
a cursor : // cursor predefined as cross on the image, label : mouselabel exists
procedure TForm1.ImageMouseMove(x,y:integer...);
var sx,sy:float;
begin
mw1.screentofloat(x,y,sx,sy);
mouselabel.caption:=format('%8.5g %8.5g',[sx,sy]);
end;
type
float=extended;
TMapWin = class(TObject)
private
{ Private declarations }
fimage:TImage;
ftlx,ftly,fbrx,fbry,fwidth,fheight:integer;
fxlow,fxhigh,fylow,fyhigh,fdx,fdy:float;
fdrawclip,fxlog,fylog,fprotectlog:boolean;
protected
{ Protected declarations }
procedure setimage(i:TImage);
procedure setTLX(u:integer);
procedure setTLY(u:integer);
procedure setWidth(u:integer);
procedure setHeight(u:integer);
procedure setxlow(z:float);
procedure setxhigh(z:float);
procedure setylow(z:float);
procedure setyhigh(z:float);
procedure setxlog(b:boolean);
procedure setylog(b:boolean);
function mapW2SxLin(xf:float):integer;
function mapW2SyLin(yf:float):integer;
function mapW2SxLog(xf:float):integer;
function mapW2SyLog(yf:float):integer;
function mapS2WxLin(xs:integer):float;
function mapS2WyLin(ys:integer):float;
function mapS2WxLog(xs:integer):float;
function mapS2WyLog(ys:integer):float;
public
{ Public declarations }
constructor create(image:TImage); // must exist or NIL
destructor destroy; override;
procedure FloatToScreen(xf,yf:float;var xs,ys:integer); virtual;
procedure ScreenToFloat(xs,ys:integer;var xf,yf:float); virtual;
procedure clear;
procedure putpixel(x,y:float;color:TColor); virtual;
procedure putline(x1,y1,x2,y2:float;color:TColor); virtual; // not yet
procedure VLine(x:float;color:TColor); virtual; // vertical line
procedure HLine(y:float;color:TColor); virtual; // horizontal line
function getX(i:integer):float; // i:=0..width-1
function getY(i:integer):float; // i:=0..height-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 xlow:float read fxlow write setXLow;
property ylow:float read fylow write setYLow;
property xhigh:float read fxhigh write setXHigh;
property yhigh:float read fyhigh write setYHigh;
property dx:float read fdx;
property dy:float read fdy;
property drawclipped:boolean read fdrawclip write fdrawclip;
property xlog:boolean read fxlog write setxlog;
property ylog:boolean read fylog write setylog;
property protectlog:boolean read fprotectlog write fprotectlog;
end;
procedure Register;
implementation
uses math;
type TMyPlotException=Class(Exception);
//...........................................................................
procedure TMapWin.setimage(i:TImage);
begin fimage:=i; end;
procedure TMapWin.setTLX(u:integer);
begin ftlx:=u; end;
procedure TMapWin.setTLY(u:integer);
begin ftly:=u; end;
procedure TMapWin.setWidth(u:integer);
begin fbrx:=ftlx+u; fwidth:=u; end;
procedure TMapWin.setHeight(u:integer);
begin fbry:=ftly+u; fheight:=u; end;
procedure TMapWin.setxlow(z:float);
begin fxlow:=z; end;
procedure TMapWin.setxhigh(z:float);
begin fxhigh:=z; end;
procedure TMapWin.setylow(z:float);
begin fylow:=z; end;
procedure TMapWin.setyhigh(z:float);
begin fyhigh:=z; end;
procedure TMapWin.setxlog(b:boolean);
begin
fxlog:=b;
if b then begin // set log
if xlow=0 then xlow:=1e-24;
end;
end;
procedure TMapWin.setylog(b:boolean);
begin
fylog:=b;
if b then begin // set log
if ylow=0 then ylow:=1e-24;
end;
end;
function TMapWin.mapW2SxLin(xf:extended):integer;
begin
result:=round(ftlx+(xf-fxlow)*(width)/(fxhigh-fxlow));
end;
function TMapWin.mapW2SyLin(yf:extended):integer;
begin
result:=round(fbry-(yf-fylow)*(height)/(fyhigh-fylow));
end;
function TMapWin.mapW2SxLog(xf:extended):integer;
begin
result:=round(ftlx+(ln(xf/fxlow)/ln(fxhigh/fxlow))*(width));
end;
function TMapWin.mapW2SyLog(yf:extended):integer;
begin
result:=fbry-round((ln(yf/fylow)/ln(fyhigh/fylow))*(height));
end;
function TMapWin.mapS2WxLin(xs:integer):extended;
begin
result:=fxlow+(xs-ftlx)*(fxhigh-fxlow)/(width);
end;
function TMapWin.mapS2WyLin(ys:integer):extended;
begin
result:=fyhigh-(ys-ftly)*(fyhigh-fylow)/(height);
end;
function TMapWin.mapS2WxLog(xs:integer):extended;
begin
result:=fxlow*exp(((xs-ftlx)/(width))*ln(fxhigh/fxlow));
end;
function TMapWin.mapS2WyLog(ys:integer):extended;
begin
result:=fyhigh/exp(((ys-ftly)/(height)*ln(fyhigh/fylow)));
end;
constructor TMapWin.create(image:TImage);
begin
inherited create;
fimage:=image;
fdrawclip:=true;
fprotectlog:=true;
xlow:=0; ylow:=0; xhigh:=1; yhigh:=1; xlog:=false; ylog:=false;
ftlx:=0;ftly:=0;
if image<>nil then begin
width:=image.width;
height:=image.height;
end
else begin
width:=100; height:=100;
end;
end;
destructor TMapWin.destroy;
begin
inherited destroy;
end;
procedure TMapWin.FloatToScreen(xf,yf:float;var xs,ys:integer);
begin
if ((fxlog)and(xf<0))or((fylog)and(yf<0)) then
raise(TMyPlotException.create('TMapWin: Number for log axis smaller than zero'));
if fxlog then xs:=mapW2SxLog(xf) else xs:=mapW2SxLin(xf);
if fylog then ys:=mapW2SyLog(yf) else ys:=mapW2SyLin(yf);
end;
procedure TMapWin.ScreenToFloat(xs,ys:integer;var xf,yf:float);
begin
if fxlog then xf:=mapS2WxLog(xs) else xf:=mapS2WxLin(xs);
if fylog then yf:=mapS2WyLog(ys) else yf:=mapS2WyLin(ys);
end;
procedure TMapWin.clear;
begin
if assigned(fimage) then begin
fimage.canvas.Pen.color:=clWhite;
fimage.canvas.brush.color:=clWhite;
fimage.canvas.rectangle(ftlx,ftly,fbrx,fbry);
end;
end;
procedure TMapWin.putpixel(x,y:float;color:TColor);
var ix,iy:integer;
var cx,cy:boolean;
begin
if ((fxlog)and(x < 0))or((fylog)and(y < 0)) then begin
if fprotectlog then
exit
else
raise(TMyPlotException.create('Number for log axis smaller than zero'));
end;
cx:=false; cy:=false; ix:=0; iy:=0;
if (x < fxlow) then begin ix:=ftlx; cx:=true; end;
if (x > fxhigh) then begin ix:=fbrx-1; cx:=true; end;
if (y < fylow) then begin iy:=fbry-1; cy:=true; end;
if (y > fyhigh) then begin iy:=ftly; cy:=true; end;
if not cx then begin
if fxlog then ix:=mapW2SxLog(x) else ix:=mapW2SxLin(x);
end;
if (not cy) then begin
if fylog then iy:=mapW2SyLog(y) else iy:=mapW2SyLin(y);
end;
if (cx or cy)and(not fdrawclip) then exit;
if assigned(fimage) then fimage.canvas.pixels[ix,iy]:=color;
end;
procedure TMapWin.putline(x1,y1,x2,y2:float;color:TColor);
var cx1,cx2,cy1,cy2:integer;
begin
end;
procedure TMapWin.VLine(x:float;color:TColor); // vertical line
var ix,iy:integer;
cx:boolean;
begin
if ((fxlog)and(x < 0))then begin
if fprotectlog then
exit
else
raise(TMyPlotException.create('Number for log axis smaller than zero'));
end;
cx:=false; ix:=0; iy:=0;
if (x < fxlow) then begin ix:=ftlx; cx:=true; end;
if (x > fxhigh) then begin ix:=fbrx-1; cx:=true; end;
if not cx then begin
if fxlog then ix:=mapW2SxLog(x) else ix:=mapW2SxLin(x);
end;
if (cx)and(not fdrawclip) then exit;
if assigned(fimage) then begin
fimage.canvas.pen.color:=color;
fimage.canvas.moveto(ix,ftly);
fimage.canvas.lineto(ix,fbry);
end;
end;
procedure TMapWin.HLine(y:float;color:TColor); // horizontal line
var ix,iy:integer;
cy:boolean;
begin
if ((fylog)and(y < 0))then begin
if fprotectlog then
exit
else
raise(TMyPlotException.create('Number for log axis smaller than zero'));
end;
cy:=false; ix:=0; iy:=0;
if (y < fylow) then begin iy:=fbry; cy:=true; end;
if (y > fyhigh) then begin iy:=ftly-1; cy:=true; end;
if not cy then begin
if fylog then iy:=mapW2SyLog(y) else iy:=mapW2SyLin(y);
end;
if (cy)and(not fdrawclip) then exit;
if assigned(fimage) then begin
fimage.canvas.pen.color:=color;
fimage.canvas.moveto(ftlx,iy);
fimage.canvas.lineto(fbrx,iy);
end;
end;
function TMapWin.getX(i:integer):float; // i:=0..width-1
begin
if fxlog then result:=mapS2WxLog(i) else result:=mapS2WxLin(i);
end;
function TMapWin.getY(i:integer):float; // i:=0..height-1
begin
if fylog then result:=mapS2WyLog(i) else result:=mapS2WyLin(i);
end;