home *** CD-ROM | disk | FTP | other *** search
/ Chip 2004 May / CMCD0504.ISO / Software / Freeware / Programare / gdiplusdelphi / demos / Using Text and Fonts / Enumerating Installed Fonts / GDITEST53.dpr
Encoding:
Text File  |  2003-10-15  |  3.6 KB  |  140 lines
  1. program GDITEST53;
  2.  
  3. uses
  4.   Windows,
  5.   Messages,
  6.   SysUtils,
  7.   GDIPAPI,
  8.   GDIPOBJ;
  9.  
  10.  
  11. Procedure OnPaint(DC: HDC);
  12. var
  13.   i: Integer;
  14.   graphics : TGPGraphics;
  15.  
  16.   fontFamily: TGPFontFamily;
  17.   font: TGPFont;
  18.   rectF: TGPRectF;
  19.   solidBrush: TGPSolidBrush;
  20.  
  21.   count: Integer;
  22.   found: Integer;
  23.   familyName: String;
  24.   familyList: string;
  25.   pFontFamily: array of TGPFontFamily;
  26.  
  27.   installedFontCollection: TGPInstalledFontCollection ;
  28. begin
  29.   graphics := TGPGraphics.Create(DC);
  30.  
  31.   fontFamily:= TGPFontFamily.Create('Arial');
  32.   font:= TGPFont.Create(fontFamily, 10, FontStyleRegular, UnitPoint);;
  33.   rectF:= MakeRect(10.0, 10.0, 500.0, 500.0);
  34.   solidBrush:= TGPSolidBrush.Create(MakeColor(255, 0, 0, 0));
  35.  
  36.   found:= 0;
  37.  
  38.   InstalledFontCollection := TGPinstalledFontCollection.Create;
  39.  
  40.   // How many font families are installed?
  41.   count := installedFontCollection.GetFamilyCount;
  42.  
  43.   // Allocate a buffer to hold the array of FontFamily
  44.   // objects returned by GetFamilies.
  45.   setLength(pFontFamily, count);
  46.   for i := 0 to count - 1 do
  47.     pFontFamily[i] := TGPFontFamily.Create;
  48.  
  49.   // Get the array of FontFamily objects.
  50.   installedFontCollection.GetFamilies(count, pFontFamily, found);
  51.  
  52.   // The loop below creates a large string that is a comma-separated
  53.   // list of all font family names.
  54.  
  55.   for i := 0 to count - 1 do
  56.   begin
  57.    pFontFamily[i].GetFamilyName(familyName);
  58.    familyList := familyList + familyName + ', ';
  59.    pFontFamily[i].Free;
  60.   end;
  61.  
  62.   // Draw the large string (list of all families) in a rectangle.
  63.   graphics.DrawString(familyList, -1, font, rectF, nil, solidBrush);
  64.  
  65.  
  66.   Finalize(pFontFamily);
  67.   fontFamily.Free;
  68.   font.Free;
  69.   solidBrush.Free;
  70.   installedFontCollection.Free;
  71.   graphics.Free;
  72. end;
  73.  
  74.  
  75. function WndProc(Wnd : HWND; message : UINT; wParam : Integer; lParam: Integer) : Integer; stdcall;
  76. var
  77.   Handle: HDC;
  78.   ps: PAINTSTRUCT;
  79. begin
  80.   case message of
  81.     WM_PAINT:
  82.       begin
  83.         Handle := BeginPaint(Wnd, ps);
  84.         OnPaint(Handle);
  85.         EndPaint(Wnd, ps);
  86.         result := 0;
  87.       end;
  88.  
  89.     WM_DESTROY:
  90.       begin
  91.         PostQuitMessage(0);
  92.         result := 0;
  93.       end;
  94.  
  95.    else
  96.       result := DefWindowProc(Wnd, message, wParam, lParam);
  97.    end;
  98. end;
  99.  
  100. var
  101.   hWnd     : THandle;
  102.   Msg      : TMsg;
  103.   wndClass : TWndClass;
  104. begin
  105.    wndClass.style          := CS_HREDRAW or CS_VREDRAW;
  106.    wndClass.lpfnWndProc    := @WndProc;
  107.    wndClass.cbClsExtra     := 0;
  108.    wndClass.cbWndExtra     := 0;
  109.    wndClass.hInstance      := hInstance;
  110.    wndClass.hIcon          := LoadIcon(0, IDI_APPLICATION);
  111.    wndClass.hCursor        := LoadCursor(0, IDC_ARROW);
  112.    wndClass.hbrBackground  := HBRUSH(GetStockObject(WHITE_BRUSH));
  113.    wndClass.lpszMenuName   := nil;
  114.    wndClass.lpszClassName  := 'GettingStarted';
  115.  
  116.    RegisterClass(wndClass);
  117.  
  118.    hWnd := CreateWindow(
  119.       'GettingStarted',       // window class name
  120.       'Enumerating Installed Fonts',       // window caption
  121.       WS_OVERLAPPEDWINDOW,    // window style
  122.       Integer(CW_USEDEFAULT), // initial x position
  123.       Integer(CW_USEDEFAULT), // initial y position
  124.       Integer(CW_USEDEFAULT), // initial x size
  125.       Integer(CW_USEDEFAULT), // initial y size
  126.       0,                      // parent window handle
  127.       0,                      // window menu handle
  128.       hInstance,              // program instance handle
  129.       nil);                   // creation parameters
  130.  
  131.    ShowWindow(hWnd, SW_SHOW);
  132.    UpdateWindow(hWnd);
  133.  
  134.    while(GetMessage(msg, 0, 0, 0)) do
  135.    begin
  136.       TranslateMessage(msg);
  137.       DispatchMessage(msg);
  138.    end;
  139. end.
  140.