TCanvas.TextWidth liefert 0 anstatt Länge

Bergmann89 · Verfasst: Di 02.08.11 18:08

Hey,

ich schreib grad an einem Editor mit SyntaxHighlight und noch ein paar anderen Spielerrein. Zur Zeit bin ich dabei eine Übersicht für Überladungen einer Funktion zu erstellen. Dort soll unter anderem der Parameter den man gerade bearbeitet hervorgehoben werde. Dazu bestimm ich mit TextWidth die Anfangs- und Endposition des Strings und zeichne ein Rechteck hinter den Text. Mit dem normalen TextWidth funktioniert auch alles 1a, aber ich will natürlich auch SyntaxHighlight haben. Dazu benutz ich SynEdit. Dort gibt es eine Methode die die Breite des HighlightStrings ermitteln kann. Dort wird auch ganz normal mit TCanvas.TextWidth gearbeitet, doch hier ist das Ergebnis manchmal 0 und nicht die gesuchte Breite. Richtig reproduzieren lässt sich der Fehler auch nicht. Das seltsame ist, das die gleiche Methode zum Zeichnen des Textes genutzt wird. Und da funktioniert es so wie es soll?! Hier mal die Methoden aus der SynEdit Unit:

markieren

Delphi-Quelltext

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:
50:
51:
52:
53:
54:
55:
56:
57:
58:
59:
60:
61:
62:
63:
64:
65:
66:
67:
68:
69:
70:
71:
72:
73:
74:
75:
76:
77:
78:
79:
80:
81:
82:
83:
84:
85:
86:
87:
88:
89:
90:
91:
92:
93:
94:
95:
96:
97:
98:
99:
100:
101:
102:
103:
104:
105:
106:
107:
108:
109:
110:
111:
112:
113:
114:
115:
116:
117:
118:
119:
120:
121:
122:
123:
124:
125:
126:
127:
128:
129:
130:
131:
132:
133:
134:
135:
136:
137:
138:
139:
140:
141:
142:
143:
144:
145:
146:
147:
148:
149:
150:
151:
152:
153:

procedure FormattedTextOut(TargetCanvas: TCanvas; const Rect: TRect;
  const Text: string; Selected: Boolean; Columns: TProposalColumns; Images: TImageList);
var
  Chunks: TFormatChunkList;
  StripCommands: TFormatCommands;
begin
  Chunks := TFormatChunkList.Create;
  try
    if Selected then
      StripCommands := [fcColor]
    else
      StripCommands := [];

    ParseFormatChunks(Text, Chunks, StripCommands);
    PaintChunks(TargetCanvas, Rect, Chunks, Columns, Images, False);
  finally
    Chunks.Free;
  end;
end;

function FormattedTextWidth(TargetCanvas: TCanvas; const Text: string;
  Columns: TProposalColumns; Images: TImageList): Integer;
var
  Chunks: TFormatChunkList;
  TmpRect: TRect;
begin
  Chunks := TFormatChunkList.Create;
  try
    TmpRect := Rect(0, 0, MaxInt, MaxInt);

    ParseFormatChunks(Text, Chunks, [fcColor]);
    Result := PaintChunks(TargetCanvas, TmpRect, Chunks, Columns, Images, True);
  finally
    Chunks.Free;
  end;
end;

function PaintChunks(TargetCanvas: TCanvas; const Rect: TRect;
  ChunkList: TFormatChunkList; Columns: TProposalColumns; Images: TImageList;
  Invisible: Boolean): Integer;
var
  i: Integer;
  X, tmpX: Integer;
  C: PFormatChunk;
  CurrentColumn: TProposalColumn;
  CurrentColumnIndex: Integer;
  LastColumnStart: Integer;
  Style: TFontStyles;
  OldFont: TFont;
