From 3884615b5c77ed14062147a853eca064a3a59130 Mon Sep 17 00:00:00 2001 From: sekelsenmat Date: Thu, 22 Dec 2011 15:21:21 +0000 Subject: [PATCH] Starts native text for LCL-CustomDrawn-Windows git-svn-id: trunk@34362 - --- .../customdrawn/customdrawndefines.inc | 2 +- .../customdrawn/customdrawnwinapi_win.inc | 112 ++++++++++++++---- lcl/lazcanvas.pas | 24 ++++ 3 files changed, 112 insertions(+), 26 deletions(-) diff --git a/lcl/interfaces/customdrawn/customdrawndefines.inc b/lcl/interfaces/customdrawn/customdrawndefines.inc index ca0b29eaf4..04d1633cd9 100644 --- a/lcl/interfaces/customdrawn/customdrawndefines.inc +++ b/lcl/interfaces/customdrawn/customdrawndefines.inc @@ -32,7 +32,7 @@ {$endif} // Default options for various backends -{$if defined(CD_Android)} +{$if defined(CD_Android) or defined(CD_Windows)} {$define CD_UseNativeText} {$endif} diff --git a/lcl/interfaces/customdrawn/customdrawnwinapi_win.inc b/lcl/interfaces/customdrawn/customdrawnwinapi_win.inc index d844ad06d6..f87de31740 100644 --- a/lcl/interfaces/customdrawn/customdrawnwinapi_win.inc +++ b/lcl/interfaces/customdrawn/customdrawnwinapi_win.inc @@ -1367,7 +1367,20 @@ function TCDWidgetSet.ExtTextOut(DC: HDC; X, Y: Integer; Options: Longint; Rect: var s: AnsiString; w: WideString; + WinDC: HDC; + WinBitmap: HBITMAP; + WinDCBitmapOld: HGDIOBJ; + lRawImage: TRawImage; + WinRect: TRect; + LazImage: TLazIntfImage; + lCanvas: TLazCanvas; + LazDC: TLazCanvas absolute DC; + lSize: Types.TSize; + Info: Windows.TBitmapInfo; + BitsPtr: Pointer = nil; begin + if DC = 0 then Exit; + // use temp buffer, if count is set, there might be no null terminator if count = -1 then s := str @@ -1376,10 +1389,59 @@ begin SetLength(s, count); move(str^, PChar(s)^, count); end; + if Length(s) = 0 then Exit; + + // Buffer bitmap preparation + WinDC := Windows.CreateCompatibleDC(0); + if Rect = nil then + begin + GetTextExtentPoint(WinDC, Str, Count, lSize); + end + else + begin + lSize.cx := Rect^.Right - Rect^.Left; + lSize.cy := Rect^.Bottom - Rect^.Top; + end; + + // Allocate a DIBSection, Windows itself will allocate the memory for the image + FillChar(Info, SizeOf(Info), 0); + Info.bmiHeader.biSize := SizeOf(Info.bmiHeader); + Info.bmiHeader.biWidth := lSize.cx; + Info.bmiHeader.biHeight := -lSize.cy; // request top down + Info.bmiHeader.biPlanes := 1; + Info.bmiHeader.biBitCount := 32; + Info.bmiHeader.biCompression := BI_RGB; + + WinBitmap := Windows.CreateDIBSection(WinDC, Info, DIB_RGB_COLORS, BitsPtr, 0, 0); + + // Now connect the Windows bitmap to our own + lRawImage.Init; + lRawImage.Description.Init_BPP32_B8G8R8_M1_BIO_TTB(lSize.cx, lSize.cy); + lRawImage.Data := BitsPtr; + lRawImage.DataSize := lSize.cx * lSize.cy * 4; + LazImage := TLazIntfImage.Create(lRawImage, False); + lCanvas := TLazCanvas.Create(LazImage); + lCanvas.FillColor(colWhite, True); + + WinDCBitmapOld := Windows.SelectObject(WinDC, WinBitmap); + Windows.SelectObject(WinDC, GetStockObject(SYSTEM_FONT)); + Windows.SetTextColor(WinDC, clBlack); + // the length of utf8 vs Wide/Ansi the strings differ, so recalc. // TODO: use the real number of chars (and not the lenght) W := UTF8ToUTF16(S); - Result := Windows.ExtTextOutW(DC, X, Y, Options, LPRECT(Rect), PWideChar(W), Length(W), Dx); + WinRect := Bounds(0, 0, lSize.cx, lSize.cy); + Result := Windows.ExtTextOutW(WinDC, 0, 0, Options, nil, PWideChar(W), Length(W), Dx); + + // Draw the output to the canvas + LazDC.AlphaBlendIgnoringDestPixels(lCanvas, X, Y, 0, 0, lSize.cx, lSize.cy); + + // Cleanup + lCanvas.Free; + LazImage.Free; + Windows.SelectObject(WinDC, WinDCBitmapOld); + Windows.DeleteObject(WinBitmap); + Windows.ReleaseDC(0, WinDC); end; {$endif} @@ -2033,19 +2095,17 @@ begin Result := Windows.GetSystemMetrics(NIndex); end; -(*function TWin32WidgetSet.GetTextColor(DC: HDC): TColorRef; -begin - Result := TColorRef(Windows.GetTextColor(DC)); -end; - +{$ifdef CD_UseNativeText} // MaxCount is provided in the number of UTF-8 characters, not bytes -function TWin32WidgetSet.GetTextExtentExPoint(DC: HDC; Str: PChar; +function TCDWidgetSet.GetTextExtentExPoint(DC: HDC; Str: PChar; Count, MaxWidth: Integer; MaxCount, PartialWidths: PInteger; var Size: TSize): Boolean; var LCLStr: string; - s: AnsiString; w: WideString; + WinDC: HDC; begin + WinDC := Windows.CreateCompatibleDC(0); + // use temp buffer, if count is set, there might be no null terminator if count = -1 then LCLStr := Str @@ -2055,22 +2115,14 @@ begin move(str^, PChar(LCLStr)^, count); end; // the length of utf8 vs Wide/Ansi the strings differ, so recalc. - if UnicodeEnabledOS then - begin - // TODO: use the real number of chars (and not the length) - w := UTF8ToUTF16(LCLStr); - Result := Windows.GetTextExtentExPointW(DC, PWideChar(W), Length(W), - MaxWidth, MaxCount, PartialWidths, Size); - end - else - begin - s := Utf8ToAnsi(LCLStr); - Result := Windows.GetTextExtentExPoint(DC, pchar(s), length(s), - MaxWidth, MaxCount, PartialWidths, Size); - end; -end;*) + // TODO: use the real number of chars (and not the length) + w := UTF8ToUTF16(LCLStr); + Result := Windows.GetTextExtentExPointW(WinDC, PWideChar(W), Length(W), + MaxWidth, MaxCount, PartialWidths, Size); + + Windows.ReleaseDC(0, WinDC); +end; -{$ifdef CD_UseNativeText} {------------------------------------------------------------------------------ Method: GetTextExtentPoint Params: DC - handle of device context @@ -2086,7 +2138,10 @@ function TCDWidgetSet.GetTextExtentPoint(DC: HDC; Str: PChar; Count: Integer; va var s: AnsiString; w: WideString; + WinDC: HDC; begin + WinDC := Windows.CreateCompatibleDC(0); + // use temp buffer, if count is set, there might be no null terminator if count = -1 then s := str @@ -2098,7 +2153,10 @@ begin // the length of utf8 vs Wide/Ansi the strings differ, so recalc. // TODO: use the real number of chars (and not the length) w := UTF8ToUTF16(S); - Result := Windows.GetTextExtentPoint32W(DC, PWideChar(W), Length(W), @Size); + Result := Windows.GetTextExtentPoint32W(WinDC, PWideChar(W), Length(W), @Size); + + Windows.ReleaseDC(0, WinDC); + Result := True; end; {------------------------------------------------------------------------------ @@ -2110,8 +2168,12 @@ end; Fills the specified buffer with the metrics for the currently selected font. ------------------------------------------------------------------------------} function TCDWidgetSet.GetTextMetrics(DC: HDC; Var TM: TTextMetric): Boolean; +var + WinDC: HDC; begin - Result := Boolean(Windows.GetTextMetrics(DC, @TM)); + WinDC := Windows.CreateCompatibleDC(0); + Result := Boolean(Windows.GetTextMetrics(WinDC, @TM)); + Windows.ReleaseDC(0, WinDC); end; {$endif} diff --git a/lcl/lazcanvas.pas b/lcl/lazcanvas.pas index 6ef6608269..069906d83e 100644 --- a/lcl/lazcanvas.pas +++ b/lcl/lazcanvas.pas @@ -120,6 +120,10 @@ type procedure FillRect(const ARect: TRect); procedure FillRect(X1,Y1,X2,Y2: Integer); {$endif} + // Fills the entire drawing with a color + // AIgnoreClippingAndWindowOrg speeds up the drawing a lot, but it is dangerous, + // don't use it unless you know what you are doing! + procedure FillColor(AColor: TFPColor; AIgnoreClippingAndWindowOrg: Boolean = False); // Utilized by LCLIntf.SelectObject and by RestoreState // This needed to be added because Pen/Brush.Assign raises exceptions procedure AssignPenData(APen: TFPCustomPen); @@ -626,6 +630,26 @@ procedure TLazCanvas.FillRect(X1, Y1, X2, Y2: Integer); begin FillRect (Rect(X1,Y1,X2,Y2)); end; + +procedure TLazCanvas.FillColor(AColor: TFPColor; + AIgnoreClippingAndWindowOrg: Boolean); +var + x, y: Integer; +begin + if AIgnoreClippingAndWindowOrg then + begin + for y := 0 to Height-1 do + for x := 0 to Width-1 do + Image.Colors[x, y] := AColor; + end + else + begin + for y := 0 to Height-1 do + for x := 0 to Width-1 do + SetColor(x, y, AColor); + end; +end; + {$endif} procedure TLazCanvas.AssignPenData(APen: TFPCustomPen);