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

算筆劃程式

 
bookworm
中階會員


發表:63
回覆:161
積分:82
註冊:2002-08-03

發送簡訊給我
#1 引用回覆 回覆 發表時間:2002-10-30 01:19:42 IP:210.85.xxx.xxx 未訂閱
unit CharTw; //作者:黎銘匡    interface //判斷某一個字元是否為中文的前導字元 function IsLeadByteTw(c:Char):Boolean;    //計算中文字的筆劃(修改自 MS Access 7.0 NorthWind 範例); //傳回值:0 表示非中文字, 否則為中文筆劃數. function NumStrokes(cstr: string):Integer;    //計算字串的總筆劃 function TotalStrokes(cstr: string):Integer;    implementation    //判斷某一個字元是否為中文的前導字元 function IsLeadByteTw(c:Char):Boolean; begin   //根據附屬應用程式中的"字元對應表"計算而得 ($81 .. $FE)   Result:=(c in [Char($81)..Char($FE)]);   {   //呼叫 Windows API 來計算 (但效率較差)   Result:=IsDBCSLeadByte(Byte(c));   } end;    function NumStrokes(cstr: string):Integer; var i:Integer; begin   Result:=0;   if Length(cstr)<2 then exit; if not IsLeadByteTw(cstr[1]) then exit; i := (Ord(cstr[1]) shl 8) Ord(cstr[2]); //一劃 If (i = $A440) Or (i = $A441) Then Result := 1 //2劃 Else If ((i >= $A442) And (i <= $A453)) Or ((i >= $C940) And (i <= $C944)) Then Result := 2 //3劃 Else If ((i >= $A454) And (i <= $A47E)) Or ((i >= $C945) And (i <= $C94C)) Then Result := 3 //4劃 Else If ((i >= $A4A1) And (i <= $A4FD)) Or ((i >= $C94D) And (i <= $C962)) Then Result := 4 //5劃 Else If ((i >= $A4FE) And (i <= $A5DF)) Or ((i >= $C963) And (i <= $C9AA)) Then Result := 5 //6劃 Else If ((i >= $A5E0) And (i <= $A6E9)) Or ((i >= $C9AB) And (i <= $CA59)) Then Result := 6 //7劃 Else If ((i >= $A6EA) And (i <= $A8C2)) Or ((i >= $CA5A) And (i <= $CBB0)) Then Result := 7 //8劃 Else If (i = $A260) Or ((i >= $A8C3) And (i <= $AB44)) Or ((i >= $CBB1) And (i <= $CDDC)) Then Result := 8 //9劃 Else If (i = $A259) Or (i = $F9DA) Or ((i >= $AB45) And (i <= $ADBB)) Or ((i >= $CDDD) And (i <= $D0C7)) Then Result := 9 //10劃 Else If (i = $A25A) Or ((i >= $ADBC) And (i <= $B0AD)) Or ((i >= $D0C8) And (i <= $D44A)) Then Result := 10 //11劃 Else If (i = $A25B) Or (i = $A25C) Or ((i >= $B0AE) And (i <= $B3C2)) Or ((i >= $D44B) And (i <= $D850)) Then Result := 11 //12劃 Else If (i = $F9DB) Or ((i >= $B3C3) And (i <= $B6C2)) Or ((i >= $D851) And (i <= $DCB0)) Then Result := 12 //13劃 Else If (i = $A25D) Or (i = $A25F) Or (i = $C6A1) Or (i = $F9D6) Or (i = $F9D8) Or ((i >= $B6C3) And (i <= $B9AB)) Or ((i >= $DCB1) And (i <= $E0EF)) Then Result := 13 //14劃 Else If (i = $F9DC) Or ((i >= $B9AC) And (i <= $BBF4)) Or ((i >= $E0F0) And (i <= $E4E5)) Then Result := 14 //15劃 Else If (i = $A261) Or ((i >= $BBF5) And (i <= $BEA6)) Or ((i >= $E4E6) And (i <= $E8F3)) Then Result := 15 //16劃 Else If (i = $A25E) Or (i = $F9D7) Or (i = $F9D9) Or ((i >= $BEA7) And (i <= $C074)) Or ((i >= $E8F4) And (i <= $ECB8)) Then Result := 16 //17劃 Else If ((i >= $C075) And (i <= $C24E)) Or ((i >= $ECB9) And (i <= $EFB6)) Then Result := 17 //18劃 Else If ((i >= $C24F) And (i <= $C35E)) Or ((i >= $EFB7) And (i <= $F1EA)) Then Result := 18 //19劃 Else If ((i >= $C35F) And (i <= $C454)) Or ((i >= $F1EB) And (i <= $F3FC)) Then Result := 19 //20劃 Else If ((i >= $C455) And (i <= $C4D6)) Or ((i >= $F3FD) And (i <= $F5BF)) Then Result := 20 //21劃 Else If ((i >= $C4D7) And (i <= $C56A)) Or ((i >= $F5C0) And (i <= $F6D5)) Then Result := 21 //22劃 Else If ((i >= $C56B) And (i <= $C5C7)) Or ((i >= $F6D6) And (i <= $F7CF)) Then Result := 22 //23劃 Else If ((i >= $C5C8) And (i <= $C5F0)) Or ((i >= $F7D0) And (i <= $F8A4)) Then Result := 23 //24劃 Else If ((i >= $C5F1) And (i <= $C654)) Or ((i >= $F8A5) And (i <= $F8ED)) Then Result := 24 //25劃 Else If ((i >= $C655) And (i <= $C664)) Or ((i >= $F8EE) And (i <= $F96A)) Then Result := 25 //26劃 Else If ((i >= $C665) And (i <= $C66B)) Or ((i >= $F96B) And (i <= $F9A1)) Then Result := 26 //27劃 Else If ((i >= $C66C) And (i <= $C675)) Or ((i >= $F9A2) And (i <= $F9B9)) Then Result := 27 //28劃 Else If ((i >= $C676) And (i <= $C678)) Or ((i >= $F9BA) And (i <= $F9C5)) Then Result := 28 //29劃 Else If ((i >= $C679) And (i <= $C67C)) Or ((i >= $F9C7) And (i <= $F9CB)) Then Result := 29 //30劃 Else If (i = $C67D) Or ((i >= $F9CC) And (i <= $F9CF)) Then Result := 30 //30劃 Else If (i = $C67D) Or ((i >= $F9CC) And (i <= $F9CF)) Then Result := 30 //31劃 Else If (i = $F9D0) Then Result := 31 //32劃 Else If (i = $C67E) Or (i = $F9D1) Then Result := 32 //33劃 Else If (i = $F9C6) Or (i = $F9D2) Then Result := 33 //35劃 Else If (i = $F9D3) Then Result := 35 //36劃 Else If (i = $F9D4) Then Result := 36 //48劃 Else If (i = $F9D5) Then Result := 48; end; //計算字串的總筆劃 function TotalStrokes(cstr: string):Integer; var i,n,L:Integer; c:string; begin Result:=0; L:=length(cstr); if L=0 then exit; n:=0; i:=1; while (i
ralph
初階會員


