Jak uzyskać taką samą czcionkę z CreateFont jak TFont pod VCL.

0

Cześć. Zwykle staram się radzić sobie sam, ale tutaj liczę na pomoc osób ogarniających WinAPI i temat czcionek. Każda rada się mi przyda.

Przymierzam się do przepisania mojego plugina dla Total Commandera z VCL na WinAPI. I póki co robię sobie wprawki testując pewne rzeczy. I natrafiłem na problem. Chciałbym aby mój ListBox miał identyczną czcionkę jak widać na screenie u samego dołu. Pod Delphi i VCL jest to po prostu standardowy font pod Windows 7 o nazwie Terminal. Styl: zwykły. Rozmiar: 12. Rysowanie i kolorowanie odbywa się przez obsługę OwnerDraw. Dla WinAPI font tworzę tak:

  Fnt := CreateFont(-18, 0, 0, 0, FW_NORMAL, 0, 0, 0,
    ANSI_CHARSET, OUT_DEFAULT_PRECIS, CLIP_DEFAULT_PRECIS,
    DEFAULT_QUALITY, DEFAULT_PITCH, 'Terminal');
  SendMessage(SamplesLBHandle, WM_SETFONT, Fnt, 1);

I efekt jest taki:
my_plugin_dlg_test.jpg

A chciałbym najlepiej tak, wtedy przy rozszerzeniu okna TotalCmd (wtedy kontrolki w groupboxie plugin przesuwa obok ListBoxa) widać na Listboxie dokładnie 31 pozycji o wysokości po 13 pikseli każda (taki jest ListBoxowy ItemHeight). Dodatkowo każdy wiersz jeśłi jest maksymalnej długości, wypełniony tekstem plus wolne miejsce na ScrollBar ListBoxowy, kiedy ListBox nie mieści wszystkich elementów (na przykład przy wybraniu widoku instrumentów dla modułów IT/XM lub zwężonym oknie podglądu.
my_plugin_in_fullscreen.jpg
Prosił bym o podpowiedzi jak to osiągnąć. Kombinowałem stawiając BreakPoint na CreateFontA w wersji okienkowej mojego playera (początkowo miał to być osobny program, ale stwierdziłem że plugin jest wygodniejszy bo odpada zabawa z całą obsługą dla plików, wystarczy je teraz tylko ładować.

Póki co plugin w wersji 0.2 z błędnie działającym TFlatScrollBarem, który poitrafi wywalić błędy AV jest na: http://www.totalcmd.net/plugring/modules_player.html - planuje go w wersji 0.3 jeśłi przejdzie testy zastapić zwykłym ScrollBarem. Natomiast docelowo następna wersja - jeśli się uda- będzie w WinAPI. Wtedy może pomyslę nad udostępnieniem source.

I dodam, że próbowałem pod OllyDbg zakładać pułpaki w wersji okienkowej programu VCL (bo taką też mam) na CreateFontA. Jednak tam tworzony jest tylko dwukrotnie domyślny font dla MS Sans Serif, a więc raczej nie tędy droga :/

0

nie bardzo rozumiem - piszesz, że standardowo fint ma rozmiar 12 a Ty tworzysz go z rozmiarem 18 :/.
No i czytałem to kilka razy ale nie jestem do końca czy zrozumiałem z czym masz problem :) - chodzi Ci o wielkość czcionki?

0

Nie wiem jak działają pluginy TC ale czy nie możesz po prostu pobrać czcionki z tamtej kontrolki i utworzyć na jej bazie takiej samej? Chodzi mi o coś w stylu:

  hFont:= SendMessage(hWnd, WM_GETFONT, 0, 0);
  ZeroMemory(@lf, SizeOf(LOGFONT));
  GetObject(hFont, SizeOf(LOGFONT), @lf);
  hFont:= CreateFontIndirect(lf);
0

Jeżeli w VCL ci działa to wykorzystaj ten VCL lub weź zajrzyj do źródeł i zaadoptuj fragment kodu. Jeżeli nie masz kodu VCL to weź go z lazarusa lub starszego delphi, na tak niskim poziomie nie powinno być różnić.

0

Terminal nie jest czcioną TrueType, tylko rastrową przeznaczoną do konsoli. Spróbuj dać OEM_CHARSET zamiast ANSI_CHARSET.

0

Dziękuje wszystkim za odpowiedzi. Niestety problem nadal nierozwiązany. Ponieważ...

@Azarien: niestety to nie pomaga. Na moje oko to czcionka dalej nie jest identyczna. Czyli 31 elementów nie wypełnia całego ListBoxa na ustawioną wysokość (342 dla dialogu zdefiniowanego w pliku *.rc).

@kAzek: nie zrozumiałeś, nie urządza mnie taki kod. Bo jak niby mam pobrać coś z kontrolki VCL? Jak docelowo cały plugin ma być w WinAPI. Nie będę miał się z czego wzorować. Kontrek VCL nie będzie. O ile wiem to pokazanie na przykłąd przez MessageBox i IntToStr zwróconego HFONT, a późnej przypisanie takiej liczby nic mi nie da.

@abrakadaber: poczytaj http://msdn.microsoft.com/en-us/library/windows/desktop/dd183499(v=vs.85).aspx - to -18, jest wartością jaką dla ListBoxa zwraca mi Font.Height. I stąd się to wzieło, nie jest to mój wymysł. Te 12 to wartość Font.Size. Oczywiście tutaj mowa o TFont.

I dodam, że cięzko mi doszukać się odpowiedniego kodu w modułach VCL, ktore mam "podkranięte" z wersji Enterprise. Dlatego pytam na forum.

0

Wiem jak to działa bo się swego czasu tym bawiłem. Zdziwiłem się bo ja dla size = 12 mam height = -16 więc nijak mi nie wychodziło Twoje -18 :). A ustaw zamiast wartości absolutnej -18 te 12

