generalvcl.pas

DelphiDoc is a program for automatic generation of documentation on a Delphi-Project. At the momen

 events will be changed.
~param Memo the memo for which the vertical scrollbar should be hidden when
            not used }
procedure RegisterMemoToHideVerticalScrollbar(Memo: TMemo);
begin
{$IFNDEF LINUX}
 if OptimizeMemoScrollBars then            //if enabled
  TMemoListener.CreateForMemo(Memo);         //create listener on the memo
{$ENDIF}
end;





{$IFNDEF LINUX}

{Adds a HTML snippet to the rich edit while interpreting some simple tags. The
 supported tags are: a, b, br, code, em, i, p, small, sub, sup. Only the
 following five base character entities are supported: <, >, &,
 " and  .
~param Snippet  the HTML snippet to add formatted
~param RichEdit the rich edit component to add the text to }
procedure AppendHTMLSnippetToRichEdit(Snippet: String; RichEdit: TRichEdit);
          //the supported tags (alphabetically sorted)
type      TTag = (
                  tA,      //a link (or anchor, but that shouldn't appear)
                  tB,      //make text bold
                  tBr,     //enter a line break
                  tCode,   //format as code
                  tEm,     //emphasize (make italic)
                  tI,      //make italic
                  tP,      //start a new paragraph (or encapsulate one?)
                  tSmall,  //make text smaller
                  tSub,    //write text in sub-script (lower)
                  tSup);   //write text in super-script (higher)

 {Checks whether the word is in the list.
 ~param Word  the word to search in the list; it is only searched if it begins
              with a letter; for the comparison it is converted to lower case
 ~param Index the index of Word in the list; if not found it is set to -1
 ~result if the word is in list }
 function IdentifyTag(Word: String; var Tag: TTag): Boolean;
          //the names of the supported tags as alphabetically sorted lower case
          //list
 const    List: array[Ord(Low(TTag))..Ord(High(TTag))] of String =
               ('a', 'b', 'br', 'code', 'em', 'i', 'p', 'small', 'sub', 'sup');
 var      l, h, m :Integer;    //low-, high-, middle-indices
          cmp     :Integer;    //result of string-compare
 begin
  Word := LowerCase(Word);   //convert to lower case
  l := Low(List);            //search whole list
  h := High(List);
  repeat
    m := (h + l) div 2;        //get the index in the middle
    //compare word with the item in the middle
    cmp := CompareStr(Word, List[m]);
    Result := cmp = 0;         //word has been found?
    if not Result then
     if cmp > 0 then             //else restrict search to the other half
      l := m + 1
     else
      h := m - 1;
  until Result or (l > h);   //until word has been found or not
  if Result then
   Tag := TTag(m)
 end;

 {Sets the vertical offset in a rich edit, this is used for super- and
  subscript.
 ~param Offset the offset from the base line in quarter-lines, 0 for normal
               text, -1 for subscript, +2 for superscript }
 procedure SetVerticalOffset(Offset: Integer);
{$IFNDEF LINUX}
 var       Format           :TCharFormat;    //the variable to set the offset
{$ENDIF}
 begin
{$IFNDEF LINUX}
  FillChar(Format, SizeOf(Format), 0);       //initialize the structure
  Format.cbSize := SizeOf(Format);

  Format.dwMask := CFM_OFFSET;               //set the new offset
  Format.yOffset := Offset * Abs(RichEdit.SelAttributes.Size) * 20 div 4;

  if RichEdit.HandleAllocated then           //and assign it
   SendMessage(RichEdit.Handle, EM_SETCHARFORMAT, SCF_SELECTION,
               LPARAM(@Format))
{$ENDIF}
 end;

          //the current index in the text up to which it has already been added
var       Index           :Integer;

 {Adds the normale text up to the next tag or character entity.
 ~param Ind1, Ind2 the indices up to which the text can be added }
 procedure HandleSimpleText(Ind1, Ind2: Integer);
 var       Min             :Integer;    //the minimum index
 begin
  Assert((Ind1 <> Ind2) or (Ind1 > Length(Snippet)));
  if Ind1 < Ind2 then                   //get the lesser index
   Min := Ind1
  else
   Min := Ind2;
  Assert(Min >= Index);
                                        //text not empty
  if Min <> Index then
   begin
    RichEdit.SelText := Copy(Snippet, Index, Min - Index); //add the text
    RichEdit.SelStart := Length(RichEdit.Text);   //move insert position to end
   end;
 end;

var       FontName        :String;      //the name of the default font
          TagIndex        :Integer;     //index of the next tag
          CharEntityIndex :Integer;     //index of the next character entity
          EndTag          :Boolean;     //whether the tag was an end-tag
          Name            :String;      //name of the tag or character entity
          Tag             :TTag;        //the tag
