sjesper Posted May 22, 2012 Share Posted May 22, 2012 This function will make 1 mainpoint and 4 subpoints (One left, right, up and down at the selected distance). - TP: The mainpoint in the dtm - Distance: The distance from the mainpoint to the subpoints. [sCAR] function GetDTM(TP: TPoint; Distance: Integer): Integer; var DTMMain: TDTMPointDef; DTMSub: array[0..3] of TDTMPointDef; TP2: TPoint; i: Integer; FinalDTM: TDTM; begin //Main With DTMMain do begin X := TP.X; Y := TP.Y; AreaSize := 1; AreaShape := 0; Color := GetColor(TP.X, TP.Y); Tolerance := 5; end; //Sub for i := 0 to 3 do begin case i of 0: begin TP2.X := TP.X + Distance; TP2.Y := TP.Y; end; 1: begin TP2.X := TP.X - Distance; TP2.Y := TP.Y; end; 2: begin TP2.X := TP.X; TP2.Y := TP.Y + Distance; end; 3: begin TP2.X := TP.X; TP2.Y := TP.Y - Distance; end; end; With DTMSub do begin X := TP2.X; Y := TP2.Y; AreaSize := 1; AreaShape := 0; Color := GetColor(TP2.X, TP2.Y); Tolerance := 5; end; end; FinalDTM.MainPoint := DTMMain; FinalDTM.SubPoints := DTMSub; Result := AddDTM(FinalDTM) end; [/sCAR] This function will make 1 mainpoint and a custom number of subpoints. - TP: The mainpoint in the dtm. - Points: The subpoints in the dtm. [sCAR] function GetDTMEx(TP: TPoint; Points: TPointArray): Integer; var DTMMain: TDTMPointDef; DTMSub: array of TDTMPointDef; TP2: TPoint; i: Integer; FinalDTM: TDTM; begin //Main With DTMMain do begin X := TP.X; Y := TP.Y; AreaSize := 1; AreaShape := 0; Color := GetColor(TP.X, TP.Y); Tolerance := 5; end; //Sub SetArrayLength(DTMSub, Length(Points)); for i := 0 to high(Points) do begin With DTMSub do begin X := Points.X; Y := Points.Y; AreaSize := 1; AreaShape := 0; Color := GetColor(TP2.X, TP2.Y); Tolerance := 5; end; end; FinalDTM.MainPoint := DTMMain; FinalDTM.SubPoints := DTMSub; Result := AddDTM(FinalDTM) end; [/sCAR] Quote Link to comment Share on other sites More sharing options...