AGB  ·  Datenschutz  ·  Impressum  







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

Problem mit DrawFontIndirect

Ein Thema von Scorpion3000 · begonnen am 12. Sep 2005 · letzter Beitrag vom 12. Sep 2005
 
Scorpion3000

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

Problem mit DrawFontIndirect

  Alt 12. Sep 2005, 15: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
 


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 19:27 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