請問一下 1.  如何做出可以顯示,目前電腦已安裝的      全形(圖B)  / 半形(圖A)  字型 的 FontDialog     例如: 以下範例 是全部都顯示,但我僅要全形或半形有哪些  if (FontDialog1.Execute) then         edt_fonttype.Text := (FontDialog1.Font.Name);    2. 圖C 的字型中,前面的 TT 及 O 代號是什麼意義???    謝謝您     -------------------------------- 這一網站,真的不錯!!

------
---------------------------------------
偶爾才來 KTOP ,交流條碼問題,在 FB [條碼標籤達人] 社團留言,感恩.

http://www.elists.org/pipermail/delphi/1999-October/003134.html http://delphi.ktop.com.tw/topic.php?TOPIC_ID=71499  

function EnumFontsProc(var LogFont: TLogFont; var TextMetric:TTextMetric;
  FontType: Integer; Data: Pointer): Integer; stdcall;
var
  S: TStrings;
  Temp: string;
begin
  S := TStrings(Data);
  Temp := LogFont.lfFaceName;
  if (S.Count = 0) or (AnsiCompareText(S[S.Count-1], Temp) <> 0) then
    S.Add(Temp);
  Result := 1;
end;    procedure TForm1.LoadFonts(cbx: TComboBox;FCharSet: Byte);
var
  DC: HDC;
  LFont: TLogFont;
  Fonts : TStringList;
  i : Integer;
begin
  Fonts := TStringList.Create;
  DC := GetDC(cbx.Handle);
  try
    Fonts.Add('Default');
    if Lo(GetVersion) >= 4 then
    begin
      FillChar(LFont, sizeof(LFont), 0);
      LFont.lfCharset := FCharSet;
      EnumFontFamiliesEx(DC, LFont, @EnumFontsProc, LongInt(Fonts), 0);
    end
    else
      Windows.EnumFonts(DC, nil, @EnumFontsProc, Pointer(Fonts));
    Fonts.Sorted := TRUE;
  finally
    ReleaseDC(cbx.Handle, DC);
  end;
  for i := 0 to Fonts.Count-1 do
    cbx.Items.Add(Fonts.Strings[i]);
  cbx.Sorted:=True;
end;    procedure TForm1.FormCreate(Sender: TObject);
begin
  LoadFonts(ENcbx,ANSI_CHARSET);
  LoadFonts(CHTcbx,CHINESEBIG5_CHARSET);
  LoadFonts(Allcbx,DEFAULT_CHARSET);
end;    end.     

網海無涯，唯學是岸！ 發表人 - qoo1234 於 2005/08/05 23:29:50

ANDY8C 您好：    1. 據我所知是無法直接使用 TFontDialog 來達到您要的功能，我以前有做過類似的動作 (過濾出所有的 BIG5 字型)，但是我是使用 BCB 配合 ComboBox 來處理的，而我是用 EnumFontFamilies 這個 API 來做 CALLBACK，在 CALLBACK 程序中可以檢查 ENUMLOGFONT 的 LOGFONT，而 LOGFONT 裡面有許多的屬性項目，您可以利用它們來做一些比對過濾的動作，例如 lfCharSet 項目是存放字型的 Charset，我就是透過這項資料來過濾出符合編碼為 CHINESEBIG5_CHARSET 的字型，然後將過續出來的自行設給 ComboBox，您可以查看一下上述 API 的相關資料，或許可以過濾出您要的字型。    2. TT = TrueType, O = OpenType      7 天天敲鍵盤 v 時時按滑鼠 8

感謝 qoo1234 及 redsnow 的解答:    經過小弟實際測試,好像無法取出自己預期中的字型(全形或半形) 全形中,有半型的字形選項 半形中,也出現中文字選項 不知原因在哪裡 ???????    程式碼如下,實際畫面如圖 ,    

procedure TForm.FormCreate(Sender: TObject);
begin
      
      LoadFonts(ComboBox_en,ANSI_CHARSET); // 僅 半形          LoadFonts(ComboBox_cht,CHINESEBIG5_CHARSET); // 僅 全形          LoadFonts(ComboBox_all,DEFAULT_CHARSET); // 全形+半形    end;    procedure TForm.LoadFonts(cbx: TComboBox;FCharSet: Byte);
var
  DC: HDC;
  LFont: TLogFont;
  Fonts : TStringList;
  i : Integer;
begin
 Fonts := TStringList.Create;
  DC := GetDC(cbx.Handle);
  try
    Fonts.Add('Default');
    if Lo(GetVersion) >= 4 then
    begin
      FillChar(LFont, sizeof(LFont), 0);
      LFont.lfCharset := FCharset ;  // 取何種 字型
      EnumFontFamiliesEx(DC, LFont, @EnumFontsProc, LongInt(Fonts), 0);
    end
    else
      Windows.EnumFonts(DC, nil, @EnumFontsProc, Pointer(Fonts));
    Fonts.Sorted := TRUE;
  finally
    ReleaseDC(cbx.Handle, DC);
  end;
  for i := 0 to Fonts.Count-1 do
    cbx.Items.Add(Fonts.Strings[i]);    end;  
    

-------------------------------- 這一網站,真的不錯!! 發表人 - ANDY8C 於 2005/08/22 22:21:26

