From: Olly
Didn't I give a solution tho..?
http://villavu.com/forum/showthread.php?t=107813&p=1282851#post1282851
You gave the start of a solution.
I'm starting with a regular ol' dtm reference and wanting to modify the color of the subpoints. Which means you have to getDTM to get it into the TMDTM structure. And this appears to be a copy since any changes are not reflected back to the original dtm.
Which means you have to free the original dtm and assign the modified mdtm to it. But this throws an error (of course it does) using mdtm. Works like a charm if you use a TSDTM instead.
This throws an error:
procedure SetDtmSubPointsColor(var ItemDtm: Integer; const Color: Integer);
var
ItemMdtm: TMDTM; // Dtm converted to a TMDTM structure.
DtmPoints: TMDTMPointArray; // Dtm points.
HiPoints: Integer; // Number of subpoints.
PointsIdx: Integer; // Loop counter - current subpoint.
begin
if not dtmExists(ItemDtm) then
Exit;
// Copy dtm into tmdtm record so we can work with it.
ItemMdtm := GetDTM(ItemDtm);
DtmPoints := ItemMdtm.getPoints();
// Loop through the subpoints setting color.
HiPoints := (ItemMdtm.getCount() - 1);
if (HiPoints < 1) then
Exit;
for PointsIdx := 1 to HiPoints do
DtmPoints[PointsIdx].c := Color;
// Assign modified record back to dtm.
FreeDTM(ItemDtm);
ItemDtm := AddDTM(ItemMdtm); // This line throws an error???
end; // proc
But this works quite nicely:
procedure SetDtmSubPointsColor(var ItemDtm: Integer; const Color: Integer);
var
ItemSdtm: TSDTM; // Dtm converted to a TSDTM record.
DtmName: String; // Name of dtm.
HiPoints: Integer; // Number of subpoints.
PointsIdx: Integer; // Loop counter - current subpoint.
begin
if not dtmExists(ItemDtm) then
Exit;
// Copy dtm into tsdtm record so we can work with it.
ItemSdtm := MDTMToSDTM(GetDTM(ItemDtm));
// Loop through the subpoints setting color.
HiPoints := High(ItemSdtm.SubPoints);
if (HiPoints < 0) then
Exit;
for PointsIdx := 0 to HiPoints do
ItemSdtm.SubPoints[PointsIdx].Color := Color;
// Assign modified record back to dtm.
DtmName := GetDTMName(ItemDtm);
FreeDTM(ItemDtm);
ItemDtm := AddSDTM(ItemSdtm);
SetDTMName(ItemDtm, DtmName);
end; // proc
Mission accomplished. I solved the problem even though I most likely will never actually use the code. A good day.
From: Nebula
When I tried using ddms about a year ago for a salamander hunting script, I spent hours trying to get it to work. followed like 5 tutorials including one by fakawi, tried everything possible, did not work.
This could perhaps be adapted to whatever you want to do. If you do you may want these functions as well:
function CreateSdtmPoint(const X, Y, Color, Tolerance, AreaSize, AreaShape: Integer): TSDTMPointDef;
begin
Result.X := X;
Result.Y := Y;
Result.Color := Color;
Result.Tolerance := Tolerance;
Result.AreaSize := AreaSize;
Result.AreaShape := AreaShape;
end; // proc
procedure PrintSdtm(const Sdtm: TSDTM);
var
HiPoints: Integer; // Number of subpoints.
PointsIdx: Integer; // Loop counter - current subpoint.
begin
with Sdtm.MainPoint do
WriteLn(Format('MP: (%d,%d) C:%d, T:%d, Sz:%d, Shp:%d', [X, Y, Color, Tolerance, AreaSize, AreaShape]));
HiPoints := High(Sdtm.SubPoints);
if (HiPoints > (-1)) then
for PointsIdx := 0 to HiPoints do
with Sdtm.SubPoints[PointsIdx] do
WriteLn(Format('P%d: (%d,%d) C:%d, T:%d, Sz:%d, Shp:%d', [PointsIdx, X, Y, Color, Tolerance, AreaSize, AreaShape]));
end; // proc