Club Delphi  
    FTP   CCD     Buscar   Trucos   Trabajo   Foros

Retroceder   Foros Club Delphi > Otros temas > Trucos
Registrarse FAQ Miembros Calendario Guía de estilo Buscar Temas de Hoy Marcar Foros Como Leídos

Los mejores trucos

 
 
Herramientas Buscar en Tema Desplegado
  #2  
Antiguo 16-01-2022
guspx guspx is offline
Miembro
 
Registrado: jun 2019
Posts: 17
Poder: 0
guspx Va por buen camino
Corrección

Para incluir si la letra es negrita o itálica:

Código Delphi [-]
function GdiPlusTextOut(Dc: HDC; x, y: Integer; stext: string): Integer;
var
  TempDc: HDC;
  oldbit, hbit: HBITMAP;
  fam: IgpFontFamily;
  f: IgpFont;
  tm: TTextMetric;
  oldfont, newfont: HFONT;
  lf: TLogFont;
  graphics: IgpGraphics;
  r: TGpRectF;
  w, h: Integer;
  curalign, curstretch, asc, desc: Integer;
  style: TgpFontStyle;
begin
  Result:= 0;
  oldfont:= GetCurrentObject(Dc, OBJ_FONT);
  if oldfont = 0 then
    exit;
  if GetObject(oldfont, sizeof(TLogFont), @lf) = 0 then
    exit;
  newfont:= CreateFontIndirect(lf);
  if newfont = 0 then
    exit;
  style:= [];
  if lf.lfWeight = FW_BOLD then
    style:= style + [FontStyleBold];
  if lf.lfItalic <> 0 then
    style:= style + [FontStyleItalic];
  if lf.lfUnderline <> 0 then
    style:= style + [FontStyleUnderline];
  TempDc:= CreateCompatibleDC(DC);
  fam:= tgpfontfamily.Create(lf.lfFaceName);
  graphics:= TgpGraphics.Create(Dc);
  f:= TGpFont.Create(Dc, newfont);
  GetTextMetrics(Dc, tm);
  curstretch:= SetStretchBltMode(Dc, COLORONCOLOR);
  try
    r:= graphics.MeasureString(stext, f, TGpPointF.Create(X, Y));
    w:= Ceil(r.Width);
    h:= tm.tmHeight;
    hbit:= CreateCompatibleBitmap(Dc, w, h);
    oldbit:= SelectObject(TempDc, hbit);
    oldfont:= SelectObject(TempDc, newfont);
    curalign:= SetTextAlign(TempDC, TA_LEFT or TA_TOP);
    try
      PatBlt(TempDc, 0, 0, w, h, WHITENESS);
      SetTextColor(TempDc, GetTextColor(Dc));
      SetBkMode(TempDc, TRANSPARENT);
      TextOut(TempDc, 0, 0, PChar(stext), Length(stext));
      asc:= Round(F.Size * fam.GetCellAscent(style) /
         fam.GetEmHeight(style));
      desc:= Round(F.Size * fam.GetCellDescent(style) /
         fam.GetEmHeight(style));
      TransparentBlt(Dc, x, y, w, asc + desc, TempDc, 0, tm.tmAscent - asc,
        w, asc + desc, $FFFFFF);
      Result:= asc + desc;
    finally
      SetTextAlign(TempDc, curalign);
      SelectObject(TempDC, oldfont);
      DeleteObject(newfont);
      SelectObject(TempDc, oldbit);
      DeleteObject(hbit);
    end;
  finally
    graphics:= nil;
    f:= nil;
    fam:= nil;
    SetStretchBltMode(Dc, curstretch);
    DeleteDC(TempDc);
  end;
end;

Última edición por Casimiro Notevi fecha: 16-01-2022 a las 19:19:28.
Responder Con Cita
 


Herramientas Buscar en Tema
Buscar en Tema:

Búsqueda Avanzada
Desplegado

Normas de Publicación
no Puedes crear nuevos temas
no Puedes responder a temas
no Puedes adjuntar archivos
no Puedes editar tus mensajes

El código vB está habilitado
Las caritas están habilitado
Código [IMG] está habilitado
Código HTML está deshabilitado
Saltar a Foro

Temas Similares
Tema Autor Foro Respuestas Último mensaje
Listado de tipos de letra jandro Varios 5 17-11-2009 23:49:46
TextBox escribir automaticamente letra por letra? Ejemplo Dentro! Gattaca Varios 2 21-03-2009 17:41:32
Relacion familias y articulos Espartaco SQL 7 20-06-2008 09:31:54
Codigos para impresoras: tipos de letra, orientacion hoja, etc Meneleo Impresión 1 11-03-2007 07:40:29
Familias de productos con TTreeView thunor Varios 0 10-08-2003 01:51:01


La franja horaria es GMT +2. Ahora son las 14:41:42.


Powered by vBulletin® Version 3.6.8
Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
Traducción al castellano por el equipo de moderadores del Club Delphi
Copyright 1996-2007 Club Delphi