Mega Code Archive
Drawrulers
<![CDATA[
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
ExtCtrls, TFlatPanelUnit;
const
RulerHeight = 16;
RulerWidth = RulerHeight;
defaultScale = 1.0;
type
//drawing parameters
TSettings = record
screenOffset0: TPoint;
currentGridSize0: Integer;
currentScale0: Real;
//rulerUnitSize0: Integer;
exts0: TRect;
screenOffset1: TPoint;
currentGridSize1: Integer;
currentScale1: Real;
rulerUnitSize1: Integer;
exts1: TRect;
end;
type
TfrmMain = class(TForm)
pnlDrawingArea: TFlatPanel;
DwgArea0: TImage;
TopRuler0: TImage;
SideRuler0: TImage;
procedure FormCreate(Sender: TObject);
procedure FillImageComponent(thisCanvas: TCanvas;
canvasWidth, canvasHeight: Integer;
fillColour: TColor);
procedure SetupTopRuler(thisCanvas: TCanvas;
cWidth, cHeight: Integer);
procedure SetupSideRuler(thisCanvas: TCanvas;
cWidth, cHeight: Integer);
procedure SetDwgSettingsToDefaults;
procedure FormShow(Sender: TObject);
private
//private declarations
dwgArea0InUse: Boolean;
settings: TSettings;
public
//public declarations
end;
var
frmMain: TfrmMain;
implementation
uses fConfig;
{$R *.DFM}
procedure TfrmMain.FormCreate(Sender: TObject);
begin
dwgArea0InUse := True;
end;
////////////////////////////////////////////
procedure TfrmMain.FormShow(Sender: TObject);
begin
//if (not(Assigned(frmConfig))) then
//frmConfig := TfrmConfig.Create(Self);
SetDwgSettingsToDefaults;
FillImageComponent(DwgArea0.Canvas, (Screen.Width - 1), (Screen.Height - 1),
frmConfig.GetBackgroundColour);
if (dwgArea0InUse = True) then
begin
SetupTopRuler(TopRuler0.Canvas, (Screen.Width - 1), TopRuler0.Height);
SetupSideRuler(SideRuler0.Canvas, SideRuler0.Width, (Screen.Height - 1));
end;
end;
//////////////////////////////////////////
procedure TfrmMain.SetDwgSettingsToDefaults;
//reset assorted values that relate purely
//to the grid, scale and rulers...
begin
if (dwgArea0InUse = True) then
begin
settings.currentGridSize0 := frmConfig.GetGridSize;
settings.currentScale0 := defaultScale;
//settings.rulerUnitSize0 := defaultRulerUnitSize;
settings.screenOffset0.x := 0;
settings.screenOffset0.y := 0;
settings.exts0.Left := 0;
settings.exts0.Right := 0;
settings.exts0.Top := 0;
settings.exts0.Bottom := 0;
end;
end;
//////////////////////////////////////////////////////////
procedure TfrmMain.FillImageComponent(thisCanvas: TCanvas;
canvasWidth, canvasHeight: Integer;
fillColour: TColor);
//set up the drawing area background colour to be that of the colour passed in...
var
imageRect: TRect;
oldColor: TColor;
begin
with thisCanvas do
begin
oldColor := Brush.Color;
Brush.Color := fillColour;
imageRect.Left := -1;
imageRect.Top := -1;
imageRect.Right := canvasWidth;
imageRect.Bottom := canvasHeight;
FillRect(imageRect);
Brush.Color := oldColor;
end;
end;
///////////////////////////////////////////////////////////////////////////////
procedure TfrmMain.SetupTopRuler(thisCanvas: TCanvas; cWidth, cHeight: Integer);
//put both 'ruler lines' and also 'ruler text' onto the canvas of the image
//component passed in as a parameter to the function. Note that the i variable
//is used to keep track of the big increments in the main loop, while the j
//variable is used for the small increments across...
var
i: Integer;
k: Integer;
xText: String;
scaledXTextValue: Integer;
dispGridSize: Integer;
loopTwoCt: Integer;
scrOriginX: Integer;
rulerShow: Boolean;
bkgdColour: TColor;
begin
rulerShow := frmConfig.GetShowRulers;
if (rulerShow = False) then
begin
bkgdColour := frmConfig.GetBackGroundColour;
FillImageComponent(thisCanvas, cWidth, cHeight, bkgdColour);
//FillImageComponent(thisCanvas, cWidth, cHeight, clTeal);
end
else
begin
if (dwgArea0InUse = True) then
begin
dispGridSize := Round(frmConfig.GetDefaultGridSize * settings.currentScale0);
scrOriginX := (settings.screenOffset0.x mod dispGridSize);
end
else
begin
dispGridSize := Round(frmConfig.GetDefaultGridSize * settings.currentScale1);
scrOriginX := (settings.screenOffset1.x mod dispGridSize);
end;
scrOriginX := (-1 + scrOriginX);
if (scrOriginX < 0) then
begin
cWidth := abs(scrOriginX) + cWidth;
end;
FillImageComponent(thisCanvas, cWidth, cHeight, frmConfig.GetRulerColour);
//FillImageComponent(thisCanvas, cWidth, cHeight, clTeal);
with thisCanvas do
begin
Brush.Color := frmConfig.GetRulerColour;
Pen.Color := clBlack;
Pen.Style := psSolid;
Pen.Width := 1;
Font.Name := 'Arial';
Font.Size := 7;
i := (cHeight - dispGridSize);
//this (main) block of code goes
//'FORWARD' from just below zero
while (i <= cWidth) do
begin
for loopTwoCt := 0 to 9 do
begin
k := i + loopTwoCt * (dispGridSize div 10);
MoveTo(k + scrOriginX, cHeight);
case loopTwoCt of
0: LineTo(k + scrOriginX, 0);
5: LineTo(k + scrOriginX, (cHeight div 3));
else
LineTo(k + scrOriginX, (cHeight div 2));
end;
end;
Inc(i, dispGridSize);
end;
//now go 'DOWNWARD' from the virtual origin
//(which is offset from the drawing area's canvas)
//down to the actual origin of the canvas...
i := (cHeight - dispGridSize);
while (i >= 0) do
begin
for loopTwoCt := 9 downto 0 do
begin
k := i + loopTwoCt * (dispGridSize div 10);
MoveTo(k + scrOriginX, cHeight);
case loopTwoCt of
0: LineTo(k + scrOriginX, 0);
5: LineTo(k + scrOriginX, (cHeight div 3));
else
LineTo(k + scrOriginX, (cHeight div 2));
end;
end;
Dec(i, dispGridSize);
end;
//draw a line across the bottom of the ruler...
MoveTo((cHeight - dispGridSize), (cHeight - 1));
LineTo(cWidth + scrOriginX, (cHeight - 1));
//set pen and brush colours back to whatever
//they might have been before...
//Pen := drawObjDefaultPen;
end;
//RulerJoinFill(thisCanvas, cHeight, cWidth);
end;
end;
////////////////////////////////////////////////////////////////////////////////
procedure TfrmMain.SetupSideRuler(thisCanvas: TCanvas; cWidth, cHeight: Integer);
//put both 'ruler lines' and also 'ruler text' onto the canvas of the image
//component passed in as a parameter to the function. Note that the i variable
//is used to keep track of the big increments in the main loop, while the j
//variable is used for the small increments down...
var
i, k: Integer;
yText: String;
scaledYTextValue: Integer;
dispGridSize: Integer;
loopTwoCt: Integer;
scrOriginY: Integer;
rulerShow: Boolean;
bkgdColour: TColor;
begin
rulerShow := frmConfig.GetShowRulers;
if (rulerShow = False) then
begin
bkgdColour := frmConfig.GetBackGroundColour;
FillImageComponent(thisCanvas, cWidth, cHeight, bkgdColour);
end
else
begin
if (dwgArea0InUse = True) then
begin
dispGridSize := Round(frmConfig.GetDefaultGridSize * settings.currentScale0);
scrOriginY := (settings.screenOffset0.y mod dispGridSize);
end
else
begin
dispGridSize := Round(frmConfig.GetDefaultGridSize * settings.currentScale1);
scrOriginY := (settings.screenOffset1.y mod dispGridSize);
end;
scrOriginY := (-1 + scrOriginY);
if (scrOriginY < 0) then
begin
cHeight := abs(scrOriginY) +
]]>