大神求助啊！！！！！

const
  maxn=73;
var
  i,j,k:longint;
  ss:array[1..26,1..73] of char;
  s:array[1..4] of string;
  a:array[1..26] of longint;
begin
  fillchar(a,sizeof(a),0);
  for i:=1 to 26 do
    ss[i,maxn]:=chr(i+ord('A')-1);
  {FOR I:=1 TO 26 DO WRITE(SS[I,MAXN]);
  WRITELN;}
  for i:=1 to 4 do readln(s[i]);
  for i:=1 to 4 do
    for j:=1 to length(s[i]) do
      if (ord(s[i][j])<ord('A'))or(ord(s[i][j])>ord('Z')) then
        delete(s[i],j,1);
  for i:=1 to 4 do
    for j:=1 to length(s[i]) do begin
      k:=ord(s[i][j])-ord('A')+1;
      inc(a[k]);
      ss[k,maxn-a[k]]:='*';
        end;
  i:=1;j:=1;
  while ss[i,j]<>'*' do begin
    ss[i,j]:=' ';
    inc(i);
    if i=27 then begin
      i:=1;
      inc(j);
    end;
  end;
  for i:=j to maxn do begin
    for k:=1 to 26 do
      write(ss[k,i],' ');
    writeln;
  end;
  {WRITELN;
  FOR I:=1 TO 26 DO WRITE(SS[I,MAXN]);}
end.

样例： * * * *

* * * *

* * * *

* * * * * *

* * * * * * * * * *

* * * * * * * * * * * * *

* * * * * * * * * * * * * * * * * *

* * * * * * * * * * * * * * * * * * * * * * * * * *

A B C D E F G H I J K L M N O P Q R S T U V W X Y Z

自己的：

* * * *

* * * *

* * * *

* * * * * *

* * * * * * * * * *

* * * * * * * * * * * * *

* * * * * * * * * * * * * * * * * *

* * * * * * * * * * * * * * * * * * * * * * * * * *

A B C D E F G H I J K L M N O P Q R S T U V W X Y Z