begin
  OldFont := TFont.Create;
  try
    OldFont.Assign(TargetCanvas.Font);

    if Assigned(Columns) and (Columns.Count > 0) then
    begin
      CurrentColumnIndex := 0;
      CurrentColumn := TProposalColumn(Columns.Items[0]);
      TargetCanvas.Font.Style := CurrentColumn.FFontStyle;
    end else
    begin
      CurrentColumnIndex := -1;
      CurrentColumn := nil;
    end;

    LastColumnStart := Rect.Left;
    X := Rect.Left;

    TargetCanvas.Brush.Style := bsClear;

    for i := 0 to ChunkList.Count -1 do
    begin
      C := ChunkList[i];

      case C^.Command of
      fcNoCommand:
        begin
          if not Invisible then
            TargetCanvas.TextOut(X, Rect.Top, C^.Str);

          tmpX := TargetCanvas.TextWidth(C^.Str);
          if tmpX = 0 then
            writeln(C^.Str); //der String ist nicht leer, aber tmpX = 0
          inc(X, tmpX);
          if X > Rect.Right then
            break;
        end;
      fcColor:
        if not Invisible then
          TargetCanvas.Font.Color := TColor(C^.Data);
      fcStyle:
        begin
          case PFormatStyleData(C^.Data)^.Style of
          'I': Style := [fsItalic];
          'B': Style := [fsBold];
          'U': Style := [fsUnderline];
          'S': Style := [fsStrikeout];
          else Assert(False);
          end;    

          case PFormatStyleData(C^.Data)^.Action of
          -1: TargetCanvas.Font.Style := TargetCanvas.Font.Style - Style;
          0: if TargetCanvas.Font.Style * Style = [] then
               TargetCanvas.Font.Style := TargetCanvas.Font.Style + Style
             else
               TargetCanvas.Font.Style := TargetCanvas.Font.Style - Style;
          1: TargetCanvas.Font.Style := TargetCanvas.Font.Style + Style;
          else Assert(False);
          end;
        end;
      fcColumn:
        if Assigned(Columns) and (Columns.Count > 0) then
        begin
          if CurrentColumnIndex <= Columns.Count -1 then
          begin
            inc(LastColumnStart, TargetCanvas.TextWidth(CurrentColumn.FBiggestWord+' '));
            X := LastColumnStart;

            inc(CurrentColumnIndex);
            if CurrentColumnIndex <= Columns.Count -1 then
            begin
              CurrentColumn := TProposalColumn(Columns.Items[CurrentColumnIndex]);
              TargetCanvas.Font.Style := CurrentColumn.FFontStyle;
            end else
              CurrentColumn := nil;
          end;
        end;
      fcHSpace:
        begin
          inc(X, Integer(C^.Data));
          if X > Rect.Right then
            break;
        end;
      fcImage:
        begin
          Assert(Assigned(Images));

          Images.Draw(TargetCanvas, X, Rect.Top, Integer(C^.Data));

          inc(X, Images.Width);
          if X > Rect.Right then
            break;
        end;
      end;
    end;

    Result := X;
    TargetCanvas.Font.Assign(OldFont);
  finally
    OldFont.Free;
    TargetCanvas.Brush.Style := bsSolid;
  end;
end;

Hat jmd von euch ne Idee woran das liegen könnte? Bzw wie ich das beheben kann?

MfG Bergmann.

_________________
Ich weiß nicht viel, lern aber dafür umso schneller^^

Tryer · Beiträge: 226 Erhaltene Danke: 7

Was liefert GetLastError?
GetTextExtentPoint32() ist die eigentliche Funktion welche von TextWidth/TextExtend aufgerufen wird und scheint ja wohl fehlzuschlagen.

Grüsse, Dirk

Bergmann89 · Verfasst: Di 02.08.11 21:47

Hey,

GetLastError liefert FehlerCode 87 - Falscher Parameter. Ab und zu kommt da auch ErrorCode 6 - ungültiges Handle.
Kann ja auch nich gehen. Die Berechnung findet in einem extra Thread statt. Und ich hatte einfach die Canvas der Form an den Thread übergeben :oops:

Jetzt hab ich mir einfach ne temporäre Canvas erstellt, mit der der Thread arbeiten kann:

markieren

Delphi-Quelltext

1:
2:
3:
4:
5:
6:
7:
8:

//Thread-Konstructor
fCanvas := TCanvas.Create;
fCanvas.Handle := GetDC(GetDesktopWindow);
fCanvas.Font.Assign(Canvas.Font); //Canvas der Form

//Thread-Destructor
ReleaseDC(GetDesktopWindow, fCanvas.Handle);
fCanvas.Free;

Man Sucht und Sucht und findet nix. Und dann hilft ein kleiner Stubs in die richtige Richtung

Dankeschön.

MfG Bergmann.

_________________
Ich weiß nicht viel, lern aber dafür umso schneller^^

	Mitgliederliste
	Gruppen
	Das Team
	Richtlinien
	Synonyme