2012/10/18

自製類 measureText 方法 - 使用 Delphi / C++ Builder

在 JavaScript 裡面有一個好用的函式:measureText
可以利用它查出 Text string 的 PX 單位寬度和高度

雖然在 Delphi 似乎不太需要用到這項功能,因為物件本身都已經有 width 和 height 屬性了

不過無聊的時候還是可以玩玩 px / width 的單位轉換

GetTextPxWidth / GetTextPxHeight 函式是參考 How to get TextWidth of string (without Canvas)?

不囉嗦了,直接來看 code 吧!


C++ Builder
hpp.
//---------------------------------------------------------------------------

#ifndef Unit1H
#define Unit1H
//---------------------------------------------------------------------------
#include <System.Classes.hpp>
#include <Vcl.Controls.hpp>
#include <Vcl.StdCtrls.hpp>
#include <Vcl.Forms.hpp>
//---------------------------------------------------------------------------
class TForm1 : public TForm
{
__published:    // IDE-managed Components
    TButton *Button1;
    TEdit *Edit1;
    TLabel *Label1;
    void __fastcall Button1Click(TObject *Sender);
private:    // User declarations
public:        // User declarations
    __fastcall TForm1(TComponent* Owner);
};
//---------------------------------------------------------------------------
extern PACKAGE TForm1 *Form1;
//---------------------------------------------------------------------------
#endif
CPP
//---------------------------------------------------------------------------

#include <vcl.h>
#pragma hdrstop

#include "Unit1.h"
//---------------------------------------------------------------------------
#pragma package(smart_init)
#pragma resource "*.dfm"
TForm1 *Form1;
//---------------------------------------------------------------------------
__fastcall TForm1::TForm1(TComponent* Owner)
    : TForm(Owner)
{
}
//---------------------------------------------------------------------------
int GetTextPxWidth(TFont *AUseFont, String AContent)
{
  TBitmap *c = new TBitmap;
  int i = 0;
  try
  {
      c->Canvas->Font->Assign(AUseFont);
      i = c->Canvas->TextWidth(AContent);
  }
  __finally
  {
      delete c;
  }
  return i;
}
int GetTextPxHeight(TFont *AUseFont, String AContent)
{
  TBitmap *c = new TBitmap;
  int i = 0;
  try
  {
      c->Canvas->Font->Assign(AUseFont);
      i = c->Canvas->TextHeight(AContent);
  }
  __finally
  {
      delete c;
  }
  return i;
}

TPoint measureText(String AContents, TFont *AUseFonts)
{
  TPoint p;
  p.X = GetTextPxWidth(AUseFonts, AContents);
  p.Y = GetTextPxHeight(AUseFonts, AContents);
  return p;
}
//---------------------------------------------------------------------------
void __fastcall TForm1::Button1Click(TObject *Sender)
{
  TPoint p = measureText(Edit1->Text, this->Font);
  Label1->Caption = Edit1->Text;
  Label1->Left = this->ClientWidth / 2 - p.X / 2;
  Label1->Top = this->ClientHeight / 2 - p.Y / 2;
}
//---------------------------------------------------------------------------

Delphi PAS
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls;

type
  TForm1 = class(TForm)
    Button1: TButton;
    Edit1: TEdit;
    Label1: TLabel;
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

function measureText(AContents: string; AUseFonts: TFont): TPoint;
  function GetTextPxWidth(AUseFont: TFont; AContent: string): Integer;
  var
    c: TBitmap;
  begin
    c := TBitmap.Create;
    try
      c.Canvas.Font.Assign(AUseFont);
      Result := c.Canvas.TextWidth(AContent);
    finally
      c.Free;
    end;
  end;
  // 本文來自:http://grandruru.blogspot.com
  function GetTextPxHeight(AUseFont: TFont; AContent: string): Integer;
  var
    c: TBitmap;
  begin
    c := TBitmap.Create;
    try
      c.Canvas.Font.Assign(AUseFont);
      Result := c.Canvas.TextHeight(AContent);
    finally
      c.Free;
    end;
  end;
var pPoint: TPoint;
begin
  pPoint.X := GetTextPxWidth(AUseFonts, AContents);
  pPoint.Y := GetTextPxHeight(AUseFonts, AContents);
  Result := pPoint;
end;

procedure TForm1.Button1Click(Sender: TObject);
var p: TPoint;
begin
  p := measureText(Edit1.Text, Self.Font);
  Label1.Caption := Edit1.Text;
  Label1.Left := Round(ClientWidth / 2 - p.X / 2);
  Label1.Top := Round(ClientHeight / 2 - p.Y / 2);
end;

end.

利用 GetTextPxHeight 和 GetTextPxWidth 取得使用指定字型的文字長度(px)
然後儲存在 TPoint 裡面,需要的時候就可以直接取得之。

如果你機會使用到的話,還希望可以分享一下囉! ^ ^


沒有留言:

張貼留言

How to use URLEncode in Delphi

URL編碼,也稱【百分號編碼(Percent-encoding)】 由於 URL 不能直接接受 UTF8 文字,所以要先轉成百分號編碼後,如此網址才能順利送給 HTTP Server 從 Indy 加入 Delphi 後,就可以用 IdURI.TIdURI 單元進行編碼 ...