I am running WpTools4.11d in an Delphi 4 environment and am getting an intermittent access Violation in WPRTFTextPaint.SetGlobalVar
(about 1 times out of 12) in the process of flushing and inserting text into a temporary WpRichText control. I am using the code below to search out custom mail merge tags and replace them with content.
-- the calling program does a FastClear on TempRichText before calling
Code
procedure TLetterFacilitator.GetAsmtText( var LetterRichText: TWPRichText; var TempRichText: TWPRichText;
sShortcut, sContentOwner: string; rAsmtID: double);
const
MFL_ANSWER_TAG = '{A:';
MFL_RANGE_TAG = '{R:';
procedure InsertResponseText(sRespTag: string);
var
i, iLen, sPos: integer;
bStringFound: boolean;
iTagLength: integer;
s1, sID: string;
sRespText: string;
bGood: boolean;
begin
iLen := Length(TempRichText.AsString);
TempRichText.Finder.ToStart;
bStringFound := TempRichText.Finder.Next(sRespTag);
TempRichText.CPPosition := TempRichText.Finder.FoundPosition;
sPos := TempRichText.CPPosition;
// loop through text until no more asmt text mfl are found
iTagLength := Length(sRespTag);
while bStringFound and (sPos < iLen) do
begin
// find position of end of current mfl
if TempRichText.Finder.Next('}') then
begin
TempRichText.CPPosition := TempRichText.Finder.FoundPosition;
i := TempRichText.CPPosition - sPos + 1;
TempRichText.SetSelPosLen(sPos, i);
// extract the response ID and remove the tag
s1 := TempRichText.SelText;
sID := Copy(s1, iTagLength + 1, Length(s1) - iTagLength - 1);
TempRichText.SelText := '';
[color=red]<<----- ACCESS VIOLATION HAPPENS HERE (at least some of the time)[/color]
try
-- lots of logic stuff here
if sRespText = '' then
begin
// delete mfl paragraph if empty
TempRichText.FastDeleteParagraph;
end else
begin
if sRespTag = MFL_RANGE_TAG then
begin
// a range tag - see if the response matches the specified range values
try
-- more logic stuff here
if bGood then
begin
// response matches range, include in text
TempRichText.SelectionAsString := sRespText;
end else
begin
// response does not fit range, delete response paragraph
TempRichText.FastDeleteParagraph;
end;
except
// delete mfl paragraph if empty
TempRichText.FastDeleteParagraph;
end;
end else
begin
// an answer tag - just use the response text
TempRichText.SelectionAsString := sRespText;
end;
end;
except
// not a valid number - no value to insert
TempRichText.FastDeleteParagraph;
end;
end;
// reset the length, to take into account any changes
iLen := Length(TempRichText.AsString);
// the finder's position must be reset
TempRichText.Finder.Position := TempRichText.SelStart;
// Find the position of the next occurence of a resp tag
bStringFound := TempRichText.Finder.Next(sRespTag);
TempRichText.CPPosition := TempRichText.Finder.FoundPosition;
sPos := TempRichText.CPPosition;
end; // while bStringFound and (st < iLen)
end;
begin // body of GetAsmtText
LetterRichText.ReadOnly := false;
try
// get the entire shortcut text - this may or may not have asmt mfl fields inserted in it
PopulateBlobWpRtf2(TempRichText, 'HCC_LETTER_ANSWER_MFL_PAGE', 'LETTER_TEXT', 'SHORTCUT', sShortcut, 'CONTENT_OWNER', sContentOwner);
// now find any embedded mfl fields and insert asmt data - check for answer flags and then range flags
InsertResponseText(MFL_ANSWER_TAG);
InsertResponseText(MFL_RANGE_TAG);
LetterRichText.SelectionAsString := TempRichText.AsString;
end else
begin
LetterRichText.SelectionAsString := '';
end;
finally
// reset letter back to readonly and free memory
LetterRichText.ReadOnly := true;
end;
end;
Alles anzeigen
Any suggestions? Sorry about the formatting, the indents seem to have gotten lost somewhere along the way.
Dave Henrickson