ustring.pas

这是一个啤酒行业的软件

         else
            result:=false;
      end//if
      else
         result:=false;
   end;//if getCount

   /////对于分割符'/'的//////
   _firstPos1:=getSubFirstPos('/',s,1);
   _secondPos1:=getSubFirstPos('/',s,2);
   _year1:=copy(s,1,_firstPos1-1);///年
   _month1:=copy(s,_firstPos1+1,_secondPos1-_firstPos1-1);//月
   _day1:=copy(s,_secondPos1+1,length(s)-_secondPos1);///日
   if (getSubstringCount('/',s)=2) then
   begin
      ///yyyy/mm/dd//////////
      if (length(trim(_year1))=4) and (length(trim(_month1))=2)  and  (length(trim(_day1))=2) then
      begin
         if (isValidateNumber(_year1,false)) and (isValidateNumber(_month1,false)) and  (isValidateNumber(_day1,false)) then
         begin
            result:=true;
         end
         else
            result:=false;
      end//if
      else
         result:=false;
      ///yy/mm/dd//////////
      if (length(trim(_year1))=2) and (length(trim(_month1))=2)  and  (length(trim(_day1))=2) then
      begin
         if (isValidateNumber(_year1,false)) and (isValidateNumber(_month1,false)) and  (isValidateNumber(_day1,false)) then
         begin
            result:=true;
         end
         else
            result:=false;
      end//if
      else
        ///yy/m/d//////////
      if (length(trim(_year1))=2) and (length(trim(_month1))=1)  and  (length(trim(_day1))=1) then
      begin
         if (isValidateNumber(_year1,false)) and (isValidateNumber(_month1,false)) and  (isValidateNumber(_day1,false)) then
         begin
            result:=true;
         end
         else
            result:=false;
      end//if
      else
         result:=false; result:=false;

   end;//if getCount

   /////对于分割符'.'的//////
   _firstPos2:=getSubFirstPos('.',s,1);
   _secondPos2:=getSubFirstPos('.',s,2);
   _year2:=copy(s,1,_firstPos2-1);///年
   _month2:=copy(s,_firstPos2+1,_secondPos2-_firstPos2-1);//月
   _day2:=copy(s,_secondPos2+1,length(s)-_secondPos2);///日
   if (getSubstringCount('.',s)=2) then
   begin
      ////yyyy.mm.dd//////////////
      if (length(trim(_year2))=4) and (length(trim(_month2))=2)  and  (length(trim(_day2))=2) then
      begin
         if (isValidateNumber(_year2,false)) and (isValidateNumber(_month2,false)) and  (isValidateNumber(_day2,false)) then
         begin
            result:=true;
         end
         else
            result:=false;
      end//if
      else
         result:=false;
      ////yy.mm.dd//////////////
      if (length(trim(_year2))=2) and (length(trim(_month2))=2)  and  (length(trim(_day2))=2) then
      begin
         if (isValidateNumber(_year2,false)) and (isValidateNumber(_month2,false)) and  (isValidateNumber(_day2,false)) then
         begin
            result:=true;
         end
         else
            result:=false;
      end//if
      else
         result:=false;
      ////yy.m.d//////////////
      if (length(trim(_year2))=2) and (length(trim(_month2))=1)  and  (length(trim(_day2))=1) then
      begin
         if (isValidateNumber(_year2,false)) and (isValidateNumber(_month2,false)) and  (isValidateNumber(_day2,false)) then
         begin
            result:=true;
         end
         else
            result:=false;
      end//if
      else
         result:=false;
   end;//if getCount

   {/////增加一种情况即:yyyy年mm月dd日///////
   _yearPos:=pos('年',s);
   _monthPos:=pos('月',s);
   _dayPos:=pos('日',s);
   _len:=length(s);
   if (_yearPos>0)  and  (_MonthPos>0)  and (_dayPos>0)  and  (_len=14) then
   begin
      result:=true;
   end;
   }
end;
{
}
Function TuString.saveMessage :boolean;
begin
   if Application.MessageBox('确定是否存盘?','系统提示',MB_yesNo+MB_IconWarning)=Id_yes then
   begin
      result:=true;
   end
   else
     result:=false;
end;
{
}
Function TuString.deleteMessage:boolean;
begin
   if Application.MessageBox('确定是否删除当前记录?','系统提示',MB_yesNo+MB_IconWarning)=Id_yes then
   begin
      result:=true;
   end
   else
     result:=false;
end;
{
}
Function TuString.updateMessage:boolean;
begin
   if Application.MessageBox('确定是否修改当前记录?','系统提示',MB_yesNo+MB_IconWarning)=Id_yes then
   begin
      result:=true;
   end
   else
     result:=false;
end;
{
}
procedure  TuString.actionOK(actionType:TactionType);
begin
    if actionType=aT_save then
    begin
       showmessage('存盘成功...');
    end;
    if actionType=aT_delete then
    begin
       showmessage('删除成功...');
    end;
    if actionType=aT_update then
    begin
       showmessage('修改成功...');
    end;
end;
{
    功能：将小写数字的钱转换成答谢
    参数：
    用法：
}
Function TuString.NumberCn(mNumber: Real): WideString;
const
  cPointCn: WideString =  '点十百千万十百千亿十百千';
  cNumberCn: WideString =  '零一二三四五六七八九';
var
  I, L, P: Integer;
  S: string;
