Zusi-Forum

Code: Alles auswählen

function TD3DZusiFont.TexturGenerieren(const strFontName: PChar; Hoehe, Flags: DWORD):HResult;
type
  pBit = array[0..0] of DWORD;
  PpBit = ^pBit;
var
  hndFont,
  hndFontOld: Windows.HFONT;  //Font-Handles
  hDC: Windows.HDC;
  hndBitmap: HBITMAP;         //Bmp-Handle
  hbmOld: HGDIOBJ;
  ErsterDurchlauf: Boolean;   // Flag clear after first run
  pBitmapBits: PpBit;         //Pointer auf Device-Independent bmp
  bmpInfo: TBitmapInfo;
  x, y: DWORD;
  d3dlr: TD3DLockedRect;
  pDstRow: PByte;
  pDst16: PWord;
  bAlpha: Byte;               // 4-bit measure of pixel intensity
  a: LongWord;
  FontName:TFontName;
begin
  StrLCopy(FontName, strFontName, SizeOf(FontName) div SizeOf(Char));
  FontName[SizeOf(FontName) div SizeOf(Char) - 1]:= #0;
  FontHoehe:=Hoehe;
  FontFlags:=Flags; // or D3DFONT_FILTERED;

  hndFont:=0;
  hndFontOld:=0;
  hndBitmap:=0;
  hbmOld := 0;

  // Assume we will draw fonts into texture without scaling unless the
  // required texture size is found to be larger than the device max
  Skalierungsfaktor:=1.0;

  hDC:=CreateCompatibleDC(0);
  SetMapMode(hDC, MM_TEXT);

  Result:=CreateGDIFont(FontName, hDC, hndFont);
  if succeeded(Result) then
  begin
    hndFontOld:=SelectObject(hDC, hndFont);

    // Calculate the dimensions for the smallest power-of-two texture which
    // can hold all the printable characters
    TexturHoehe:=128;
    TexturBreite:=TexturHoehe;
    Result:=PaintAlphabet(strFontName, hDC, True);
    while (Result=D3DERR_MOREDATA) do
    begin
      TexturBreite:=TexturBreite*2;
      TexturHoehe:=TexturHoehe*2;
      Result:=PaintAlphabet(strFontName, hDC, True);
    end;

    //Texturgröße der Graka überschritten ?
    if (TexturBreite>d3dCaps.MaxTextureWidth) then
    begin
      Skalierungsfaktor:=d3dCaps.MaxTextureWidth/TexturBreite;
      TexturHoehe:=d3dCaps.MaxTextureWidth;
      TexturBreite:=TexturHoehe;

      ErsterDurchlauf:= True;
      repeat
        // If we've already tried fitting the new text, the scale is still
        // too large. Reduce and try again.
        if not ErsterDurchlauf then Skalierungsfaktor:=Skalierungsfaktor * 0.9;

        // The font has to be scaled to fit on the maximum texture size; our
        // current font is too big and needs to be recreated to scale.
        DeleteObject(SelectObject(hDC, hndFontOld));

        Result:=CreateGDIFont(FontName, hDC, hndFont);
        if succeeded(Result) then
        begin
          hndFontOld:=SelectObject(hDC, hndFont);
          ErsterDurchlauf:=False;

          Result:=PaintAlphabet(strFontName, hDC, True);
        end
      
      until Result<>D3DERR_MOREDATA;
    end;

    if succeeded(Result) then
    begin
      Result:=pIDirect3DDevice9^.CreateTexture( TexturBreite,
                                                TexturHoehe,
                                                1,
                                                0,
                                                D3DFMT_A4R4G4B4,
                                                Zusi_TexStandardPool,
                                                FontTexture,
                                                nil);
      if succeeded(Result) then
      begin
        // Prepare to create a bitmap
        ZeroMemory(@(bmpInfo.bmiHeader), SizeOf(TBitmapInfoHeader));
        bmpInfo.bmiHeader.biSize:=SizeOf(TBitmapInfoHeader);
        bmpInfo.bmiHeader.biWidth:=TexturBreite;
        bmpInfo.bmiHeader.biHeight:=TexturHoehe;
        bmpInfo.bmiHeader.biPlanes:=1;
        bmpInfo.bmiHeader.biCompression:=BI_RGB;
        bmpInfo.bmiHeader.biBitCount:=32;
        bmpInfo.bmiHeader.biHeight:=-bmpInfo.bmiHeader.biHeight;

        // Create a bitmap for the font
        hndBitmap:=CreateDIBSection(hDC, bmpInfo, DIB_RGB_COLORS, Pointer(pBitmapBits), 0, 0);

        hbmOld:=SelectObject(hDC, hndBitmap);

        // Set text properties
        SetTextColor(hDC, RGB(255, 255, 255));
        SetBkColor(hDC, $00000000);
        SetTextAlign(hDC, TA_TOP);

        // Paint the alphabet onto the selected bitmap
        Result:=PaintAlphabet(strFontName, hDC, False);
        if succeeded(Result) then
        begin
          // Lock the surface and write the alpha values for the set pixels
          FontTexture.LockRect(0, d3dlr, nil, 0);
          pDstRow := d3dlr.pBits;
          {$R-} //wegen der shr/shl-Aktionen
          for y := 0 to (TexturHoehe - 1) do
          begin
            pDst16 := PWord(pDstRow);
            for x := 0 to (TexturBreite - 1) do
            begin
              bAlpha := (pBitmapBits^[TexturBreite*y + x] and $ff) shr 4;
              if (bAlpha > 0) then
              begin
                pDst16^ := Word((bAlpha shl 12) or $0fff);
                Inc(pDst16);
              end else
              begin
                pDst16^ := $0000;    //  <--------------------- Zugriffsverletzung
                Inc(pDst16);
              end;
            end;
            pDstRow := PByte(Integer(pDstRow) + d3dlr.Pitch);
          end;
          {$R-}

             
          Result:= S_OK;
        end;

      end

    end

  end
  
  if (FontTexture<>nil) then FontTexture.UnlockRect(0);

  SelectObject(hDC, hbmOld);
  SelectObject(hDC, hndFontOld);
  DeleteObject(hndBitmap);
  DeleteObject(hndFont);
  DeleteDC(hDC);
end;

Code: Alles auswählen

pDstRow := PByte(Integer(pDstRow) + d3dlr.Pitch);