AGB  ·  Datenschutz  ·  Impressum  







Anmelden
Nützliche Links
Registrieren
Thema durchsuchen
Ansicht
Themen-Optionen

Stringlänge parsen

Ein Thema von EWeiss · begonnen am 4. Sep 2017 · letzter Beitrag vom 7. Sep 2017
 
TiGü

Registriert seit: 6. Apr 2011
Ort: Berlin
3.074 Beiträge
 
Delphi 10.4 Sydney
 
#11

AW: Stringlänge parsen

  Alt 4. Sep 2017, 14:45
Ich mache es hier mit aber erst dann wenn ich den längsten String ermittelt habe. (einmalig..)

Delphi-Quellcode:
function GetTextBound(UseText: WideString; UseFont: WideString; UseSize: single; var bW: integer;
  var bH: integer; UseStrFormat: integer): GPSTATUS; stdcall;
var
  Graphics: cardinal;
  Fam: GpFontFamily;
  TempFont: GpFont;
  DC: HDC;
begin

  result := GenericError;
  strFormat := nil;
  Fam := nil;
  // Create matching font
  try
    GdipCheck(GdipCreateFontFamilyFromName(UseFont, nil, Fam));
    if Assigned(Fam) then
    begin
      GdipCheck(GdipCreateFont(Fam, UseSize, 0, 2, TempFont));
      if Assigned(TempFont) then
      begin
        DC := GetDC(GetDesktopWindow);

        GdipCheck(GdipCreateStringFormat(0, 0, strFormat));
        GdipCheck(GdipCreateFromHDC(DC, Graphics));

        GdipCheck(GdipMeasureString(Graphics, PWideChar(UseText), length(UseText), TempFont,
            @layoutRect, strFormat, @boundingBox, nil, nil));

        if Assigned(strFormat) then
          GdipCheck(GdipDeleteStringFormat(strFormat));

        bW := round(boundingBox.Width - boundingBox.X);
        bH := round(boundingBox.Height - boundingBox.Y);

        if UseStrFormat <> 0 then
          Swap(bW, bH);

        ReleaseDc(GetDesktopWindow, DC);
      end;
    end;
  finally
    if Graphics <> 0 then
      GdipCheck(GdipDeleteGraphics(Graphics));
    if Assigned(TempFont) then
      GdipCheck(GdipDeleteFont(TempFont)); // Lösche das Font Object
    if Assigned(Fam) then
      GdipCheck(GdipDeleteFontFamily(Fam)); // Lösche das Font Family Object
  end;

end;
Ich will ja nicht meckern, aber hast du das gerade aus dem Gedächtnis abgetippt oder irgendwoher kopiert?
Weil so kompiliert es zumindest in höheren Versionen (Berlin, Tokyo) nicht.
Ggf. unterscheidet sich der dort mitgelieferte übersetzte Header Winapi.GDIAPI.pas (von http://www.progdigy.com, hgourvest@progdigy.com, 15-02-2002) von deiner GDIPlus-Unit.
Ist die selbstgemacht oder irgendwoher kopiert?

Außerdem sind da einige Fehler drin, die ein funktionieren unmöglich gemacht haben.
Hier eine entsprechende korrigierte Version:

Delphi-Quellcode:
function GetTextBound(UseText: WideString; UseFont: WideString; UseSize: single; var bW: integer;
  var bH: integer; UseStrFormat: integer): GPSTATUS; stdcall;
var
  Graphics: GPGRAPHICS; // Tigü: Hier war ein falscher Typ (Cardinal)
  Fam: GpFontFamily;
  TempFont: GpFont;
  DC: HDC;
  strFormat: GPSTRINGFORMAT; // Tigü: war nicht definiert
  boundingBox, layoutRect: TGPRectF; // Tigü: war nicht definiert
begin
  Result := GPSTATUS.GenericError; // Tigü: Result ist immer GenericError?? Wird nirgens auf GPStatus.ok gesetzt
  strFormat := nil;
  Fam := nil;
  TempFont := nil; // Tigü: war nicht initialisiert!
  // Create matching font
  try
    GdipCheck(GdipCreateFontFamilyFromName(PWideChar(UseFont), nil, Fam)); // Tigü: PWideChar fehlte
    if Assigned(Fam) then
    begin
      GdipCheck(GdipCreateFont(Fam, UseSize, 0, 2, TempFont));
      if Assigned(TempFont) then
      begin
        DC := GetDC(GetDesktopWindow);

        GdipCheck(GdipCreateStringFormat(0, 0, strFormat));
        GdipCheck(GdipCreateFromHDC(DC, Graphics));

        FillChar(boundingBox, SizeOf(boundingBox), 0); // Tigü: waren nicht initialisiert, Werte waren "unendlich" klein oder groß
        FillChar(layoutRect, SizeOf(layoutRect), 0); // Tigü: waren nicht initialisiert, Werte waren "unendlich" klein oder groß
                                                                  //
        GdipCheck(GdipMeasureString(Graphics, PWideChar(UseText), Length(UseText), TempFont,
          @layoutRect, strFormat, @boundingBox, nil, nil));

        if Assigned(strFormat) then
          GdipCheck(GdipDeleteStringFormat(strFormat));

        bW := round(boundingBox.Width - boundingBox.x);
        bH := round(boundingBox.Height - boundingBox.y);

        if UseStrFormat <> 0 then
          Swap(bW, bH);

        if (bW <> 0) or (bH <> 0) then
          Result := GPSTATUS.Ok; // Tigü: Wenns klappt, sollte das so auch per Result mitgeteilt werden!!

        ReleaseDc(GetDesktopWindow, DC);
      end;
    end;
  finally
    if Assigned(Graphics) then // Tigü: entsprechend des neuen Typs anpassen
      GdipCheck(GdipDeleteGraphics(Graphics));
    if Assigned(TempFont) then
      GdipCheck(GdipDeleteFont(TempFont)); // Lösche das Font Object
    if Assigned(Fam) then
      GdipCheck(GdipDeleteFontFamily(Fam)); // Lösche das Font Family Object
  end;
end;

Geändert von TiGü ( 4. Sep 2017 um 14:54 Uhr)
  Mit Zitat antworten Zitat
 


Forumregeln

Es ist dir nicht erlaubt, neue Themen zu verfassen.
Es ist dir nicht erlaubt, auf Beiträge zu antworten.
Es ist dir nicht erlaubt, Anhänge hochzuladen.
Es ist dir nicht erlaubt, deine Beiträge zu bearbeiten.

BB-Code ist an.
Smileys sind an.
[IMG] Code ist an.
HTML-Code ist aus.
Trackbacks are an
Pingbacks are an
Refbacks are aus

Gehe zu:

Impressum · AGB · Datenschutz · Nach oben
Alle Zeitangaben in WEZ +1. Es ist jetzt 11:23 Uhr.
Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
LinkBacks Enabled by vBSEO © 2011, Crawlability, Inc.
Delphi-PRAXiS (c) 2002 - 2023 by Daniel R. Wolf, 2024-2025 by Thomas Breitkreuz