paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-08-16 10:19:36 +02:00
Code Issues Packages Projects Releases Wiki Activity

accelerated code completion box in IDE and replaced ExtTextOut with ExtUTF8Out in TCanvas.TextOut

Browse Source 
git-svn-id: trunk@6453 -
This commit is contained in:
mattias 2005-01-01 20:05:08 +00:00
parent 965c1e6b30
commit 0b6defabbf
2 changed files with 24 additions and 4 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

22
ide/sourceeditprocs.pas
View File

@ -62,6 +62,7 @@ var
BGRed: Integer; BGRed: Integer;
BGGreen: Integer; BGGreen: Integer;
BGBlue: Integer; BGBlue: Integer;
TokenStart: Integer;
function InvertColor(AColor: TColor): TColor; function InvertColor(AColor: TColor): TColor;
var Red, Green, Blue: integer; var Red, Green, Blue: integer;
@ -95,6 +96,20 @@ var
ACanvas.Font.Color:=NewColor; ACanvas.Font.Color:=NewColor;
end; end;
procedure WriteToken(var TokenStart, TokenEnd: integer);
var
CurToken: String;
begin
if TokenStart>=1 then begin
CurToken:=copy(AKey,TokenStart,TokenEnd-TokenStart);
ACanvas.TextOut(x+1, y, CurToken);
x := x + ACanvas.TextWidth(CurToken);
//debugln('Paint A Text="',CurToken,'" x=',dbgs(x),' y=',dbgs(y),' "',ACanvas.Font.Name,'" ',dbgs(ACanvas.Font.Height));
TokenStart:=0;
end;
end;
var var
i: Integer; i: Integer;
s: string; s: string;
@ -222,10 +237,12 @@ begin
end else begin end else begin
// parse AKey for text and style // parse AKey for text and style
i := 1; i := 1;
TokenStart:=0;
while i <= Length(AKey) do begin while i <= Length(AKey) do begin
case AKey[i] of case AKey[i] of
#1, #2: #1, #2:
begin begin
WriteToken(TokenStart,i);
// set color // set color
ACanvas.Font.Color := (Ord(AKey[i + 3]) shl 8 ACanvas.Font.Color := (Ord(AKey[i + 3]) shl 8
+ Ord(AKey[i + 2])) shl 8 + Ord(AKey[i + 2])) shl 8
@ -234,6 +251,7 @@ begin
end; end;
#3: #3:
begin begin
WriteToken(TokenStart,i);
// set style // set style
case AKey[i + 1] of case AKey[i + 1] of
'B': ACanvas.Font.Style := ACanvas.Font.Style + [fsBold]; 'B': ACanvas.Font.Style := ACanvas.Font.Style + [fsBold];
@ -246,11 +264,11 @@ begin
inc(i, 2); inc(i, 2);
end; end;
else else
ACanvas.TextOut(x+1, y, AKey[i]); if TokenStart<1 then TokenStart:=i;
x := x + ACanvas.TextWidth(AKey[i]);
inc(i); inc(i);
end; end;
end; end;
WriteToken(TokenStart,i);
end; end;
end; end;

6
lcl/include/canvas.inc
View File

@ -811,8 +811,7 @@ begin
Flags := 0; Flags := 0;
If TextStyle.Opaque then If TextStyle.Opaque then
Flags := ETO_Opaque; Flags := ETO_Opaque;
ExtTextOut(FHandle, X, Y, Flags, nil, ExtUTF8Out(FHandle, X, Y, Flags, nil, PChar(Text), Length(Text), nil);
PChar(Text), Length(Text), nil);
MoveTo(X + TextWidth(Text), Y); MoveTo(X + TextWidth(Text), Y);
Changed; Changed;
end; end;
@ -1269,6 +1268,9 @@ end;
{ ============================================================================= { =============================================================================
$Log$ $Log$
Revision 1.85 2005/01/01 20:05:08 mattias
accelerated code completion box in IDE and replaced ExtTextOut with ExtUTF8Out in TCanvas.TextOut
Revision 1.84 2004/11/07 17:21:08 micha Revision 1.84 2004/11/07 17:21:08 micha
fix text position to be at X, Y; if alignment/layout indicates so fix text position to be at X, Y; if alignment/layout indicates so