讲述如何开发一个控件,很有价值(四)

To start with I used the Edit1 Control to display the results of all these variables. I then tried manipulating text in the RichEdit to see what values I got. You should do the same. Type slowly in:

1234567890<CR>1234567890<CR>1234567890

and see how the results are reflected in the Edit control as you do so. Then experiment - try adding stuff to the ends of lines, and in the beginning of the line, and middle of lines. You may have to refer back to the Code to work out which number represents which variable.

Okay, now using the variables we have, lets try selecting the text of the current line, and display it in a new Edit Control (Edit2).

Add the following code to see what happens (don’t forget to add the second edit control and make it as wide as possible):

  MyRe.SelStart    := BeginSelStart;

  MyRe.SelLength   := EndSelStart - BeginSelStart;
  Edit2.Text       := MyRe.SelText;
end;

Run the program and try it out.

OOPS - That doesn't work - the text remains selected and the original cursor position is lost.
We need to reset SelStart and SelLength before we finish in the [OnChange] event. So let’s add at the end:

  MyRe.SelStart    := WasSelStart; 

     //back to were we started
  MyRe.SelLength   := 0;                  // nothing selected
end;

While playing with text in the edit control I discovered something weird.

If you typed [1] then <CR> then [2] the Edit1 displayed [4-1-3-4].

But there were only two characters in the display.

I made a mistake. It appears that RichEdit.Text can tell you where the beginning and end of line is. Why? Because you can access the <CR><LF> characters in the Text string. So we could have manipulated the Text property of the control to work out the beginning and end of lines by reading back and forward from SelStart to find <CR><LF> characters. We may not have known which line we were on, but we would know where it began and ended. Nevertheless we should keep this in mind, it might come in handy later.

But it doesn't matter - the EM_###### messages are a neat way of doing things. And they work. For the moment at least we'll stick with them.

7. Okay implement: Part 2 - Change the format

After the line Edit2.Text := MyRe.SelText, but before the "resetting" part, lets put some logic in to turn lines RED when they are longer than a certain length:

if (MyRe.SelLength > 10) then MyRe.SelAttributes.Color := clRed;

You'll notice two things if you test this out. First - it does work. Second however, is that if you type a line > 10 characters, press return and type one character - its in Red. This is because it inherits the Attributes of the preceding text. Just like if you have bold on in a Word processor, it doesn't reset if you press return. So lets change the line to include an else situation:

else MyRe.SelAttributes.Color := clBlack;

That seems to work - except when you press return in the middle of a > 10 character line you have already typed (which is already Red) to leave a stump < 10 characters on the line above - it remains red. This is because the code leaves you on the next line, and SelStart refers to this new line, not the previous one. In our eventual code, we'll have to take care to ensure this doesn't happen - we have to catch this situation and deal with it. It wont be the only situation I'm sure....

PS: There will be a number of situation we're we'll have to be careful. Can you think of any now? Try putting a lot of text in the Control (or manipulate a loaded file) and selecting some and using the inherit Drag and Drop (move your Mouse over some selected text, press and hold down the Left MouseButton and then drag away) to move some text. This only Triggers one OnChange Event. We may also be moving multiple lines along the way. In the future we'll have to put in some code to detect this happening, and ensure the [OnChange] event can deal with the need to reformat in two different locations. That means thinking in the back of the head about how in the future we may have to deal with this kind of situation, and ensure our code to deal with the simple situation can be adapted - i.e. be "versatile".

8. Basically it all seems to kind-of work.. can't we do some real programming now?

Okay, okay. But first we have a problem. Actually a rather big problem. The problem is PasCon. Why?

First: It returns RTF code.
Problem: We can't use RTF code.

Second: its designed to work an entire stream, and then give it back to us again as a whole.
Problem: We actually want greater control over it than this "all or nothing" approach.
 
 

OOP to the Rescue
 

When you have something that works in a situation, and needs to be applied in another situation were it has to do a similar, but subtly different job - you have two choices:

1. copy the function, and re-write it for the new situation, or
2. kludge around it (e.g use Pas2Rtf, and then write a RtfCodes2RtfControl procedure).

Modern languages however give you an option: OOP it. "Objectify" it. This is more than just deriving something from an existing object. It is in a sense programming in a "state of mind". Controls should be created so they can be used in a variety of situations - father than situation specific. In this case all PasCon can deal with is tokenising the input stream and returning code RTF text. What we really need to do is divide it into two entitites. We need to separate the [Parsing/Recognise the Token and TokenType] from the [Encode it in RTF codes].