0

Przy takim kodzie z innym pierwszym parametrem za radą @abrakadaber i innym OEM (hint @Azarien'a):

        LBFontH := CreateFont(12, 0, 0, 0, FW_NORMAL, 0, 0, 0,
          OEM_CHARSET, OUT_DEFAULT_PRECIS, CLIP_DEFAULT_PRECIS,
          DEFAULT_QUALITY, DEFAULT_PITCH, 'Terminal');
        SendMessage(SamplesLBHandle, WM_SETFONT, LBFontH, 1);

Mam taki efekt:
font_12.jpg
Ale faktycznie coś może jest na rzeczy z ustawieniami Windows'a. Ponieważ o ile pamiętam pod VMWare Workstation kiedy testowałem mój plugin na Windowsach: 98, XP x86 oraz 8 x64. To czcionki zarówno w ListBoxie jak i te na Labelu obok przycisków Play/Pause/Stop (to standardowy MS Sans Serif) mają inne rozmiary. Być może powodem jest ustawienie "Zwiększ czytelność ekranu" w ustawieniach Personalizuj w Windows 7 na niestandardowe 111%, ponieważ wtedy lepiej układają mi się ikonki na Pulpicie, ale nie myślałem też że ma to wpływ na czcionki w kontrolkach. Tak to wygląda na XP, gdzie nie modziłem z takimi ustawieniami, bo tam chyba nawet ich nie ma.

Plugin w akcji:
modules_player_windows_xp.jpg
Wygląd testowego dialogu (brak paska tytułowego jest celowy, bo plugin nie będzie go posiadać):
font_12_windows_xp.jpg

I teraz pytanie, jak można zrobić szerszą czcionkę, tak jak to jest przy moich 111% ustawienia w Windows 7. I żeby pod innymi systemami niż siódemka też miało to zastosowanie. Bo przyznam, że taka rozciągnięta czcionka jest dla mnie czytelniejsza. A widać, że pod WinAPI w przeciwieństwie do VCL takie ustawienia "zwiększenia czytelności" są chyba ignotowane. Co może jest i na plus, bo pod różnymi systemami wszystko będzie wyglądać tak samo. Ale za to niestety jak dla mnie czytelność sux.

1

jeśli weźmiesz font skalowalny to w nWidth możesz podać jego szerokość. Ja się tak bawiłem jak pisałem programik, który wydruki na igłówkę drukował na laserówkach i to dość fajnie działa

BTW @olesio jesteś pewien, że w TC to jest Terminal - nie używam go ale pamiętam, że tam można chyba było wybrać sobie czcionkę jaka ma być w okienkach

0

Być może powodem jest ustawienie "Zwiększ czytelność ekranu" w ustawieniach Personalizuj w Windows 7 na niestandardowe 111%, ponieważ wtedy lepiej układają mi się ikonki na Pulpicie

Echh... odstęp między ikonkami ustawia się zupełnie gdzie indziej ;-)

