Pascal基础

celltree001

已于 2024-05-21 17:33:42 修改

阅读量1.6k

点赞数 2

分类专栏： pascal 文章标签： pascal delphi

于 2022-01-13 10:22:34 首次发布

本文链接：https://blog.csdn.net/happytor/article/details/122467989

版权

pascal 专栏收录该内容

3 篇文章 3 订阅

订阅专栏

基础

环境

用的免费的编译器fpc

编辑器随便找个自己喜欢的就行, IDE 可以选 lazarus,跨平台

pascal版本有更迭,支持的方言(dialect)很多,基于目前的最佳实践，所有代码里使用 ${mode objfpc } {$H+}{$J-}{$I+}{$R+}
{$H+} 开启AnsiString

{$J-} const常量不可修改

{$I+} i/o错误检测

{$R+} 开启越界检查
注: {$mode objfpc}也可改为{$mode delphi}
此编译指令需要写在uses之前
pascal不区分大小写,习惯使然,则采用和C#类似的编码规范

注释

pascal的注释有多种可选,前两种支持多行,最后一行是单行注释,pascal的注释允许嵌套,但是tp和delphi不支持,为了可移植,建议注释不要嵌套

(* some comments *)
{ some comments }
// some comments

关键字(保留字)

语言内置的具有特殊含义的标识符,关键字列表如下

absolute  and  array  asm  begin  case  const  constructor  destructor  div  do  downto  else  end  file  for  function  goto  if  implementation  in  inherited  inline  interface  label  mod  nil  not  object  of  operator  or  packed  procedure  program  record  reintroduce  repeat  self  set  shl  shr  string  then  to  type  unit  until  uses  var  while  with  xor  as  class  dispinterface  except  exports  finalization  finally  initialization  inline  is  library  on  out  packed  property  raise  resourcestring  threadvar  try

正常情况写不能定义和关键字一样的标识符.有时必须为之(比如调用了c语言开发的dll)则可以在前面加上&符号

var    
  &var : integer;    
   
begin    
  &var:=1;    
  Writeln(&var);    
end.

标识符

标识符可以使用字母,数字,下划线(_), 不能用数字开头, 长度1-127

数据类型

以下分类参考freepascal的文档

基本类型

类型	sizeof	符号位
byte,uint8	1	无
word,uint16	2	无
longword,Cardinal,dword,uint32	4	无
qword,uint64	8	无
shortint,int8	1	有
smallint,int16	2	有
longint,int32	4	有
int64	8	有
integer	2 or 4	有

整型: byte,shortint,smallint,word,integer,longint,int64…
数值默认是十进制,如果16进制使用$前缀, 8进制使用&前缀,2进制使用%前缀. TP(Turbo Pascal)和delphi不支持 8进制和2进制的前缀形式

浮点型: real,single,double,extended,comp,currency
布尔型:boolean,ByteBool ,WordBool ,LongBool

字符串类型

字符串: shortstring,ansistring,widestring,unicodestring,pchar
字符串使用单引号, 不支持类似C语言的\r\n\t等形式的转义.而是使用类似下面的方法
使用LINEENDING常量可以跨平台的换行.

var a:string;
begin
a := 'contain tab '#9' example ';
a:='contain new line '#13#10' example';
a:='contain new line '+LINEENDING+' example';
end.

结构类型

子界,枚举,数组,集合,类,文件
具体使用见后续

指针

var i:integer;p: ^integer; //定义

p:=@i;i=p^; //取地址,取值

看起来不如c语言的指针操作流畅,应该是不鼓励使用指针吧

类型转换

数值转字符串IntToStr FloatToStr IntToHex等等
字符串转数值StrToInt,StrToFloat等

控制流程

基本结构

program {程序名}
uses {逗号分隔使用的Unit}
const {常量定义}
var {全局变量定义}

//函数定义
function foo();boolean;
{ 局部变量定义 }
begin
...
end;

//过程定义
procedure bar();
{ 局部变量定义 }
begin
...
end;

begin { 主程序开始}
...
end. { 主程序结束 }

这个可执行程序的结构,dll的创建见后续
下面是Unit的结构,大同小异

unit {Unit名称};
interface

//函数声明
function foo();boolean;
//过程声明
procedure bar();

implementation
//函数实现
function foo();boolean
{ 局部变量定义 }
begin
end;


//过程实现
procedure bar();
{ 局部变量定义 }
begin
end;

end.

var a:integer; //变量定义方式

a:=10;//赋值方式

函数和过程

函数有返回值,过程没有.其它都一样
变量类型一样且顺序临近的可以用逗号分隔然后后面写一个统一的类型
参数可以有默认值procedure Hello(i:integer=1;j:integer=2);类似这种，和C#这种大多数语言一样，有默认值的参数要处于函数参数的后面

