こんな強引な感じになりましたが一応例どおり動きました。 Program en9a(input,output); var i,n :integer; max,min :real; sin:array[1..100] of integer; begin write('人数は？'); readln(n); for i:=1 to n do begin writeln(i,'人目の身長を入力してください'); readln(sin[i]); end; max:=sin[1]; min:=sin[1]; writeln('人数 制御変数 身長 最高 最低 '); writeln(n);
709 名前：６７６ [03/11/04 12:18]
i:=1; repeat IF sin[i]>max then max:=sin[i]; IF sin[i]<min then min:=sin[i]; write(' ',i,' ', sin[i]); IF sin[i]=max then write(' ',max:3:1); IF sin[i]=min then write(' ',min:3:1); writeln; i:=i+1; until i<>1; for i:=2 to n do begin IF sin[i]>max then max:=sin[i]; IF sin[i]<min then min:=sin[i]; write(' ',i,' ', sin[i]); IF sin[i]=max then write(' ',max:3:1); IF sin[i]=min then write(' ',min:3:1); writeln; end; end.
710 名前：６７６ Ｂのほう [03/11/04 12:19]
Program en9b(input,output); var i,n :integer; max,min :real; sin:array[1..100] of integer; begin n:=1; i:=1; writeln(i,'人目の身長を入力してください'); readln(sin[i]); while sin[i]<>0 do begin i:=i+1; writeln(i,'人目の身長を入力してください'); readln(sin[i]); n:=n+1; end; max:=sin[1]; min:=sin[1]; writeln('人数 制御変数 身長 最高 最低 '); writeln(n-1);
711 名前：６７６ Ｂのほう２ [03/11/04 12:20]
i:=1; repeat IF sin[i]>max then max:=sin[i]; IF sin[i]<min then min:=sin[i]; write(' ',i,' ', sin[i]); IF sin[i]=max then write(' ',max:3:1); IF sin[i]=min then write(' ',min:3:1); writeln; i:=i+1; until i<>1; for i:=2 to n-1 do begin IF sin[i]>max then max:=sin[i]; IF sin[i]<min then min:=sin[i]; write(' ',i,' ', sin[i]); IF sin[i]=max then write(' ',max:3:1); IF sin[i]=min then write(' ',min:3:1); writeln; end; end.
program sifuto(input,uotput); type suuji = array[1..10] of char; var a : suuji; x,y,n : integer; begin begin write('１０文字入力'); readln(a); end; write('いくつずらす？'); readln(x); for y:= 11-x to 10 do write(a[y]); for n:=1 to 10-x do write(a[n]); writeln() end.
720 名前：デフォルトの名無しさん mailto:sage [03/11/05 20:11]
今日配列使って作ったもう一個のﾔﾂ program sinnsuu(input,output); type suuji = array[1..4] of integer; var a : suuji; c, ans : integer; d : integer; begin Write('Decimal : '); Read(d); c := 0; while d <> 0 do begin c := c + 1; ans := d mod 2; d := d div 2; a[c]:=ans end; for c:= 4 downto 1 do write(a[c]); writeln() end.
とりあえず、簡単なサンプル(Delphi6で確認）。 何かキーを押すと終了する。 program Project2; {$APPTYPE CONSOLE} uses Windows, SysUtils, Win32Crt; var f, b: Integer; begin for b := 0 to 15 do begin ClrScr; for f := 0 to 15 do begin TextColor(f); TextBackground(b); gotoXY(f * 2, f); Writeln('Test String [', WhereX, ',', WhereY, ']'); Sleep(1000); if KeyPressed then Exit end end end.
function ReverseString( S : String ) : string; var I, J : Integer; begin J:=Length(S); SetLength( Result, J); for I:=1 to J do Result[i]:=S[J+1-I]; end;
実行してないんで動くかどうかはシラネ
769 名前：デフォルトの名無しさん mailto:sage [03/11/22 15:47]
program rev; var st : string; i : integer;
procedure swap(var a, b : char); var t : char; begin t := a; a := b; b := t; end;
begin readln(st); for i := 1 to length(st) div 2 do swap(st[i], st[length(st) - i + 1]); writeln(st); end.
function ReverseString(S : string) : string; var i : integer; begin for i := 1 to length(S) do result := concat(S[i], result); end;
777 名前：デフォルトの名無しさん mailto:sage [03/11/24 17:04]
再帰バージョン
function reverseString (a: string): string; begin if length(a) <= 1 then reverseString := a else reverseString := concat(reverseString(omit(a, 1, 1)), a[1]); end;
program Hoge; {$APPTYPE CONSOLE} var bignum : array [1..30] of Integer; function keta: Integer; var i : Integer; begin i := 30; while (bignum[i] = 0) and (i > 1) do i := i - 1; keta := i; end; { keta } procedure nibai; var i : Integer; begin for i := 1 to 30 do bignum[i] := bignum[i] * 2; for i := 1 to 29 do begin bignum[i+1] := bignum[i+1] + bignum[i] div 10; bignum[i] := bignum[i] mod 10; end;end; { nibai } procedure print; var i : Integer; begin for i := 30 downto 1 do Write(bignum[i]);end; { print } procedure init; var i : Integer; begin for i := 2 to 30 do bignum[i] := 0; bignum[1] := 1;end; { init } begin init; while keta < 30 do nibai; print; end.
784 名前：デフォルトの名無しさん mailto:sage [03/11/25 09:49]
procedure init; var i : Integer; begin Read(i); bignum[1] := i; for i := 1 to 29 do begin bignum[i+1] := bignum[i] div 10; bignum[i] := bignum[i] mod 10; end; end; { init }
program ensyu(input,output); const msg ='英単語の綴りを逆順にします。'; var engword,downword:string[30]; Len,i :integer; begin writeln(msg); write('英単語は？'); readln(engword); Len:=length(engword); for i:=Len downto 1 do begin downword:=downword+engword[i]; end; writeln('逆順にした綴りは',downword,'です。'); readln; end.
786 名前：デフォルトの名無しさん mailto:sage [03/11/25 12:41]
function ReverseString(S: String): String; var i, j : integer; c : char; begin i := 1; j := Length(S); while i < j do begin c := S[i]; S[i] := S[j]; S[j] := c; i := i + 1; j := j - 1; end; ReverseString := S; end; { ReverseString }
787 名前：デフォルトの名無しさん mailto:sage [03/11/25 13:54]
激遅 function ketaketa(e : extended):integer; begin while true do begin e:=e*2; if log10(e)>=30 then break; end; ShowMessage（FloatToStr(e)); end;
788 名前：デフォルトの名無しさん mailto:sage [03/11/25 14:16]
procedure ketaketa(e : extended); begin while log10(e) < 30-1 do e:=e*2; ShowMessage（FloatToStr(e)); end;
789 名前：デフォルトの名無しさん mailto:sage [03/11/25 14:39]
procedure ketaketa(e : extended); var i : Integer; begin for i := 1 to Ceil((30-1 - log10(e)) / log10(2)) do e := e * 2; ShowMessage（FloatToStr(e)); end;
program enshu(input,output); const K=30; var i,j,m,v, :integer n :array[1..K]of integer; begin write('出発の値は？'); readln(m); if m >0 then begin ............. while m<>0 do begin ............. end; J:=J+1; ・・。
795 名前：782 mailto:age [03/11/26 03:28]
while j > 1 do begin for i:=K downto J do n[i]:= 2*n[i]; for i:=K downto J do begin ............... end; if n[i-1]<>0 then j:=j-1 end; for i:=1 1 to K do write(chr(n[i]+Ord('0'))); writeln end; readln end.
スマソ全然わかんないです・
796 名前：デフォルトの名無しさん mailto:sage [03/11/26 09:14]
program enshu(input,output); const K= 30; var i,j,m : integer; {var i,j,m,v, : integer} n : array[1..K]of integer; begin write('出発の値は？'); readln(m); if m >0 then begin j := K; while m<>0 do begin n[j] := m mod 10; m := m div 10; j := j - 1; end; J:=J+1;
797 名前：デフォルトの名無しさん mailto:sage [03/11/26 09:15]
while j > 1 do begin for i:=K downto J do n[i]:= 2*n[i]; for i:=K downto J do begin n[i-1] := n[i-1] + n[i] div 10; n[i] := n[i] mod 10; end; if n[j-1]<>0 then j:=j-1 { if n[i-1]<>0 then j:=j-1 } end; for i:= 1 to K do { for i:=1 1 to K do } write(chr(n[i]+Ord('0'))); writeln end; readln end.
続きです Personarray=array[index] of person; procedure sort(n:index;var x:personarray); procedure exchangeperson(var A,B:person);
var temp:person; begin ・・・ end;
var i,j:index; begin for i:=1 to N-1 do for j:=N-1 downto 1 do ・・・ end;
var num:o..nmax; i:index; Student:personarray; Infile:text; Filename:string[80]; begin ・・・ end.
801 名前：デフォルトの名無しさん mailto:sage [03/11/27 20:25]
あのー、少しは自分でやった方がいいと思うよ？ せめて、自分が考えたものを書くとかしたほうが。
802 名前：デフォルトの名無しさん mailto:sage [03/11/27 22:18]
コンパイル通しただけだから、バグ取りは自分で program seiretu(input,output); const nmax = 100; type index = 1..nmax; Person = record name : string[14]; math,eng : 0..100; total : 0..200; end; Personarray = array[index] of person; procedure sort(n : index; var x:personarray); procedure exchangeperson(var A,B : person); var temp : person; begin temp := A; A := B; B := temp; end; var i,j: index; begin for i:=1 to N-1 do for j:=N-1 downto i do if x[j+1].total < x[j].total then exchangeperson(x[j+1], x[j]); end;
