ucountstroke.pas

姓名缘分测试之Delphi版

#12#13#13#14#14#14#15#20#21#22#0#5#5#6#6#6+ 
#6#6#6#6#7#7#7#7#7#7#7#7#7#7#7#7+ 
#7#7#7#7#7#7#7#7#7#7#7#8#8#8#8#8+ 
#8#8#8#8#8#8#8#8#8#8#8#8#8#8#9#9+ 
#9#9#9#9#9#9#9#9#9#9#9#9#9#9#9#9+ 
#9#9#9#9#9#9#9#9#9#9#9#9#9#10#10#10+ 
#10#10#10#10#10#10#10#10#10#10#10#10#10#10#10#10+ 
#10#11#11#11#11#11#11#11#11#11#11#11#11#11#11#11+ 
#11#11#11#11#11#11#11#11#11#11#11#12#12#12#12#12+ 
#12#12#12#12#12#12#12#12#12#12#12#12#12#13#13#13+ 
#13#13#13#13#13#13#13#13#13#13#13#13#13#14#14#14+ 
#14#14#14#14#14#14#14#14#15#15#15#15#15#15#15#15+ 
#15#16#16#16#16#16#16#16#16#16#17#17#17#17#17#18+ 
#19#19#19#20#20#22#0#9#6#7#9#9#10#10#11#0+ 
#6#7#13#0#6#7#8#8#8#8#9#9#9#10#10#10+ 
#11#11#11#11#11#11#11#11#11#11#11#11#12#12#12#12+ 
#12#12#12#12#12#12#13#13#13#13#13#13#13#13#14#14+ 
#14#14#14#15#15#15#15#16#16#16#17#17#19#23#25#3+ 
#7#8#12#5#5#5#5#5#5#6#6#6#7#7#7#7+ 
#7#7#7#7#7#7#7#8#8#8#8#8#8#8#8#8+ 
#8#8#9#9#9#9#9#9#9#9#9#9#9#9#9#9+ 
#9#9#9#9#9#9#9#9#9#9#10#10#10#10#10#10+ 
#10#10#10#10#10#11#11#11#11#11#11#11#11#11#11#11+ 
#11#11#11#11#11#11#11#11#12#12#12#12#12#12#12#12+ 
#12#12#12#12#12#12#12#12#12#13#13#13#13#13#13#13+ 
#13#13#13#13#13#13#13#13#13#13#13#13#13#13#14#14+ 
#14#14#14#14#14#14#14#15#15#15#15#15#15#15#15#15+ 
#15#15#16#16#16#16#16#16#17#17#19#25#0#6#6#7+ 
#7#8#9#10#11#11#16#7#8#8#8#10#11#11#11#12+ 
#14#14#15#15#6#6#7#7#7#7#7#7#7#7#7#8+ 
#8#8#8#8#8#8#8#8#8#9#9#9#9#10#10#11+ 
#11#11#11#11#11#11#12#12#12#12#12#12#12#12#12#12+ 
#13#13#13#14#15#15#17#17#19#3#7#8#9#9#9#10+ 
#11#11#12#13#15#16#24#0#0#5#6#6#6#7#7#8+ 
#8#8#9#9#9#9#10#10#10#10#10#10#10#11#11#11+ 
#11#11#11#11#12#12#12#12#12#12#14#14#15#15#16#17+ 
#20#6#14#12#14#0#0#6#7#7#7#7#7#8#9#10+ 
#10#11#12#12#13#13#14#15#15#25#5#7#7#8#9#9+ 
#11#11#11#11#12#13#14#15#16#16#17#0#5#6#6#7+ 
#7#7#7#7#7#7#7#7#7#7#8#8#8#8#8#8+ 
#8#8#8#8#8#9#9#9#9#9#9#9#10#10#10#10+ 
#10#10#10#10#11#11#11#11#11#11#11#11#12#12#12#12+ 
#12#12#12#13#13#14#15#15#15#16#16#18#8#17#4#6+ 
#7#7#7#7#9#9#10#10#10#11#11#11#11#11#11#12+ 
#12#13#13#13#14#0#4#8#0#6#6#6#7#7#7#7+ 
#7#7#7#7#7#7#7#7#8#8#8#8#8#8#8#8+ 
#8#8#8#8#8#8#8#8#9#9#9#9#9#9#9#9+ 
#9#9#9#9#9#9#9#9#9#9#10#10#10#10#10#10+ 
#10#10#10#10#10#11#11#11#11#11#11#11#11#11#11#11+ 
#11#11#11#11#12#12#12#12#12#12#12#12#12#12#12#12+ 
#13#13#13#13#13#13#13#13#13#13#13#13#13#13#13#13+ 
#13#14#14#14#14#14#14#14#14#14#14#14#14#14#14#15+ 
#15#15#15#15#15#16#16#16#16#16#16#17#17#17#17#17+ 
#19#19#19#20#20#21#24#0#5#8#8#9#10#12#13#14+ 
#14#15#16#16#17#17#0#7#7#8#8#8#8#8#8#8+ 
#9#9#10#10#10#10#10#10#11#11#11#11#12#12#12#12+ 
#13#13#13#13#15#15#16#16#17#17#18#0#11#9#12#5+ 
#9#10#10#12#14#15#21#8#8#9#11#12#22#0#6#6+ 
#7#7#7#7#7#7#7#7#7#7#8#8#8#8#9#9+ 
#9#9#9#9#9#10#10#10#10#10#10#10#10#11#11#11+ 
#11#11#11#11#12#12#12#12#13#13#13#13#13#13#14#14+ 
#14#14#14#14#14#15#16#16#17#17#20#5#9#7#8#12+ 
#3#3#8#8#8#8#8#8#8#8#9#9#9#10#11#11+ 
#11#11#12#12#13#13#13#14#14#15#19#20#0#6#6#6+ 
#6#6#7#7#7#8#8#8#8#8#8#8#9#9#9#10+ 
#10#10#11#11#11#11#11#11#11#11#11#11#11#12#12#12+ 
#12#12#12#12#12#12#12#13#13#13#13#13#13#13#13#14+ 
#14#14#14#14#15#15#15#16#16#16#16#19#3#15#3#8+ 
#10#6#6#8#8#8#9#9#9#9#9#9#9#9#10#10+ 
#10#10#10#10#10#10#10#11#12#12#12#12#12#12#12#12+ 
#12#12#13#13#13#13#13#14#14#15#15#15#15#15#15#15+ 
#16#17#17#17#18#20#19#13#13#14#7#7#7#7#7#8+ 
#8#8#8#8#8#8#8#8#8#8#8#8#9#9#9#9+ 
#9#9#9#9#9#9#9#9#9#9#9#9#9#9#9#10+ 
#10#10#10#10#10#10#10#10#10#10#10#10#10#10#10#10+ 
#10#10#11#11#11#11#11#11#11#12#12#12#12#12#12#12+ 
#12#12#12#12#12#13#13#13#13#13#13#13#13#13#13#13+ 
#13#13#13#13#13#13#13#13#14#14#14#14#14#14#14#14+ 
#14#14#14#14#14#15#15#15#15#15#15#15#14#16#16#16+ 
#16#16#16#16#16#16#16#16#17#17#17#17#18#13#14#8+ 
#9#9#9#11#11#11#12#12#14#16#7#8#9#9#9#9+ 
#9#9#9#9#9#10#10#10#10#11#12#12#12#12#13#15+ 
#16#10#5#8#11#12#12#13#13#13#14#14#8#9#12#16+ 
#16#17#4#6#6#7#8#8#8#8#8#8#8#9#9#9+ 
#9#9#9#10#10#10#10#10#10#11#11#12#13#13#14#14+ 
#16#18#18#20#21#9#9#9#9#10#10#10#10#11#11#11+ 
#12#12#14#9#10#11#12#13#14#15#15#9#16#6#8#9+ 
#11#11#12#12#12#13#14#10#11#12#14#17#10#10#12#12+ 
#12#13#16#16#16#22#5#6#7#7#9#10#10#11#13#0+ 
#11#13#12#13#15#9#15#6#7#7#7#8#8#8#8#8+ 
#8#8#8#9#9#9#9#9#9#9#9#9#9#9#9#9+ 
#10#10#10#10#10#10#10#10#10#11#11#11#11#11#11#12+ 
#12#12#12#12#12#12#13#13#13#13#13#13#13#13#14#14+ 
#14#15#15#16#17#17#17#17#17#16#7#11#12#13#13#16+ 
#9#9#12#13#16#16#4#13#13#17#12#15#16#8#10#10+ 
#10#11#11#13#14#7#8#8#8#9#9#9#9#9#10#10+ 
#11#11#11#12#12#13#13#13#13#13#13#13#13#14#15#15+ 
#15#15#16#16#16#18#21#30#0#11#13#16#8#8#9#11+ 
#12#0#7#8#8#9#9#9#9#9#9#9#10#10#12#12+ 
#13#14#16#21#7#7#9#10#10#10#10#10#10#11#13#13+
#14#16#16#17#17#25#0#6#8#9#12#7#8#8#9#9+ 
#9#9#9#9#9#10#10#10#10#10#10#10#10#10#10#11+
#11#11#11#11#11#11#11#12#13#13#13#13#13#14#14#14+ 
#14#14#15#15#15#16#16#17#17#18#19#18#21#11#12#17+ 
#19#8#9#9#9#9#9#10#10#10#11#11#11#11#12#12+ 
#12#12#13#13#13#13#14#14#14#14#15#15#16#16#16#17+ 
#18#7#8#9#9#9#10#12#13#17#9#10#10#12#13#14+ 
#14#16#17#17#10#16#23#0#6#6#7#7#7#8#8#8+ 
#8#8#8#9#9#9#9#9#9#9#9#9#9#10#10#10+ 
#10#10#10#10#10#10#10#10#10#10#10#10#10#10#10#10+ 
#11#11#11#11#11#11#11#11#11#11#11#11#11#11#11#11+ 
#11#11#11#11#11#11#11#11#11#11#12#12#12#12#12#12+ 
#12#12#12#12#12#12#12#12#12#12#12#13#13#13#13#13+ 
#13#13#13#13#13#13#13#14#14#14#14#14#14#14#14#14+ 
#14#14#14#15#15#15#15#15#15#15#15#16#16#16#16#16+ 
#16#16#16#17#17#17#17#17#17#17#17#17#17#18#18#18+ 
#19#20#14#9#12#13#9#9#10#10#11#12#12#12#13#13+ 
#15#15#16#17#18#22#9#11#12#13#17#10#11#7#7#8+ 
#9#9#10#10#10#10#10#10#11#11#11#11#11#12#12#12+ 
#12#12#12#13#13#13#13#13#14#14#14#14#14#15#15#16+ 
#16#16#17#17#17#17#19#18#22#0#7#7#8#8#9#9+ 
#10#10#10#10#10#10#10#10#11#11#12#12#12#12#12#12+ 
#13#13#13#13#13#13#13#14#14#14#14#14#14#14#15#15+ 
#15#15#16#16#16#16#16#16#16#16#17#18#18#18#18#21+ 
#23#11#12#8#8#9#9#10#11#13#13#14#14#14#15#0+ 
#8#9#9#9#9#10#11#11#11#11#12#12#12#12#13#13+ 
#13#13#13#13#14#14#14#14#14#15#15#16#17#19#24#5+ 
#9#11#12#9#6#9#10#11#12#13#14#15#15#16#16#22+ 
#12#8#11#11#11#12#15#16#12#9#10#10#12#12#12#12+ 
#13#15#15#16#16#16#18#20#21#0#10#7#8#9#9#9+ 
#9#10#10#10#10#10#10#10#10#10#10#11#11#11#11#11+ 
#11#11#11#11#11#11#12#12#12#12#12#12#12#12#12#12+ 
#12#12#13#13#13#13#13#13#13#13#14#14#14#14#14#14+ 
#14#14#14#14#14#14#14#14#15#15#15#15#15#15#15#15+ 
#15#15#15#15#15#15#16#16#16#16#16#16#16#16#16#16+ 
#17#17#17#17#17#17#17#17#17#17#17#18#18#18#18#19+ 
#19#19#19#20#21#24#26#6#14#17#17#10#8#9#9#9+ 
#10#10#10#10#10#11#11#11#11#11#11#11#11#11#11#11+ 
#11#12#12#12#12#12#12#13#13#13#13#13#13#14#14#14+ 
#14#14#14#14#14#14#14#14#14#15#15#15#15#16#16#16+ 
#16#16#17#17#17#17#17#17#18#18#18#19#19#19#8#9+ 
#11#12#10#10#9#9#9#10#10#10#10#11#11#11#11#12+ 
#13#13#14#15#17#18#19#10#10#11#13#13#19#11#11#13+ 
#15#15#16#9#10#10#11#11#12#12#13#14#14#14#15#15+ 
#15#15#15#16#18#6#14#9#11#12#14#14#15#15#16#17+ 
#6#12#14#14#17#25#11#19#9#12#13#13#23#11#15#10+ 
#11#9#10#10#10#12#12#12#13#13#13#14#14#14#14#14+ 
#15#15#16#16#16#17#17#18#19#19#19#20#20#21#7#16+ 
#10#13#14#18#18#10#10#11#11#11#12#12#12#12#12#12+ 
#12#12#13#13#13#13#13#13#13#14#14#15#15#15#15#15+ 
#15#15#15#16#16#16#16#16#16#16#16#17#17#17#19#19+ 
#19#19#19#20#21#22#22#23#24#7#12#13#13#17#17#11+ 
#11#12#12#13#13#14#15#13#18#12#11#12#12#14#14#15+ 
#16#16#19#19#20#22#10#13#13#13#14#14#15#15#17#8+ 
#12#20#8#10#10#13#14#18#18#14#14#15#16#17#18#18+ 
#21#24#12#12#13#13#13#13#13#13#13#13#14#14#14#14+ 
#14#14#14#14#15#15#15#15#15#15#15#15#15#15#16#16+ 
#16#16#16#16#16#16#16#16#16#16#17#17#17#17#17#17+ 
#17#17#18#18#18#18#18#19#19#19#19#19#19#20#20#20+ 
#21#14#14#15#15#16#18#18#18#19#19#13#13#14#14#14+ 
#15#15#17#17#18#18#19#19#22#14#14#15#16#16#17#19+ 
#12#15#18#22#22#10#13#14#15#15#16#16#16#18#19#20+ 
#23#25#14#15#17#13#16#16#17#19#19#21#23#17#17#17+ 
#18#18#19#20#20#20#20#21#17#18#20#23#23#16#17#23; 