Przelicznik między dodatnim a ujemnym rozmiarem czcionki jest taki:

ujemna = - dodatnia * DPI / 72
dodatnia = - ujemna * 72 / DPI

gdzie DPI wyrażone w procentach jest względem 96, czyli 100% to 96, 125% to 120, a użyte przez ciebie 111% to 106,56 (co Windows zapewne zaokrągli do 107).

zatem twoje -18 przy 107 dpi odpowiada 12,11 ≈ 12 punktom.

0

@Azarien: zatem mógłbym Ciebie prosić o przykład kodu użycia CreateFont, dla takiego efektu i DPI, aby uzyskać taki rezultat jak pod VCL na screenach z siódemki dla Pluginu? A ustawienia siódemki ogarniam tak sobie i te 111 procent ustawiłem kiedyś i tak zostało. Poza ikonkami zauważyłem tylko, że ma to też wpływ na domyślne powiększenie strony startowej wczytanej z pliku html pod nowszymi IE.

Zastanawia mnie też teraz rozwiązanie, które podał @kAzek. Czy jeśli bym sobie otworzył moduł w moim pluginie, ustalił HWND ListBoxa i na sztywno podając jego uchwyt bez zamykania pluginu, pobrał tę czcionkę tak jak to pokazał @kAzek, i ustawił w testowym dialogu dla "WinAPIowego ListBoxa". To jeżeli font byłby identyczny znaczy, że jednak taką informację zawiera sam typ HFONT. Jednak wątpię, skoro dochodzi kwestia DPI. Ale upewnie się dopiero jutro, będąc w domu.

1

Czy jeśli bym sobie otworzył moduł w moim pluginie, ustalił HWND ListBoxa i na sztywno podając jego uchwyt bez zamykania pluginu, pobrał tę czcionkę tak jak to pokazał @kAzek, i ustawił w testowym dialogu dla "WinAPIowego ListBoxa"
Mając LOGFONT pobrany przez WM_GETFONT+GetObject, wyświetl sobie po prostu wszystkie dane tego rekordu, i użyj tych samych u siebie w CreateFont (a jeszcze lepiej CreateFontIndirect).

1

w załączniku masz programik, który tworzy listboxa w winapi i delphiowego. Ustawia im też czcionkę i pobiera potem info o czcionce. Porównaj sobie to się dzieje tu i tu. Jedyne co się okazało to to, że jeśli pod vcl ustawiasz rozmiar czcionki na dodatni to pod winapi musisz to przeliczyć na wartość z minusem i na odwrót.

kod odpowiedzialny za ustawienie czcionki

  FLBFont := CreateFont (Round(-StrToIntDef(edtFontSize.Text, 12) * 96 / 72),  //96 jest na sztywno bo tak mam ustawione a nie chciało mi się pobierać
          0, 0, 0, FW_NORMAL, 0, 0, 0,
          OEM_CHARSET, OUT_DEFAULT_PRECIS, CLIP_DEFAULT_PRECIS,
          DEFAULT_QUALITY, DEFAULT_PITCH, PChar(edtFontName.Text));
  SendMessage(FhListbox, WM_SETFONT, FLBFont, 1);

  lst1.Font.Name := edtFontName.Text;
  lst1.Font.Size := StrToIntDef(edtFontSize.Text, 12);

dupa.png

0

Dziękuje Wam bardzo za aktywność w tym wątku. Przejrze na spokojnie ten kod po południu, kiedy będę miał czas spokojnie usiąśc przy komputerze. A tak z ciekawości to skąd się bierze te 72, tak ma być i już? Anyway, jest szansa znormalizować font chyba bez względu na system i DPI.

0
olesio napisał(a):

A tak z ciekawości to skąd się bierze te 72, tak ma być i już?

Tak ma być i już.

Bierze się stąd, że jeden punkt [pt] to 1/72 cala, więc tekst o rozmiarze 72 będzie miał wysokość 1 cala (przynajmniej na wydruku, bo wiadomo że monitory są większe i mniejsze).

