Custom Search
This essay will prvide you with some crude, and in some ways flawed, subroutines... but I hope the corners I've cut make them more accessible to Lazarus beginners.
This essay, by the way, was created after my problems with "fencepost errors" in respect of drawing with Lazarus and Delphi. (They were explained in PixelProblem.htm.) I may have RE-made those old mistakes, in the (relatively trivial) graphing elements of this... but THINK (and hope!) not.
Each of the subroutines meant to be of general use, each of the routines you should be able to "patch into" something have "DGTool", for "DrawGraphTool" near the start of their names.
If, by the way, you are not an "old hand" when it comes to using subroutines, you may want to read a tutorial on using subroutines which I wrote for Lazarus's inspiration, Delphi. (For our wants, there are hardly any differences.) Using subroutines- i.e. procedures and functions- can make programming a lot easier!
There are a few global variables... something we try to avoid. They too have DGTool in their names.
There is an object that has to be set up before the routine makes any sense, and it too is "global", in that inside the subroutine there is an expectation that the object, by the name "imgDGTool", will exist.
You may want to glance through my more fundamental tutorial about drawing on images with Lazarus/ Delphi before starting this. (It will open in a new tab... just close that to get back to here.)
For the purposes of this tutorial, what I did as "iImageLeft" in the one just cited has been replaced with the global constant "iDGToolImgLeft". There are similar changes throughout.
(You can skip down to a more thorough explanation, if that's what you want.)
Later, I will take you gently through "everything". But if you just want the subroutines, here's the short version.
You can work with the main unit listing at the bottom of this page (which may be dated), or you can Download the sourcecode.
procedure TLT2N_DrawTools_bF1.
DGToolDoDotWWr(iX1,iY1
:integer;clInk:TColor);
//TOOLS_B version... imprived over original in
// Tools_a. This wraps if values
// of iY1 become negative. Tools_a may
// have been upgraded to this by the time
// you are reading these comments
begin
//Next two: New since 1Dec18
iX1:=iX1 mod iDGToolImgWidth;
while (iX1<0) do iX1:=iX1+iDGToolImgWidth;
iY1:=iY1 mod iDGToolImgHeight;//REVISED
while (iY1<0) do iY1:=iY1+iDGToolImgHeight;
imgDGTool.picture.bitmap.
canvas.pixels[iX1,iY1]:=clInk;//REVISED
end; //DGToolDrawLineWWr
... THEN PLEASE MODIFY ACCORDING TO THE ABOVE... which fixes some "roll over" handling. Apologies for that. (If the sourecode you download DOES have that, then please let me know that now I need to edit this "nota bene"!)
In fact, for the harder working among you, oh Gentle Readers, your best bet is to skim what is in this essay, and then move on to lt2n-drawtools-pt2.htm, which is "part two" of this. "Part One" (which is what you are reading) IS a "stand-alone" essay, but limited. And my energies are mostly going into Part 2, in terms of getting it "just so" for you. Sorry! But I can't do "everything".
====
If you download the sourcecode, that gives you the subroutines and a small shell to exercise them. You may prefer to go "straight to the answer", and merely extract the .pas file, open that in a text editor, and copy/ paste the bits you need to your app.
You'll need, in your application, an image object named imgDGTool.
You'll need the following global constants, but you can set them to any (sensible) values, to meet your wants...
const iDGToolImgLeft=10;
iDGToolImgTop=30;
iDGToolImgWidth=200;
iDGToolImgHeight=100;
During the FormCreate event handler, we need....
bmDGTool:=TBitmap.create;//Explained in
// https://sheepdogguides.com/lut/lt1Graphics.htm
bmDGTool.width:=iDGToolImgWidth;
bmDGTool.height:=iDGToolImgHeight;
//The next two give you a white background..
bmDGTool.canvas.pen.color:=clWhite;
bmDGTool.canvas.rectangle(0,0,iDGToolImgWidth,iDGToolImgHeight);
imgDGTool.picture.graphic:=bmDGTool;
imgDGTool.left:=iDGToolImgLeft;
imgDGTool.top:=iDGToolImgTop;
imgDGTool.width:=iDGToolImgWidth;
imgDGTool.height:=iDGToolImgHeight;
Also add a global "bmDGTool:TBitmap;", and the forward declarations for the two subroutines that are the subject of this webpage...
private { private declarations } bmDGTool:TBitmap; procedure DGToolDrawLine(iX1,iY1, iX2,iY2:integer;clInk:TColor); procedure DGToolDoDotWWr(iX1,iY1 :integer;clInk:TColor);
...and the code (in the implementation section), as follows. (The "TLT2N_DrawTools_aF1." part will need to be changed, of course.)
procedure TLT2N_DrawTools_aF1.DGToolDrawLine(iX1,iY1,
iX2,iY2:integer;clInk:TColor);
//Draws a line. Does not "wrap" the line, if the
// coordinates given take it off the edge of
// the canvas of imgDGTool.
begin
imgDGTool.canvas.pen.color:=clInk;
imgDGTool.picture.bitmap.canvas.moveto(iX1,iY1);
imgDGTool.picture.bitmap.canvas.lineto(iX2,iY2);
end; //DGToolDrawLine
procedure TLT2N_DrawTools_aF1.DGToolDoDotWWr(iX1,iY1
:integer;clInk:TColor);
//Sets a pixel's color... *W*ith *Wr*apping, if
// co-ordinates are specified which are too
// big.
begin
iY1:=iY1 mod iDGToolImgHeight;
while (iY1<0) do iY1:=iY1+iDGToolImgHeight;
imgDGTool.picture.bitmap.
canvas.pixels[iX1 mod iDGToolImgWidth,
iY1]:=clInk;
end; //DGToolDrawLineWWr
And that should be it!
With all of the above added to your application, the following become available...
DGToolDrawLine(10,12,20,22,clRed); will draw a line from 10 across, 12 down to 20 across, 22 down, in red.
DGToolDoDotWWr(10,12,clGreen); will make the pixel at 10 across, 12 down green.
In the examples, I have have used two Lazarus-supplied constants- clRed, clGreen- to specify colors. There are many other ways to say what color you want, the most basic being to give the routine the raw number behind the color you want.
If you want to "build it alongside me", you can. Or you can just follow along, and eventually download various stages of the application.
First, put an image on the form, call it imgDrawTools. The placement and size are not critical.
In the application's code, just after "private", add...
bmDGTool:TBitmap;
Near the top of the code, just after the "Uses" before "Type", insert...
const iDGToolImgLeft=10; iDGToolImgTop=30; iDGToolImgWidth=200; iDGToolImgHeight=100;
In the event handler for OnFormCreate...
begin
bmDGTool:=TBitmap.create;//Explained in
// https://sheepdogguides.com/lut/lt1Graphics.htm
imgDGTool.left:=iDGToolImgLeft;
end;
... to get things started. Get that much to compile! Then add the bits needed to make it...
procedure TLT2N_DrawTools_aF1.FormCreate(Sender: TObject);
begin
bmDGTool:=TBitmap.create;//Explained in
// https://sheepdogguides.com/lut/lt1Graphics.htm
bmDGTool.width:=iDGToolImgWidth;
bmDGTool.height:=iDGToolImgHeight;
//The next two give you a white background..
bmDGTool.canvas.pen.color:=clWhite;
bmDGTool.canvas.rectangle(0,0,iDGToolImgWidth,iDGToolImgHeight);
imgDGTool.picture.graphic:=bmDGTool;
imgDGTool.left:=iDGToolImgLeft;
imgDGTool.top:=iDGToolImgTop;
imgDGTool.width:=iDGToolImgWidth;
imgDGTool.height:=iDGToolImgHeight;
end;
Just to see that the basics are working... Put a button the form, call it "buDoShortLine", and for the OnClick event handler...
imgDGTool.canvas.pen.color:=clBlue; imgDGTool.picture.bitmap.canvas.moveto(5,20); imgDGTool.picture.bitmap.canvas.lineto(10,40);
Once that's working: Hurrah! The basics are in place.
There is, by the way, a way to put a dot on the graph...
imgDGTool.picture.bitmap.canvas.pixels[4,6]:=clRed;
(If you try that, and it "doesn't work", look very closely near the upper left of the graph drawing area. The dots can be so small as to be nearly invisible.)
With that example, you get a red dot in the 4th pixel to the right of the left hand side of the drawing area, in the 6th down from the top. (Not rocket science, just not the way coordinates worked on a plane when you were 12 years old.)
What would happen with...
imgDGTool.picture.bitmap.canvas.pixels[0,0]:=clGreen;
...? Yes! You DO get a green pixel. (In the upper left hand corner of the graph.
But! What about...
imgDGTool.picture.bitmap.canvas. pixels[iDGToolImgWidth,iDGToolImgHeight]:=clGreen;
That, I want you to notice, give you no pixel!. But, the following WILL give you a pixel at the lower right, which is possibly what you expected the previous line of code to do...
imgDGTool.picture.bitmap.canvas.
pixels[iDGToolImgWidth-1,iDGToolImgHeight-1]:=clGreen;
That much I promise you. I've been struggling to get the "-1", "include or leave out?" right for YEARS. I will TRY to get it right in what follows... but won't promise to succeed!
In general... nothing too terrible. You just don't get a painted pixel where you expect it.
This next will seem pointless (even leaving out the digression, at first, but bear with me...
Add a button- buTest- and make it's OnClick handler be...
OOPS! DIGRESSION.... my first attempt to draw a line using "pixels"....
procedure TLT2N_DrawTools_aF1.buTestClick(Sender: TObject);
var iLocalX,iLocalY:integer;
begin
for iLocalX:=10 to 40 do begin
for iLocalY:=20 to 25 do begin
imgDGTool.picture.bitmap.canvas.
pixels[iLocalX,iLocalY]:=clGreen;
end;//end for iLocal**Y**
end;//end for iLocal**X**
end; //buTestClick
That was SUPPOSED to draw a line from 10,20 to 40,25. Can you see what it ACTUALLY does?
END OF DIGRESSION...
Add a button- buTest- and make it's OnClick handler be...
procedure TLT2N_DrawTools_aF1.buTestClick(Sender: TObject); begin imgDGTool.canvas.pen.color:=clBlue; imgDGTool.picture.bitmap.canvas.moveto(10,25); imgDGTool.picture.bitmap.canvas.lineto(40,20); end; //buTestClick
So far, so boring. We've just put what we did before in a button. But always build gradually.
Now we're going to create our first "drop in" sub-routine... something which, with a little "support" stuff, and care, will work in any program.
It will be called DGToolDrawLine
At first, it will merely duplicate what we have already, for buTest's Click handler. And buTest will, at first, merely call DGToolDrawLine.
(I've not written out the details of going from where we were a moment ago to that situation. Let me know if this is a big deal for YOU.)
So now we have...
procedure TLT2N_DrawTools_aF1.DGToolDrawLine;
begin
imgDGTool.canvas.pen.color:=clBlue;
imgDGTool.picture.bitmap.canvas.moveto(10,25);
imgDGTool.picture.bitmap.canvas.lineto(40,20);
end; //DGToolDrawLine
(And buTest is merely...
procedure TLT2N_DrawTools_aF1.buTestClick(Sender: TObject);
begin
DGToolDrawLine;
end; //buTestClick
First something really simple, obvious (I hope)...
Change the header for DGToolDrawLine to DGToolDrawLine(clInk:TColor);, and make the first line imgDGTool.canvas.pen.color:=clInk;
Change buTestClick so that DGToolDrawLine becomes DGToolDrawLine(clRed);
When that's working, do a second test button (buTest2), and set it up to call DGToolDrawLine(clGreen);
Neat? (It is, really!)
Carrying on, in a similar way...
Make the header for DGToolDrawLine the header for DGToolDrawLine(iX1,iY1,iX2,iY2:integer,clInk:TColor);.. and make the implied changes...
procedure TLT2N_DrawTools_aF1.buTestClick(Sender: TObject);
begin
DGToolDrawLine(10,25,40,20,clRed);
end; //buTestClick
procedure TLT2N_DrawTools_aF1.buTest2Click(Sender: TObject);
begin
DGToolDrawLine(15,29,45,18,clGreen);
end; //buTest2Click
procedure TLT2N_DrawTools_aF1.DGToolDrawLine(iX1,iY1,
iX2,iY2:integer;clInk:TColor);
begin
imgDGTool.canvas.pen.color:=clInk;
imgDGTool.picture.bitmap.canvas.moveto(iX1,iY1);
imgDGTool.picture.bitmap.canvas.lineto(iX2,iY2);
end; //DGToolDrawLine
Wow! Now DGToolDrawLine has become quite useful! And "general". General is good.
We're not done... not NEARLY done... but now do this, with these numbers, though it will look rather dull...
Set up ANOTHER button, buTest3...
procedure TLT2N_DrawTools_aF1.buTest3Click(Sender: TObject); begin DGToolDrawLine(10,0,30,0,clRed); DGToolDrawLine(30,1,50,1,clGreen); DGToolDrawLine(50,2,70,2,clBlue); DGToolDrawLine(70,1,90,1,clGreen); DGToolDrawLine(90,0,110,0,clRed); end;//buText3Click
(No changes needed to DGToolDrawLine at this point.)
Fine. (Should draw five lines, all horizontal, all NEAR top of the graphing area, two of them at the top of it.)
So far, we have been relying on the programmer knowing how big the graphing area is, and using numbers with moveto and lineto that are within the graphing area. No "bad things" happen if "the rule" is broken... but the user won't see the line that the application has drawn, so what was the point?
We've going to make DGToolDrawLine fancier.
Make another test button, similar to buTest3, but with the following numbers...
procedure TLT2N_DrawTools_aF1.buTest4Click(Sender: TObject); begin DGToolDrawLine(10,10,30,10,clRed); DGToolDrawLine(30,21,50,21,clGreen); DGToolDrawLine(50,32,70,32,clBlue); DGToolDrawLine(70,21,90,21,clGreen); DGToolDrawLine(90,10,110,10,clRed); end;//buTest4Click
Now make a new procedure... note the "WWr" added to the name of this, which, otherwise, for now, is just a second "copy" of DGToolDrawLine..
procedure TLT2N_DrawTools_aF1.DGToolDrawLineWWr(iX1,iY1,
iX2,iY2:integer;clInk:TColor);
begin
imgDGTool.canvas.pen.color:=clInk;
imgDGTool.picture.bitmap.canvas.moveto(iX1,iY1);
imgDGTool.picture.bitmap.canvas.lineto(iX2,iY2);
end; //DGToolDrawLineWWr
(The "WWr" is for "With Scaling"... what THAT'S about, we will see in a moment. First...)
... and revise buTest4Click to use the new procedure...
procedure TLT2N_DrawTools_aF1.buTest4Click(Sender: TObject); begin DGToolDrawLineWWr(10,10,30,10,clRed); DGToolDrawLineWWr(30,21,50,21,clGreen); DGToolDrawLineWWr(50,32,70,32,clBlue); DGToolDrawLineWWr(70,21,90,21,clGreen); DGToolDrawLineWWr(90,10,110,10,clRed); end;//buTest4Click
For now, should just do what it did previously.
Change the last line of buTest4Click by changing just the Y coordinate of the end of the line. I.e. make that line...
DGToolDrawLineWWr(90,10,110,130,clRed);
Humm. The drawing area is currently only 100 high. How are we going to see a line that goes to Y=130? We won't see all of it, is the answer. Run the program. We see MOST of the line. So things aren't too bad.
That "WWr" is to stand for "With WRAP". We're going to fix things so that if the numbers sent to the routine would put the line off the edge of the page, then the program "wraps" the plotting around.
But before we can do that, we need to change where we're going, a bit.
Previously, we have been drawing lines.
And we will keep our DGToolDrawLine. Just as it is. And the three test buttons that go with that.
But we're going to change DGToolDrawLineWWr to DGToolDoDotWWr, and only draw a dot.
The forward declaration will be...
procedure DGToolDoDotWWr(iX1,iY1
:integer;clInk:TColor);
Our test routine, i.e. buTest4Click, will be...
procedure TLT2N_DrawTools_aF1.buTest4Click(Sender: TObject); begin DGToolDoDotWWr(10,10,clRed); DGToolDoDotWWr(30,21,clGreen); DGToolDoDotWWr(50,32,clBlue); DGToolDoDotWWr(70,21,clGreen); DGToolDoDotWWr(90,10,clRed); end;//buTest4Click
And the procedure will become...
procedure TLT2N_DrawTools_aF1.DGToolDoDotWWr(iX1,iY1
:integer;clInk:TColor);
begin
imgDGTool.picture.bitmap.canvas.pixels[iX1,iY1]:=clInk;
end; //DGToolDrawLineWWr
All nearly what we had before. Apart from the obvious, note that we now only send two numbers (the coordinates of where we want the dot) and the color to the routine.
Run it in this intermediate form, and you should see dots where the lines began previously.
Add another button, buLineOfDots, programmed as follows...
procedure TLT2N_DrawTools_aF1.buLineOfDotsClick(Sender: TObject);
var xTmp, yTmp:integer;
begin
xTmp:=10;
for yTmp:=10 to 50 do begin
DGToolDoDotWWr(xTmp,yTmp,clRed);
xTmp:=xTmp+1;
end;// of for...
end;// of buLineOfDotsClick
That Just Works. And why not. Simple enough. (Draws a diagonal line from near upper left, and down towards lower right.
We haven't done the "with wrap" part yet, by the way.
What happens if we make the "for..." line say...
for yTmp:=10 to 150 do begin
We still get our line... but it goes down and right, "right" off of the page!. Because we don't have the "with scaling" bit written in yet.
Here we go... All it takes is the magic of modulus arithmetic...
Make DGToolDoDotWWr...
procedure TLT2N_DrawTools_aF1.DGToolDoDotWWr(iX1,iY1
:integer;clInk:TColor);
begin
imgDGTool.picture.bitmap.
canvas.pixels[iX1 mod iDGToolImgWidth,
iY1 mod iDGToolImgHeight]:=clInk;
end; //DGToolDrawLineWWr
.. and NOW when we go "off the page", the dot placement "wraps around"... and all is well! Hurrah! Success! Or so I thought. THAT code takes care of wrapping if you go "off the page" one way. A small tweak was needed to ensure that the wrapping happens when you go off the page the other ways, too....
procedure TLT2N_DrawTools_aF1.DGToolDoDotWWr(iX1,iY1
:integer;clInk:TColor);
begin
iY1:=iY1 mod iDGToolImgHeight;
while (iY1<0) do iY1:=iY1+iDGToolImgHeight;
imgDGTool.picture.bitmap.
canvas.pixels[iX1 mod iDGToolImgWidth,
iY1]:=clInk;
end; //DGToolDrawLineWWr
Down to here, you were taken gently by the hand, led through "the story". Here's the full listing of the ,pas file, which has the things you need to copy/ paste to the application of your choice, to enable easy line drawing and pixel color changing in your app.
Or you can Download the full sourcecode.
procedure TLT2N_DrawTools_aF1.DGToolDoDotWWr(iX1,iY1
:integer;clInk:TColor);
begin
iY1:=iY1 mod iDGToolImgHeight;
while (iY1<0) do iY1:=iY1+iDGToolImgHeight;
imgDGTool.picture.bitmap.
canvas.pixels[iX1 mod iDGToolImgWidth,
iY1]:=clInk;
end; //DGToolDrawLineWWr
... THEN PLEASE MODIFY ACCORDING TO THE ABOVE... which fixes the "roll over" when it occurs in one of the two possible directions. Apologies for that. (If the sourecode you download DOES have that, then please let me know that now I need to edit this "nota bene"!)
unit LT2N_DrawTools_aU1;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, StdCtrls,
ExtCtrls;
const iDGToolImgLeft=10;
iDGToolImgTop=30;
iDGToolImgWidth=200;
iDGToolImgHeight=100;
type
{ TLT2N_DrawTools_aF1 }
TLT2N_DrawTools_aF1 = class(TForm)
buDoShortLine: TButton;
buTest: TButton;
buTest2: TButton;
buTest3: TButton;
buTest4: TButton;
buLineOfDots: TButton;
imgDGTool: TImage;
laTitleEtc: TLabel;
procedure buLineOfDotsClick(Sender: TObject);
procedure buTest2Click(Sender: TObject);
procedure buTest3Click(Sender: TObject);
procedure buTest4Click(Sender: TObject);
procedure buTestClick(Sender: TObject);
procedure buDoShortLineClick(Sender: TObject);
procedure FormCreate(Sender: TObject);
private
{ private declarations }
bmDGTool:TBitmap;
procedure DGToolDrawLine(iX1,iY1,
iX2,iY2:integer;clInk:TColor);
procedure DGToolDoDotWWr(iX1,iY1
:integer;clInk:TColor);
public
{ public declarations }
end;
var
LT2N_DrawTools_aF1: TLT2N_DrawTools_aF1;
implementation
{$R *.lfm}
{ TLT2N_DrawTools_aF1 }
procedure TLT2N_DrawTools_aF1.FormCreate(Sender: TObject);
begin
bmDGTool:=TBitmap.create;//Explained in
// https://sheepdogguides.com/lut/lt1Graphics.htm
bmDGTool.width:=iDGToolImgWidth;
bmDGTool.height:=iDGToolImgHeight;
//The next two give you a white background..
bmDGTool.canvas.pen.color:=clWhite;
bmDGTool.canvas.rectangle(0,0,iDGToolImgWidth,iDGToolImgHeight);
imgDGTool.picture.graphic:=bmDGTool;
imgDGTool.left:=iDGToolImgLeft;
imgDGTool.top:=iDGToolImgTop;
imgDGTool.width:=iDGToolImgWidth;
imgDGTool.height:=iDGToolImgHeight;
end;
procedure TLT2N_DrawTools_aF1.buDoShortLineClick(Sender: TObject);
begin
imgDGTool.canvas.pen.color:=clBlue;
imgDGTool.picture.bitmap.canvas.moveto(5,20);
imgDGTool.picture.bitmap.canvas.lineto(10,40);
imgDGTool.picture.bitmap.canvas.
pixels[iDGToolImgWidth-1,iDGToolImgHeight-1]:=clGreen;
end;
procedure TLT2N_DrawTools_aF1.buTestClick(Sender: TObject);
begin
DGToolDrawLine(10,25,40,20,clRed);
end; //buTestClick
procedure TLT2N_DrawTools_aF1.buTest2Click(Sender: TObject);
begin
DGToolDrawLine(15,29,45,18,clGreen);
end; //buTest2Click
procedure TLT2N_DrawTools_aF1.buLineOfDotsClick(Sender: TObject);
var xTmp, yTmp:integer;
begin
xTmp:=10;
for yTmp:=10 to 150 do begin
DGToolDoDotWWr(xTmp,yTmp,clRed);
xTmp:=xTmp+1;
end;// of for...
end;// of buLineOfDotsClick
procedure TLT2N_DrawTools_aF1.buTest3Click(Sender: TObject);
begin
DGToolDrawLine(10,0,30,0,clRed);
DGToolDrawLine(30,1,50,1,clGreen);
DGToolDrawLine(50,2,70,2,clBlue);
DGToolDrawLine(70,1,90,1,clGreen);
DGToolDrawLine(90,0,110,0,clRed);
end;//buText3Click
procedure TLT2N_DrawTools_aF1.buTest4Click(Sender: TObject);
begin
DGToolDoDotWWr(10,10,clRed);
DGToolDoDotWWr(30,21,clGreen);
DGToolDoDotWWr(50,32,clBlue);
DGToolDoDotWWr(70,21,clGreen);
DGToolDoDotWWr(90,10,clRed);
end;//buTest4Click
procedure TLT2N_DrawTools_aF1.DGToolDrawLine(iX1,iY1,
iX2,iY2:integer;clInk:TColor);
begin
imgDGTool.canvas.pen.color:=clInk;
imgDGTool.picture.bitmap.canvas.moveto(iX1,iY1);
imgDGTool.picture.bitmap.canvas.lineto(iX2,iY2);
end; //DGToolDrawLine
procedure TLT2N_DrawTools_aF1.DGToolDoDotWWr(iX1,iY1
:integer;clInk:TColor);
begin
iY1:=iY1 mod iDGToolImgHeight;
while (iY1<0) do iY1:=iY1+iDGToolImgHeight;
imgDGTool.picture.bitmap.
canvas.pixels[iX1 mod iDGToolImgWidth,
iY1]:=clInk;
end; //DGToolDrawLineWWr
end.
Search across all my sites with the Google search...
|
|
Page tested for compliance with INDUSTRY (not MS-only) standards, using the free, publicly accessible validator at validator.w3.org. Mostly passes. There were two "unknown attributes" in Google+ button code. Sigh.
....... P a g e . . . E n d s .....