Mega Code Archive
Rulerstwo
<![CDATA[
RULER TWO
COMPLETE UNIT FOLLOWS
but SEE 'RULERS' DIRECTORY
not far from here FOR COMPLETE
SOURCE INCLUDING THE FORMS ETC
Richard Ebbs
Feb 2000
----------------
unit Source;
{Small Program To Demonstrate The Implementation Of A Graphics Ruler.
Richard Ebbs for Honeywood February 2000.
To be integrated into the Fox project}
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
ExtCtrls, StdCtrls;
const
rulerWidth = 20;
rulerHeight = 20;
type
TMainForm = class(TForm)
DrawArea: TImage;
TopRulerImage: TImage;
SideRulerImage: TImage;
procedure FormCreate(Sender: TObject);
procedure SetupTopRuler(thisCanvas: TCanvas; cWidth, cHeight: Integer);
procedure SetupSideRuler(thisCanvas: TCanvas; cWidth, cHeight: Integer);
procedure FillImageComponent(thisCanvas: TCanvas;
cWidth, cHeight: Integer);
procedure DrawAreaMouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
procedure DrawRulerCursors(CanvasOne, CanvasTwo: TCanvas;
currMouseX, currMouseY: Integer);
procedure WriteCoordinateText(thisCanvas: TCanvas;
xCoord, yCoord: Integer);
private
{private declarations}
HalfSliderWidth: Integer;
currentScale: Integer;
currMouseX: Integer;
currMouseY: Integer;
public
{public declarations}
end;
var
MainForm: TMainForm;
implementation
{$R *.DFM}
procedure TMainForm.FormCreate(Sender: TObject);
begin
currentScale := 50;
SetupTopRuler(TopRulerImage.Canvas, TopRulerImage.Width, TopRulerImage.Height);
SetupSideRuler(SideRulerImage.Canvas, SideRulerImage.Width, SideRulerImage.Height);
end;
procedure TMainForm.SetupTopRuler(thisCanvas: TCanvas; cWidth, cHeight: Integer);
var
i, j, k: Integer;
xText: String;
begin
FillImageComponent(thisCanvas, cWidth, cHeight);
with thisCanvas do
begin
Pen.Color := clBlack;
Pen.Style := psSolid;
Pen.Width := 1;
Pen.Mode := pmBlack;
Font.Name := 'Arial';
Font.Size := 7;
end;
i := rulerWidth;
while (i <= cWidth) do
begin
with thisCanvas do
begin
MoveTo(i, cHeight);
LineTo(i, 0);
j := 0;
while (j < currentScale) do
begin
k := i + j;
MoveTo(k, cHeight);
LineTo(k, (cHeight div 2));
j := (j + (currentScale div 5));
end;
xText := IntToStr(i - rulerWidth);
TextOut((i + 2), 1, xText);
end;
i := (i + currentScale);
end;
with thisCanvas do
begin
{put a shadow line across the bottom of the ruler...}
Pen.Color := clBlack;
Pen.Width := 1;
MoveTo(rulerWidth, (cHeight - 1));
LineTo(cWidth, (cHeight - 1));
end;
end;
procedure TMainForm.SetupSideRuler(thisCanvas: TCanvas; cWidth, cHeight: Integer);
var
i, j, k: Integer;
xText: String;
begin
FillImageComponent(thisCanvas, cWidth, cHeight);
with thisCanvas do
begin
Pen.Color := clBlack;
Pen.Style := psSolid;
Pen.Width := 1;
Pen.Mode := pmBlack;
Font.Name := 'Arial';
Font.Size := 7;
end;
i := 0;
while (i <= cHeight) do
begin
with thisCanvas do
begin
MoveTo(cWidth, i);
LineTo(0, i);
j := 0;
while (j < currentScale) do
begin
k := i + j;
MoveTo(cWidth, k);
LineTo((cWidth div 2), k);
j := (j + (currentScale div 5));
end;
xText := IntToStr(i);
TextOut(1, (i + 1), xText);
end;
i := (i + currentScale);
end;
with thisCanvas do
begin
{put a shadow line down the right edge of the ruler...}
Pen.Color := clBlack;
Pen.Width := 1;
MoveTo((cWidth - 1), 0);
LineTo((cWidth - 1), cHeight);
end;
end;
procedure TMainForm.FillImageComponent(thisCanvas: TCanvas;
cWidth, cHeight: Integer);
{set up the drawing area to be white not grey...}
var
imageRect: TRect;
begin
with thisCanvas do
begin
Brush.Color := clBtnFace;
imageRect.Left := 0;
imageRect.Top := 0;
imageRect.Right := cWidth;
imageRect.Bottom := cHeight;
FillRect(imageRect);
end;
end;
procedure TMainForm.DrawAreaMouseMove(Sender: TObject; Shift: TShiftState;
X, Y: Integer);
begin
{re-draw the rulers prior to each call to the function to draw the cursorline}
SetupTopRuler(TopRulerImage.Canvas, TopRulerImage.Width, TopRulerImage.Height);
SetupSideRuler(SideRulerImage.Canvas, SideRulerImage.Width, SideRulerImage.Height);
{draw the cursors on both the 'top' and the 'side' ruler...}
DrawRulerCursors(TopRulerImage.Canvas, SideRulerImage.Canvas, X, Y);
{write out the current X,Y coordinate in the wee space on the top left...}
WriteCoordinateText(TopRulerImage.Canvas, X, Y);
end;
procedure TMainForm.DrawRulerCursors(CanvasOne, CanvasTwo: TCanvas;
currMouseX, currMouseY: Integer);
{need to add SideRulerImage.Canvas as a paramateer above and handle that also}
begin
with CanvasOne do
begin
Pen.Color := clBlue;
Pen.Width := 1;
//Pen.Mode := pmBlack;
//Pen.Mode := pmWhite;
//Pen.Mode := pmNop;
//Pen.Mode := pmNot;
//Pen.Mode := pmCopy; done
//Pen.Mode := pmNotCopy; done
//Pen.Mode := pmMergePenNot;
//Pen.Mode := pmMaskPenNot;
//Pen.Mode := pmMergeNotPen;
//Pen.Mode := pmMaskNotPen;
//Pen.Mode := pmMerge;
//Pen.Mode := pmNotMerge;
//Pen.Mode := pmMask;
//Pen.Mode := pmNotMask;
//Pen.Mode := pmXor; done
{OK it's none of THEM -it must be[!]:}
Pen.Mode := pmNotXor;
{cookin' on gas, man...}
MoveTo((currMouseX + rulerWidth), (Height));
LineTo((currMouseX + rulerWidth), 0);
end;
with CanvasTwo do
begin
Pen.Color := clBlue;
Pen.Width := 1;
Pen.Mode := pmNotXor;
MoveTo(Width, currMouseY);
LineTo(0, currMouseY);
end;
end;
procedure TMainForm.WriteCoordinateText(thisCanvas: TCanvas;
xCoord, yCoord: Integer);
var
xText: String;
yText: String;
begin
with thisCanvas do
begin
Pen.Color := clRed;
//Pen.Style := psSolid;
//Pen.Width := 1;
//Pen.Mode := pmBlack;
Font.Name := 'Arial';
Font.Size := 7;
xText := IntToStr(xCoord);
xText := xText + ',';
TextOut(0, 0, xText);
yText := IntToStr(yCoord);
TextOut(0, 10, yText);
end;
end;
end.
]]>