unit v_AutoCompleteForm; interface {$I ValistusDefines.inc} uses Classes, SysUtils, Forms, Controls, Graphics, StdCtrls, ExtCtrls, SynEdit, SynEditKeyCmds, v_ideCodeParser, v_ideCodeInsight, {$IFDEF FPC} LMessages, lcltype, mPasLex {$ELSE} Windows, Messages {$ENDIF}; type TInsertProc = procedure(Str: string) of object; TAutoCompleteListBox = class(TListBox) protected fIndexList: array of Integer; fList: TStrings; fInsertList: TStrings; fFilter: string; procedure setItemList(List: TStrings); procedure setInsertList(List: TStrings); procedure setFilter(Filter: string); procedure DblClick; override; {$IFDEF ccFORMCAPTION} procedure DoSelectionChange(User: Boolean); override; {$ENDIF} procedure DrawItem(Index: Integer; ARect: TRect; State: TOwnerDrawState); override; {$IFDEF FPC} procedure WMEraseBkgnd(var message: TLMEraseBkgnd); message LM_ERASEBKGND; procedure WMVScroll(var message: TLMVScroll); message LM_VSCROLL; procedure CNChar(var message: TLMessage); message CN_CHAR; {$ELSE} procedure WMEraseBkgnd(var message: TWMEraseBkgnd); message WM_ERASEBKGND; procedure WMVScroll(var message: TWMVScroll); message WM_VSCROLL; procedure CNChar(var message: TMessage); message CN_CHAR; {$ENDIF} public ColumnSizes: array of Integer; Redirect: TWinControl; InsertProc: TInsertProc; procedure setLists(ItemList, InsertList: TStrings); function getInsert: string; constructor Create(TheOwner: TComponent); override; destructor Destroy; override; published property ItemList: TStrings read fList write setItemList; property InsertList: TStrings read fInsertList write setInsertList; property Filter: string read fFilter write setFilter; end; TAutoCompletePopup = class(TForm) protected l: TAutoCompleteListBox; procedure DoShow; override; function getRedirect: TWinControl; procedure setRedirect(Control: TWinControl); function getInsertProc: TInsertProc; procedure setInsertProc(Proc: TInsertProc); public constructor Create(TheOwner: TComponent); override; procedure Show(Pos: TPoint; ItemList, InsertList: TStrings; Filter: string = ''; Editor: TWinControl = nil); reintroduce; procedure DoHide; override; procedure HandleKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState); procedure HandleKeyPress(Sender: TObject; var Key: char); published property ListBox: TAutoCompleteListBox read l; property Redirect: TWinControl read getRedirect write setRedirect; property InsertProc: TInsertProc read getInsertProc write setInsertProc; end; TParamHint = class(THintWindow) private fPreparedString : string; LastParameterIndex : integer; FSynEdit : TSynedit; FStartPoint : TPoint; FBracketPoint : TPoint; FMP : TCodeInsight; FDecl : TciProcedureDeclaration; FParameters : TDeclarationArray; procedure ParamHintHide(Sender: TObject); procedure ApplicationIdle(Sender: TObject; var Done: Boolean); procedure DrawHints(var MaxWidth, MaxHeight: Integer; Draw: boolean); function PrepareParamString(out Str : string; out MustHide : boolean) : integer; public destructor Destroy; override; constructor Create(TheOwner: TComponent); override; procedure CalculateBounds; procedure UpdateHint; procedure Paint; override; procedure Show(StartPoint,BracketPoint : TPoint;Decl : TciProcedureDeclaration; Editor : TSynedit; mp : TCodeInsight); reintroduce; end; implementation uses StrUtils {$IFDEF FPC}, lclintf{$ENDIF},math, Themes; procedure TAutoCompleteListBox.setItemList(List: TStrings); begin fList.Assign(List); end; procedure TAutoCompleteListBox.setInsertList(List: TStrings); begin fInsertList.Assign(List); end; procedure TAutoCompleteListBox.setLists(ItemList, InsertList: TStrings); var i: Integer; begin //fList.Assign(ItemList); //fInsertList.Assign(InsertList); {$IFDEF FPC}LockSelectionChange;{$ENDIF} fList.BeginUpdate; try fList.Clear; fList.AddStrings(ItemList); finally fList.EndUpdate; end; fInsertList.BeginUpdate; try fInsertList.Clear; fInsertList.AddStrings(InsertList); finally fInsertList.EndUpdate; end; Items.BeginUpdate; try Items.Clear; Items.AddStrings(ItemList); finally Items.EndUpdate; end; fFilter := ''; SetLength(fIndexList, fList.Count); for i := 0 to fList.Count - 1 do fIndexList[i] := i; if (fList.Count > 0) then ItemIndex := 0 else ItemIndex := -1; {$IFDEF FPC}UnlockSelectionChange;{$ENDIF} end; procedure TAutoCompleteListBox.setFilter(Filter: string); var i, c, l, del: Integer; begin Filter := LowerCase(Filter); if (Filter = fFilter) then Exit; {$IFDEF FPC}LockSelectionChange;{$ENDIF} c := 0; if (LeftStr(Filter, Length(fFilter)) = fFilter) then begin fFilter := Filter; Items.BeginUpdate; try l := Length(fFilter); del := 0; for i := 0 to Items.Count - 1 do if (LowerCase(LeftStr(fInsertList[fIndexList[i]], l)) <> fFilter) then begin Items.Delete(i - del); Inc(del); end else begin if (ItemIndex = i) or (LowerCase(fInsertList[fIndexList[i]]) = fFilter) then ItemIndex := c; fIndexList[c] := fIndexList[i]; Inc(c); end; SetLength(fIndexList, c + 1); finally Items.EndUpdate; end; end else begin fFilter := Filter; Items.BeginUpdate; try Items.Clear; l := Length(fFilter); SetLength(fIndexList, fInsertList.Count); for i := 0 to fInsertList.Count - 1 do if (LowerCase(LeftStr(fInsertList[i], l)) = fFilter) then begin Items.Append(fList[i]); if (LowerCase(fInsertList[i]) = fFilter) then ItemIndex := i; fIndexList[c] := i; Inc(c); end; SetLength(fIndexList, c + 1); finally Items.EndUpdate; end; end; {$IFDEF FPC}UnlockSelectionChange;{$ENDIF} end; function TAutoCompleteListBox.getInsert: string; begin if (ItemIndex < 0) or (ItemIndex > Length(fIndexList)) then Result := '' else Result := fInsertList[fIndexList[ItemIndex]]; end; {$IFDEF FPC} procedure TAutoCompleteListBox.WMEraseBkgnd(var message: TLMEraseBkgnd); {$ELSE} procedure TAutoCompleteListBox.WMEraseBkgnd(var message: TWMEraseBkgnd); {$ENDIF} begin if (Count < Round(ClientHeight / ItemHeight)) then begin Canvas.Brush.Color := clYellow; FillRect(message.DC, Rect(0, Count * ItemHeight, ClientWidth, ClientHeight), HBRUSH({$IFDEF FPC}Brush.Reference.Handle{$ELSE}Parent.Brush.Handle{$ENDIF})); end; message.Result := 1; end; {$IFDEF FPC} procedure TAutoCompleteListBox.WMVScroll(var message: TLMVScroll); {$ELSE} procedure TAutoCompleteListBox.WMVScroll(var message: TWMVScroll); {$ENDIF} var c: Integer; begin {$IFDEF FPC}LockSelectionChange;{$ENDIF} if (ItemIndex < TopIndex) then ItemIndex := TopIndex else begin c := Round(ClientHeight / ItemHeight) - 1; if (ItemIndex > TopIndex + c) then ItemIndex := TopIndex + c; end; {$IFDEF FPC}UnlockSelectionChange;{$ENDIF} end; {$IFDEF FPC} procedure TAutoCompleteListBox.CNChar(var message: TLMessage); {$ELSE} procedure TAutoCompleteListBox.CNChar(var message: TMessage); {$ENDIF} begin inherited; {$IFDEF FPC} if (message.Result = 0) and (Redirect <> nil) and (TLMChar(message).CharCode <> VK_DOWN) and (TLMChar(message).CharCode <> VK_UP) and (TLMChar(message).CharCode <> VK_RETURN) then {$ELSE} if (message.Result = 0) and (Redirect <> nil) and (TWMChar(message).CharCode <> VK_DOWN) and (TWMChar(message).CharCode <> VK_UP) and (TWMChar(message).CharCode <> VK_RETURN) then {$ENDIF} begin Redirect.SetFocus; Application.ProcessMessages; if (Redirect is TSynEdit) then TSynEdit(Redirect).CommandProcessor(ecChar, TUTF8Char(Chr(TLMChar(message).CharCode)), nil) else SendMessage(Redirect.Handle, CN_Char, message.wParam, message.lParam); end; end; procedure TAutoCompleteListBox.DblClick; begin if (Assigned(InsertProc)) then InsertProc(GetInsert); if (Owner is TForm) then TForm(Owner).Hide; end; {$IFDEF ccFORMCAPTION} procedure TAutoCompleteListBox.DoSelectionChange(User: Boolean); begin if (Owner is TForm) then TForm(Owner).Caption := getInsert; end; {$ENDIF} procedure TAutoCompleteListBox.DrawItem(Index: Integer; ARect: TRect; State: TOwnerDrawState); var p1, p2, p3, tl, col: Integer; s, c: string; begin if (ItemIndex = -1) and (Count > 0) then begin {$IFDEF FPC}LockSelectionChange;{$ENDIF} ItemIndex := TopIndex; {$IFDEF FPC}UnlockSelectionChange;{$ENDIF} end; if (not Visible) or (ARect.Left > ClientRect.Right) or (ARect.Top > ClientRect.Bottom) or (Index < 0) or (Index >= Items.Count) then Exit; tl := ARect.Left; col := 0; with Canvas do begin Font.Style := []; Font.Color := clBlack; if (Index = Count - 1) and (ARect.Bottom < ClientHeight - 1) then begin Brush.Color := clWhite; FillRect(Rect(0, ARect.Bottom + 1, ClientWidth, ClientHeight)); end; if (odSelected in State) then Brush.Color := clHighlight else if (odHotLight in State) then Brush.Color := clHotLight else if Odd(Index) then Brush.Color := $F0F0F0 else Brush.Color := clWhite; FillRect(ARect); s := Items[Index]; p1 := Pos('{', s); p3 := 1; while (p1 > 0) do begin p2 := PosEx('}', s, p1 + 1); if (p2 > 0) then begin if (s[p2 - 1] <> '\') then begin c := Copy(s, p3, p1 - p3); TextOut(tl, ARect.Top + Round((ItemHeight - TextHeight(c) + 0.001) / 2) , c); tl := tl + TextWidth(c) + 1; p3 := p2 + 1; if ((p2 - p1 - 2) > 0) then begin c := LowerCase(Copy(s, p1 + 2, p2 - p1 - 2)); case Char(CharUpper({$IFNDEF FPC}PChar{$ELSE}Char{$ENDIF}(s[p1 + 1]))) of '#', 'C': Font.Color := StringToColor(c); 'B': if (c = '+') then Font.Style := Font.Style + [fsBold] else Font.Style := Font.Style - [fsBold]; 'I': if (c = '+') then Font.Style := Font.Style + [fsItalic] else Font.Style := Font.Style - [fsItalic]; 'U': if (c = '+') then Font.Style := Font.Style + [fsUnderline] else Font.Style := Font.Style - [fsUnderline]; end; end else if (s[p1 + 1] = '|') then begin if (ColumnSizes[col] = -1) then ColumnSizes[col] := Canvas.TextWidth('constructor') + 5; tl := ColumnSizes[col]; Inc(Col); end; p1 := PosEx('{', s, p2 + 1); end; end else Break; end; if ((Length(s) - p3 + 1) > 0) then begin c := Copy(s, p3, Length(s) - p3 + 1); TextOut(tl, ARect.Top + Round((ItemHeight - TextHeight(c) + 0.001) / 2), c); end; end; end; constructor TAutoCompleteListBox.Create(TheOwner: TComponent); begin inherited; DoubleBuffered := True; ControlStyle := ControlStyle + [csOpaque]; BorderStyle := bsNone; Style := lbOwnerDrawFixed; IntegralHeight := True; {$IFDEF FPC} ItemHeight := CalculateStandardItemHeight + 4; {$ELSE} ItemHeight := 19; {$ENDIF} Constraints.MinHeight := ItemHeight; SetLength(ColumnSizes, 1); ColumnSizes[0] := -1; Redirect := nil; InsertProc := nil; Items.Clear; fList := TStringList .Create; fInsertList := TStringList.Create; fFilter := ''; end; destructor TAutoCompleteListBox.Destroy; begin FreeAndNil(fList); FreeAndNil(fInsertList); inherited; end; procedure TAutoCompletePopup.DoShow; begin //ClientHeight := Max(Min(Round(l.ClientHeight / l.ItemHeight), l.Count), 1) * l.ItemHeight; //ClientHeight := Max(Round(l.ClientHeight / l.ItemHeight), 1) * l.ItemHeight; end; function TAutoCompletePopup.getRedirect: TWinControl; begin Result := ListBox.Redirect; end; procedure TAutoCompletePopup.setRedirect(Control: TWinControl); begin ListBox.Redirect := Control; end; function TAutoCompletePopup.getInsertProc: TInsertProc; begin Result := ListBox.InsertProc; end; procedure TAutoCompletePopup.setInsertProc(Proc: TInsertProc); begin ListBox.InsertProc := Proc; end; constructor TAutoCompletePopup.Create(TheOwner: TComponent); begin inherited; l := TAutoCompleteListBox.Create(Self); with l do begin Parent := Self; Align := alClient; OnKeyDown := {$IFDEF FPC}@{$ENDIF}HandleKeyDown; OnKeyPress := {$IFDEF FPC}@{$ENDIF}HandleKeyPress; end; DefaultMonitor := dmMainForm; FormStyle := fsStayOnTop; {$IFDEF FPC} ShowInTaskBar := stNever; {$ENDIF} {$IFDEF ccFORMCAPTION} {$IFDEF ccFORMRESIZE} BorderStyle := bsSizeToolWin; BorderIcons := [biSystemMenu]; {$ELSE} BorderStyle := bsToolWindow; BorderIcons := [biSystemMenu]; {$ENDIF} {$ELSE} {$IFDEF ccFORMRESIZE} BorderStyle := bsSizeToolWin; BorderIcons := []; SetWindowLong(Handle, GWL_STYLE, GetWindowLong(Handle, GWL_STYLE) and (not WS_CAPTION) or WS_BORDER); Height := Height - GetSystemMetrics(SM_CYCAPTION); {$ELSE} BorderStyle := bsNone; BorderIcons := []; l.BorderStyle := bsSingle; {$ENDIF} {$ENDIF} DoubleBuffered := True; ControlStyle := ControlStyle + [csOpaque]; ClientHeight := (Round(ClientHeight / l.ItemHeight) * l.ItemHeight); Constraints.MinHeight := l.ItemHeight; Constraints.MinWidth := 100; end; procedure TAutoCompletePopup.DoHide; begin ListBox.Clear; inherited; end; procedure TAutoCompletePopup.HandleKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState); begin if Visible then begin case Key of VK_UP: if (ListBox.Count > 0) and (ListBox.ItemIndex > 0) then ListBox.ItemIndex := ListBox.ItemIndex - 1; VK_DOWN: if (ListBox.Count > 0) and (ListBox.ItemIndex + 1 < ListBox.Count) then ListBox.ItemIndex := ListBox.ItemIndex + 1; VK_RETURN: ListBox.DblClick; VK_ESCAPE: Hide; else Exit; end; Key := 0; end; end; procedure TAutoCompletePopup.HandleKeyPress(Sender: TObject; var Key: char); begin if Visible and (not (Key in ['a'..'z', 'A'..'Z', '0'..'9', '_'])) then if (Key in ['.', '(', '[', ';', ':']) then ListBox.DblClick else Hide; end; procedure TAutoCompletePopup.Show(Pos: TPoint; ItemList, InsertList: TStrings; Filter: string = ''; Editor: TWinControl = nil); begin ListBox.setLists(ItemList, InsertList); ListBox.Redirect := Editor; ListBox.Filter := Filter; Left := Pos.x; Top := Pos.y; inherited Show; if (Editor <> nil) then Editor.SetFocus; end; function StringListPartToText(BeginPos, EndPos : TPoint; Strings :TStrings) : string; var i : integer; begin; result := ''; if (Strings = nil) then exit; if endpos.y < beginpos.y then exit; if beginpos.y < 0 then exit; if endpos.y >= strings.Count then exit; if beginpos.x > length(strings[beginpos.y]) then exit; if endpos.x > (length(strings[endpos.y]) + 1) then exit; if EndPos.y = beginpos.y then begin result := copy(strings[beginpos.y], beginpos.x, endpos.x - beginpos.x + 1); exit; end; result := copy(strings[beginpos.y],beginpos.x, length(strings[beginpos.y]) - beginpos.x + 1); for i := beginpos.y + 1 to endpos.y-1 do result := result + strings[i]; result := result + copy(strings[endpos.y], 1, endpos.x - 1); //Position <> count! end; function TParamHint.PrepareParamString(out Str: string; out MustHide : boolean): Integer; var Parser : TmwPasLex; bracketcount, parameterindex,ParamC : integer; ParamNames : TDeclarationArray; typedecl : TDeclaration; s,TypeStr,Params : string;// i,ii :integer; CursorXY : TPoint; begin Result := -1; MustHide := True; if (FSynEdit = nil) then Exit; Parser := TmwPasLex.Create; //The position of the bracket try Parser.Origin:= PChar(StringListPartToText(Point(FBracketPoint.x,FBracketPoint.y-1), Point(min(FSynEdit.CaretX,length(FSynEdit.Lines[FSynEdit.CaretY - 1])+1),FSynEdit.CaretY-1), FSynEdit.lines)); bracketcount := 0; ParameterIndex := -1; while parser.TokenID <> tkNull do begin case parser.tokenID of tkRoundOpen,tkSquareOpen: begin inc(BracketCount); if BracketCount = 1 then ParameterIndex := 0; end; tkRoundClose, tkSquareClose: begin dec(BracketCount); if bracketcount =0 then exit; end; tkComma: begin if bracketcount = 1 then inc(parameterIndex); end; end; parser.NextNoJunk; end; finally Parser.Free; end; if parameterindex = -1 then exit; if parameterindex = LastParameterIndex then begin mustHide := false; str := fPreparedString; result := parameterindex; exit; end; str := ''; ParamC := 0; {typedecl := FDecl.Name; if typedecl = nil then exit; if typedecl.shorttext = '' then exit;} for i := 0 to high(FParameters) do begin if (FParameters[i] is TciConstParameter) then s := 'const ' else if (FParameters[i] is TciOutParameter) then s := 'out ' else if (FParameters[i] is TciInParameter) then s := 'in ' else if (FParameters[i] is TciVarParameter) then s := 'var ' else s := ''; ParamNames:= FParameters[i].Items.GetItemsOfClass(TciParameterName); TypeDecl := FParameters[i].Items.GetFirstItemOfClass(TciParameterType); if TypeDecl <> nil then TypeStr := ': ' + typedecl.ShortText else TypeStr := ''; Params := ''; for ii := 0 to high(ParamNames) do begin; if parameterindex = ParamC then //Found the current parameter index in the parameterdecl! begin; if s <> '' then s := '\' + s + '\'; //If it has a const/var/in/out thingy, bold this as well if TypeStr <> '' then //If has a type then bold the type TypeStr := '\' + TypeStr + '\'; if Params <> '' then Params := Params +', \' + ParamNames[ii].ShortText + '\' else Params := '\' + ParamNames[ii].ShortText + '\'; end else begin; if Params <> '' then Params := Params +', ' + ParamNames[ii].ShortText else Params := ParamNames[ii].ShortText; end; inc(ParamC); end; if str <> '' then str := str + ';' + s + Params + typestr else str := s + params + typestr; end; if (FDecl <> nil) then TypeDecl := FDecl.Items.GetFirstItemOfClass(TciReturnType) else TypeDecl := nil; if TypeDecl <> nil then TypeStr := ': ' + typedecl.ShortText else TypeStr := ''; str := '(' + str + ')' + TypeStr + ';'; if (FDecl <> nil) and (FDecl.Name <> nil) then str := FDecl.Name.ShortText + str; str := StringReplace(str,'\\','',[rfReplaceAll]); //Delete all the \\, something like \const \\x\ is the same as \const x\ MustHide := False; Result := parameterindex; fPreparedString := str; end; destructor TParamHint.Destroy; begin Application.RemoveOnIdleHandler(@ApplicationIdle); inherited Destroy; end; constructor TParamHint.Create(TheOwner: TComponent); begin inherited; {$IFDEF FPC} AutoHide := False; {$ENDIF} OnHide:=@ParamHintHide; LastParameterIndex:= -1; Application.AddOnIdleHandler(@ApplicationIdle); Fmp := nil; FDecl := nil; FSynEdit := nil; end; procedure TParamHint.CalculateBounds; var DrawWidth: LongInt; DrawHeight: LongInt; ScreenTextXY: TPoint; ClientXY: TPoint; ScreenXY: TPoint; begin if (FSynEdit = nil) then Exit; ScreenTextXY := FSynEdit.LogicalToPhysicalPos(FStartPoint); ClientXY := FSynEdit.RowColumnToPixels(ScreenTextXY); DrawWidth := FSynEdit.ClientWidth; //Maximum width it can have.. DrawHeight := ClientXY.y; //Maximum height it can have.. DrawHints(DrawWidth,DrawHeight,false); //Calculate the max size we need! if DrawWidth<20 then DrawWidth:=20; //Some default values! if DrawHeight<5 then DrawHeight:=5; if ClientXY.X+DrawWidth>FSynedit.ClientWidth then //If we go out of bounds, lets put it to the left a bit. ClientXY.X:=FSynedit.ClientWidth-DrawWidth; if ClientXY.X<0 then //If we go to the left a lil bit to much, go to the right! ClientXY.X:=0; dec(ClientXY.Y,DrawHeight); //Move this a lil bit up! if ClientXY.y < 0 then ClientXY.y := 0; ScreenXY:=FSynedit.ClientToScreen(ClientXY); //Position on the screen dec(ScreenXY.Y,4); //Move it up a lilttle bit above your text, to make the shade come out better? //Set the new position BoundsRect:=Bounds(ScreenXY.X,ScreenXY.Y,DrawWidth,DrawHeight); end; procedure TParamHint.UpdateHint; var MustHide : boolean; CursorXY : TPoint; Line : string; begin if not self.Visible then exit; try MustHide := True; if not Assigned(FSynEdit) then exit; if FSynEdit.Focused = false then //No focus, hide this hint exit; //Exits to the finally statement ;) CursorXY := FSynEdit.CaretXY; if (CursorXY.y < FBracketPoint.y) or ((CursorXY.x <= FBracketPoint.x) and (CursorXY.y <= FBracketPoint.y)) then //Cursor moved in front of the bracket exit; if (FBracketPoint.Y <= 0) or (FBracketPoint.Y > FSynEdit.Lines.Count) then Line := '' else Line:=FSynEdit.Lines[FBracketPoint.Y - 1]; if (FBracketPoint.X > length(Line)) or (not (Line[FBracketPoint.X] in ['(','['])) then exit; if PrepareParamString(Line,MustHide) = LastParameterIndex then exit else if not MustHide then Self.Invalidate; finally if MustHide then Self.hide; end; end; procedure TParamHint.ParamHintHide(Sender: TObject); begin if Fmp <> nil then FreeAndNil(Fmp); FDecl := nil; FSynEdit := nil; LastParameterIndex := -1; end; procedure TParamHint.DrawHints(var MaxWidth, MaxHeight: Integer; Draw: boolean); var HorizontalSpace: Integer; VerticalSpace: Integer; BackgroundColor, TextGrayColor, TextColor, PenColor: TColor; TextGrayStyle, TextStyle: TFontStyles; procedure DrawHint(const Line: string; var AHintRect: TRect); var ATextRect: TRect; //The area we can use TokenRect: TRect; //The area the text takes up TokenSize: TPoint; //The W/H the text takes up TokenPos: TPoint; //The position where the text is drawn UsedWidth: Integer; // maximum right token position LineHeight: Integer; // Current line height Bolding : boolean; //If we are in a bolding part. Pos : integer; StartPos : integer; //Text takes up it's own Width/Height + the space around the text. begin ATextRect:=Rect(AHintRect.Left+HorizontalSpace, AHintRect.Top+VerticalSpace, AHintRect.Right-HorizontalSpace, AHintRect.Bottom-VerticalSpace);//Possible area! UsedWidth:=0; LineHeight:=0; TokenPos:=Point(ATextRect.Left,ATextRect.Top); //StartPoint like (0,0) Bolding := False; Pos := 0; //Split the drawing up in words, that way we can split the function if it gets to long ;). while (Pos < Length(Line)) do begin inc(Pos); if (Line[Pos] = '\') then //Bold from now begin; if Draw then begin if not Bolding then begin Canvas.Font.Color := TextColor; Canvas.Font.Style := TextStyle; end else begin Canvas.Font.Color := TextGrayColor; Canvas.Font.Style := TextGrayStyle; end; Bolding := not Bolding; end; continue; end; StartPos := Pos; if (Pos <= Length(Line)) and (Line[Pos] in ['a'..'z', 'A'..'Z', '0'..'9', '_']) then //We are in a word, lets draw that completely ;) begin while ((Pos < length(line)) and (Line[Pos + 1] in ['a'..'z', 'A'..'Z', '0'..'9', '_'])) do inc(pos); end else while ((Pos < length(line)) and not(Line[Pos + 1] in ['a'..'z', 'A'..'Z', '0'..'9', '_','\'])) do inc(pos); TokenRect:=Bounds(0,0,12345,1234); //Random rect DrawText(Canvas.Handle,@Line[StartPos],Pos-StartPos + 1,TokenRect, DT_SINGLELINE+DT_CALCRECT+DT_NOCLIP); //Calculate the size it takes to draw this text TokenSize:=Point(TokenRect.Right,TokenRect.Bottom); //The size it takes to draw this text if (LineHeight>0) and (TokenPos.X+TokenSize.X>ATextRect.Right) then //It doesn't fit.. Text = 2 long begin if Draw and (TokenPos.X0) then //Fill the rest of the unused area Canvas.FillRect(Rect(TokenPos.X,TokenPos.Y-VerticalSpace, AHintRect.Right,TokenPos.Y+LineHeight+VerticalSpace)); if (not Draw) and (UsedWidth>0) then AHintRect.Right:=UsedWidth+HorizontalSpace; //Calculate the width we actually need AHintRect.Bottom:=TokenPos.Y+LineHeight+VerticalSpace; end; var CurHintRect: TRect; MustHide : boolean; hintstr: string; begin if Draw then begin BackgroundColor:=clInfoBk; TextGrayColor:=clInfoText; TextGrayStyle:=[]; TextColor:=clInfoText; TextStyle:=[fsBold]; PenColor:=clBlack; end; HorizontalSpace:=2; //The spaces around the text VerticalSpace:=2; if Draw then begin Canvas.Brush.Color:=BackgroundColor; Canvas.Font.Color:=TextGrayColor; Canvas.Font.Style:=TextGrayStyle; Canvas.Pen.Color:=PenColor; end else begin Canvas.Font.Style:=[fsBold]; //Let us calculate the maximum width we need :) end; CurHintRect:=Rect(0,0,MaxWidth,MaxHeight); PrepareParamString(HintStr,MustHide); if MustHide then begin; Self.Hide; exit; end; DrawHint(HintStr, CurHintRect); if Draw then //Fill the rest if needed.. (Possible if we calculated we need 2 rows, but turns out we need only 1 this time). begin if CurHintRect.Bottom