Tweet
Ist es möglich auc Text im XOR Modus (Doppeltes Zeichnen löscht es wieder)auf dem Canvas auszugeben. (Ähnlich wie bei line etc). Ziel ist es den Text am Cursour zum Positionieren in mousemove schon anzuzeigen.
-
-
Nein es gibt kein spezielles API dafür. Man kann aber über Bitmaps dieses Verhalten hinbekommen. Dazu wird als erstes eine monochrome Bitmap erzeugt in die der Text gezeichent wird. Danach wird diese Bitmap per transparentem XOR in den Zielcanvas gezeichnet. Ich versuche mal hier einen Quick&Dirty Source hinzubekommen:
<pre>
procedure DrawXORText(ACanvas: TCanvas; const ARect: TRect; const AText: String; AFlags: Integer; AColor: TColor);
var
R: TRect;
MonoBMP: TBitmap;
begin
if IsRectEmpty(ARect) or (AText = '') then Exit;
MonoBMP := TBitmap.Create;
try
with MonoBMP, Canvas do
begin
Monochrome := True;
Width := ARect.Right - ARect.Left;
Height := ARect.Bottom - ARect.Top;
Brush.Color := clWhite;
R := Rect(0, 0, Width, Height);
FillRect(R);
Font.Assign(ACanvas.Font);
SetBkMode(Handle, Windows.Transparent);
SetTextColor(Handle, 0);
DrawText(Handle, PChar(AText), Length(AText), R, AFlags);
end;
with ACanvas do
if TryLock then
try
SetTextColor(Handle, ColorToRGB(AColor));
SetBkColor(Handle, 0);
with ARect do
BitBlt(Handle, Left, Top, Right - Left, Bottom - Top, MonoBMP.Canvas.Handle, 0, 0, SrcInvert);
SetTextColor(Handle, ColorToRGB(Font.Color));
SetBkColor(Handle, ColorToRGB(Brush.Color));
finally
Unlock;
end;
finally
MonoBMP.Free;
end;
end;<br>
procedure TForm1.FormMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
const
Pos: TPoint = (X: -100; Y:-100);
begin
DrawXORText(Canvas, Bounds(Pos.X, Pos.Y, 100, 20), 'Test XOR', dt_SingleLine, clWhite);
Pos := Point(X, Y);
DrawXORText(Canvas, Bounds(Pos.X, Pos.Y, 100, 20), 'Test XOR', dt_SingleLine, clWhite);
end;<br>
</pre>
Gruß Hage
Comment