pascalcc礦池

㈠ pascal函數過程表

1.算術函數
函數標識符 自變數類型 意義 結果類型
abs 整型、實型 絕對值 同自變數
arctan 整型、實型 反正切 實型
cos 整型、實型 餘弦 實型
exp 整型、實型 指數 實型
frac 整型、實型 小數部分 實型
int 整型、實型 整數部分 實型
ln 整型、實型 自然對數 實型
pi 無自變數 圓周率 實型
sin 整型、實型 正弦 實型
sqr 整型、實型 平方 同自變數
sqrt 整型、實型 平方根 實型
例：abs(-4)=4 abs(-7.49)=7.49 arctan(0)=0.0
sin(pi)=0.0 cos(pi)=-1.0 frac(-3.71)=-0.71
int(-3.71)=-3.0 sqr(4)=16 sqrt(4)=2

2.標准函數
函數標識符 自變數類型 意義 結果類型
odd 整型 判斷奇數 布爾型
pred 離散類型 求前趨 同自變數
succ 離散類型 求後繼 同自變數
例：odd(1000)=false pred(2000)=1999 succ(2000)=2001
odd(3)=true pred('x')='w succ('x')='y'

3.轉換函數
函數標識符 自變數類型 意義 結果類型
chr byte 自變數對應的字元 字元型
ord 離散類型 自變數對應的序號 longint
round 實型 四捨五入 longint
trunc 實型 截斷取整 longint
例：chr(66)='B' ord('A')=65 round(-4.3)=-5 trunc(2.88)=2

