Category : Pascal Source Code
Archive   : TPDMON.ZIP
Filename : TPDMON.DOC

 
Output of file : TPDMON.DOC contained in archive : TPDMON.ZIP

This document describes the changes needed to TurboPower's TPDATE.PAS
version 5.08 to allow month names to be returned as part of a date
string. A picture mask character of 'x' can be used in place of 'm'
to return the month's name (or abbreviation) instead of number.

These changes are by Rick Brodzinsky, 71631,374. They are posted
here freely for anyone's use.

-----------------------------

The remainder of this document contains Pascal code fragments, along
with comments on where to patch the TPDATE.PAS code. I've used {...}
to indicate where existing lines of code are.

{...}
{In the interface declaration of constants, add the following,
(this could also be put right after the IMPLEMENTATION keyword,
if you don't want to recompile all the routines that use TPDATE,
but that would also prohibit its use in TPENTRY's date fields) }

const
AMonthOnly = 'x'; {note - OPRO will use 'n' - but don't here }

{...}
{In the routine ExtractFromPicture, add a local variable MS }
MS : string[9]; {used to hold the month name}

{... }
{in ExtractFromPicture, replace the block commented 'convert to a value'
with the following (Note: the last three lines are what current exist)}

if Ch=UpCase(AmonthOnly) then begin {alpha month mask}
for J:= 1 to TLen do Tmp[J] := UpCase(Tmp[J]);
K := 0;
repeat
inc(K);
MS := MonthString[K];
for j:= 1 to Length(MS) do MS[J] := UpCase(MS[J]);
until ((K=12) or (Pos(Tmp,MS)=1));
if Pos(Tmp,MS)=1 then
I := K else I := ErrorCode;
end else begin
{convert to a value}
Val(Tmp, I, Code);
if Code <> 0 then
I := ErrorCode; end;

{...}
{in function DateStringToDMY, add the following lines immediately after
the begin, so that the exisiting first call to ExtractFromPicture
becomes the ELSE clause of the added IF }

if (Pos(AmonthOnly,Picture)<>0) or (Pos(UpCase(AmonthOnly),Picture)<>0) then
ExtractFromPicture(Picture, S, AMonthOnly,M, 0, DefaultMonth) else

{...}
{in function DateStringIsBlank, add the following (just like above) }

if (Pos(AMonthOnly,Picture)<>0) or (Pos(UpCase(AMonthOnly,Picture)<>0) then
ExtractFromPicture(Picture, S, AMonthOnly,M, -1, -1) else

{...}
{Add the following routine after procedure SubstChar and before
procedure MergeIntoPicture}

procedure MergeAMonthIntoPicture(var Picture : DateString; I : Integer);
{-Merge alpha month I into location in Picture indicated by 'x'}
var
Tmp : DateString;
PLen : Byte absolute Picture;
J,K,L : Integer;
Ch : char;
TLen : Byte absolute Tmp;
begin
Ch := AMonthOnly;
{find the start of the subfield}
J := Pos(Ch, Picture);
Ch := Upcase(Ch);
if J = 0 then begin
J := Pos(Ch, Picture);
if J = 0 then
Exit;
end;
K := J; {save start}
{find the end of the subfield}
while (J < PLen) and (Upcase(Picture[J+1]) = Ch) do
Inc(J);

L := J-K+1; {length of alpha field}
Tmp := MonthString[I];
if Tlen Move(Tmp[1],Picture[K],L);
SubstChar(Picture,AmonthOnly,' '); {blank out any x's}
end;

{...}
{in function DMYtoDateString, add the following call after the three
existing calls to MergeIntoPicture }

MergeAMonthIntoPicture(Picture, Month);

{...}
{in function DateToDateString, add the following call after the three
existing calls to SubstChar }

SubstChar(Picture, AMonthOnly, ' ');

---------------------------------
If you want to implement this type of date mask with TPENTRY, then edit
the file TPENTRY.IN1, and add the constant AMonthOnly to the other
constants called out in the procedure InitPictureFlags.
---------------------------------

That's it! You can now specify a date picture mask of 'dd-xxx-yy' to
return a date as '14-Jan-90'. You can't mix x's and m's in your masks,
and while it is possible to specify a mask to print the whole month
name, shorter months will leave a lot of spaces.

Enjoy,

Rick Brodzinsky

First version: 14 Jan 90
Second version: 15 Jan 90 (forgot to include the TPENTRY instructions)


  3 Responses to “Category : Pascal Source Code
Archive   : TPDMON.ZIP
Filename : TPDMON.DOC

  1. Very nice! Thank you for this wonderful archive. I wonder why I found it only now. Long live the BBS file archives!

  2. This is so awesome! 😀 I’d be cool if you could download an entire archive of this at once, though.

  3. But one thing that puzzles me is the “mtswslnkmcjklsdlsbdmMICROSOFT” string. There is an article about it here. It is definitely worth a read: http://www.os2museum.com/wp/mtswslnk/