yybj.~pas

简单的语音报价控件,支持男声和女声,以及各种文明用语等

unit YyBJ;

interface

uses
  SysUtils, Classes, MMSYSTEM;

type
  TYyBJ = class(TComponent)
  private
    FValue: single;
    procedure SetValue(const Value: single);
    function RoundValue(value: single;bit: integer): string;//用来四舍五入的函数
     procedure play(name:string);
    { Private declarations }
  protected
    { Protected declarations }
  public
    { Public declarations }
    procedure ReadHz(Value: single;bit: integer;sex:string);
    procedure ReadString(name: string;sex: string);
  published
    { Published declarations }
    property  Value: single read FValue write SetValue;
  end;

procedure Register;

implementation
{$R sound.res}
{$r MenSound.res}
procedure Register;
begin
  RegisterComponents('Samples', [TYyBJ]);
end;

{ TYyBJ }

procedure TYyBJ.play(name:string);
begin
 playsound(pchar(name),hInstance,SND_RESOURCE or SND_SYNC);
end;

procedure TYyBJ.ReadHZ(Value: single;bit: integer;sex:string);
var
  temp,str1: string;
  i,j,k: integer;
begin
  if value<0 then
  begin
    if sex='女' then play('fu') else play('mfu');
    value:=-value;
  end;
  if pos('.',floattostr(value))=0 then
    temp := floattostr(value)
  else
    temp := RoundValue(Value,bit);
  k := pos('.',temp)-1;
  j := length(temp);
  for i:= 1 to j do
  begin
     if (i=1)  and  (temp[i]='0') then
      continue
     else
     case temp[i] of
       '1': if sex='女' then play('one')   else play('mone');         // '一';
       '2': if sex='女' then play('two')   else play('mtwo');         // '二';
       '3': if sex='女' then play('three') else play('mthree');       // '三';
       '4': if sex='女' then play('four')  else play('mfour');        // '四';
       '5': if sex='女' then play('five')  else play('mfive');        // '五';
       '6': if sex='女' then play('six')   else play('msix');         // '六';
       '7': if sex='女' then play('seven') else play('mseven');       // '七';
       '8': if sex='女' then play('eight') else play('meight');       // '八';
       '9': if sex='女' then play('nine')  else play('mnine');        //  '九';
       '0': begin
            if (temp[i+1]='0') then
            begin
               continue;
            end
            else
              if (i<>j) and (temp[i+1]<>'.') and (length(temp)=1) then
               if sex='女' then play('ling') else play('mling');   // '零';
            end;
       '.': if (temp[i-1]<>'0')and(temp[i]<>'.') or (temp[i]='.') and (i<=j) then
             if sex='女' then play('yuan') else play('myuan');     // '元';
     end;
   str1 := copy(temp,1,pos('.',temp)-i);
   if (str1='') then
   if (i<=k) or (k=-1) then
    str1 :=copy(temp,1,length(temp)-i+1);
    case length(str1) of
      2:  begin
           if temp[i]<>'0' then
            if sex='女' then play('shi') else play('mshi');
          end;  //  '十';
      3:  begin
           if temp[i]<>'0' then
            if sex='女' then play('bai') else play('mbai');
          end;  //  '百';
      4:  begin
           if temp[i]<>'0' then
             if sex='女' then play('qian') else play('mqian');
          end;  //  '千';
      5:  begin
            if temp[i]<>'0' then
             if sex='女' then play('wan')  else play('mwan');
          end;  //  '万';
      6:  begin if (temp[i]<>'0') then
                  if temp[i+1]='0' then
                     begin
                       if sex='女' then
                         begin play('shi');play('wan'); end
                       else
                         begin play('mshi');play('mwan');end
                     end   // '十万';
                  else if sex='女' then play('shi') else play('mshi');
          end;
      7:  begin if temp[i]<>'0' then
            begin if temp[i+1]='0' then
              begin if temp[i+2]='0' then
                      begin
                        if sex='女' then
                          begin play('bai');play('wan');end
                        else
                          begin play('mbai');play('mwan');end;
                      end
                    else
                      if sex='女' then  play('bai') else play('mbai');
              end
              else // if temp[i+2]='0' then
                       //if sex='女' then  play('shi') else play('mshi')
                    //else
                       if sex='女' then  play('bai') else play('mbai');
            end;
          end;
    end;
    if pos('.',temp)<>0 then
    begin
     if i=pos('.',temp)+1 then
        if sex='女' then play('jiao') else play('mjiao')    //  '角'
      else if i=pos('.',temp)+2 then
        if sex='女' then play('fen')  else play('mfen');   //  '分'
    end;
  end;
  if k=-1 then
  begin
   if sex='女' then
   begin
    play('yuan');
    play('zhen');
   end
   else
   begin
    play('myuan');
    play('mzhen');
   end;
  end;
end;


function TYyBJ.RoundValue(value: single; bit: integer):string;
var
  temp: single;
  i,J: integer;
begin
  J := 1;
  for i := 1 to bit do
    J := J*10;
  temp := Value * J;
  temp:=int(temp+0.5);
  result:=floattostr(temp/j);
end;

procedure TYyBJ.SetValue(const Value: single);
begin
  FValue := Value;
  self.ReadHz(fvalue,1,'女');
end;



procedure TYyBJ.ReadString(name, sex: string);
begin
if sex='女' then
  self.play(name)
else
  self.play('m'+name);
end;

end.