とりあえず、簡単なサンプル(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;
803 名前：デフォルトの名無しさん mailto:sage [03/11/27 22:19]
var num : 0..nmax; i : index; Student : personarray; Infile : text; Filename : string[80]; begin Write('データファイル名は？'); Readln(Filename); i := 1; Assign(Infile, Filename); while not eof(Infile) do begin Readln(Infile, Student[i].name, Student[i].math, Student[i].eng); i := i + 1; end; num := i - 1; sort(num, Student); for i := 1 to num do Writeln(Student[i].name, Student[i].math, Student[i].eng, Student[i].total); end.
function hoge(n, base: integer): string; var x: integer; s: string; begin if (base <> 2) and (base <> 8) and (base <> 16) then base := 16; s := ''; repeat x := n mod base; if x < 10 then s := chr(ord('0') + x) + s else s := chr(ord('A') + x - 10) + s; n := n div base; until n <= 0; hoge := s; end;
