Полезные коды для PascalABC.NET

{$reference 'System.Windows.Forms.dll'}
{$reference 'System.Drawing.dll'}
 
uses
  System.Windows.Forms,
  System.Drawing;
 
var
  Bm: Bitmap;
  Gr: Graphics;
  
begin
  Bm := new Bitmap(Screen.PrimaryScreen.Bounds.Width, Screen.PrimaryScreen.Bounds.Height); // Создаём новый Bitmap
  Gr := Graphics.FromImage(Bm); // Создаём новую поверхность для рисования
  Gr.CopyFromScreen(0, 0, 0, 0, Bm.Size); // Копируем в неё изображения с экрана
  Bm.Save('C:\Screen.jpg', System.Drawing.Imaging.ImageFormat.Jpeg); // Сохраняем в формате .jpg 
end.

for var i := 1 to n do
...

for i: integer := 1 to n do
...

begin
  for i: integer := 1 to 10 do
    WriteLn(i);
end.

for var i := 1 to 10 do
...

begin
  for var i := 1 to 10 do
    WriteLn(i);
end.

begin
  for var i := 1 to 10 do
    WriteLn(i);
  
  for var i := 1 to 10 do
    Write(i, ' ');
end.

begin
  for var i := 1 to 10 do
    WriteLn(i);
  
  WriteLn(i); // Эта строка не входит в цикл
end.

begin
  WriteLn('Hello World!');
  ReadLn();
end.

{$mainresource hwres.res}
 
begin
  WriteLn('Hello World!');
  ReadLn();
end.

uses
  GraphABC;
 
begin
  // Тело
  Line(220, 100, 200, 380);
  Line(420, 100, 440, 380);
  Line(200, 380, 440, 380);
  Arc(320, 290, 140, 120, 60);
  
  // Уши
  Line(220, 100, 250, 170);
  Line(420, 100, 390, 170);
  
  // Глаза
  Circle(290, 220, 30);
  Circle(350, 220, 30);
  
  SetBrushColor(Color.Black);
  Circle(310, 220, 5);
  Circle(330, 220, 5);
  
  // Нос
  SetBrushColor(Color.Pink);
  Circle(320, 240, 10);
  
  // Рот
  Line(320, 250, 320, 290);
  Arc(320, 230, 60, -130, -50);
  
  // Усы
  Line(239, 270, 310, 245);
  Line(239, 280, 310, 245);
  Line(239, 290, 310, 245);
  
  Line(329, 245, 400, 270);
  Line(329, 245, 400, 280);
  Line(329, 245, 400, 290);
  
  // Лапы
  Arc(250, 390, 30, 160, 20);
  Arc(390, 390, 30, 160, 20);
  
  Line(240, 380, 240, 370);
  Line(250, 380, 250, 370);
  Line(260, 380, 260, 370);
  
  Line(380, 380, 380, 370);
  Line(390, 380, 390, 370);
  Line(400, 380, 400, 370);
end.

{$reference 'PresentationCore.dll'}
 