var 
  no:integer;
  BiHua:integer;
  str:string; // str[40]
  BiHuaI:integer;
  ch1:char;
  ch2:char;
  len:integer;
  StrokesTotal:integer;
begin 
  str:=chnstr;
  BiHuaI:=1;
  BiHua:=0;
  StrokesTotal:=0;
  len:=length(str);
  while BiHuaI<=len do
  begin
    ch1:=str[BiHuaI];
    BiHuaI:=BiHuaI+1;
    if (ord(ch1)>=176) and (BiHuaI<=len) then
    begin
      ch2:=str[BiHuaI];
      BiHuaI:=BiHuaI+1;  //----这一行在只查一个汉字的时候用不着 2002.10
      no:=(ord(ch1)-176)*94+(ord(ch2)-160);
      BiHua:=ord(StrokesTable[no]);
      StrokesTotal:= StrokesTotal + BiHua; //多个汉字
    end
    else
    begin
      BiHua:=0;
    end;
   //  break; 只要查出第一个汉字即可
  end;
  result:=StrokesTotal;
end;


procedure TfrmTestlot.btncountClick(Sender: TObject);
var
  YourNum,OtherNum,differenceNum:integer;
begin
  if (eYourName.Text<>'') and (eOtherName.Text<>'') then
  begin
    YourNum := GetStrokes(trim(eYourName.Text));
    OtherNum := GetStrokes(trim(eOtherName.Text));
    differenceNum := abs(OtherNum -YourNum);
    lResult.Caption:=CheckTab(differenceNum);
  end
  else
  begin
    application.MessageBox('请输入各自的姓名！','提示',MB_OK);
    eYourName.SetFocus;
  end;
