AGB  ·  Datenschutz  ·  Impressum  







Anmelden
Nützliche Links
Registrieren
Zurück Delphi-PRAXiS Code-Bibliothek Neuen Beitrag zur Code-Library hinzufügen Font aus Resource laden ohne zwischenspeichern

Font aus Resource laden ohne zwischenspeichern

Ein Thema von turboPASCAL · begonnen am 7. Aug 2011
Antwort Antwort
Benutzerbild von turboPASCAL
turboPASCAL

Registriert seit: 8. Mai 2005
Ort: Sondershausen
4.274 Beiträge
 
Delphi 6 Personal
 
#1

Font aus Resource laden ohne zwischenspeichern

  Alt 7. Aug 2011, 09:12
Manchmal ist es nötig oder gewollt einen eigenen Font in sein Programm einzubauen.
Mit dieser Version ist es nicht nötig den Font der in der Resourcedatei eingebunden
wurde Temporär auszulagern.

Zur einfachen Verwendung habe ich eine kleine Klasse daraus gemacht die sowohl
in der VCL und nonVCL Programmierung verwendet werden kann.

Da es den Anschein hat das der Resourcencompieler (BRCC32.exe) Probleme hat,
jedenfalls bei meinem Delphi 6, im Resourcenscript (*.rc) mit dem Resourcentyp "FONT"
und eingebundenen Truetypefont ist nun ein neuer Resourcentyp an Bord mit dem Namen "RCFONT".



Delphi-Quellcode:
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, ExtCtrls, Classes, Controls, Graphics, Forms,
  Dialogs, StdCtrls;

const
  RT_RCFONT = 'RCFONT';

type
  TResourceFont = class
  private
    fntBuffer: Pointer;
    fntSize: Integer;
    fntHandle: DWORD;
    fFontLoaded: Boolean;
    function AddFontRes(Instance: DWORD; ResName: PChar): Boolean;
    function DeleteFontRes: Boolean;
  public
    constructor Create(Instance: THandle; ResName: PChar);
    destructor Destroy; override;
    property Loaded: Boolean read fFontLoaded;
  end;

type
  TForm1 = class(TForm)
    Label1: TLabel;
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
  private
    { Private-Deklarationen }
    ResourceFont: TResourceFont;
  public
    { Public-Deklarationen }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

// --- TResourceFont - Class -------------------------------------------------
// Optimiert für nonVCL

constructor TResourceFont.Create(Instance: THandle; ResName: PChar);
begin
  fFontLoaded := AddFontRes(Instance, ResName);
end;

destructor TResourceFont.Destroy;
begin
  DeleteFontRes;
  inherited Destroy;
end;

function TResourceFont.AddFontRes(Instance: DWORD; ResName: PChar): Boolean;
var
  hResInfo: DWORD;
  hResData: DWORD;
  pResource: Pointer;
  ResFontCount: DWord;
begin
  // Font aus Resource laden
  hResInfo := FindResource(Instance, ResName, RT_RCFONT);
  hResData := LoadResource(Instance, hResInfo);
  if hResData <> 0 then
  begin
    // wenn Fnt.-Daten vorhanden weiter
    fntSize := SizeOfResource(Instance, hResInfo);
    pResource := LockResource(hResData);

    // Fnt.-Daten (die komplette Datei) in den Speicher ("fntBuffer") laden
    GetMem(fntBuffer, fntSize);
    CopyMemory(fntBuffer, pResource, fntSize);
    
    // ein Font mit einem Font
    ResFontCount := 1;

    // Font "systemweit" hinzufügen
    fntHandle := AddFontMemResourceEx(fntBuffer, fntSize, nil, @ResFontCount);

    // Windows mitteilen das Änderungen an den Fonts vorgenommen wurde
    PostMessage(HWND_BROADCAST, WM_FONTCHANGE, 0, 0);

    // Resourcenspeicher freigeben
    UnlockResource(hResData);
  end else
    MessageBox(GetForegroundWindow, PCHAR('Font-Resourse not found.'), '!', MB_ICONWARNING);

  FreeResource(hResData);

  Result := fntHandle <> 0;
end;

function TResourceFont.DeleteFontRes: Boolean;
begin
  Result := False;
  
  if fntHandle <> 0 then
  begin
    FreeMem(fntBuffer, fntSize);
    Result := RemoveFontMemResourceEx(fntHandle);
    SendMessage(HWND_BROADCAST, WM_FONTCHANGE, 0, 0);
  end;
end;

// --- TForm1 ----------------------------------------------------------------

procedure TForm1.FormCreate(Sender: TObject);
begin
  // ResourceFont := TResourceFont.Create(hInstance, 'MEIN_FONT'); //
  ResourceFont := TResourceFont.Create(hInstance, MAKEINTRESOURCE(100));

  if ResourceFont.Loaded then
  begin
    Label1.Font.Name := 'TR';
    Label1.Font.Size := 18;
    Label1.Caption := 'Font from Resource.';
  end;
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  ResourceFont.Destroy;
end;

end.
Angehängte Dateien
Dateityp: zip ResFontSample.zip (244,6 KB, 56x aufgerufen)
Matti
Meine Software-Projekte - Homepage - Grüße vom Rüsselmops -Mops Mopser

Geändert von turboPASCAL ( 9. Aug 2011 um 17:35 Uhr)
  Mit Zitat antworten Zitat
Themen-Optionen Thema durchsuchen
Thema durchsuchen:

Erweiterte Suche
Ansicht

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 18:05 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