發表:41
回覆:82
積分:29
註冊:2003-02-04

發送簡訊給我
#2 引用回覆 回覆 發表時間:2003-02-13 08:59:37 IP:66.171.xxx.xxx 未訂閱
此程式在算"璿"筆劃會有問題 正確為19 它為18
bookworm
中階會員


發表:63
回覆:161
積分:82
註冊:2002-08-03

發送簡訊給我
#3 引用回覆 回覆 發表時間:2003-02-14 01:06:30 IP:210.85.xxx.xxx 未訂閱
「璿」是18劃吧?我反覆算了很多遍,都是18劃 還是你的算筆劃程式是想拿來算姓名學的呢? 如果這樣,這個程式不適合,還得修改..
axsoft
版主


發表:681
回覆:1056
積分:969
註冊:2002-03-13

發送簡訊給我
#4 引用回覆 回覆 發表時間:2003-02-14 12:05:09 IP:61.218.xxx.xxx 未訂閱
引言: 此程式在算"璿"筆劃會有問題 正確為19 它為18
如為姓名學算法需考慮標準字典及康熙字典的筆劃換算...兩者比畫有很大的差異 聯盟----Visita網站http://www.vista.org.tw ---[ 發問前請先找找舊文章 ]---
bookworm
中階會員


發表:63
回覆:161
積分:82
註冊:2002-08-03