So lets start with ConvertReadStream, editing it so it looks something like this:
 

function TPasConversion.ConvertReadStream: Integer; begin     FOutBuffSize := size+3;     ReAllocMem(FOutBuff, FOutBuffSize);     FTokenState := tsUnknown;     FComment    := csNo;     FBuffPos    := 0;     FReadBuff   := Memory;     {Write leading RTF}     WriteToBuffer('{/rtf1/ansi/deff0/deftab720');     WriteFontTable;     WriteColorTable;     WriteToBuffer('/deflang1033/pard/plain/f2/fs20 ');     Result:= Read(FReadBuff^, Size);     if Result > 0 then     begin         FReadBuff[Result] := #0;         Run := FReadBuff;         while Run^ <> #0 do         begin          Run := GetToken(Run,FTokenState,TokenStr);          ScanForRTF;          SetRTF;          WriteToBuffer(PreFix + TokenStr + PostFix);         end;         {Write ending RTF}         WriteToBuffer(#13+#10+'/par }{'+#13+#10);     end;     Clear;     SetPointer(FOutBuff, fBuffPos-1) ; end; { ConvertReadStream }

The code for ConvertReadStream is now much smaller, and also easier to understand. We can then take all the code that used to be in ConvertReadStream that did the tokenizing and create a new subroutine - the GetToken function that just does the recognizing and labelling of the individual tokens. In the process we also loose a huge number of repeated lines of code, as well as a number of sub-routines such as HandleBorCom and HandleString.
 

// // My Get Token routine // function TPasConversion.GetToken(Run: PChar; var aTokenState: TTokenState;  var aTokenStr: string):PChar; begin     aTokenState := tsUnknown;     aTokenStr := '';     TokenPtr := Run;         // Mark were we started     Case Run^ of #13 : begin aTokenState := tsCRLF; inc(Run, 2); end; #1..#9, #11, #12, #14..#32: begin while Run^ in [#1..#9, #11, #12, #14..#32] do inc(Run); aTokenState:= tsSpace; end; 'A'..'Z', 'a'..'z', '_': begin aTokenState:= tsIdentifier; inc(Run); while Run^ in ['A'..'Z', 'a'..'z', '0'..'9', '_'] do inc(Run); TokenLen:= Run - TokenPtr; SetString(aTokenStr, TokenPtr, TokenLen); if IsKeyWord(aTokenStr) then begin if IsDirective(aTokenStr) then aTokenState:= tsDirective else aTokenState:= tsKeyWord; end; end; '0'..'9': begin inc(Run); aTokenState:= tsNumber; while Run^ in ['0'..'9', '.', 'e', 'E'] do inc(Run); end; '{': begin FComment := csBor; aTokenState := tsComment; while not ((Run^ = '}') or (Run^ = #0)) do inc(Run); inc(Run); end; '!','"', '%', '&', '('..'/', ':'..'@', '['..'^', '`', '~' : begin aTokenState:= tsUnknown; while Run^ in ['!','"', '%', '&', '('..'/', ':'..'@', '['..'^', '`', '~'] do begin Case Run^ of '/':  if (Run + 1)^ = '/' then begin if (aTokenState = tsUnknown) then begin while (Run^ <> #13) and (Run^ <> #0) do inc(Run); FComment:= csSlashes; aTokenState := tsComment; break; end else begin aTokenState := tsSymbol; break; end; end; '(':  if (Run + 1)^ = '*' then begin if (aTokenState = tsUnknown) then begin while (Run^ <> #0) and not ( (Run^ = ')') and ((Run - 1)^ = '*') ) do inc(Run); FComment:= csAnsi; aTokenState := tsComment; inc(Run); break; end else begin aTokenState := tsSymbol; break; end;  end; end; aTokenState := tsSymbol; inc(Run);  end;  if aTokenState = tsUnknown then aTokenState := tsSymbol;  end; #39: begin aTokenState:= tsString; FComment:= csNo; repeat  Case Run^ of          #0, #10, #13: raise exception.Create('Invalid string'); end; inc(Run); until Run^ = #39; inc(Run); end; '#': begin aTokenState:= tsString; while Run^ in ['#', '0'..'9'] do inc(Run); end; '$': begin FTokenState:= tsNumber; while Run^ in ['$','0'..'9', 'A'..'F', 'a'..'f'] do inc(Run); end; else if Run^ <> #0 then inc(Run);     end;     TokenLen := Run - TokenPtr;     SetString(aTokenStr, TokenPtr, TokenLen);     Result := Run end; { ConvertReadStream }