begin
 FontName := RichEdit.SelAttributes.Name;      //save name of the default font

 //ignore all unsused white spaces
 Snippet := UniqueWhiteSpacesToSpace(Snippet); //clear all unused white spaces

 Index := 1;                                   //start at beginning of the text
 TagIndex := Pos('<', Snippet);                //search the first tag
 if TagIndex = 0 then                          //if none found
  TagIndex := Length(Snippet) + 1;               //is placed "behind" the end
 CharEntityIndex := Pos('&', Snippet);         //search first character entity
 if CharEntityIndex = 0 then                   //if none found
  CharEntityIndex := Length(Snippet) + 1;        //is placed "behind" the end

 while Index < Length(Snippet) do              //for the whole text
  begin
   HandleSimpleText(TagIndex, CharEntityIndex);  //add the text

   if TagIndex < CharEntityIndex then            //tag found?
    begin
     Inc(TagIndex);                                //skip the '<'
     //check whether it is an end-tag
     EndTag := (TagIndex <= Length(Snippet)) and (Snippet[TagIndex] = '/');
     Inc(TagIndex, Ord(EndTag));                   //in that case skip the '/'

     Index := TagIndex;                            //search the end of the name
     while (Index <= Length(Snippet)) and
           (Snippet[Index] in ['A'..'Z', 'a'..'z', '0'..'9']) do
      Inc(Index);

     Name := Copy(Snippet, TagIndex, Index - TagIndex); //extract tag name

     Index := SearchString('>', Snippet, Index);   //search end of the tag
     if Index = 0 then
      Index := Length(Snippet);
     Inc(Index);                                   //text begins after it

     if IdentifyTag(Name, Tag) then                //get the tag by its name
      case Tag of                                    //handle the tag
        tA:      //a link (or anchor, but that shouldn't appear)
                 ;   //links are not really supported
        tB:      //make text bold
                 if EndTag then
                  RichEdit.SelAttributes.Style := RichEdit.SelAttributes.Style
                                                  - [fsBold]
                 else
                  RichEdit.SelAttributes.Style := RichEdit.SelAttributes.Style
                                                  + [fsBold];
        tBr:     //enter a line break
                 if not EndTag then
                  RichEdit.Lines.Append('');
        tCode:   //format as code
                 if EndTag then
                  RichEdit.SelAttributes.Name := FontName
                 else
                  RichEdit.SelAttributes.Name := 'Courier New';
        tEm:     //emphasize (make italic)
                 if EndTag then
                  RichEdit.SelAttributes.Style := RichEdit.SelAttributes.Style
                                                  - [fsItalic]
                 else
                  RichEdit.SelAttributes.Style := RichEdit.SelAttributes.Style
                                                  + [fsItalic];
        tI:      //make italic
                 if EndTag then
                  RichEdit.SelAttributes.Style := RichEdit.SelAttributes.Style
                                                  - [fsItalic]
                 else
                  RichEdit.SelAttributes.Style := RichEdit.SelAttributes.Style
                                                  + [fsItalic];
        tP:      //start a new paragraph (or encapsulate one?)
                 begin
                  RichEdit.Lines.Append('');
                  RichEdit.Lines.Append('');
                 end;
        tSmall:  //make text smaller
                 if EndTag = (RichEdit.SelAttributes.Size > 0) then
                  RichEdit.SelAttributes.Size := RichEdit.SelAttributes.Size
                                                 + 3
                 else
                  RichEdit.SelAttributes.Size := RichEdit.SelAttributes.Size
                                                 - 3;
        tSub:    //write text in sub-script (lower)
                 if EndTag then
                  SetVerticalOffset(0)
                 else
                  SetVerticalOffset(-1);
        tSup:    //write text in super-script (higher)
                 if EndTag then
                  SetVerticalOffset(0)
                 else
                  SetVerticalOffset(+2);
      else
       Assert(False);
      end; //if IdentifyTag() then case Tag of

     TagIndex := SearchString('<', Snippet, Index); //search the next tag
     if TagIndex = 0 then                           //if none found
      TagIndex := Length(Snippet) + 1;                //place "behind" the end
    end //if TagIndex < CharEntityIndex
   else
    if CharEntityIndex <= Length(Snippet) then      //end of text not reached?
     //must be a character entity
     begin
      //search the end of the character entity
      Index := SearchString(';', Snippet, CharEntityIndex + 1);
      if Index = 0 then                               //if invalid
       begin
        Index := CharEntityIndex + 1;                  //search by characters
        while (Index <= Length(Snippet)) and
              (Snippet[Index] in ['A'..'Z', 'a'..'z', '0'..'9']) do
         Inc(Index);
       end;
      //extract the name of the character entity
      Name := Copy(Snippet, CharEntityIndex + 1, Index - CharEntityIndex - 1);
      if Index < Length(Snippet) then
       Inc(Index);
      //select the character represented by the character entity
      if Name = 'lt' then
       Name := '<'
      else
       if Name = 'gt' then
        Name := '>'
       else
        if Name = 'amp' then
         Name := '&'
        else
         if Name = 'quot' then
          Name := '"'
         else
          if Name = 'nbsp' then
           Name := ' '
          else
           Name := '&' + Name + ';';  //if unknown show the character entity
      //add the character
      RichEdit.SelText := Name;
      RichEdit.SelStart := Length(RichEdit.Text);
      //search the next character entity
      CharEntityIndex := SearchString('&', Snippet, Index);
      if CharEntityIndex = 0 then                    //if none found
       CharEntityIndex := Length(Snippet) + 1;         //place "behind" the end
     end //if CharEntityIndex <= Length(Snippet)
    else //end of the text reached
     Index := Length(Snippet) + 1;                   //therefore end the loop

  end; //while Index < Length(Snippet)
end;

{$ENDIF}








{$IFDEF VER120}

{Fixes the maximum allowed length to include the terminating
 0-character for notification TVN_GETDISPINFO.
~param Message the message the TreeView is notified about }
procedure TFixedTreeView.CNNotify(var Message: TWMNotify);
begin
 //error only happens, when the "Display Information" about an item
 if Message.NMHdr^.code = TVN_GETDISPINFO then            //is requested
  //there is no additional room for the terminating 0 by default!
  //so decrement the available length, to get it
  Dec(PTVDispInfo(Message.NMHdr)^.item.cchTextMax);

 inherited;                  //now handle the message
end;

{$ENDIF}


end.