Delphi заготовки

{
заполнить прямоугольный целочисленный массив следующим
    образом по периметру массива стоят единицы, в центре-нули
}
uses crt;
const n=4;

var
   a: array [1..n,1..n] of integer;


   procedure Zpmassiv;
   var x,y:integer;
   begin
   for X:=2 to n-1 do
     for y:=2 to n-1 do
      a[x,y]:=0; {заносим нули в массив }
  {заполняем контур}
      for X:=1 to n do begin
      a[x,1]:=1;
      a[1,x]:=1;
      a[x,n]:=1;
      a[n,x]:=1;
      end;
      
      
   end;
{выводим массив }
Procedure ShowMassiv;
var x,y:integer;
begin
for y:=1 to n do begin
 writeln ... Читать дальше »

Процедура позволяет определить входит ли цифра B в число Х

Помогите решить задачку

Определить, есть ли среди цифр заданного положительного четырехзначного числа цифра "0"

Function GetIntInInteger(x:Integer;B:integer):boolean;
var
    g:boolean;
begin
x:=10234;
g:=false;
  while x>0 do begin
     if (x mod 10)=B then g:=true;
     x:=x div 10;
  end;
  result:=g;
end;

вариант через String 

var x:integer;
begin 
 if pos('0',inttostr(x))>0 then // есть 
else // нет 

		
		... 
		
			Читать дальше »
		

 для открытия его в Excel

Процедура открытия файла с расширением *.CSV или как загрузить таблицу из CSV файла Delphi.

//  Table - таблица TStringGrid
//  Filename - имя файла
//ch разделитель  - по умолчанию точка с запятой ";"
// StartRow сколько строк оставить для заготовка

Function LoadTableFormFile(Table:TStringGrid;Filename:string;ch:char=';'; StartRow:integer=0 ):boolean;
var t,l,x,y:integer;
    s2,s:string;
    f:textfile;
begin
if fileage(Filename)>0 then begin // проверка на существование файла
  assignfile(f,Filename);
  reset(F);
y:=StartRow-1;

  repeat
  readln(f,s);
  y:=y+1;
  if y>=Table.RowCount then Table.RowCount:=y+1;
  l:=length(s);
  s2:='';
  t:=0;
  x:=1;
  while x<=l do begin
       if s[x]='#' then begin
   ... Читать дальше »

Сортировка строк в TListBox TMemo  TStringList TString Пузырьковая сортировка

Procedure SortStringList(var value:TStringList);
var x:integer;
     L:integer;
     b,min:string;
     k:integer;
begin
l:=value.Count;
 for x:=0 to l-1 do begin
     min:=value[x];
     for k:=x to l-1 do
        if (value[k]<min) then begin
           b:=value[x];
           value[x]:=value[k];
           value[k]:=b;
           min:=value[x];
        end;
  end;
end;
Function SortStringListInString(S:String):string;
var t:TstringList;
begin
&n ... Читать дальше »

{
Задание : Дана строка текста.Вывести на экран слова ,в которых буква "а"
входит не менее двух раз .
}
uses crt;
const MaxCountWord=1000; { максимальное количество слов в тексте }
type
  Tword=record
   word:string;
   col:integer;
 end;

 TDocumcent=record;
    WordList: array[1..MaxCountWord] of Tword;{список слов}
    WordListCount:integer; {список слов }
 end;
var
    DocBody:TDocumcent; {тело документа }
    s,text:string; {строка }
    ai,i,x,lnstr:integer; {длина слова}


 Procedure AddWord(word:string;var Doc:TDocumcent);
 var x:integer;
 begin
   for x:=1 to Doc.WordListCount do
   if Doc.wordlist[x].word=word then begin Doc.WordList[x].col:=Doc.WordList[x].col+1; exit; end;
   Doc.WordListCount:=Doc.WordListCount+1;
   Doc.W ... Читать дальше »

UTF кодировка при подключении к базе данных FireBird

   В базе данных FireBird при внесении изменений в текст хранимой процедуры возникает сообщение вида

The next statement causes the following error:

—This operation is not defined for system tables.
unsuccessful metadata update.
STORE RDB$RELATIONS failed.
Malformed string.

или

—This operation is not defined for system tables.
unsuccessful metadata update.
MODIFY TRIGGER failed.
Malformed string.

или

—This operation is not defined for system tables.
unsuccessful metadata update.
MODIFY RDB$PROCEDURES failed.
Malformed string.

ответ с сайта
   http://www.mail-archive.com/ru-firebird@googlegroups.com/msg34063.html

 Потому что сервер не делает преобразования для NONE, а метаданные
хранятся в UTF8. Задавай правильно чарсет соединения, или пиши скрипты
в UTF8 сам.

для этого необходимо в свойствах компонента TIBDa
		
		... 
		
			Читать дальше »
		

Операторы Pascal  div

—  оператор «div» используется для целочисленного деления

  Например

   8 div 2 = 8/2 = 4
   8 div 3 = (8-3-3-2)  // последняя 2 меньше числа 3 => считаем количество троек  «3»
   8 div 2 = 4
   5 div 2 = 2
  

Операторы Pascal «mod»

 

—  оператор «mod» используется для получения остатка от деления

  Например

   8 mod 2 = 8-(8 div 2)*2 = 8-(4)*2= 0
   8 mod 3 = 8-(8 div 3)*3 = 8-2*3 = 2
   5 mod 2 = 1

  получить количество  элементов кратное 3 в массиве

const
   count=100; // размер массива
var
    A:array [1..count] of integer;
    x:integer;
    c3:integer;
 begin
 c3:=0;
&nb ... Читать дальше »

{ **** UBPFD *********** by delphibase.endimus.com ****
>> Дополнение строки пробелами слева

Дополненяет строку слева пробелами до указанной длины

Зависимости: нет
Автор:       Anatoly Podgoretsky, anatoly@podgoretsky.com, Johvi
Copyright:
Дата:        26 апреля 2002 г.
***************************************************** }

function PADL(Src: string; Lg: Integer): string;
begin
  Result := Src;
   ... Читать дальше »

// генерирует к — разрядное число
function GetNumb(k: integer) : integer;
var
n: integer; // генерируемое число
i: integer;
begin
// процедура генерирует число по разрядам
// начиная со старшего
n:= Random(9)+1; // старший разряд не может быть нулем
// остальные разряды
for i := 1 to (k-1) do
n := n*10 + Random(10);
GetNumb := n;
end;

на основе примера
http://mathem.h1.ru/examples/example.html?3


Функции работы с матрицами


Const
maxCount=30;
type
  TArrayReal=array[0..maxCount, 0..maxCount] of real;
var
   Count:integer;


{функция расчета обратной матрицы }
procedure GetBackMatrix(source:TArrayReal;var Back:TArrayReal);
var k, i, j: integer;
begin
 for i:=0 to Count - 1 do
 for j:=0 to Count - 1 do Back[i,j]:=source[i,j];

 for k:=0 to Count - 1 do
 begin
      for i:=0 to Count - 1 do
       for j:=0 to Count - 1 do
       begin
            if (i=k) and (j=k) then
               source[i,j] := 1/Back[i,j];
            &nb ... Читать дальше »