4.雜類函數
函數標識符 自變數類型 意義 結果類型
random 無自變數 [0,1間的隨機實數 real
random word [0,自變數間的隨機整數) word
randomize 無自變數 初始化內部隨機數產生器 longint
upcase 字元型 使小寫英文字母變為大寫 字元型
downcase 字元型 使小寫英文字母變為大寫 字元型

SYSTEM TP的運行庫，包括常用的標准函數和過程，可以在程序中直接使用，不需USES語句說明。
DOS 具有日期、時間、目錄查找、程序執行等功能
CRT 具有屏幕模式控制、擴展鍵盤碼、顏色、窗口、聲音等 功能
PRINTER 支持列印輸出操作。
GRAPH 高級圖形軟體包，支持多種圖形適配器。
GRAPH3 實現TP3.0的圖形軟體包。
TURBO3 兼容TP3.0的源程序。
OVERLAY 實現高級覆蓋管理

SYSTEM單元常用過程與函數
ABS(X) F 求變數的絕對值
ADDR(X) F 測變數地址
APPEND(F) P 打開一個存在的文本文件，並將文件指 針指向文件末尾准備添加元素
ARCTAN(X) F 反正切
ASSIGN(F,C) P 將字元串C所表示的外部文件名賦給文 件變數F
ASSIGNED(X) P 測試程序當中的指針或變數是否為空
BLOCKREAD(F,D,NUM) P 讀類型文件。
BLOCKWRITE(F,D,NUM) P 寫無類型文件
BREAK P 中止或結束循環
CHDIR(PATH) P 改變當前目錄
CHR(X) F 求ASCII碼值為X的字元
CLOSE(F) P 關閉文件
CONCAT(S1,S2...S3） F 字元串合並
CONTINUE P 繼續循環
COPY(S,POS,LEN) F 返回一個字元串的子串
COS(X) F 餘弦函數
CSEG F 返回CS寄存器的當前值
DEC(X) F X:=X-1
DELETE(S,POS,LEN) P 刪除一個字元串的子串
DISPOSE(P) P 釋放一個動態變數
DSEG F 返回DS寄存器的當前值
EOF(F) F 判斷文件是否結束
EOLN(F) F 判斷文件類型中的一行是否結束
ERASE(F) P 刪除一個存在的外部文件。
EXIT P 過程中止
EXP(X) F 以E為底的指數函數
FILEPOS(F) F 文件記錄的當前位置
FILESIZE(F) F 文件記錄數
FILLCHAR(D,LEN,DATE) P 填充數值或字元
FLUSH(F) P 清空文件緩存區
FRAC(X) F 取實形變數的小數部分
FREEMEM(P,I) P 釋放變長動態變數
GETDIR(DRV,PATH) P 取當前盤，當前目錄
GETMEM(P,I) P 分配變長的動態變數，並把塊地址存放在一個指針變數中
HALT P 立即中止程序執行，返回TP編輯器或DOS
HI(I) F 返回一個變數的高位位元組
INSERT(S,D,POS) F 在一個字元串中某一位置開始插入一個子串
INT F 取整數部分
IORESULT F 返回最後一次輸入/出操作的結果狀態
LENGTH(S) F 取字元串的長度
LN(R) F 求自然對數
LO(I) F 返回一個變數的低位位元組
MAXAVAIL F 返回最大內存空間
MEMAVAIL F 返回可用內存數目
MKDIR(PATH) P 建立一個子目錄
MOVE(S,D,LEN) P 快傳送
NEW(P) P 建立一個新的動態變數
ODD(X) F 判斷一個變數的值是否為奇數
OFS(X) F 側變數偏移地址
ORD(CH) F 求一個字元的ASCII碼值
PARAMCOUNT F DOS參數串長度
PARAMSTR(N) F DOS參數串
PI F 圓周率的值
pos(str1,str2) f 測一個字元串中包含的另一個子串的開始位置
pred(x) f 求前驅
ptr(i) f 指針賦值
random f 返回0~1之間的隨機實數
randomize p 初始化隨機數發生器
read/readln(f,x) p 讀入/輸入數據
rename(f,str) p 給一個外部文件改名
reset(f) p 打開文件，並將文件指針指向開始，並准備讀數據
rewrite(f) p 打開文件，並將文件指針指向開始，准備寫資料
rmdir(path) p 刪除一個子目錄
round(x) f 求實數的近似數
runerror p 停止程序的運行
scrollto p 滾動顯示窗口的某部分內容
seek(f,n) p 將文件指針定位於文件f的第n個文件成分上
seekrof(f) f 定位到文件尾
seekroln(f) f 定位到行尾
seg(n) f 測變數段地址
settextbuf(f) p 將輸入/出緩沖區與一個文本文件建立關聯
sin(x) f 正弦函數
sizeof(x) f 測變數大小
sptr f 返回sp寄存器的當前值
sqr(x) f 平方
sqrt(x) f 平方根
sseg f 返回ss寄存器的當前值
str(i,s) f 將一個整數轉換成字元串
succ(X) f 後繼函數
swap(x) f 交換一個變數的高位和低位位元組
trunc(x) f 截去實數的小數部分
truncate(f) p 截去文件當前指針以後的內容
upcase(ch) f 將小寫字母轉換成大寫字母
val(s,r,p) p 將一個字元串轉換成數值
writeln(f,x) p 輸出
dos單元常用過程與函數
getdate p 返回系統當前日期
detftime p 返回最後一次寫入的日期和時間
gettime p 返回系統當前時間
packtime p 轉換系統日期和時間，封裝成4個位元組的長整形格式
setdate p 設置系統當前日期
setftime p 寫入新的系統日期和時間，覆蓋系統最後一次寫入的 系統日期和時間文件
settime p 設置系統當前時間
uppacktime p 將系統日期和時間轉換成紀錄格式
diskfree f 返回指定磁碟可用剩餘空間
disksize f 返回指定磁碟的總容量
get/setverity p 返回/設置dos狀態下的磁碟讀寫標記
fexpand f 返回函數名的全稱
fsearch f 在一個目錄中查找文件
fsplit f 將一個文件名分成目錄、文件名、擴展名
findfirst p 在當前目錄或指定目錄下查找第一個與給定屬性相匹 配的文件名

作者： 巫山霏雲 2005-2-7 16:49 回復此發言

--------------------------------------------------------------------------------

3 turbo pascal基本函數過程及解釋
findnext p 返回下一個滿足匹配條件的文件名
getfattr p 返迴文件的屬性
setfattr p 設置文件屬性
gerintvec p 返回某個中斷變數值
intr p 執行軟中斷
msdos p 執行dos 系統調用
setintvec p 設定中斷值
exec p 通過一個特定命令行執行特定程序段
keep p 中斷程序的執行但仍駐留在內存中
swapvectors p 用當前變數交換所有中斷變數值
dosexitcode f 回到子程序出口
dosversion f 顯示dos版本
crt單元
assigncrt(f) p 將文本文件f與顯示器crt建立聯系
clreol p 清除當前行游標所在位置以後的字元
clrscr p 清除當前窗口或屏幕，游標返回到左上角
delay(t) p 等待t毫秒
delline p 清除游標所在行上所有內容
gotoxy(x,y) p 將游標移到屏幕某處
highvideo p 選擇高亮度顯示字元
insline p 在當前游標位置插入空行
keypressed f 測定鍵盤輸入狀態
lowvideo p 低亮度顯示字元
normvideo p 選擇正常文本屬性從游標所在位置開始顯示字元
nosound p 關閉內部揚聲器
readkey p 等待從鍵盤輸入一個字元
sound(hz) p 以hz指定的頻率發聲
textbackground(soor) p 設置正文背景顏色
textcolor(color) p 設置正文前景顏色
textmode p 選擇特定的文本顯示模式
wherex/y f 返回當前游標位置的坐標值
window(x1,y1,x2,y2) p 在屏幕定義一個文本窗口

其他單元
chain(f) p 目標程序鏈接
execute(f) p 執行目標程序
mark(p) p 標記動態變數
release(p) p 釋放動態變數區
srtinit p 屏幕初始化
crtline p 漢字屏幕方式轉換
graphbackground(color) p 選擇背景色
graphcolormode p 中解析度彩色圖形方式，320*200彩色
graphmode p 中解析度黑白圖形方式，320*200黑白
graphwindow(x1,y1,x2,y2,color)p 定義圖形方式窗口
hires p 高解析度單色圖形方式，640*200黑白
hirescolor(color) p 高解析度彩色圖形方式，640*200彩色
palette(color) p 中解析度彩色圖形顏色組
ovrpath(path) p 指定覆蓋文件路徑
draw(x1,y1,x2,y2,color) p 畫線
intr(n,m) p 8086中斷調用
plot(x,y,color) p 畫點
random(integer) f 產生隨機整數
seg(x) f 測變數段地址
colortable(c1,c2,c3,c4) p 重定義顏色組
arc(x,y,radius,color) p 畫圓弧
circle(x,y,radius,color) p 畫圓
getpic(buffer,x1,x2,y1,y2) p 屏幕轉儲到屏幕
putpic(buffer,x,y) p 緩沖器轉儲到屏幕
getdotcolor(x,y) p 讀點
fillscreen(color) p 填充屏幕
fillshape(x,y,fillcol,bordercol) p 填充一個區域

常用數學函數
求絕對值函數abs(x)
定義：function Abs(X): (Same type as parameter);
說明：X可以是整型，也可以是實型；返回值和X的類型一致例子：

取整函數int(x)
定義：function Int(X: Real): Real;

注意：X是實型數，返回值也是實型的；返回的是X的整數部分，也就是說，X被截尾了（而不是四捨五入）例子：
var R: Real;
begin
R := Int(123.567); { 123.0 }
R := Int(-123.456); { -123.0 }
end.

截尾函數trunc(x)
定義：function Trunc(X: Real): Longint;

注意：X是實型表達式. Trunc 返回Longint型的X的整數部分例子：
begin
Writeln(1.4, ' becomes ', Trunc(1.4)); { 1 }
Writeln(1.5, ' becomes ', Trunc(1.5)); { 1 }
Writeln(-1.4, 'becomes ', Trunc(-1.4)); { -1 }
Writeln(-1.5, 'becomes ', Trunc(-1.5)); { -1 }
end.

四捨五入函數round(x)
定義：function Round(X: Real): Longint;

注意：X是實型表達式. Round 返回Longint型的X的四捨五入值.如果返回值超出了Longint的表示範圍，則出錯. 例子：
begin
Writeln(1.4, ' rounds to ', Round(1.4)); { 1 }
Writeln(1.5, ' rounds to ', Round(1.5)); { 2 }
Writeln(-1.4, 'rounds to ', Round(-1.4));{ -1 }
Writeln(-1.5, 'rounds to ', Round(-1.5));{ -2 }
end.

取小數函數frac(x)
定義：function Frac(X: Real): Real;

注意：X 是實型表達式. 結果返回 X 的小數部分; 也就是說，Frac(X) = X - Int(_X). 例子：
var
R: Real;
begin
R := Frac(123.456); { 0.456 }
R := Frac(-123.456); { -0.456 }
end.

求平方根函數sqrt(x)和平方函數sqr(x)
定義：平方根：function Sqrt(X: Real): Real;
注意：X 是實型表達式. 返回實型的X的平方根. 平方：function Sqr(X): (Same type as parameter);
注意：X 是實型或整型表達式.返回值的類型和X的類型一致，大小是X的平方，即X*X.
例子：
begin
Writeln('5 squared is ', Sqr(5)); { 25 }
Writeln('The square root of 2 is ',Sqrt(2.0)); { 1.414 }

㈡ pascal[AOI2010]最大連續組長度

program aoi;
var
n,i,now,ans:longint;
c,last,ansc:char;
begin
readln(n);
read(last);
ans:=0;
ansc:=#0;
now:=1;
for i:=2 to n do
begin
read(c);
if c=last then inc(now) else
begin
if now>ans then
begin
ans:=now;
ansc:=last;
end;
now:=1;
end;
last:=c;
end;
readln;
if now>ans then
begin
ans:=now;
ansc:=last;
end;
writeln(ans);
writeln(ansc);
readln;
end.

㈢ pascal 利比亞問題

const maxn=2000;maxm=2000;
var a:array[1..maxn,1..maxm]of boolean;
q:array[1..maxn*maxm,1..3]of longint;
n,m,i,j,head,tail:longint;
x,y,z:longint;
cc:char;

procere go(x,y,z:longint);
begin
if (x<1) or (x>n) or (y<1) or (y>m) then exit;
if not a[x,y] then exit;
if (x=n) and (y=m) then begin
writeln(z);
close(output);close(input);
halt;
end;
inc(tail);
q[tail,1]:=x;q[tail,2]:=y;q[tail,3]:=z;
a[x,y]:=false;
end;

begin
assign(input,'libyan.in');reset(input);
assign(output,'libyan.out');rewrite(output);
readln(n,m);
fillchar(a,sizeof(a),false);
for i:=1 to n do begin
for j:=1 to m do begin
read(cc);
if cc<>'*' then a[i,j]:=true;
end;
readln;
end;
q[1,1]:=1;q[1,2]:=1;q[1,3]:=0;
a[1,1]:=false;
head:=1;tail:=1;
while head<=tail do begin
x:=q[head,1];y:=q[head,2];z:=q[head,3];
go(x-1,y,z+1); //up
go(x+1,y,z+1); //down
go(x,y-1,z+1); //left
go(x,y+1,z+1); //right
inc(head);
end;
end.
用的bfs可以改成dfs

㈣ 線段樹的Pascal 語言實現。。

const
maxn=500010;
type
rec=record
l,r:longint;
ans:int64;
end;
var
c:array[0..500010] of longint;
tree:array[0..maxn*4] of rec;
i,a,b,n,m,cc,co,f,flag:longint;
aa:int64;
sc:char;
procere maketree(sum,x,y:longint);
var mid:longint;
begin
if x=y then begin
tree[sum].l:=c[x];
tree[sum].r:=c[y];
tree[sum].ans:=1;
exit;
end;
mid:=(x+y) shr 1;
maketree(sum*2,x,mid);
maketree(sum*2+1,mid+1,y);
tree[sum].l:=tree[sum*2].l;
tree[sum].r:=tree[sum*2+1].r;
tree[sum].ans:=tree[sum*2].ans+tree[sum*2+1].ans;
if tree[sum*2].r=tree[sum*2+1].l then dec(tree[sum].ans);
end;
procere color(sum,le,ri,x,y,z:longint);
var mid:longint;
begin
if (x=le)and(ri=y) then begin
tree[sum].ans:=1;
tree[sum].l:=z;
tree[sum].r:=z;
exit;
end;
if tree[sum].ans=1 then begin
tree[sum*2]:=tree[sum];
tree[sum*2+1]:=tree[sum];
end;
mid:=(le+ri) shr 1;
if x>mid then color(sum*2+1,mid+1,ri,x,y,z) else begin
if y<=mid then color(sum*2,le,mid,x,y,z) else begin
color(sum*2,le,mid,x,mid,z);
color(sum*2+1,mid+1,ri,mid+1,y,z);
end;
end;
tree[sum].l:=tree[sum*2].l;
tree[sum].r:=tree[sum*2+1].r;
tree[sum].ans:=tree[sum*2].ans+tree[sum*2+1].ans;
if (tree[sum*2].r=tree[sum*2+1].l) then dec(tree[sum].ans);
end;

function count(sum,le,ri,x,y:longint):longint;
var mid:longint;
begin
if (le=x)and(ri=y) then exit(tree[sum].ans);
if tree[sum].ans=1 then begin
tree[sum*2]:=tree[sum];
tree[sum*2+1]:=tree[sum];
end;
mid:=(le+ri) shr 1;
if y<=mid then exit(count(sum*2,le,mid,x,y));
if x>mid then exit(count(sum*2+1,mid+1,ri,x,y));
if tree[sum*2].r=tree[sum*2+1].l then
count:=count(sum*2,le,mid,x,mid)+count(sum*2+1,mid+1,ri,mid+1,y)-1
else
count:=count(sum*2,le,mid,x,mid)+count(sum*2+1,mid+1,ri,mid+1,y);
end;

function find(sum,le,ri,target:longint):longint;
var mid:longint;
begin
if le=ri then exit(tree[sum].l);
if tree[sum].ans=1 then begin
tree[sum*2]:=tree[sum];
tree[sum*2+1]:=tree[sum];
end;
mid:=(le+ri) shr 1;
if target<=mid then exit(find(sum*2,le,mid,target));
if target>mid then exit(find(sum*2+1,mid+1,ri,target));
end;

procere init;
begin
readln(n,m);
for i:=1 to n do read(c[i]);readln;
maketree(1,1,n);
end;

procere main;
begin
readln(m);
f:=1;
flag:=1;
for m:=1 to m do begin
read(sc);
if sc='F' then f:=-f
else begin
if (sc='C')and(eoln) then begin
aa:=tree[1].ans;
if (aa>1)and(tree[2].l=tree[3].r) then dec(aa);
writeln(aa);
end else begin
if sc='R' then begin
read(a);
flag:=(flag-f*a+n-1) mod n+1;
end else begin
if sc='C'then begin
read(sc);
read(a,b);
a:=(flag+f*a-f+n-1) mod n+1;
b:=(flag+f*b-f+n-1) mod n+1;
if f<0 then begin
a:=a+b;
b:=a-b;
a:=a-b;
end;
if a<=b then writeln(count(1,1,n,a,b)) else
begin
aa:=count(1,1,n,1,b)+count(1,1,n,a,n);
if (aa>1)and(tree[3].r=tree[2].l) then dec(aa);
writeln(aa);
end;
end else begin
read(a,b);
a:=(flag+f*a-f+n-1) mod n+1;
b:=(flag+f*b-f+n-1) mod n+1;
if sc='S' then begin
co:=find(1,1,n,a);
color(1,1,n,b,b,co);
co:=find(1,1,n,b);
color(1,1,n,a,a,co);
end else begin
read(cc);
if f<0 then begin
a:=a+b;
b:=a-b;
a:=a-b;
end;
if a<=b then color(1,1,n,a,b,cc) else
begin
color(1,1,n,1,b,cc);
color(1,1,n,a,n,cc);
end;
end;
end;
end;
end;
end;
readln;
end;
end;

begin
init;
main;
end.

LZ看下主要過程吧（構樹、更新那塊），這是神奇手鏈（jewels.pas/.c/.cpp）的AC code

㈤ 單詞背誦 pascal

思想：用二分查找的方法，找出相連的包含最多要背的單詞並且單詞長度最短。
代碼與題解：http://oj.luogu.org:8888/wiki?name=%E9%A2%98%E8%A7%A3+P1381
題目提交地址：http://oj.luogu.org:8888/problemshow.php?pid=1381
請理解後完成程序。

㈥ Pascal高精度加法

定義a，b表示兩個待加數組，ans表示結果，x用於處理進位，total記錄當時得到結果的位數。
total初始化為a，b之間最大的位數（其實也可以定義一個足夠大的數為位數，相對耗點時間）
i，j用於循環變數，核心程序段：
x=0; 初始化
for i=1 to total do
begin
x=a[i]+b[i]+x; x代表的是進位及當前加法所得的值
ans[i]=x mod 10; 加法所得的當前位
x=x div 10; 進位
end;

while (x>0)
begin
inc(total);
ans[total]=x mod 10;
x=x div 10;
end; 處理最高位的進位

for i=total downto 1 do
write(ans[i]); 輸出段

㈦ pascal如何實現文件加密

用哪種演算法？AES安全性好，但代碼很長，沒法貼，你自己搜索下
一般的話用DES就足夠了

㈧ Pascal P進制數的最小公倍數和最大公因數 （函數與過程做）

var
p:2..16;
a,b:string[32];
s:string;
words:array[1..3]ofstring[32];
i,j,k,code:integer;
aa,bb,x,y:longint;
xs,ys:string;

functionconvert10(c:string;a:integer):longint;
var
	k,i,j:integer;
	cc:longint;
	ch:char;
begin
{以下a進制先轉為10進制}
k:=length(c);
cc:=0;
fori:=1tokdobegin
ch:=c[i];
casechof
'A'..'F':j:=ord(ch)-ord('A')+10;
'a'..'f':j:=ord(ch)-ord('a')+10;
'0'..'9':j:=ord(ch)-ord('0');
end;
cc:=cc*a+j;
end;
convert10:=cc;
end;

functionconvert_b(cc:longint;b:integer):string;
var
	k,i,j:integer;
	bb:array[1..32]ofchar;
	bbb,s:string;
begin
{以下10進制再轉為b進制}
k:=1;
repeat
j:=ccmodb;
casejof
0..9:bb[k]:=chr(j+ord('0'));
10:bb[k]:='A';
11:bb[k]:='B';
12:bb[k]:='C';
13:bb[k]:='D';
14:bb[k]:='E';
15:bb[k]:='F';
end;
cc:=ccdivb;
ifcc>0theninc(k);
untilcc=0;
bbb:='';	
fori:=kdownto1dobbb:=bbb+bb[i];
convert_b:=bbb;
end;

functiongcd(a,b:longint):longint;
begin
ifb=0thengcd:=a
elsegcd:=gcd(b,amodb);
end;

functionlcm(a,b:longint):longint;
varc:longint;temp:longint;
begin
ifa<bthenbeginc:=a;a:=b;b:=c;end;
temp:=a;
whiletempmodb>0dotemp:=temp+a;
lcm:=temp;
end;

begin
{readln(s);}
s:='21101001';
whiles[1]=''dos:=(s,2,length(s)-1);
s:=s+'';
k:=length(s);
j:=1;
words[j]:='';
fori:=1tokdobegin
	ifs[i]<>''thenwords[j]:=words[j]+s[i]
	elseifs[i-1]<>''thenbegininc(j);words[j]:='';end;
end;
val(words[1],p,code);			
a:=words[2];
b:=words[3];
aa:=convert10(a,p);
bb:=convert10(b,p);
x:=gcd(aa,bb);
y:=lcm(aa,bb);
xs:=convert_b(x,p);
ys:=convert_b(y,p);	
writeln('('+a+','+b+')=',xs);
writeln('('+a+','+b+')=',ys);
end.

㈨ pascal高精度加法

wikioi的都過了，望採納
比樓上那位短多了
const max=2000;
var
sa,sb,sc:ansistring;
b:array[0..max] of integer;
a:array[0..max+1] of integer;
len,la,lb,i,p:integer;
begin
while not eof do
begin
readln(sc);
p:=pos(' ',sc);
sa:=(sc,1,p-1);
sb:=(sc,p+1,length(sc)-p);
fillchar(a,sizeof(a),0); fillchar(b,sizeof(b),0); //數組初始化
la:=length(sa); lb:=length(sb);
for i:= la downto 1 do a[la-i+1]:=ord(sa[i])-ord('0'); //數據存儲
for i:= lb downto 1 do b[lb-i+1]:=ord(sb[i])-ord('0'); //數據存儲
if la>lb then len:=la else len:=lb;
for i:=1 to len do
begin
a[i+1]:=a[i+1]+(a[i]+b[i]) div 10; //計算與進位同時處理，
a[i]:=(a[i]+b[i]) mod 10;
end;
if a[len+1]>0 then len:=len+1;
for i:=len downto 1 do write(a[i]);
writeln;
end;
end.

㈩ Pascal運行時總出現variable identifier expected

var中沒寫ys這個變數...
在jc(ys,v1,x,b1,x1,b2);中沒發現變數錯誤...