Einzelnen Beitrag anzeigen

Scorpion3000

Registriert seit: 18. Apr 2004
47 Beiträge
 
Delphi 7 Enterprise
 
#1

Problem mit DrawFontIndirect

  Alt 12. Sep 2005, 16:40
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
  Mit Zitat antworten Zitat