發送簡訊給我
#5 引用回覆 回覆 發表時間:2003-02-14 13:04:06 IP:211.76.xxx.xxx 未訂閱
axsoft兄如果有姓名學算法的程式,也請不吝分享! 以前想過總是不得其門而入,盼指教!
ralph
初階會員


發表:41
回覆:82
積分:29
註冊:2003-02-04

發送簡訊給我
#6 引用回覆 回覆 發表時間:2003-02-19 01:35:35 IP:66.171.xxx.xxx 未訂閱
在姓名學(或字典)裡 璿為玉字旁
Main Chen
高階會員


發表:29
回覆:134
積分:127
註冊:2002-10-07

發送簡訊給我
#7 引用回覆 回覆 發表時間:2003-03-10 17:27:11 IP:61.56.xxx.xxx 未訂閱
姓名學中的文字筆劃依康熙字典筆劃, 沒有類似上述規則, 唯有建立查表才可能達到. 例: '政' 康熙 8 劃 '異' 康熙 12 劃 (下半部不算 '共' 是兩個 '十' 再一橫再兩點) 僅列舉一二, 還有很多很多的比較特殊例子.
aaronka2002
一般會員


發表:6
回覆:15
積分:4
註冊:2002-08-30

發送簡訊給我
#8 引用回覆 回覆 發表時間:2003-03-15 10:39:20 IP:218.187.xxx.xxx 未訂閱
function TotalStrokes中有一行 while (i begin 應改為啥呢?
irvinehing
初階會員


發表:75
回覆:79
積分:30
註冊:2003-11-12

發送簡訊給我
#9 引用回覆 回覆 發表時間:2004-01-07 10:53:37 IP:202.174.xxx.xxx 未訂閱
引言: //判斷某一個字元是否為中文的前導字元 function IsLeadByteTw(c:Char):Boolean; begin //根據附屬應用程式中的"字元對應表"計算而得 ($81 .. $FE) Result:=(c in [Char($81)..Char($FE)]); { //呼叫 Windows API 來計算 (但效率較差) Result:=IsDBCSLeadByte(Byte(c)); } end;
請問以上程式碼如何轉換成BCB程式碼?
qoo1234
版主


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

發送簡訊給我
#10 引用回覆 回覆 發表時間:2004-01-29 00:46:09 IP:218.163.xxx.xxx 未訂閱
引言: function TotalStrokes中有一行 while (i begin 應改為啥呢?
//計算字串的總筆劃
function TotalStrokes(cstr: string):Integer;
var
  i,n,L:Integer;
  c:string;
begin
  Result:=0;
  L:=length(cstr);
  if L=0 then exit;
  n:=0;
  i:=1;
  while (i
網海無涯,學無止境!
系統時間:2017-12-17 6:25:57
聯絡我們 | Delphi K.Top討論版
本站聲明
1. 本論壇為無營利行為之開放平台,所有文章都是由網友自行張貼,如牽涉到法律糾紛一切與本站無關。
2. 假如網友發表之內容涉及侵權,而損及您的利益,請立即通知版主刪除。
3. 請勿批評中華民國元首及政府或批評各政黨,是藍是綠本站無權干涉,但這裡不是政治性論壇!