function 函数名(变量名1:变量类型;变量名2:变量类型;变量名3,变量名4:变量类型;.....):返回类型;
var
	变量名3:变量类型;
	变量名4:变量类型;
begin
	函数定义

	result := 返回值 	
end;

返回值也可以使用 函数名:= 返回值, 个人喜欢用result:=返回值,另外result可以用于递归调用

function 过程名(变量名1:变量类型;变量名2:变量类型...);
var
	变量名3:变量类型;
	变量名4:变量类型;
begin
	过程定义
end;

循环结构

while-do 循环

while (condition) do S;
//for example
while i<10 do 
begin
i := i-1;
writeln(i);
end;

for 循环

for < variable-name > := < initial_value > to [down to] < final_value > do 
   S;
//for example

for i:=1 to 10 do writeln(i);

for i:=10 downto 1 do writeln(i);

for i in array do writeln(i);

until循环

repeat S until condition;
// for example
repeat
	sum := sum+ i;
	i := i-1
until i=0;

break,continue用于跳出循环这个和C语言都一样
当然还有goto语句,个人几乎不用

如果要退出循环或者函数可以使用exit(-1)，exit的参数用于覆盖function的result

分支结构

if condition then S;
if condition then S1 else S2;

注意没有else if

case (expression) of
   L1 : S1;
   L2: S2;
   ...
   ...
   Ln: Sn;
end;

case (expression) of
   L1 : S1;
   L2,L3 : S2;
   ...
   ...
   Ln: Sn;
else
   Sm;
end;

代码示例

//仅作语法演示,无具体需求
demo01.pas


Program demo01;
${mode objfpc } {$H+}{$J-}{$I+}{$R+}

Uses SysUtils,Common;

Const PI = 3.14;

Function FactTail(n,a:integer): longint;
Begin
  If n < 0 Then result := 0
  Else
    Begin
      If n<=2 Then result := a
      Else
        result := FactTail(n-1,n*a);
    End
End;

Function Sum(n:integer): integer;

Var 
  s: integer;
  i: integer;
Begin
  s := 0;
  For i:=1 To n Do
    s := s+i;
  result := s;
End;

Function Mean(n:integer): real;

Var 
  s: integer;
  i:integer;
Begin
  s := 0;
  i := n;
  Repeat
    s := s + n;
    i := i-1;
  Until i=0;
  result := s*1.0/n;
End;

Var a,b,c: integer;
Begin
  a := 10;
  b := 20;
  c := 10;

  Swap(a,b);

  writeln(FactTail(5,1), ', ',Sum(c),', ',Mean(c));

End.

common.pas


Unit common;
${mode objfpc } {$H+}{$J-}{$I+}{$R+}

Interface
Function RectangleArea(l,w :real ): real;
Function CircleArea(r :real ): real;
Function TriangleArea(a,b,c :real ): real;
Procedure Swap(Var a:integer;Var b:integer);

Implementation
Procedure Swap(Var a:integer;Var b:integer);

Var 
  temp: integer;
Begin
  temp := a;
  a := b;
  b := temp;
End;

Function RectangleArea(l,w :real ): real;
Begin
  result := l*w;
End;

Function CircleArea(r :real ): real;

Const PI =  3.14;
Begin
  result := PI*r*r;
End;

Function TriangleArea(a,b,c :real ): real;

Var s : real;
Begin
  s := (a+b+c)/2.0;
  result := sqrt(s*(s-a)*(s-b)*(s-c));
End;

End.

命令行编译

如果没有使用IDE,可以使用命令行来编译,最简单的用法就是
fpc main.pas,具体用法可以fpc -h来查看.
-g 开启调试，然后可以使用gdb调试
-gh开启heaptrc ,用来检测内存泄漏
-gl开启lineinfo,显示行号
另外可以使用fpc -al -Amasm main.ps来生成汇编文件,里面把pas源码作为了汇编代码的注释,可以对照参考.

结构类型举例

枚举

type Color = (Red,Green,Blue);

枚举默认是全局命名空间，为了防止重复一般情况下使用前缀缩写。
枚举和整型默认是不一样的。需要使用ord(akDuck) 转为整型，使用TAnimalKind(1)转为枚举, 但是如果枚举值越界TAnimalKind(100) 会报错,C#里好像不会
可以使用low(TAnimalKind)和high(TAnimalKind)来确定枚举的范围
可以使用pred和succ确定前一个和后一个值
可以使用for a in TAnimalKind来遍历枚举的所有可用值
{$scopedenums on} 可以使用这个指令关闭枚举的全局作用范围，然后使用方法就类似C#一样 TAnimalKind.akDuck
枚举值不指定时默认从0开始，可以手动指定值，但是指定后如果不连续,则for .. in 和pred,succ不能使用