begin
  var Player := new System.Windows.Media.MediaPlayer; {Присваиваем переменной "Player" новый экземпляр MediaPlayer'а}
  Player.Open( new System.Uri('Имя_файла.mp3', System.UriKind.Relative)); {Задаём путь до файла*}
  Player.Play(); {Воспроизводим файл}
  
  System.Windows.Forms.Application.Run();
end.

System.UriKind.Relative

System.UriKind.Absolute

System.UriKind.RelativeOrAbsolute

uses
  Microsoft.Win32;
 
const
  ApplicationName = 'PABC.NET AutoRun'; {Имя программы в автозапуске}
 
begin
  // Добавляем программу в автозапуск
  var Reg := Registry.LocalMachine.CreateSubKey('Software\Microsoft\Windows\CurrentVersion\Run');
  Reg.SetValue(ApplicationName, GetEXEFileName);
  Reg.Close;
  
  // Удаляем программу из автозапуска
  var Reg := Registry.LocalMachine.CreateSubKey('Software\Microsoft\Windows\CurrentVersion\Run');
  Reg.DeleteValue(ApplicationName);
  Reg.Close;
end.

procedure MainForm_MouseDown(sender: object; args: System.Windows.Forms.MouseEventArgs);
begin
  Down := True; {Зажали кнопку}
  
  // Запоминаем координаты формы
  X := MainForm.Left;
  Y := MainForm.Top;
  
  // Запоминаем координаты курсора
  cX := System.Windows.Forms.Cursor.Position.X;
  cY := System.Windows.Forms.Cursor.Position.Y;
end;

procedure MainForm_MouseUp(sender: object; args: System.Windows.Forms.MouseEventArgs);
begin
  Down := False; {Отпустили кнопку}
end;

procedure MainForm_MouseMove(sender: object; args: System.Windows.Forms.MouseEventArgs);
begin
  if Down then {Если кнопка нажата}
  begin
  // Двигаем форму относительно курсора
    MainForm.Left := System.Windows.Forms.Cursor.Position.X - cX + X;
    MainForm.Top := System.Windows.Forms.Cursor.Position.Y - cY + Y;
  end;
end;

{$apptype windows}
{$reference 'System.Windows.Forms.dll'}
{$reference 'System.Drawing.dll'}
uses
  System.Windows.Forms,
  System.Drawing;
 
var
  MainForm: System.Windows.Forms.Form;
  X, Y, cX, cY: integer;
  Down: boolean := False;
 
procedure MainForm_MouseDown(sender: object; args: System.Windows.Forms.MouseEventArgs);
begin
  Down := True; {Зажали кнопку}
  
  // Запоминаем координаты формы
  X := MainForm.Left;
  Y := MainForm.Top;
  
  // Запоминаем координаты курсора
  cX := System.Windows.Forms.Cursor.Position.X;
  cY := System.Windows.Forms.Cursor.Position.Y;
end;
 
procedure MainForm_MouseUp(sender: object; args: System.Windows.Forms.MouseEventArgs);
begin
  Down := False; {Отпустили кнопку}
end;
 
procedure MainForm_MouseMove(sender: object; args: System.Windows.Forms.MouseEventArgs);
begin
  if Down then {Если кнопка нажата}
  begin
  // Двигаем форму относительно курсора
    MainForm.Left := System.Windows.Forms.Cursor.Position.X - cX + X;
    MainForm.Top := System.Windows.Forms.Cursor.Position.Y - cY + Y;
  end;
end;
 
begin
  
  MainForm := new Form;
  MainForm.StartPosition := FormStartPosition.CenterScreen;
  MainForm.FormBorderStyle := FormBorderStyle.None;
  MainForm.MouseDown += MainForm_MouseDown;
  MainForm.MouseUp += MainForm_MouseUp;
  MainForm.MouseMove += MainForm_MouseMove;
  
  Application.Run(MainForm);
end.

{$apptype windows}
{$reference 'System.Windows.Forms.dll'}
{$reference 'System.Drawing.dll'}
 
uses
  System.Windows.Forms,
  System.Drawing;
  
var
  MainForm: Form;
  
begin
  MainForm := new Form;
  MainForm.StartPosition := FormStartPosition.CenterScreen;
  MainForm.FormBorderStyle := FormBorderStyle.None;
  MainForm.ClientSize := new System.Drawing.Size(200, 200); {Подгоняем под размер изображения}
  MainForm.BackColor := Color.HotPink; {Цвет фона задаём "левый", который больше нигде не будет использоваться}
  MainForm.TransparencyKey := Color.HotPink; {Делаем прозрачным наш "левый" цвет}
  MainForm.BackgroundImage := Image.FromFile('background.png');
  
  Application.EnableVisualStyles;
  
  Application.Run(MainForm);
end.

function FindDir(): string;
begin
  Result := System.IO.Directory.GetDirectoryRoot('\WINDOWS\System32\shutdown.exe');
end;
 
begin
  Exec(FindDir + 'WINDOWS\System32\shutdown.exe', '-f');
end.

{$apptype windows}
{$reference 'System.Windows.Forms.dll'}
{$reference 'System.Drawing.dll'}
uses System.Windows.Forms;
var myForm:Form;
begin
  myForm:=new Form; //В переменную myForm записываем экземпляр новой формы
  myForm.Text:='Программа с формой'; //Определяем заголовок окна
  myForm.Width:=600; //Устанавливаем ширину
  myForm.Height:=350; //Устанавливаем высоту
  myForm.Left:=95; //Расстояние от начала экрана до левой границы формы
  myForm.Top:=150;
  Application.Run(myForm);
end.

{$apptype windows}
{$reference 'System.Windows.Forms.dll'}
{$reference 'System.Drawing.dll'}
 
uses
  System.Windows.Forms,
  System.Drawing;
  
var
  MainForm: System.Windows.Forms.Form;
  B1: System.Windows.Forms.Button;
 
procedure B1_Click(Sender: Object; Args: System.EventArgs);
begin
  MainForm.Text := 'Вы нажали кнопку!';
end;
  
begin
  B1 := new Button; {Создаём кнопку}
  B1.Location := new System.Drawing.Point(100, 110); {Позиция кнопки на форме}
  B1.Text := 'Кнопка'; {Текст кнопки}
  B1.Click += B1_Click; {Процедура, выполняющаясь по нажатию}
 
  MainForm := new Form;
  MainForm.Text := 'Нажмите кнопку';
  
  MainForm.Controls.Add(B1); {Добавляем кнопку на форму}
  
  Application.EnableVisualStyles; {Подключаем визуальные стили}
  
  Application.Run(MainForm);
end.

begin
var Player := new System.Media.soundPlayer('Ваш файл.wav'); //Создаем плеер и привязываем файл
player.Play;//Включаем плеер
player.Stop; //Останавливает плеер
end.

player.IsLoadCompleted //True если файл загружен успешно
player.LoadCompleted //Событие вызываемое при успешной или неуспешной загрузке файла
player.SoundLocation //Путь к файлу
player.PlayLooping //Зацикливает плеер

{$reference 'PresentationCore.dll'}
 
begin
  var Player1 := new System.Windows.Media.MediaPlayer;
  Player1.Open( new System.Uri('1.mp3', System.UriKind.Relative));
  Player1.Play();
  
  var Player2 := new System.Windows.Media.MediaPlayer;
  Player2.Open( new System.Uri('2.mp3', System.UriKind.Relative));
  Player2.Play();
  
  System.Windows.Forms.Application.Run();
end.

procedure ReverseString(var s:string); //назвать можно как угодно
begin
s:=ReverseString(s); //Это ФУНКЦИЯ которая возвращает перевернутую строку
end;

function func(s:string):string;
begin
result:=reversestring(s);
end;
 
begin
s:='СЛОВО';
s:=func(s);
writeln(s); //ОВОЛС

procedure func(var s:string);
begin
s:=reversestring(s);
end;
 
begin
s:='СЛОВО';
func(s);
writeln(s); //ОВОЛС

function count(s:string;c:char):integer;
begin
for var i:=1 to length(s)-1 do
if s[i]=c then
inc(result);
end;

procedure count(var arr:array of string;s:string); 
var k:integer; 
begin
if not (s[length(s)]=' ') then begin
setlength(s,length(s)+1);
s[length(s)]:=' '; end;
setlength(arr,count(s,' ')+1);
for var i:=1 to count(s,' ')+1 do begin
repeat
k+=1;
arr[i-1]+=s[k];
until s[k+1]=' ';
k+=1;
end;
end;

var words:array of string;
str:string;
///Считает количество 'c' в строке 's'
function count(s:string;c:char):integer; begin
for var i:=1 to length(s)-1 do
if s[i]=c then
inc(result);
end;
 
///Разбирает строку 's' на слова и помещает в массив 'arr'
procedure count(var arr:array of string;s:string); 
var k:integer; begin
setlength(arr,0);
if not (s[length(s)]=' ') then begin
setlength(s,length(s)+1);
s[length(s)]:=' '; end;
setlength(arr,count(s,' ')+1);
for var i:=1 to count(s,' ')+1 do begin
repeat
k+=1;
arr[i-1]+=s[k];
until s[k+1]=' ';
k+=1;
end;
end;
 
///Выводит в столбик массив
procedure writelnArray(arr:array of string);
begin
for var i:=0 to length(arr)-1 do
writeln(arr[i]);
end;
 
///Выводит в строчку массив
procedure writeArray(arr:array of string);
begin
for var i:=0 to length(arr)-1 do
write(arr[i],' ');
end;
 
begin
str:='Строка состоящая из пяти слов';
count(words,str);
writelnArray(words);
writeln;
str:='Строка из четырех слов';
count(words,str);
writelnArray(words);
writeln;
str:='Здесь три слова';
count(words,str);
writelnArray(words);
writeln;
str:='Два слова';
count(words,str);
writelnArray(words);
writeln;
str:='Слово';
count(words,str);
writelnArray(words);
end.

procedure writelnArray(arr:array of string);
begin
for var i:=0 to length(arr)-1 do
writeln(arr[i]);
end;

procedure writeArray(arr:array of string);
begin
for var i:=0 to length(arr)-1 do
write(arr[i],' ');
end;

procedure Inc(var i: integer);
begin
  i += 1;
end;