function IntToEAN13(var Value:Int64):PChar; cdecl; export;
var S:String;
    i:Integer;
    _check, _sum, _odd, _even : Integer;
const zArray : array [1..11] of String =
(
'20000000000',
'2000000000',
'200000000',
'20000000',
'2000000',
'200000',
'20000',
'2000',
'200',
'20',
'2'
);

begin
   //
   S := IntToStr(Value);
   S := zArray[Length(S)] + S;
   _odd := 0;
   _even := 0;
   for i:=0 to 11 do
   begin
      if (i div 2)*2=i
      then _even := _even + StrToInt(Copy(S,i+1,1))
      else _odd  := _odd +  StrToInt(Copy(S,i+1,1));
   end;
   _odd := _odd * 3;
   _sum := _odd + _even;
   _check := (_sum div 10)*10;
   if _check=_sum
   then _check := 0
   else _check := _check + 10 - _sum;
   //
   Result := PChar(S + IntToStr(_check));
end;

CREATE PROCEDURE ID2EAN13 (
    prefix varchar(10),
    id integer)
returns (
    barcode varchar(13))
as
declare variable n integer;
begin
      barcode = prefix || lpad(id, 12-char_length(prefix), '0');

      n = (cast (substring (barcode from 2 for 1) as integer)+
           cast (substring (barcode from 4 for 1) as integer)+
           cast (substring (barcode from 6 for 1) as integer)+
           cast (substring (barcode from 8 for 1) as integer)+
           cast (substring (barcode from 10 for 1) as integer)+
           cast (substring (barcode from 12 for 1) as integer))*3+
           cast (substring (barcode from 1 for 1) as integer)+
           cast (substring (barcode from 3 for 1) as integer)+
           cast (substring (barcode from 5 for 1) as integer)+
           cast (substring (barcode from 7 for 1) as integer)+
           cast (substring (barcode from 9 for 1) as integer)+
           cast (substring (barcode from 11 for 1) as integer);

      n = mod(n,10);
      if (n>0) then n = 10-n;
      barcode = barcode || cast (n as varchar(20));
  suspend;
end

Attribute VB_Name = "Barcode"
Option Explicit
Private Function Code_39_Ch(Ch As String) As String
    Dim S As String
    Select Case Ch
        Case "1": S = "28002"
        Case "2": S = "0:002"
        Case "3": S = "2:000"
        Case "4": S = "08202"
        Case "5": S = "28200"
        Case "6": S = "0:200"
        Case "7": S = "08022"
        Case "8": S = "28020"
        Case "9": S = "0:020"
        Case "0": S = "08220"
        Case Else: S = ""
    End Select
    Code_39_Ch = S
End Function
Public Function CODE_BAR(CARD As String)
    Dim I As Integer
    Dim S As String
    S = ""
    For I = 1 To Len(CARD)
        S = S & Code_39_Ch(Mid(CARD, I, 1))
    Next I
    CODE_BAR = "80220" & S & "80220"
End Function

Posted via ActualForum NNTP Server 1.5