type
  TAnimalKind = (akDuck, akCat, akDog);
  TOpAction = (akNew=10,akView,akDelete);
  TAnimalNames = array [TAnimalKind] of string;
   TAnimals = set of TAnimalKind;
var
  A: TAnimals;
begin
  A := [];
  A := [akDuck, akCat];
  A := A + [akDog];
  A := A * [akCat, akDog];
  Include(A, akDuck);
  Exclude(A, akDuck);
end;

子界

var age:0..120;
或者使用枚举作子界的起始
type Month=(Jan,Feb,Mar,Apr,May);
type Spring = Jan..Mar;

数组

type
   array-identifier = array[index-type] of element-type;

type vector = array [0..24] of integer;
type temp = array[-10..50] of real;
type color = (Red,Blue,Green,Silver);
var a:vector;b:temp;c:color;d:array [1..10] of integer;
e:array[1..5,1..10] of integer;

数组定义后就不能修改大小了,这个很多语言(C语言等)都是这样的,如果想要使用运行时大小的数据则:

type darray = array of integer;
var a:darray;
b:array of array of integer;
begin
setlength(a,100);
end;

集合

var s1: set of 'a' .. 'z';
  s2:set of 'a'..'z';
  s3: set of 'a'..'z';

s1 := ['a','b','c'];
s2 := ['c','e','d'] ;

s3 := s1 + s2; //union
s3 := s1 - s2; //difference
s3 := s1 * s2; // intersection

集合元素不重复,可以支持交,并,差等集合操作

文件和记录

type Student = record
  id:integer;
  name:string[20];  
end;
var FileA:file of integer;
  FileB:file of Student;
  FileC: textfile;
  s:Student;
begin
  assignfile(FileC,"file-c.txt");
  append(FileC);

  writeln(fileC,'Hello');
  closefile(FileC);

  assignfile(FileB,'file-b.dat');
  rewrite(FileB);
  s.id := 10;
  s.name := 'tom';

  write(f,s);
  closefile(f);

end;

常用函数和标准库

常用函数

数学函数

abs,sqrt,int,trunc,round,power,odd,exp,ln,ceil,floor 见名知意就不注释了
sqr // 平方
frac //返回小数部分
sin,cos,tran等三角函数

输入输出

writeln,write,readln
writeln支持格式化输出

WriteLn('You can output an integer: ', 3 * 4);
WriteLn('You can pad an integer: ', 666:10);
WriteLn('You can output a float: ', Pi:1:4);

输入换行WriteLn('One line.' + LineEnding + 'Second line.');

其它

random(n),randomize
pred 前导
succ 后继
chr,ord ascii 与字符的转换
inc,dec 加减值

字符串操作

字符串用的比较广泛,单独拿出来

concat //连接
copy //拷贝
delete //删除
insert //插入
length //长度
pos // 检索子串位置
upcase // 大写
str(v,s) //把数值v转换为字符串s
val(s,v,I) // 把字符串s转换为数值v

字符串的格式化

Format('%d %f %s', [MyInt, MyFloat, MyString])

日期时间

TimeToStr(Time)
DateTimeToStr(Now)
DeCodeDate (Date,year,month,day)
Format (‘Day: %d,Month: %d, Year:%d’,[day,month,year])

