Delphi-PRAXiS

Delphi-PRAXiS (https://www.delphipraxis.net/forum.php)
-   GUI-Design mit VCL / FireMonkey / Common Controls (https://www.delphipraxis.net/18-gui-design-mit-vcl-firemonkey-common-controls/)
-   -   Delphi Problem mit DrawFontIndirect (https://www.delphipraxis.net/53222-problem-mit-drawfontindirect.html)

Scorpion3000 12. Sep 2005 15:40


Problem mit DrawFontIndirect
 
Hallo!

Ich stehe vor einem Problem: Ich habe mir eine neue Komponente basierend auf TPageControl geschrieben. Im WM_Paint zeichne ich diese neu. Ist die Option Multiline aktiviert und wechselt man eine Zeit lang zwischen Tabs kommt es dann zu einem unschönen Fehler, der (so glaube ich) mit dem Aufruf "CreateFontIndirect" zusammen hängt. Ich bekomme, wenn dieser Fehler auftritt, kein Handle von "CreateFontIndriect" zurück. Dh. es ist im DC kein Font und somit stimmt die Schriftgröße, usw nicht mehr.

Delphi-Quellcode:
function TExtPageControl.FontToLogFont(Font: TFont): TLogFont;
begin
   //Font-Werte uebergeben
   FillChar(result, sizeof(TLogFont), #0);
   result.lfHeight:= Font.Height;
   if (fsBold in Font.Style) then
      result.lfWeight:= FW_BOLD
   else
      result.lfWeight:= FW_NORMAL;
   result.lfItalic       := byte(fsItalic in Font.Style);
   result.lfUnderline    := byte(fsUnderline in Font.Style);
   result.lfStrikeOut    := byte(fsStrikeOut in Font.Style);
   result.lfCharSet      := Font.Charset;
   result.lfOutPrecision := OUT_DEFAULT_PRECIS   ;
   result.lfClipPrecision := CLIP_LH_ANGLES or CLIP_DEFAULT_PRECIS ;
   result.lfQuality      := DEFAULT_QUALITY;
   result.lfPitchAndFamily:= byte(Font.Pitch);
   //Ausrichtung des Textes
   case TabPosition of
      tpLeft : result.lfEscapement:= 900;
      tpRight: result.lfEscapement:= -900;
   end;
   //Schriftart
   StrPCopy(result.lfFaceName, Font.Name);
end;

procedure TExtPageControl.WMPaint(var Message: TWMPaint);
var
   lpPaint : tagPaintStruct;
   HBr     : HBrush;
   HPe     : HPen;
   HFo     : HFont;
   Rect    : TRect;
   i1, i2   : integer;
   lf      : TLogFont;
   b1       : boolean;
begin
   AllocConsole;

   //Falls noch kein DC wird es ueber BeginPaint erstellt
   if Message.DC = 0 then begin
      BeginPaint(Handle, lpPaint);
      Message.DC:= lpPaint.hdc;
   end;

   //Zeichnen der Tabs (falls vorhanden)
   if PageCount > 0 then begin
      i1:= -1;
      //Hintergrundfarbe -> Transparent
      SetBKMode(Message.DC, TRANSPARENT);
      //Font umwandeln in LogFont
      LF:= FontToLogFont(Font);
      //Font erstellen
      HFo:= CreateFontIndirect(lf);
      SelectObject(Message.DC, HFo);
      if Hfo = 0 then begin
         Writeln('ERROR HFO');
      end;
      CreateMultiLineTabList;
      //Wenn mindestens ein Tab sichtbar
      if NextTabListItemExists(-1) then begin
         i1:= -1;
         //Zeichnen der sichtbaren Tabs
         repeat
            inc(i1);
            //Zeichnen des Tabs
            DrawTab(Message.DC, FTabList[i1].Index, FTabList[i1].Rect);
         until not NextTabListItemExists(i1);
      end;  
      //Objects loeschen
      DeleteObject(HBr);
      DeleteObject(HPe);
      DeleteObject(HFo);
   end;

  //Wenn BeginPaint ausgefuehrt wurde, EndPaint ausfuehren
   if lpPaint.hdc <> 0 then
      EndPaint(Handle, lpPaint);
   //Damit Windows nit arbeiten muss (Result = 1)
   Message.Result:= 1;
end;
Ich hoff ihr könnt mir helfen.

Mfg Scorpion3000

Flocke 12. Sep 2005 16:33

Re: Problem mit DrawFontIndirect
 
1. (habe ich letztens noch irgendwo geschrieben) Du musst Objekte, die du mit SelectObject in einen DC selektierst, auch wieder deselektieren. Die richtige Vorgehensweise ist:
Delphi-Quellcode:
OldObject := SelectObject(DC, NewObject);
// Zeichen etc.
SelectObject(DC, OldObject);
Und das gilt für jeden Handle-Typen separat, also für HBRUSH, HPEN, HBITMAP und HFONT.

2. Die Aussage
Delphi-Quellcode:
  //Wenn BeginPaint ausgefuehrt wurde, EndPaint ausfuehren
   if lpPaint.hdc <> 0 then
im Kommentar stimmt nicht ganz, denn lpPaint ist gänzlich uninitialisiert wenn Message.DC<>0 war. Du hast also eine Chance von 1:2^32 dass in diesem Fall in lpPaint.hdc ein Zufallswert <> 0 drinsteht.

Scorpion3000 12. Sep 2005 18:38

Re: Problem mit DrawFontIndirect
 
Danke! Werds gleich mal ausprobieren (Hab grad in der MSDN nachgelesen (die Sache mit SelectObject) Is mir irgendwie unter den Tisch gerutscht)

Scorpion3000 12. Sep 2005 18:47

Re: Problem mit DrawFontIndirect
 
Hey danke!!! An dem hats gelegen!!! :dancer:


Alle Zeitangaben in WEZ +1. Es ist jetzt 00:28 Uhr.

Powered by vBulletin® Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
LinkBacks Enabled by vBSEO © 2011, Crawlability, Inc.
Delphi-PRAXiS (c) 2002 - 2023 by Daniel R. Wolf, 2024 by Thomas Breitkreuz