0

Dziękuję jeszcze raz za cierpliwość i odpowiedzi. Oczywiście tak to jest jak się pisze wątek na szybko przed wyjściem do pracy, a później z pracy już nie ma się dostepu do swojego kodu w łatwy sposób. Problem rozwiązany, a sprawę dodatkowo komplikowało to - o czym zupełnie zapomniałem, iż mam ustawiony ItemHeight na 18. Co nie zmienia faktu, że najfajnie to będzie ogarnąc sukcesywnie w WinAPI. Ponieważ pod XP na przykład wtedy wszystko się w ListBoxie pokazuje tak samo jak pod siódemką. A pod VCL, Delphi sobie coś tam modzi i pomimo ustawienia Font.Handle czcionka różni się szerokością. Teraz test wypadł ok:
ok_font.png
A wprawka WinAPI pod XP również pokazuje wszystko jak należy, dla próby wczytane nazwy sampli z modułu z małym ASCII logo, żeby mieć pewnośc, że wszystkoo jest ogarnięte, tak jak chcę. A stąd te kombinację, bo chcę aby plugin wyświetlał listę sampli/instrumentów w miarę wyraźnym fontem, dlatego tak kombinowałem.
pod_xp_test_winapi.png
Podsumowując najbardziej naprowadził mnie kod @abrakadaber'a. Poniżej podaję zastosowane rozwiązania wycięte z kodu:

//...
const
  Test_FileName = 'C:\PROGRAMY\MODULY\sound_h.mod';
  Plugin_Ver = '0.1';
  IDC_MAINDLG = 1000;
  IDC_SAMPLESLB = 100;
  IDC_CONTROLSGB = 101;
  IDC_TITLEEDIT = 102;
  IDC_SHOWKINDGB = 103;
  IDC_SHOWKINDGB_ITEM_1 = 104;
  IDC_SHOWKINDGB_ITEM_2 = 105;
  IDC_LOOPCBX = 106;
  IDC_PLAYBTN = 301;
  IDC_PAUSEBTN = 302;
  IDC_STOPBTN = 303;

type
  TColor = -$7FFFFFFF - 1..$7FFFFFFF;

const
  GFX_BASE = 500;
  Error_Text = 'Error';
  Buttons_Icon_Size = 32;
  clLime = TColor($00FF00);
  clBlack = TColor($000000);
  WM_CHANGEMSGBOX = WM_USER + 555;
  Bass_Resource_Name = 'library_bass';

var
  Channel : DWORD;
  PNewMsgBoxProc, POldMsgBoxProc, POldStaticssProc : Pointer;
  ActiveWindowHandle, MainDialogHandle, PlayBtnHandle, SamplesLBHandle : HWND;

procedure OnDrawSamplesLB(DIS : PDrawItemStruct);
var
  S : string;
  HB : HBRUSH;
  Rect : TRect;
begin
  S := LBGetItemText(DIS.hwndItem, DIS.itemID);
  SetTextColor(DIS.hDC, ColorToRGB(clLime));
  HB := CreateSolidBrush(ColorToRGB(clBlack));
  SetBkMode(DIS.hDC, TRANSPARENT);
  Windows.FillRect(DIS.hDC, DIS.rcItem, HB);
  CopyMemory(@Rect, @DIS.rcItem, SizeOf(TRECT));
  Windows.TextOut(DIS.hDC, Rect.Left, Rect.Top, PChar(S), Length(S));
end;

function LoadResourceDllAndInit(AHandle : HWND) : boolean;
begin
  Result := LoadBassDllFromResource(Bass_Resource_Name);
  if not Result then
  begin
    MessageBox(AHandle, PChar('Resource named "' +
      Bass_Resource_Name + '" with bass.dll - invalid! Plugin will be closed.'),
      PChar(Error_Text), MB_ICONERROR or MB_OK);
  end
  else
  begin
    Result := BASS_Init(-1, 44100, 0, 0, nil);
    if not Result then
    begin
      MessageBox(AHandle, 'Audio initialization error! Plugin will be closed.',
        PChar(Error_Text), MB_ICONERROR or MB_OK);
    end;
  end;
end;

