IMSI_TURBOCAD_AUTOOBJECT.PAS
unit IMSI_TurboCAD_AutoObject;
interface
uses
OleAuto,
Forms,
Controls,
EmbeddedScriptEngine,
Ty_Script_Editor;
{***************************************************************}
{Modified from RRect example provided in the TurboCad's Delphi SDK}
{****************************************************************}
{ }
{ TurboCAD for Windows }
{ Copyright (c) 1993 - 1997 }
{ International Microcomputer Software, Inc. }
{ (IMSI) }
{ All rights reserved. }
{ }
{****************************************************************}
type
Tscripter = class(TAutoObject)
private
{ Private declarations }
MyForm: TfrmEditor; { Property Page form }
function GetDescription: string;
function GetClassID: string;
automated
{ Automated declarations }{ Smart Objects: Required properties and methods for Regen Methods }
property Description: string read GetDescription;
property ClassID: string read GetClassID;
function GetEnumNames(PropID: Integer; var Names: Variant;var Values: Variant): Integer;
function GetPageInfo(AGraphic: Variant; var StockPages: Integer;var Names: Variant): Integer;
function GetPropertyInfo(var Names: Variant; var Types: Variant;var IDs: Variant; var Defaults: Variant): Integer;
function GetWizardInfo(var Names: Variant): Integer;
function Draw(GrfThis: Variant; View: Variant; mat: Variant): WordBool;
procedure OnGeometryChanged(Graphic: Variant; GeomID: Longint;paramOld: Variant; paramNew: Variant);
function OnGeometryChanging(Graphic: Variant; GeomID: Integer;paramOld: Variant; paramNew: Variant): WordBool;
function OnNewGraphic(grfThis: Variant; boolCopy: WordBool): WordBool;
function OnCopyGraphic(grfCopy: Variant; grfSource: Variant): WordBool;
procedure OnPropertyChanged(Graphic: Variant; PropID: Integer;OldValue: Variant; NewValue: Variant);
function OnPropertyChanging(Graphic: Variant; PropID: Integer;OldValue: Variant; NewValue: Variant): WordBool;
procedure OnPropertyGet(Graphic: Variant; PropID: Integer);
function PageControls(ThisRegenMethod: Variant; Graphic: Variant; PageNumber: Integer;SaveProperties: WordBool): WordBool;
procedure PageDone(ThisRegenMethod: Variant; PageNumber: Variant);
function PropertyPages(ThisRegenMethod: Variant; PageNumber: Variant): WordBool;
procedure Regen(grfThis: Variant);
function Wizard(ThisRegenMethod: Variant; WizardNumber: Variant): WordBool;
end;
function GetServerProgIDs(var ProgIDs: Variant) : Integer;Pascal;export;
{ Required exports for .DLL servers and TurboCAD Delphi extensions. }
exports
DllGetClassObject, DllCanUnloadNow,
DllRegisterServer, DllUnregisterServer,
GetServerProgIDs;
implementation
uses SysUtils, Dialogs; { Required for StrToFloat, etc. }
const
{ Smart Objects: Make AutoClassInfo accessible to other functions }
{ Needed because Delphi does not create type libraries }
AutoClassInfo: TAutoClassInfo = (
AutoClass: Tscripter;
ProgID: 'TScripter.version1';
ClassID: '{316BDF47-FED3-4545-BA55-374F3961B906}'; //ctrl+shift+g
Description: 'Pascal Script Engine - Ty Harness';
Instancing: acMultiInstance);
{ DBAPI constants }
gkGraphic = 11;
gkArc = 2;
gkText = 6;
gfCosmetic = 128;
{ Useful math constants }
Pi: double = 3.14159265;
{ Special variant types }
typeIntegerEnum = varSmallint + 100;
typeLongEnum = varInteger + 100;
typeStringEnum = varOleStr + 100;
{ Stock property pages }
ppStockPen = 1;
ppStockBrush = 2;
ppStockText = 4;
ppStockInsert = 8;
ppStockViewport = 16;
ppStockAuto = 32;
{ Property Ids }
idfilename = 1;
{ Property enums }
{ Number of properties, pages, wizards }
NUM_PROPERTIES = 1;
NUM_PAGES = 1;
NUM_WIZARDS = 0;
{ Returns the user-visible description of this RegenMethod }
function Tscripter.GetDescription: string;
begin
GetDescription := AutoClassInfo.Description;
end;
{ Returns the persistent class id for this RegenMethod's property section }
function Tscripter.GetClassID: string;
begin
GetClassID := AutoClassInfo.ClassID;
end;
{ Retrieve types and names }
function Tscripter.GetPropertyInfo(var Names: Variant; var Types: Variant;
var IDs: Variant; var Defaults: Variant): Integer;
begin
try
VarArrayRedim(Names, NUM_PROPERTIES);
VarArrayRedim(Types, NUM_PROPERTIES);
VarArrayRedim(IDs, NUM_PROPERTIES);
VarArrayRedim(Defaults, NUM_PROPERTIES);
Names[0] := 'Filename';
Types[0] := varOleStr;
IDs[0] := idfilename;
Defaults[0] := extractfilepath(paramstr(0) ) + 'FirstEffort.pas';
Result := NUM_PROPERTIES;
except
Result := 0;
end;
end;
{ Get the number of property pages supporting this RegenMethod }
function Tscripter.GetPageInfo(AGraphic: Variant; var StockPages: Integer;
var Names: Variant): Integer;
begin
VarArrayRedim(Names, NUM_PAGES);
{ Need the form }
MyForm := TfrmEditor.Create(Application);
Names[0] := MyForm.Caption;
MyForm.Free;
StockPages := ppStockBrush + ppStockPen + ppStockAuto;
GetPageInfo := NUM_PAGES;
end;
{ Get the number of wizards supporting this RegenMethod }
function Tscripter.GetWizardInfo(var Names: Variant): Integer;
begin
GetWizardInfo := NUM_WIZARDS;
end;
{ Enumerate the names and values of a specified property }
function Tscripter.GetEnumNames(PropID: Integer; var Names: Variant;
var Values: Variant): Integer;
begin
GetEnumNames := 0;
end;
function Tscripter.PageControls(ThisRegenMethod: Variant; Graphic: Variant; PageNumber: Integer;
SaveProperties: WordBool): WordBool;
var
Filename : string;
begin
try
if SaveProperties then
begin
{ OK button on property page was clicked }
{ Form is still loaded }
with MyForm do
begin
{ Need try block for the case where you have }
{ TRoundedRect Turbo Shape and ahother "shape" selected }
try
Filename := Edit1.text;
Graphic.Properties['Filename'] := Filename;
except
end;
end;
end
else
begin
{ Property page is about to be opened }
{ Make sure the form is loaded }
MyForm := TfrmEditor.Create(Application);
with MyForm do
begin
try
Filename := Graphic.Properties['Filename'];
edit1.Text := Filename;
except
end;
end;
end;
PageControls := True;
except
{ For debugging purposes, report that an error occurred }
{ Return false if an error occurred }
PageControls := False;
end;
end;
procedure Tscripter.PageDone(ThisRegenMethod: Variant; PageNumber: Variant);
begin
{ Done with form }
MyForm.Free;
end;
function Tscripter.PropertyPages(ThisRegenMethod: Variant; PageNumber: Variant): WordBool;
var
PageResult: Integer;
begin
with MyForm do
begin
PageResult := ShowModal;
PropertyPages := (PageResult = mrOk);
end;
end;
function Tscripter.Wizard(ThisRegenMethod: Variant; WizardNumber: Variant): WordBool;
begin
Wizard := False;
end;
{ Called when vertex has been moved, or other geometry change }
procedure Tscripter.OnGeometryChanged(Graphic: Variant; GeomID: Longint;
paramOld: Variant; paramNew: Variant);
begin
{ Do nothing }
end;
{ Called when vertex is moved, or other geometry change }
function Tscripter.OnGeometryChanging(Graphic: Variant; GeomID: Integer;
paramOld: Variant; paramNew: Variant): WordBool;
begin
{ OK to continue with change }
OnGeometryChanging := True;
end;
function Tscripter.OnCopyGraphic(grfCopy: Variant; grfSource: Variant): WordBool;
begin
{ OK to proceed }
OnCopyGraphic := True;
end;
{ Notification function called after graphic property is saved }
procedure Tscripter.OnPropertyChanged(Graphic: Variant; PropID: Integer;
OldValue: Variant; NewValue: Variant);
begin
{ Do nothing }
end;
{ Notification function called when graphic property is saved }
function Tscripter.OnPropertyChanging(Graphic: Variant; PropID: Integer;
OldValue: Variant; NewValue: Variant): WordBool;
begin
{ OK to proceed }
OnPropertyChanging := True;
end;
{ Notification function called when graphic property is retrieved }
procedure Tscripter.OnPropertyGet(Graphic: Variant; PropID: Integer);
begin
{ Do nothing }
end;
function Tscripter.OnNewGraphic(grfThis: Variant; boolCopy: WordBool): WordBool;
begin
if boolCopy then
begin
{ Vertices are already added for us... }
OnNewGraphic := True;
exit;
end;
try
{ New Graphic being created }
// showmessage('on new graphic called');
OnNewGraphic := True;
except
{ Return false on failure }
OnNewGraphic := False;
end;
end;
{ Called when graphic's internal structure needs to be updated }
procedure Tscripter.Regen(grfThis: Variant);
var
LockCount: Integer;
ScriptTest : string;
f : textfile;
s : string;
begin
{ Setup error handler }
try
{ grfThis.Application.PushVertexDefaults Editable:=True, Selectable:=True }
{ Set up lock (prevent recursion) }
LockCount := grfThis.RegenLock;
{ Setup error handler (make sure lock is removed) }
if LockCount = 0 then
begin
try
// showmessage('regen method called');
{ Delete any previous cosmetic children }
grfThis.Graphics.Clear(gfCosmetic);
App := grfThis; //I don't want to do this really
//simple test script
//ScriptTest := 'begin MyOwnFunction(''Embeded Pascal Test''); TC_Wrapp_line(0,0,0,400,400,0); TC_Wrapp_Text(''Hello World'',20,20,0,50); end.';
// scripttest := 'var i : integer; begin MyOwnFunction(''Embeded Pascal Test''); for i := 0 to 9 do begin TC_Wrapp_line(i*10,0,0,400,400,0); end; TC_Wrapp_Text(''Hello World'',20,20,0,50);end.';
//load the script from file - prefer to load compiled byte code really
//Bodge this for example
assignfile(f,'H:\Program Files\IMSI\TCWP105\Program\FirstEffort.pas');
reset(f);
while not eof(f) do
begin
readln(f,s);
scripttest := scripttest + s ;
end;
closefile(f);
//showmessage(scripttest);
//compile and execute the pascal script
ExecuteScript(ScriptTest);
except
showmessage('Regen Method Errored out')
end;
end; { if LockCount = 0 }
{ Remove lock }
grfThis.RegenUnlock;
{ grfThis.Application.PopVertexDefaults }
except
end;
end;
{ Called to do special draw proocessing }
function Tscripter.Draw(GrfThis: Variant; View: Variant; mat: Variant)
: WordBool;
begin
{ Return True if we did the redraw (no further processing necessary, }
{ no children will be drawn). }
{ Since this is just a test, we return False to let TurboCAD do the }
{ drawing operation. }
Draw := False;
end;
function GetServerProgIDs(var ProgIDs: Variant) : Integer;Pascal;export;
begin
VarArrayRedim(ProgIDs, 1); { Redimension array }
ProgIDs[0] := AutoClassInfo.ProgID; { Return ProgID in array element }
GetServerProgIDs := 1; { Return size of array }
end;
procedure RegisterTScripter;
begin
Automation.RegisterClass(AutoClassInfo);
end;
initialization
RegisterTScripter;
end.
Generated by PasToWeb, a tool by Marco Cantù.