参考文档(Pascal datetime)[https://www.freepascal.org/docs-html/rtl/sysutils/datetimeroutines.html]

动态链接库

编译时链接

d09.pas


Library d09;
{$mode delphi}

Uses SysUtils,Classes;

Function MaxInt(x,y :integer ): integer;
stdcall;
Begin
  If x>y Then result := x
  Else
    result := y

End;

Function PlusInt(a,b :integer ): integer;
stdcall;
Begin
  result := a+b;
End;

exports
MaxInt ,
PlusInt;
Begin
End.

d01.pas


Program d01;

Uses SysUtils,classes;

Function MaxInt(a,b :integer ): integer;
stdcall;
external 'd09';

Var a,b,c: integer;
Begin
  randomize;
  a := 10;
  b := 20;
  c := a+b;
  writeln(MaxInt(a,b));

  writeln(c);
End.

makefile

CFLAGS=-O-  -Fl. -gh
d01:d01.pas d09
	ptop d01.pas d01.pas
	export LD_LIBRARY_PATH=.
	fpc $(CFLAGS) -od01.elf d01.pas
d09:d09.pas
	ptop d09.pas d09.pas
	fpc $(CFLAGS) -od09.dll d09.pas
	cp d09.dll libd09.so

环境是ubuntu 18.04
奇怪的问题: 链接的时候需要libd09.so 但是运行时却需要d09.dll,未解

运行时加载

更新后的d01.pas,d09.pas和makefile不变


Program d01;

Uses SysUtils,classes,dynlibs;

Function MaxInt(a,b :integer ): integer;
stdcall;
external 'd09';

Type TMyFunc = Function (a : integer;b:integer ): integer;
  stdcall;


Procedure LoadDllDemo(a,b :integer );

Var handle : TLibHandle;
  func    : TMyFunc;
Begin
  handle := LoadLibrary('libd09.so');
  If handle = dynlibs.NilHandle Then exit;
  func := TMyFunc(GetProcedureAddress(handle,'PlusInt'));
  If func = Nil Then exit;
  writeln(a,'+',b,'=',func(a,b));
  If handle <> dynlibs.NilHandle Then
    If FreeLibrary(handle) Then
      handle := dynlibs.NilHandle;
End;

Var a,b: integer;
Begin
  randomize;
  a := trunc(random()*1000);
  b := round(random()*1000);
  writeln('bigger of ',a,',',b,' is: ',MaxInt(a,b));
  LoadDllDemo(a,b);
End.

Pascal 调用 C语言开发的动态链接库

C 语言的编译和链接相对简单(相对于C++), 所有只有C语言的动态链接库的调用方法记录,C++本身就复杂，编译和链接自然也复杂, 个人猜测ABI 一致也相对较难，暂不涉及

有时间会记录一篇Pascal编译为dll, 供C语言调用的例子

环境: Fedora 31, gcc 9.2.1, fpc 3.0.4

C语言动态链接库源码

//simplemath.h
#ifndef SIMPLEMATH_H
#define SIMPLEMATH_H
#include <stdlib.h>
typedef enum LoLevel_{
    llDebug,
    llInfo,
    llWarn,
    llError,
    llFatal
}LogLevel;
typedef struct Student_{
    int id;
    char name[20];
}Student;

/*
int plus_int(int a,int b);
int max_int(int x,int y); 
void swap_int(int* x,int* y);
int swap_void(void *a,void* b,size_t t);
void logger(char* msg,LogLevel level);
*/
#endif
//simplemath.c
#include <string.h>
#include <stdlib.h>
#include <stdio.h>
#include <time.h>

#include "simplemath.h"

int max_int(int x,int y){
    if (x>y){
        return x;
    }else{
        return y;
    }
}

int plus_int(int x,int y){
    return x+y;
}
int swap_int(int* a,int* b){
    int c = *a;
    *a = *b;
    *b = c;
    return 0;
}
int swap_void(void* a,void* b,size_t t){
    char* c = malloc(t);
    if(c==NULL){
        return -1;
    }
    memcpy(c,a,t);
    memcpy(a,b,t);
    memcpy(b,c,t);
    free(c);
    return 0;
}
int current_date(char* buffer,size_t t){
    time_t rawtime;
    struct tm* timeinfo;
    time(&rawtime);
    timeinfo = localtime(&rawtime);
    strftime(buffer,t,"%Y-%m-%d %H:%M:%S",timeinfo);
    return 0;
}
const char* get_name(LogLevel level){
    switch(level){
        case llInfo:
            return "Info";
        case llDebug:
            return "Debug";
        default:
            return "Unkown";
    }
}
void logger(const char* msg, LogLevel level){
    char buffer[20];
    current_date(buffer,20);
    printf("%s - %s - %s\n",buffer,get_name(level), msg);
}
void student_tostring(Student* student, char* buffer){
    sprintf(buffer,"id: %d , name: %s\n",student->id,student->name);
}

pascal的调用代码

//main.pas


Program main;
{$mode objfpc}{$H+}

Uses SysUtils;

Type LogLevel = (llDebug,llInfo,llWarn,llError,llFatal);

Type Student = Record
  id: integer;
  name: string[20];
End;

Function max_int(a,b:integer): integer;
stdcall;
external 'libsm';
Function plus_int(x,y:integer): integer;
stdcall;
external 'libsm';
Function swap_int(Var x:integer;Var y:integer): integer;
stdcall;
external 'libsm';
Function swap_void(x:pchar;y:pchar;t:integer): integer;
stdcall;
external 'libsm';
Procedure logger(msg:pchar;level:LogLevel);
stdcall;
external 'libsm';

Type PStudent = ^Student;
Procedure student_tostring(s:PStudent;buffer:pchar);
stdcall;
external 'libsm';


Var a,b: integer;
  c,d: pchar;
  s: Student;
  buffer: pchar;
Begin
  a := 10;
  b := 20;

  writeln(max_int(a,b));
  writeln(plus_int(a,b));
  swap_int(a,b);
  writeln(a,',',b);
  c := @a;
  d := @b;
  swap_void(c,d,sizeof(a));
  writeln(a,',',b);
  logger('Hello world',llInfo);
  s.id := 20;
  s.name := 'Jerry';
  buffer := stralloc(80);
  student_tostring(@s,buffer);
  logger(buffer,llInfo);
  strdispose(buffer);
End.

makefile

main.elf:main.c libsimplemath.a
	gcc main.c libsimplemath.a -o main.elf
main2.elf:main.c libsm.so
	export LD_LIBRARY_PATH=.
	gcc -o main2.elf main.c -lsm -L.
mainp.elf:main.pas libsm.so
	ptop main.pas  main.pas
	export LD_LIBRARY_PATH=.
	fpc -Fl. main.pas -omainp.elf
libsm.so:simplemath.c simplemath.h
	gcc --shared -o libsm.so -fPIC simplemath.c simplemath.h
libsimplemath.a:simplemath.o
	ar -q libsimplemath.a simplemath.o
simplemath.o:simplemath.c simplemath.h
	gcc -c simplemath.c  -o simplemath.o
clean:
	rm -f *.elf
	rm -f *.o
	rm -f *.a
	rm -f *.so

OOP与运算符重载

类

看到前面有记录record,class和record类似.record出现的早,class是后来加的.

record 特点:

不支持继承
不支持方法
支持栈,堆内存
支持变体
不支持作用域

class 特点:

支持继承
支持方法
支持堆内存
不支持变体类型
支持作用域

代码示例

//无具体要解决的问题,只是演示pascal语法

program demo02;

{$mode delphi}{$H+}
{$I+} // Errors will lead to an EInOutError exception (default)
uses SysUtils,Classes;

type Gender = (Male,Female);
type Weekday = (Monday,Tuesday,Wednesday,Thursday,Friday,Saturday,Sunday);
type Workday = Monday..Friday;
type Weekend = Saturday..Sunday;  
type Person = record
  id:integer;
  name:string[20];
end;

type Student = record
  id :integer;
  name:string;
  fgender:Gender; 
  other:variant;

end;



type Teacher = class
private 
  FId :integer;
  FName:string; 
  LessionAt: array of Weekday; //上课时间
  procedure SetName(n:string);
public    
  property Id:integer read FId write FId;
  property Name:string read FName write SetName;
  procedure Hello();  
end;

procedure Teacher.SetName(n:string);
begin
  // data validation
  Self.FName := n;
end;

procedure Teacher.Hello();
begin
  writeln(FId,FName);
end;
procedure StudentHello(s:Student);
begin
  writeln(s.id,s.name);
end;  

var s:Student;  
  s2:^Student;
  t:Teacher;  
  p:Person;
  f1: file of integer;
  f2: file of Person;
  f3: TextFile;
  ss:string;
begin


  s.id := 10;
  s.name := 'tom';
  s.other := TRUE;
  s.other := 'test';
  StudentHello(s);


  s2 := getmem(sizeof(Student));
  s2.id := 20;
  s2.name := 'jerry';
  StudentHello(s2^);
  freemem(s2);

  new(s2);
  if not assigned(s2) then
  begin
    writeln('error ');
    exit();
  end
  else
  begin
    s2.id := 50;
    s2.name := 'Tomas';
    StudentHello(s2^);
    freemem(s2);
  end;


  t := Teacher.Create;
  try
    t.id := 30;
    t.name := 'davaid';
    setlength(t.LessionAt,3);
    
    t.LessionAt[0] := Wednesday;    
    t.LessionAt[1] := Thursday;   
    t.LessionAt[2] := Friday;   
    
    t.Hello();
  finally
    t.Free;
  end;


  AssignFile(f1,'f1.dat');
  try
    rewrite(f1);
    write(f1,10);
    write(f1,20);
    CloseFile(f1);
  except on E: EInOutError do
     writeln('File handling error occurred. Details: ', E.Message);
    end;

    AssignFile(f2,'f2.dat');
    rewrite(f2);
    p.id := 120;
    p.name := 'mike';
    write(f2,p);
    CloseFile(f2);

    p.name := 'tom';

    AssignFile(f2,'f2.dat');
    reset(f2);
    read(f2,p);
    assert(p.name = 'mike');
    CloseFile(f2);




    AssignFile(f3,'f3.txt');
    if FileExists('f3.txt') then
    append(f3)
  else
    rewrite(f3);
    writeln(f3,'hello world');
    writeln(f3,'bye');
    CloseFile(f3);


    AssignFile(f3,'d02.pas');
    reset(f3);
    while not eof(f3) do
    begin
      readln(f3, ss);
      writeln(ss);
    end;
    CloseFile(f3);
end.

OOP

OOP现在很流行,个人认为对于GUI编程,OOP也有一定的优势.
下文仅使用class,不使用record,object
下面从OOP的三个特征记录Pascal的OOP的基础

封装

type Rectangle = class
private
  width,length:integer;
  procedure SetLength(l:integer);
protected
  procedure Move(x,y:integer);  
public
  constructor Create();
  destructor Destroy();
  function Area():real;  
end;

继承

只能继承自一个基类,可是实现多个接口

type Person = class
private
  id:integer;
  name:string;  
public
  constructor Create();
  destructor Destroy();
  function NextId():integer;static;
  procedure Display();virtual;
end;

type Student= class(Person)
private
  sno:string;
public
  constructor Create();
  procedure ChooseLession();  
end;

constructor Student.Create;
begin
  inherited.Create();
  sno := '';
end;

多态

type Teacher = class(Person);
private
  jobTitle:string;
public
  constructor Create;overload; // 重载,运行时多态
  constructor Create(name:string);overload;// 重载,运行时多态
  procedure Display();override;// 覆盖,运行时多态
end;
type ICanSwim = interface
  procedure Swimming();
end;

type SwimTeacher = class(Teacher, ICanSwim)  

end;

type CanSwim =  class
  procedure Swimming();virtual;abstract;
end;

异常处理

两种方式如下,注意的是无法连在一起用,except和finally只能嵌套起来才能达到try…except.finally的效果.

var a:real;b:real;c:real;
begin
try
  c := a/b;
except on E: EInOutError do
  writeln(E);
end;

try
  c:= a/b;
finally
  c := 0;
end;


try
  try
    c := a/b;
  except on E:EInOutError do
  writeln(E);
  end;
finally
  c:=0
end;  
  
end.

文件补充

有了OOP,可以看一下新式的文件操作方式,具体见例子

代码示例

program demo03;

{$mode delphi}{$H+}
{$interfaces corba}
{$I+} // Errors will lead to an EInOutError exception (default)
uses SysUtils,Classes;


type TeacherJobTitle = (LowGrade,MidGrade,HighGrade);

// object pascal does not support, only work in delphi
type ISwim = interface
  procedure Swimming();
end;  

type Swim =  class
  procedure Swimming();virtual;abstract;
end;  

type Person = class
private
  class var cid:integer;  
protected
  id:integer;
  name:string;
public  
  constructor Create;
  destructor Destroy;   
  class function NextId():integer;static;
  procedure Display;virtual;overload;
  procedure Display(header:string);overload;
  procedure Save(filename:string);virtual;
end;  

procedure Person.Save(filename:string);
var
  sout:TFilestream;
begin
if FileExists(filename) then
    sout := TFileStream.Create(filename, fmOpenWrite)
  else
    sout := TFileStream.Create(filename, fmCreate);

  sout.WriteAnsiString('person:'+inttostr(id)+','+name+';\n');
  sout.Free;
end;  


class function Person.NextId():integer;
begin
  result := cid + 1;
end;

procedure Person.Display();
begin
  writeln(id,name);
end;

procedure Person.Display(header:string);
begin
  writeln('Id: ',id,';Name: ',name);
end;

constructor Person.Create;
begin
  id := Person.NextId;
end;

destructor Person.Destroy;
begin
  // TODO:
end;


type SwimTeacher = class(Person,ISwim)
private
  jobTitle:TeacherJobTitle;
public
  constructor Create;
  procedure Display;override;
  procedure Swimming();
end;  

procedure  SwimTeacher.Swimming();
begin
  writeln('teach swimming');
end;


constructor SwimTeacher.Create;
begin
  inherited.Create;
  jobTitle := LowGrade;
end;

procedure SwimTeacher.Display;
begin
  writeln(id,name,jobTitle)
end;

procedure CopyFile(src,target:string);
var sin,sout:TFileStream; 
begin
if FileExists(src) and FileExists(target) then
  begin
  sin := TFilestream.Create(ParamStr(1), fmOpenRead);
  try
    sout :=TFilestream.Create(Paramstr(2), fmOpenwrite);
    try
      sout.position := sout.size;
      sout.copyfrom(sin,0);// appends
    finally
      sin.free;
    end;
  finally
    sout.free;
  end;
  end else writeln('invalid arguments');
end;  

procedure CopyFile2(src,target:string);
var mem:TMemoryStream; 
begin
  mem := TMemoryStream.Create;
  try
    mem.LoadFromFile(src);
    mem.SaveToFile(target);     
  except
    //swallow exception; function result is false by default
  end;
  // Clean up
  mem.Free
end;  

var
  a:Person;
  b:SwimTeacher;
begin

  a := Person.Create;
  a.name := 'tom';
  a.Display;

  b := SwimTeacher.Create;
  b.Display();

  a.Free;

  a := b;
  a.Display;

  a.Save('d03.txt');
  b.Free;

end.

参考资料

(File_Handling_In_Pascal)[https://wiki.freepascal.org/File_Handling_In_Pascal]

record, object, class 三个关键字异同

record的特点与使用场景

record 类似与C语言的struct, 分配在栈(Stack).
默认不支持方法(function)和过程(procedure)，开启{$modeSwitch advancedRecords}则可以支持方法和函数

record可以实现C语言中union的相同效果,在和C语言开发的lib调用时可能用到

class的特点与使用场景

class 就和现在C#,java类似, 默认支持字段，属性，方法，属性。可以使用public,private,protected等作用域关键字,内存分配在堆(Heap).

object的特点与使用场景

object 是兼容性导致的遗留关键字，目前几乎用不到。它的功能和class类似。
和class的不同点是内存可以在栈(默认),也可以在堆(使用new) 。目前不建议使用

OOP基本

单继承,默认继承自TObject
构造函数可以有多个, 析构只能有一个
构造函数需要开发者使用inherited调用基类的构造函数
声明析构函数时需要加上override关键字

其它见Pascal基础(三) - OOP

运算符重载

type
  TVector2 = record
  public
    x, y: single;
    procedure Normalize();
    function Length(): single;
    class operator +(const v1, v2: TVector2): TVector2; inline;
    class operator +(v: TVector2; z: single): TVector2; inline;
  //class operator + (z:single;v:TVector2):TVector2;inline;
    class operator -(const v1, v2: TVector2): TVector2; inline;
  //class operator - (const v:TVector2):TVector2;inline;
    class operator / (v: TVector2; z: single): TVector2; inline;
    class function Equals(const V1, V2: TVector2): boolean; overload; inline; static;
    class function Equals(const V1, V2: TVector2; const Epsilon: single): boolean;
        overload; inline; static;
    function ToString: string;

    function IsZero: boolean;

  end;

调用代码示例

program test;

{$mode objfpc}{$H+}

uses
  SysUtils,
  Classes,
  vector2;

var
  a: TVector2;
  f: TVector2;
  g: TVector2;
begin

  f.x := 10;
  f.y := 20;

  g := f + 10.0;
  g := f / 2;


  writeln(g.ToString);
  a := g + f;
  writeln(a.toString);

end.

完整代码见 https://gitee.com/tom-cat/sdl-hello/blob/v4.0/vector2.pas

泛型

前言

目前很多语言都有泛型或者类似实现

C语言比较古老，没有泛型实现
C++ 有template来实现，个人对c++不懂，应该template和泛型不一样
java 1995发布，2004年的1.5版本加入泛型
C# 2000年发布, 2004年发布2.0加入泛型
go 2009年发布, 据说2021年8月发布的 Go 1.17 中添加泛型 [https://www.oschina.net/news/116519/go-generics-next-step]

简介

泛型有时也称之参数化类型.

从2.2开始,objfpc模式{$mode objfpc}官方支持泛型,而delphi模式{$mode delphi}需要从2.6开始.之所以支持两种方言dialect仅仅因为泛型的实现比delphi官方语言早了几年.

支持部分units使用{$mode objfpc},其它units使用{$mode delphi}

FGL(Free Generics Library) 是objfpc{$mode objfpc}模式下原生fpc泛型容器集合,rtl-generics是尽力兼容delphi{$mode delphi}泛型库的功能更多的泛型容器集合,从fpc 3.0.4 可用，3.1.1+以后成为标准库之一.

FGL,rtl-generics都可以用于两种语法模式

FGL

fgl 单元入手极易.包含以下几个基本类

TFPGList
TFPGObjectList
TFPGInterfacedObjectList
TFPGMap

代码示例


Program demo2;
{$mode objfpc}

Uses fgl,sysutils;

Type 
  TStudent = Class(TObject)
    FId : integer;
    FName: string;
  End;
  TStudents = specialize TFPGObjectList<TStudent>;

Function GetList(i:integer): TStudents;

Var 
  c : TStudent;
Begin
  result := TStudents.Create;
  For i:=1 To 10 Do
    Begin
      c := TStudent.Create;
      c.FId := i;
      c.FName := 'hello'+inttostr(i);
      result.Add(c);
    End;
End;

Var 
  list : TStudents;
  c : TStudent;
  i : integer;
Begin
  list := GetList(10);
  For i:=1 To list.Count Do
    Begin
      c := list[i-1];
      writeln(c.Fid,',',c.Fname);
    End;
  list.Clear;
  list.Free;
End.

demo2.elf:demo2.pas
	ptop demo2.pas  demo2.pas
	fpc -gh demo2.pas -odemo2.elf

自定义泛型类

如果fgl定义的泛型类不能满足需求，可以自定义泛型类

自定义泛型类定义,使用generic关键字。

type
  generic TList<T> = class
    Items: array of T;
    procedure Add(Value: T);
  end;

自定义泛型类实现

implementation

procedure TList.Add(Value: T);
begin
  SetLength(Items, Length(Items) + 1);
  Items[Length(Items) - 1] := Value;
end;

自定义泛型类使用

Type  
  TIntegerList = specialize TList<Integer>;
  TPointerList = specialize TList<Pointer>;
  TStringList = specialize TList<string>;

备注

理论上泛型类和一般类没有性能差异

代码示例

一个获取最大值的泛型示例

program demo3;

{$mode objfpc}{$H+}

type
  generic TFakeClass<_GT> = class
    class function gmax(a,b: _GT):_GT;
  end;

  TFakeClassInt = specialize TFakeClass<integer>;
  TFakeClassDouble = specialize TFakeClass<double>;

  class function TFakeClass.gmax(a,b: _GT):_GT;
  begin
    if a > b then 
      result := a
    else 
      result := b;
  end;

begin
    // show max of two integers
  writeln( 'Integer GMax:', TFakeClassInt.gmax( 23, 56 ) );
    // show max of two doubles
  writeln( 'Double GMax:', TFakeClassDouble.gmax( 23.89, 56.5) );
  readln();
end.

Xml

前言

xml和json是文本数据交换的主流格式. web端开发的流行是json在当下对比xml可能使用率高一些. 但是xml也没有到用不到的地步

除了主角Xml,本篇还需要Pascal的几个基础知识点如下

泛型
扩展方法
前置声明
转义符
oop

前置基础知识点

现代Pascal面向对象编程设计(OOP)

目前OOP应该算是主流开发范式, Pascal历史悠久变动繁杂,包袱很重所以只使用现代Pascal的特性.

转义符

Pascal中转义符和C系语言(C,C#,C++,Java)等不同,不是使用\,而是使用'#ascii'来实现. 例子说明可以参考Pascal 基础

前置声明

和C语言类似,未声明或在定义的方法和类不能使用.现代的C#,Java等语言没有这种限制.也就是说被调用方(方法或类)需要定义在调用方之前
由于一则需要注意定义顺序浪费脑力二则有循环的has-a关系,所以只是调整顺序不能很好的解决问题
解决方法也是和C语言类似,需要一个声明

type TA = class;
TB = class
public
	a:TA;
end;
TA = class
public
	b:TB;
end;
procedure A();forward;
procedure B();
begin
	A();
end;
procedure A();
begin
	writeln('hello');
end;

扩展方法

在不修改原有类的代码的前提下,为了给已有类新增方法.一般的做法就是定义一个静态的方法去调用.看起来不是太优雅.于是有了扩展方法这个语法糖.
C#中也允许这个设计.

先看需要解决的问题的场景,即无扩展方法的通常做法
为了给一个现有的类TStudent新增一个方法MoveTo,如果不修改TStudent的源代码的情况下(也可能是无法修改,比如是第三方提供,不允许修改)

type TStudentHelper = class
class procedure MoveTo(t:TStudent;x,y:integer);
end;

procedure TestMoveTo;
var s:TStudent;
begin
	s := TStudent.Create;
	TStudentHelper.MoveTo(s,10,10);
end;

扩展方法的使用方式如下
首先定一个helper

type TStudentHelper = class helper for TStudent
procedure MoveTo(x,y:integer);
end;

这样定义可以在MoveTo中方法TStudent的成员变量.
使用后的效果就是这样.和一般的方法看起来一样

procedure MoveTest;
var s:TStudent;
begin
    s := TStudent.Create;
	s.MoveTo(10,20);
end;

泛型

泛型可以生产力, 可以在编译时发现问题所在.
日常使用很是频繁.

Pascla解析Xml

由于Xml语言无关,虽然不同语言API不同 ,但是大体思路一致

 var
    doc: TXMLDocument;
ReadXMLFile(Doc, 'demo.xml');

从文件中创建TXmlDocument
然后遍历根结点,子节点,节点属性.

思路清楚接下来的就是熟悉一个API的官方文档即可.如果你用的是Lazarus,可以按住Ctrl,鼠标左键点击跳转到类的定义.

完整代码

celltree001

关注

2
点赞
踩
10

收藏

觉得还不错? 一键收藏
0
评论
Pascal基础

Pascal基础语法(一)序言有时无聊,翻看pascal,奈何看完即忘.于是记录之pascal听说将被NOIP停用,我没有去验证.管他呢,本来只是好奇环境用的免费的编译器 fpc [https://www.freepascal.org/]编辑器随便找个自己喜欢的就行, IDE 可以选 lazarus[https://www.lazarus-ide.org/],跨平台pascal版本有更迭,支持的方言很多,基于目前的最佳实践，所有代码里使用 ${mode objfpc } {$H+}{$J-}{
复制链接

扫一扫