function MainDlgProc(AHWnd : HWND; Msg : UINT; AWParam : WParam; ALParam : LParam) : LRESULT; stdcall;
var
  H : HWND;
  DC : HDC;
  I : integer;
  LBFontH : HFONT;
  DlgStyles : DWORD;
  DrawItem : PDrawItemStruct;
  MeasItem : PMEasureItemStruct;
begin
//...
    WM_DRAWITEM :
      begin
        DrawItem := Pointer(ALParam);
        case LoWord(AWParam) of
          IDC_PLAYBTN, IDC_PAUSEBTN, IDC_STOPBTN :
            begin
              OnDrawStatics(DrawItem);
            end;
          IDC_SAMPLESLB :
            begin
              DrawItem := Pointer(ALParam);
              OnDrawSamplesLB(DrawItem);
            end;
        end;
      end;
    WM_MEASUREITEM :
      begin
        MeasItem := Pointer(ALParam);
        MeasItem.itemHeight := 18;
      end;
//...
    WM_INITDIALOG :
      begin
        LoadSettings;
        MainDialogHandle := AHWnd;
        SamplesLBHandle := GetDlgItem(AHWnd, IDC_SAMPLESLB);
        LBFontH := CreateFont(Round(-12 * 111 / 72), 0, 0, 0, FW_NORMAL, 0, 0, 0,
          OEM_CHARSET, OUT_DEFAULT_PRECIS, CLIP_DEFAULT_PRECIS,
          DEFAULT_QUALITY, DEFAULT_PITCH, 'Terminal');
        SendMessage(SamplesLBHandle, WM_SETFONT, LBFontH, 1);
        if not LoadResourceDllAndInit(AHWnd) then
        begin
          Halt(5);
        end;
        Channel := BASS_MusicLoad(False, PChar(Test_FileName), 0, 0, BASS_MUSIC_PRESCAN, 0);
        ShowSamplesOrInstrumentsData(0);
        LBSetItemIndex(SamplesLBHandle, 0);
//...

Tylko właśnie ważne było to ustawianie ItemIndexu na końcu na zero, bo inaczej pojawiała
się ramka na zerowym elemencie i trzeba było by kliknąc na nią, a później na inny element aby uniknąć zaznaczenia.

Niestety póki co wydając wersję VCL 0.3 pluginu, muszę w niej implementować taki lamerski trick, co będzie jak wspomniałem zbędne raczej w wersji WinAPI. Ale niestety były cyrki z dopasowaniem na szerokość tekstu w ListBoxie pod XP, względem wyglądu na przykład w Windows 7. Nie umiejąc wpaść na inne rozwiązanie zrobiłem tak jak poniżej.

//...

const
  SamplesLB_Width_Chars_Count = 32;

//...
function GetTextWidth(TextToCheck : string; GivenTextFont : HFONT) : integer;
var
  DC : HDC;
  PStr : PChar;
  Size : TSize;
begin
  Result := 0;
  if TextToCheck <> '' then
  begin
    GetMem(PStr, Length(TextToCheck));
    CopyMemory(PStr, PChar(TextToCheck), Length(TextToCheck));
    DC := GetDC(0);
    SelectObject(DC, GivenTextFont);
    GetTextExtentPoint32(DC, PStr, Length(TextToCheck), Size);
    ReleaseDC(0, DC);
    FreeMem(PStr);
    Result := Size.cx;
  end;
end;

//...
  SamplesLBFontH := CreateFont(Round(-12 * 111 / 72), 0, 0, 0, FW_NORMAL, 0, 0, 0,
    OEM_CHARSET, OUT_DEFAULT_PRECIS, CLIP_DEFAULT_PRECIS,
    DEFAULT_QUALITY, DEFAULT_PITCH, 'Terminal');
  SamplesLB.Font.Handle := SamplesLBFontH;
  TempStr := '';
  for I := 1 to SamplesLB_Width_Chars_Count do
  begin
    TempStr := TempStr + 'C';
  end;
  SamplesLB.Width := GetTextWidth(AnsiUpperCase(TempStr), SamplesLBFontH);
//...

Także kończąc rozpiskę jak to ja ;P jeszcze raz dziękuję Wam za pomoc i co złego to nie ja ;)

Zarejestruj się i dołącz do największej społeczności programistów w Polsce.

Otrzymaj wsparcie, dziel się wiedzą i rozwijaj swoje umiejętności z najlepszymi.