標籤: 字型

Delphi 將字型樣式轉成字串

[pascal]
// 字串轉成字型樣式
Function StringToStyle(s:String):TFontStyles;
var ft:TFontStyles;
begin
if pos(‘B’,s) >0 then
ft := ft + [fsBold];
if pos(‘I’,s) >0 then
ft := ft + [fsItalic];
if pos(‘U’,s) >0 then
ft := ft + [fsUnderline];
if pos(‘S’,s) >0 then
ft := ft + [fsStrikeOut];
Result := ft;
end;

// 字型樣式轉成文字
Function StyleToString(ft:TFontStyles):String;
var s:String;
begin
s:= ”;
if fsBold in ft then
s := s + ‘B’;
if fsItalic in ft then
s := s + ‘I’;
if fsUnderline in ft then
s := s + ‘U’;
if fsStrikeOut in ft then
s := s + ‘S’;
Result := s;
end
[/pascal]

XE6使用FMX(FireMonkey)取得系統字型列表(For Win/Mac OS)

早上看到大陸網友留言發問，在Delphi的VCL架構中，只要Screen.Fonts就可以取得系統的字型列表，那在FMX(FireMonkey)架構裡沒有Screen.Fonts，該如何取得系統的字型列表呢?壽山做了一個簡單的程式做回應跟說明囉:)

首先我們新增一個FireMonkey Desktop Application專案
螢幕快照 2014-06-21 上午11.54.13

 

 

接著在畫面上放三個元件，Listbox、Label以及Button螢幕快照 2014-06-21 上午11.56.45

 

首先，在Uses的下面加上

  {$IFDEF MACOS}
  MacApi.Appkit,Macapi.CoreFoundation, Macapi.Foundation,
  {$ENDIF}
  {$IFDEF MSWINDOWS}
  Winapi.Messages, Winapi.Windows,
  {$ENDIF}

接著我們要寫一個CollectFonts的函數，讓程式在不同平台可以抓到字型。

主要運用的技巧是

Mac OS裡的NSFontManager
Windows裡的EnumFontFamiliesEx

{$IFDEF MSWINDOWS}
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;
{$ENDIF}

procedure CollectFonts(FontList: TStringList);
var
{$IFDEF MACOS}
  fManager: NsFontManager;
  list:NSArray;
  lItem:NSString;
{$ENDIF}
{$IFDEF MSWINDOWS}
  DC: HDC;
  LFont: TLogFont;
{$ENDIF}
  i: Integer;
begin
  {$IFDEF MACOS}
    fManager := TNsFontManager.Wrap(TNsFontManager.OCClass.sharedFontManager);
    list := fManager.availableFontFamilies;
    if (List <> nil) and (List.count > 0) then
    begin
      for i := 0 to List.Count-1 do
      begin
        lItem := TNSString.Wrap(List.objectAtIndex(i));
        FontList.Add(String(lItem.UTF8String))
      end;
    end;
  {$ENDIF}
  {$IFDEF MSWINDOWS}
    DC := GetDC(0);
    FillChar(LFont, sizeof(LFont), 0);
    LFont.lfCharset := DEFAULT_CHARSET;
    EnumFontFamiliesEx(DC, LFont, @EnumFontsProc, Winapi.Windows.LPARAM(FontList), 0);
    ReleaseDC(0, DC);
  {$ENDIF}
end;

最後在Button1Click事件加上

procedure TForm1.Button1Click(Sender: TObject);
var fList: TStringList;
    i: Integer;
begin
  fList := TStringList.Create;
  CollectFonts(fList);
  Label1.Text := '系統字型數量'+ IntToStr(fList.Count);
  for i := 0 to fList.Count -1 do
  begin
     ListBox1.Items.Add(FList[i]);
  end;
  fList.Free;
end;

在Windows及Mac OS執行的畫面如下
10374079_10152084884031541_8800976866348499936_n

10402863_10152084884291541_3407519286840592873_n

GitHub >> https://github.com/superlevin/XE6FMXGetFonts

[Delphi] DBGrid顯示不同字型、顏色

dbgrid選擇顏色字型的方式
1.在DBGrid的Columns Editor中，將要出現按鈕的欄位的ButtonStyle設為cbsEllipsis
2.接著到OnEditButtonClick中增加程式判斷
if dbgrid1.SelectedField = xxxx(欄位名稱) then begin
end;
3.顯示的方式則是在OnDrawColumnCell中增加程式
IF COLUMN.FieldName = ‘xxxx(欄位名稱)’ THEN BEGIN
DBGrid1.canvas.brush.Color := STRINGTOCOLOR(‘clGreen’);
END;
// 記得要加上
DbGrid1.DefaultDrawColumnCell(Rect, DataCol, Column, []);