扑克牌算24点的程序我很久以前编过，但是编得程序太长，一直不满意。

program point_24;
type
    numbertype=record
       val:real;
       c:integer;
       s:string[100];
    end;
    arraynum=array[1..4] of numbertype;
var
  b:arraynum;
  a:array[1..4] of real;
  i:integer;
  found,error:boolean;

function inttostr(n:integer):string;
var
  s:string;
begin
    s:='';
    repeat
       s:=chr(ord('0')+n mod 10)+s;
       n:=n div 10;
    until n=0;
    inttostr:=s;
end;

procedure connet_it(a0,b0:numbertype;i:integer);
var
   j:integer;
   s1,s2:string;
begin
    if a0.s='' then s1:='('+inttostr(trunc(a0.val))
        else s1:='('+a0.s;
    if b0.s='' then s2:=inttostr(trunc(b0.val))+')'
        else s2:=b0.s+')';

    case  b0.c of
     1:   begin
            a0.s:=s1+'+'+s2;
            a0.val:=a0.val+b0.val;
          end;
     2:   begin
            a0.s:=s1+'-'+s2;
            a0.val:=a0.val-b0.val;
          end;
     3:   begin
            a0.s:=s1+'*'+s2;
            a0.val:=a0.val*b0.val;
          end;
     4:   begin
             if b0.val=0 then
               begin
                   error:=true;
                   exit;
               end;
            a0.s:=s1+'/'+s2;
            a0.val:=a0.val/b0.val;
          end;
    end;
    b[i]:=a0;
    for j:=i+2 to 4 do b[j-1]:=b[j];
end;

procedure Cal(n:integer);
var
   i:integer;
   temp:arraynum;
begin
   if (n=1)  then
     begin
       if not error and (abs(b[1].val-24)<0.000001) then
        begin
           found:=true;
           writeln(b[1].s,' = ', 24);
         end;
       exit;
     end;
   for i:=1 to n-1 do
     begin
          error:=false;
          temp:=b;
          connet_it(b[i],b[i+1],i);
          if not error then Cal(n-1);
          if found then exit;
          b:=temp;
     end;
end;

procedure SortC(n:integer);
var
   i:integer;
begin
    if n=5 then
     begin
        found:=false;
        Cal(4);
        exit;
     end;
    for i:=1 to 4 do
      begin
         b[n].c:=i;
         SortC(n+1);
         if found then exit;
      end;
end;

procedure SortNum(n:integer);
var
   i,j,k,L:integer;
begin
   if n=5 then
    begin
        b[1].c:=1;
        SortC(2);
        exit;
    end;
   for i:=1 to 4 do
     if a[i]<>-1 then
      begin
          b[n].val:=a[i];
          a[i]:=-1;
          SortNum(n+1);
          if found then exit;
          a[i]:=b[n].val;
      end;
end;

begin
    write('Enter 4 integers: ');
    for i:=1 to 4 do
      begin
          read(a[i]);
          b[i].c:=0;
          b[i].s:='';
      end;
    found:=false;
    SortNum(1);
    if not found then  writeln('Not found.');
end.

var
a,ca:array[1..4] of real;
b:array[1..4] of integer;
fu:array[1..3] of char;
m,n,i,xt:integer;
procedure c24(f,k:integer;x:real);
  var
   i,j,t:integer;
  begin
    if (k=4)and(x=24) then
       if ((fu[1]='+')or(fu[1]='-'))and((fu[2]='+')or(fu[2]='-'))and((fu[3]='*')or(fu[3]='/')) then
         writeln('(',a[b[1]]:0:0,fu[1],a[b[2]]:0:0,fu[2],a[b[3]]:0:0,')',fu[3],a[b[4]]:0:0)
       else
         if ((fu[1]='+')or(fu[1]='-'))and((fu[2]='*')or(fu[2]='/')) then
         writeln('(',a[b[1]]:0:0,fu[1],a[b[2]]:0:0,')',fu[2],a[b[3]]:0:0,fu[3],a[b[4]]:0:0)
       else
         if ((fu[1]='*')or(fu[1]='/'))and((fu[2]='+')or(fu[2]='-'))and((fu[3]='*')or(fu[3]='/')) then
         writeln('(',a[b[1]]:0:0,fu[1],a[b[2]]:0:0,fu[2],a[b[3]]:0:0,')',fu[3],a[b[4]]:0:0)
       else writeln(a[b[1]]:0:0,fu[1],a[b[2]]:0:0,fu[2],a[b[3]]:0:0,fu[3],a[b[4]]:0:0)
    else if k<4 then
      begin
        for i:=1 to 4 do
          begin
            t:=0;
            for j:=1 to k do
            if b[j]=i then t:=1;
            if t=0 then
              begin
                b[k+1]:=i;
                fu[f]:='+'; c24(f+1,k+1,x+a[i]);
                fu[f]:='-'; c24(f+1,k+1,x-a[i]);
                fu[f]:='*'; c24(f+1,k+1,x*a[i]);
                fu[f]:='/'; c24(f+1,k+1,x/a[i]);
              end;
           end;
      end;
  end;
begin
  for m:=1 to 4 do
    begin
      read(a[m]);
      xt:=0; ca[m]:=0;
      for n:=1 to m-1 do
        if a[m]=ca[n] then xt:=1;
      if xt=0 then
        ca[m]:=a[m];
    end;
  for m:=1 to 4 do
    if ca[m]<>0 then
      begin
        b[1]:=m;
        c24(1,1,ca[m]);
      end;
end.

给个算法自己做.
 flag:=True;
 for op1:='+' to '/' do
  for op2:='+' to '/' do
   for op3:='+' to '/' do
    if 运算结果=24 then
     begin
      输出算式;
      flag:=false;
     end;
    if flag=true then声称无解;