------
---------------------------------------
偶爾才來 KTOP ,交流條碼問題,在 FB [條碼標籤達人] 社團留言,感恩.

ANDY8C 您好：    您改寫後的程式是直接套用 qoo1234 所提供的那段 EnumFontsProc 程序嗎？該程序內並未針對 Charset 做過濾動作，您必須在那個 CALLBACK 程序作相對的過濾動作，否則無法達到您所要求的結果。      7 天天敲鍵盤 v 時時按滑鼠 8

引言: ANDY8C 您好： 您改寫後的程式是直接套用 qoo1234 所提供的那段 EnumFontsProc 程序嗎？該程序內並未針對 Charset 做過濾動作，您必須在那個 CALLBACK 程序作相對的過濾動作，否則無法達到您所要求的結果。 7 天天敲鍵盤 v 時時按滑鼠 8

RedSnow : 我是直接用 qoo1234 的程式測試 沒錯, 您說的 Charset ?? 不解?? CallBack ?? 不解?? 可否再提示一些方向,謝謝您 -------------------------------- 這一網站,真的不錯!!

事實上，用 TFontDialog 是可以做到的。 只不過有點麻煩。 用 SendDlgItemMessage 替換逐一篩檢charset ～～～～～～～～～～～ 難得聰明，常常糊塗。 ～～～～～～～～～～～

不用判斷 CharSet ，偷懶直接判斷字型名稱。 若字型為 Widestring 為中文字。 並套用到 TFontDialog 如下：

  Procedure GetFontNames(FontNames:TStrings);
  var
    DC: HDC;
    Function EnumFontsProc(var LogFont: TLogFont; var TextMetric: TTextMetric;
                           FontType: Integer; Data: Pointer): Integer; stdcall;
    begin
      if Length(WideString(Copy(LogFont.lfFaceName,1,2)))=1
        then TStrings(Data).Add((LogFont.lfFaceName));
      Result:= 1;
    end;
  begin
    DC:= GetDC(0);
    Try
      FontNames.BeginUpdate;
      FontNames.Clear;
      EnumFonts(DC, nil, @EnumFontsProc, Pointer(Fontnames));
      FontNames.EndUpdate;
    Finally
      ReleaseDC(0, DC);
    end;
  end;
{ Fontdialog 的onshow 事件 }
procedure TForm1.FontDialog1Show(Sender: TObject);
var
  DlgHwnd  :THandle;
  FontNames:TStringList;
  I:integer;
begin
  DlgHwnd := Fontdialog1.Handle;
  SendDlgItemMessage(DlgHwnd,cmb1,CB_RESETCONTENT,0, 0);      FontNames := TStringList.Create;
  Try
    GetFontNames(FontNames);
    for I := 0 to FontNames.Count-1 do
      SendDlgItemMessage(DlgHwnd, cmb1, CB_ADDSTRING, 0, LongInt(PCHAR(FontNames[I])));
  Finally
    FontNames.Free;
  end;
end;

～～～～～～～～～～～ 難得聰明，常常糊塗。 ～～～～～～～～～～～ 發表人 - wameng 於 2005/09/08 13:02:16

引言: 不用判斷 CharSet ，偷懶直接判斷字型名稱。 若字型為 Widestring 為中文字。 並套用到 TFontDialog 如下：

  Procedure GetFontNames(FontNames:TStrings);
  var
    DC: HDC;
    Function EnumFontsProc(var LogFont: TLogFont; var TextMetric: TTextMetric;
                           FontType: Integer; Data: Pointer): Integer; stdcall;
    begin
      if Length(WideString(Copy(LogFont.lfFaceName,1,2)))=1
        then TStrings(Data).Add((LogFont.lfFaceName));
      Result:= 1;
    end;
  begin
    DC:= GetDC(0);
    Try
      FontNames.BeginUpdate;
      FontNames.Clear;
      EnumFonts(DC, nil, @EnumFontsProc, Pointer(Fontnames));
      FontNames.EndUpdate;
    Finally
      ReleaseDC(0, DC);
    end;
  end;
{ Fontdialog 的onshow 事件 }
procedure TForm1.FontDialog1Show(Sender: TObject);
var
  DlgHwnd  :THandle;
  FontNames:TStringList;
  I:integer;
begin
  DlgHwnd := Fontdialog1.Handle;
  SendDlgItemMessage(DlgHwnd,cmb1,CB_RESETCONTENT,0, 0);      FontNames := TStringList.Create;
  Try
    GetFontNames(FontNames);
    for I := 0 to FontNames.Count-1 do
      SendDlgItemMessage(DlgHwnd, cmb1, CB_ADDSTRING, 0, LongInt(PCHAR(FontNames[I])));
  Finally
    FontNames.Free;
  end;
end;

～～～～～～～～～～～ 難得聰明，常常糊塗。 ～～～～～～～～～～～ 發表人 - wameng 於 2005/09/08 13:02:16

wameng : 謝謝您,我再試看看 -------------------------------- 這一網站,真的不錯!!

引言: SendDlgItemMessage(DlgHwnd, cmb1, CB_ADDSTRING, 0, LongInt

請問一下 cmb1 是來自哪裡?? 謝謝您 -------------------------------- 這一網站,真的不錯!!