begin
   Result := '';
   if mNumber = 0 then begin
      Result := cNumberCn[1];
      Exit;
   end;
   S := FloatToStr(mNumber);
   if Pos('.', S) <= 0 then
   begin
       S := S + '.';
   end;
   P := Pos('.', S);
   L := Length(S);
   for I := 1 to L do
   begin
      if P > I then
      begin
         Result := Result + cNumberCn[StrToInt(S[I]) + 1] + cPointCn[P - I];
      end
      else
      begin
         if P = I then
         begin
            Result := StringReplace(Result, '零十零', '零', [rfReplaceAll]);
            Result := StringReplace(Result, '零百零', '零', [rfReplaceAll]);
            Result := StringReplace(Result, '零千零', '零', [rfReplaceAll]);
            Result := StringReplace(Result, '零十', '零', [rfReplaceAll]);
            Result := StringReplace(Result, '零百', '零', [rfReplaceAll]);
            Result := StringReplace(Result, '零千', '零', [rfReplaceAll]);
            Result := StringReplace(Result, '零万', '万', [rfReplaceAll]);
            Result := StringReplace(Result, '零亿', '亿', [rfReplaceAll]);
            Result := StringReplace(Result, '亿万', '亿', [rfReplaceAll]);
            Result := StringReplace(Result, '零点', '点', [rfReplaceAll]);
         end
         else
         begin
            if P < I then
               Result := Result + cNumberCn[StrToInt(S[I]) + 1];
            if Result[Length(Result)] = cPointCn[1] then
               Result := Copy(Result, 1, Length(Result) - 1);
            if Result[1] = cPointCn[1] then
               Result := cNumberCn[1] + Result;
            if (Length(Result) > 1) and (Result[2] = cPointCn[2]) and  (Result[1] = cNumberCn[2]) then
               Delete(Result, 1, 1);
         end;///if p
     end;////P>I
   end;//for I      
end;///Function NumberCN
/////将小写金额转化为大写金额////////////////////////////////////////
Function TuString.MoneyToCn(mMoney: Real): WideString;
var
   p:integer;
begin
     if mMoney = 0 then
     begin
        Result := '无';
        Exit;
     end;
     Result := NumberCn(Round(mMoney * 100) / 100);
     Result := StringReplace(Result, '一', '壹', [rfReplaceAll]);
     Result := StringReplace(Result, '二', '贰', [rfReplaceAll]);
     Result := StringReplace(Result, '三', '叁', [rfReplaceAll]);
     Result := StringReplace(Result, '四', '肆', [rfReplaceAll]);
     Result := StringReplace(Result, '五', '伍', [rfReplaceAll]);
     Result := StringReplace(Result, '六', '陆', [rfReplaceAll]);
     Result := StringReplace(Result, '七', '柒', [rfReplaceAll]);
     Result := StringReplace(Result, '八', '捌', [rfReplaceAll]);
     Result := StringReplace(Result, '九', '玖', [rfReplaceAll]);
     Result := StringReplace(Result, '九', '玖', [rfReplaceAll]);
     Result := StringReplace(Result, '十', '拾', [rfReplaceAll]);
     Result := StringReplace(Result, '百', '佰', [rfReplaceAll]);
     Result := StringReplace(Result, '千', '仟', [rfReplaceAll]);
     P := Pos('点', Result);
     if P > 0 then
     begin
       Insert('分', Result, P + 3);
       Insert('角', Result, P + 2);
       Result := StringReplace(Result, '点', '圆', [rfReplaceAll]);
       Result := StringReplace(Result, '角分', '角', [rfReplaceAll]);
       Result := StringReplace(Result, '零分', '', [rfReplaceAll]);
       Result := StringReplace(Result, '零角', '', [rfReplaceAll]);
       Result := StringReplace(Result, '分角', '', [rfReplaceAll]);
       if Copy(Result, 1, 2) = '零圆' then
       begin
          Result := StringReplace(Result, '零圆', '', [rfReplaceAll]);
       end
       else
          Result := Result + '整';
     end;////if
     ////////////////////////////
     Result := '' + Result;
end;////
procedure TuString.ShowPloyForm(bmp:Tbitmap;Hcontrol:Thandle);
var
   w1:Tbitmap;
   w2:Tcolor;
   Rgn:Hrgn;
begin
   w1:=TBitmap.Create;
   w1.Assign(bmp);
   w2:=w1.Canvas.Pixels[0,0];
   rgn := CreateRegion(w1,w2,hcontrol);
   if rgn<>0 then
   begin
      SetWindowRgn(Hcontrol, rgn, true);
   end;
   w1.Free;
end;
{
  功能:
  参数:
  用法:
}
Function TuString.CreateRegion(wMask:TBitmap;wColor:TColor;hControl:THandle): HRGN;
var
  dc, dc_c: HDC;
  rgn: HRGN;
  x, y: integer;
  coord: TPoint;
  line: boolean;
  color: TColor;
begin
  dc := GetWindowDC(hControl);
  dc_c := CreateCompatibleDC(dc);
  SelectObject(dc_c, wMask.Handle);
  BeginPath(dc);
  for x:=0 to wMask.Width-1 do
  begin
    line := false;
    for y:=0 to wMask.Height-1 do
    begin
      color := GetPixel(dc_c, x, y);
      if not (color = wColor) then
      begin
        if not line then
        begin
          line := true;
          coord.x := x;
          coord.y := y;
        end;
      end;
      if (color = wColor) or (y=wMask.Height-1) then
      begin
        if line then
        begin
          line := false;
          MoveToEx(dc, coord.x, coord.y, nil);
          LineTo(dc, coord.x, y);
          LineTo(dc, coord.x+1 , y);
          LineTo(dc, coord.x+1 , coord.y);
          CloseFigure(dc);
        end;
      end;
    end;
  end;
  EndPath(dc);
  rgn := PathToRegion(dc);
  ReleaseDC(hControl, dc);
  Result := rgn;
end;
{
  类定义结束
}
end.