線上訂房服務-台灣趴趴狗聯合訂房中心
發文 回覆 瀏覽次數:3067
推到 Plurk!
推到 Facebook!

僅顯示全形字 及 半形字 的 FontDialog

答題得分者是:wameng
ANDY8C
資深會員


發表:114
回覆:582
積分:299
註冊:2006-10-29

發送簡訊給我
#1 引用回覆 回覆 發表時間:2005-08-05 21:36:57 IP:211.74.xxx.xxx 未訂閱
請問一下 1.  如何做出可以顯示,目前電腦已安裝的      全形(圖B)  / 半形(圖A)  字型 的 FontDialog     例如: 以下範例 是全部都顯示,但我僅要全形或半形有哪些  if (FontDialog1.Execute) then         edt_fonttype.Text := (FontDialog1.Font.Name);    2. 圖C 的字型中,前面的 TT 及 O 代號是什麼意義???    謝謝您     -------------------------------- 這一網站,真的不錯!!
------
---------------------------------------
偶爾才來 KTOP ,交流條碼問題,在 FB [條碼標籤達人] 社團留言,感恩.
qoo1234
版主


發表:256
回覆:1166
積分:659
註冊:2003-02-24

發送簡訊給我
#2 引用回覆 回覆 發表時間:2005-08-05 23:24:26 IP:220.131.xxx.xxx 未訂閱
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
RedSnow
版主


發表:79
回覆:1322
積分:845
註冊:2003-12-15

發送簡訊給我
#3 引用回覆 回覆 發表時間:2005-08-06 00:01:22 IP:59.115.xxx.xxx 未訂閱
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
ANDY8C
資深會員


發表:114
回覆:582
積分:299
註冊:2006-10-29

發送簡訊給我
#4 引用回覆 回覆 發表時間:2005-08-22 22:19:08 IP:211.74.xxx.xxx 未訂閱
感謝 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 [條碼標籤達人] 社團留言,感恩.
RedSnow
版主


發表:79
回覆:1322
積分:845
註冊:2003-12-15

發送簡訊給我
#5 引用回覆 回覆 發表時間:2005-09-01 19:05:25 IP:61.230.xxx.xxx 未訂閱
ANDY8C 您好:    您改寫後的程式是直接套用 qoo1234 所提供的那段 EnumFontsProc 程序嗎?該程序內並未針對 Charset 做過濾動作,您必須在那個 CALLBACK 程序作相對的過濾動作,否則無法達到您所要求的結果。      7 天天敲鍵盤 v 時時按滑鼠 8
ANDY8C
資深會員


發表:114
回覆:582
積分:299
註冊:2006-10-29

發送簡訊給我
#6 引用回覆 回覆 發表時間:2005-09-06 03:48:23 IP:211.74.xxx.xxx 未訂閱
引言: ANDY8C 您好: 您改寫後的程式是直接套用 qoo1234 所提供的那段 EnumFontsProc 程序嗎?該程序內並未針對 Charset 做過濾動作,您必須在那個 CALLBACK 程序作相對的過濾動作,否則無法達到您所要求的結果。 7 天天敲鍵盤 v 時時按滑鼠 8
RedSnow : 我是直接用 qoo1234 的程式測試 沒錯, 您說的 Charset ?? 不解?? CallBack ?? 不解?? 可否再提示一些方向,謝謝您 -------------------------------- 這一網站,真的不錯!!
------
---------------------------------------
偶爾才來 KTOP ,交流條碼問題,在 FB [條碼標籤達人] 社團留言,感恩.
wameng
版主


發表:31
回覆:1336
積分:1183
註冊:2004-09-16

發送簡訊給我
#7 引用回覆 回覆 發表時間:2005-09-07 22:41:23 IP:219.86.xxx.xxx 未訂閱
事實上,用 TFontDialog 是可以做到的。 只不過有點麻煩。 用 SendDlgItemMessage 替換逐一篩檢charset ~~~~~~~~~~~ 難得聰明,常常糊塗。 ~~~~~~~~~~~
wameng
版主


發表:31
回覆:1336
積分:1183
註冊:2004-09-16

發送簡訊給我
#8 引用回覆 回覆 發表時間:2005-09-08 12:59:44 IP:61.222.xxx.xxx 未訂閱
不用判斷 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 的 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
ANDY8C
資深會員


發表:114
回覆:582
積分:299
註冊:2006-10-29

發送簡訊給我
#9 引用回覆 回覆 發表時間:2005-09-17 16:25:04 IP:211.74.xxx.xxx 未訂閱
引言: 不用判斷 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 的 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 : 謝謝您,我再試看看 -------------------------------- 這一網站,真的不錯!!
------
---------------------------------------
偶爾才來 KTOP ,交流條碼問題,在 FB [條碼標籤達人] 社團留言,感恩.
ANDY8C
資深會員


發表:114
回覆:582
積分:299
註冊:2006-10-29

發送簡訊給我
#10 引用回覆 回覆 發表時間:2005-09-22 00:28:40 IP:211.74.xxx.xxx 未訂閱
引言: SendDlgItemMessage(DlgHwnd, cmb1, CB_ADDSTRING, 0, LongInt
請問一下 cmb1 是來自哪裡?? 謝謝您 -------------------------------- 這一網站,真的不錯!!
------
---------------------------------------
偶爾才來 KTOP ,交流條碼問題,在 FB [條碼標籤達人] 社團留言,感恩.
系統時間:2017-12-11 9:51:12
聯絡我們 | Delphi K.Top討論版
本站聲明
1. 本論壇為無營利行為之開放平台,所有文章都是由網友自行張貼,如牽涉到法律糾紛一切與本站無關。
2. 假如網友發表之內容涉及侵權,而損及您的利益,請立即通知版主刪除。
3. 請勿批評中華民國元首及政府或批評各政黨,是藍是綠本站無權干涉,但這裡不是政治性論壇!