end;

function TfrmTestlot.CheckTab(differenceNum:integer): string;
var
conclusion:string;
begin
  case differenceNum of
    0:conclusion:='亲密无间';
    1:conclusion:='永远和你在一起';
    2:conclusion:='水火不相容';
    3:conclusion:='知心朋友';
    4:conclusion:='心上人';
    5:conclusion:='帮你做事的人';
    6:conclusion:='帮你的人';
    7:conclusion:='面和心不合';
    8:conclusion:='男女关系不正常';
    9:conclusion:='情投意合';
    10:conclusion:='关系马虎';
    11:conclusion:='尊敬你的人';
    12:conclusion:='爱你的人';
    13:conclusion:='适合你的';
    14:conclusion:='说你坏话的人';
    15:conclusion:='克星';
    16:conclusion:='救星';
    17:conclusion:='忠心的人';
    18:conclusion:='狼心狗肺的人';
    19:conclusion:='单相思';
    20:conclusion:='山盟海誓';
    21:conclusion:='情敌';
    22:conclusion:='服从你的人';
    23:conclusion:='永远在一起';
    24:conclusion:='伴终生';
    25:conclusion:='恨你又爱你';
    else
      conclusion:='只有天知道';
  end;
  result := conclusion;
end;


procedure TfrmTestlot.FormKeyPress(Sender: TObject; var Key: Char);
begin
  if (Key = #13) then
  begin
    Key := #0;
    perform(WM_NEXTDLGCTL,0,0);
  end;
end;

procedure TfrmTestlot.LhyperlinkClick(Sender: TObject);
begin
  ShellExecute(handle,nil,pchar(Lhyperlink.Caption),nil,nil,sw_shownormal);
  { 如果为字符串参数,其中包含有变量或运算的需要用 PCHAR() 函数进行类型转化。 }

end;

procedure TfrmTestlot.LhyperlinkMouseMove(Sender: TObject;
  Shift: TShiftState; X, Y: Integer);
begin
   with Lhyperlink do
   begin
     Font.Color := clBlue;
     Font.Style := [fsUnderline];
   end;
end;

procedure TfrmTestlot.LhyperlinkMouseLeave(Sender: TObject);
begin
  with Lhyperlink do
  begin
    Font.Color := clWindowText;
    Font.Style := [];
  end;
end;

procedure TfrmTestlot.btnTryagainClick(Sender: TObject);
begin
  eYourName.text:='';
  eotherName.Text:='';
  lResult.Caption := '';
  eYourName.SetFocus;
end;                       

end.