Delphi заготовки

Функция перевода чисел из римского в арабское

Function myodd(s1:integer):integer;
begin
if s1 mod 2 =0 then result:=0
else result:=1;
end;

function RomanToArabic( const romanNumber : string) : integer ;
const
romanChars = 'IVXLCDMvxlcdm?!#' ;
decades : array [0..8] of integer = (
0, 1, 10, 100, 1000, 10000, 100000,
1000000, 10000000) ;
OneFive : array [0..1] of byte = (1, 5) ;
var
newValue, oldValue : integer ;
cIdx, P : byte ;
begin
result := 0;
oldValue := 0 ;
for cIdx := Length(romanNumber) downto 1 do
begin
P := Succ(Pos(romanNumber[cIdx], romanChars)) ;
newValue := OneFive[myodd(p)] * decades[P div 2] ;
if newValue = 0 then
begin
result := -1;
Exit;
end ;
if newValue < oldValue then newValue := - newValue ;
Inc(result, newValue) ;
oldValue := newValue
end ;
end;

Функция перевода чисел из арабских в римские

function Arab2Roman(arab:integer):s ... Читать дальше »

пересечение двух прямых на плоскости
исходник функции
возвращает координаты пересечения двух отрезков

Delphi/Pascal

function Subtract(AVec1, AVec2 : TPoint) : TPoint;
begin
  Result.X := AVec1.X - AVec2.X;
  Result.Y := AVec1.Y - AVec2.Y;
end;

function LinesCross(LineAP1, LineAP2, LineBP1, LineBP2 : TPoint) : boolean;
Var
  diffLA, diffLB : TPoint;
  CompareA, CompareB : integer;
begin
  Result := False;
  diffLA := Subtract(LineAP2, LineAP1);
  diffLB := Subtract(LineBP2, LineBP1);
  CompareA := diffLA.X*LineAP1.Y - diffLA.Y*LineAP1.X;
  CompareB := diffLB.X*LineBP1.Y - diffLB.Y*LineBP1.X;
  if ( ((diffLA.X*LineBP1.Y - diffLA.Y*LineBP1.X) < CompareA) xor
       ((diffLA.X*LineBP2.Y - diffLA.Y*LineBP2.X) < CompareA) ) and
     ( ((diffLB.X*LineAP1.Y - diffLB.Y*LineAP1.X) < CompareB) xor
   ... Читать дальше »

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

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

Перевод программы через gogle

1. Для примера берем стандартный пример  Delphi&RichEdit

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

перевод в любую систему счисления
исходник Pascal/Delphi
простой пример


Inttostr(x); // перевод из Integer в String 
FloatTostr(3.14);   // перевод из Real (вещественного числа) в строку 
FormatFloat('0.0',3.14); // перевод из Real (вещественного числа) в строку  с форматом например два числа после запятой
inttohex(5,2); // перевод в 16-ричную



пример для перевода в другие системы счисления



const
   stroka:string='0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ'; // список символов используемых в качестве чисел; максимальная строка 37 знаков

Function GetSistema(Value:string;DDefault:integer):integer; { получаем систему счисления Value   система счисления поумолчанию DDefault=10}
var m,x,l:integer;
    s:string; { временная строка для процедуры}
begin
  s:=Value;
  l:=length(s); { длна строки}
  m:=DDefault;{}
  for x:=1 to l ... Читать дальше »

Технический авангардизм Delphi/Pascal
Писал программу для отображения шарика движущегося по разным траекториям.
получил красивые визуальные эффекты.
пример работы с Brush

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

Пример  Пузырьковой  сортировки
Пузырьковая сортировка

procedure TForm1.Button1Click(Sender: TObject);
var x:integer;
     a: array of integer;
     L:integer;
     s2,s:string;
     b,k,min:integer;
begin
  l:=0;
  s:=form1.edit1.text;
  // ==================================
  // занести массив из поля Edit1.text
  for X:=1 to length(s) do
    if (s[x]=',') or (length(s)=x) then begin
    if length(s)=x then if s[x]<>',' then s2:=s2+s[x];
    l:=l+1;
    setlength(a,l);
    trystrtoint(s2,a[l-1]);
    s2:='';
    end
    else s2:=s2+s[x];
  // занести массив из поля Edit1.text и через запятую
  // ==================================
  // -----  сортировк ... Читать дальше »

Функция перерисовки звездочки

исходник на Pascal / Delphi

procedure Tform1.StarLine(xO,yO,r: integer; Canvas: TCanvas);
 var p: array [0..11] of TPoint;
a,i: integer;
begin
a := 18;
for i:=0 to 11 do begin
if (i mod 2 = 0 ) then begin

p[i].x:=xO+round((r/2)*cos(a*pi/180));
p[i].y:=yO+Round((r/2)*sin(a*pi/180));


end
else begin
p[i].x:=xO+Round(r*cos(a*pi/180));
p[i].y:=yO+Round(r*sin(a*pi/180)) ;
end;
a:=a+36;
end;

Canvas.Polyline(p);

end;

программа



http://ne ... Читать дальше »