Автор: Даниил Карапетян

WEB сайт: https://program.dax.ru

 

При нажатии на Button1 используется свойство Pixels, а при нажатии на Button2 - ScanLine. В заголовок окна выводится время в миллисекундах, за которое было создано изображение.

Code:

procedure TForm1.Button1Click(Sender: TObject);

var

t: cardinal;

x, y: integer;

bm: TBitmap;

begin

bm := TBitmap.Create;

bm.PixelFormat := pf24bit;

bm.Width := Form1.ClientWidth;

bm.Height := Form1.ClientHeight;

t := GetTickCount;

for y := 0to bm.Height - 1do

for x := 0to bm.Width - 1do

bm.Canvas.Pixels[x,y] := RGB(x+y, x-y, y-x);

Form1.Caption := IntToStr(GetTickCount - t);

Form1.Canvas.Draw(0, 0, bm);

end;

 

procedure TForm1.Button2Click(Sender: TObject);

var

t: cardinal;

x, y: integer;

bm: TBitmap;

p: PByteArray;

begin

bm := TBitmap.Create;

bm.PixelFormat := pf24bit;

bm.Width := Form1.ClientWidth;

bm.Height := Form1.ClientHeight;

t := GetTickCount;

for y := 0to bm.Height - 1do

begin

p := bm.ScanLine[y];

for x := 0to bm.Width - 1do

begin

p^[x*3] := x+y;

p^[x*3+1] := x-y;

p^[x*3+2] := y-x;

end;

end;

Form1.Caption := IntToStr(GetTickCount - t);

Form1.Canvas.Draw(0, 0, bm);

end;

Code:

function TextToTime(S: string): Integer;

var

p, i: Integer;

Sh, Sm, Ss: string;

begin

Sh := '';

SM := '';

SS := '';

i := 1;

p := 0;

while i do

begin

if (s[i] <> ':') then

begin

case P of

0: SH := Sh + s[i];

1: SM := SM + S[i];

2: SS := SS + S[i];

end;

end

else

Inc(p);

Inc(i);

end;

try

Result := (StrToInt(SH) * 3600) + (StrToInt(SM) * 60) + (StrToInt(SS))

except

Result := 0;

end;

end;

 

function TimeToText(T: Integer): string;

var

H, M, S: string;

ZH, ZM, ZS: Integer;

begin

ZH := T div3600;

ZM := T div60 - ZH * 60;

ZS := T - (ZH * 3600 + ZM * 60);

if ZH then H := '0' + IntToStr(ZH)

else

H := IntToStr(ZH);

if ZM then M := '0' + IntToStr(ZM)

else

M := IntToStr(ZM);

if ZS then S := '0' + IntToStr(ZS)

else

S := IntToStr(ZS);

Result := H + ':' + M + ':' + S;

end;

Code:

{ BrthDate: Date of birth }

 

function TFFuncs.CalcAge(brthdate: TDateTime): Integer;

var

month, day, year, bmonth, bday, byear: word;

begin

DecodeDate(BrthDate, byear, bmonth, bday);

if bmonth = 0then

result := 0

else

begin

DecodeDate(Date, year, month, day);

result := year - byear;

if (100 * month + day) < (100 * bmonth + bday) then

result := result - 1;

end;

end;

 


 

Code:

procedure TForm1.Button1Click(Sender: TObject);

var

Month, Day, Year, CurrentMonth, CurrentDay, CurrentYear: word;

Age: integer;

begin

DecodeDate(DateTimePicker1.Date, Year, Month, Day);

DecodeDate(Date, CurrentYear, CurrentMonth, CurrentDay);

if (Year = CurrentYear) and (Month = CurrentMonth) and (Day = CurrentDay) then

Age := 0

else

begin

Age := CurrentYear - Year;

if (Month > CurrentMonth) then

dec(Age)

elseif Month = CurrentMonth then

if (Day > CurrentDay) then

dec(Age);

end;

Label1.Caption := IntToStr(Age);

end;

 

 

 

 

 

Взято с Delphi Knowledge Base: https://www.baltsoft

 


 

Code:

function CalculateAge(Birthday, CurrentDate: TDate): Integer;

var

Month, Day, Year, CurrentYear, CurrentMonth, CurrentDay: Word;

begin

DecodeDate(Birthday, Year, Month, Day);

DecodeDate(CurrentDate, CurrentYear, CurrentMonth, CurrentDay);

 

if (Year = CurrentYear) and (Month = CurrentMonth) and (Day = CurrentDay) then

begin

Result := 0;

end

else

begin

Result := CurrentYear - Year;

if (Month > CurrentMonth) then

Dec(Result)

else

begin

if Month = CurrentMonth then

if (Day > CurrentDay) then

Dec(Result);

end;

end;

end;

 

procedure TForm1.Button1Click(Sender: TObject);

begin

Label1.Caption := Format('Your age is %d',

[CalculateAge(StrToDate('01.01.1903'), Date)]);

end;

 

 

Взято с сайта: https://www.swissdelphicenter.

 

 


 

Code:

DecodeDate(DM.Table.FieldByName('Born').AsDateTime, Year, Month, Day); // Дата рождения

DecodeDate(Date, YYYY, MM, DD); // Текущая дата

 

if (MM >= Month) and (DD >= Day) then

Edit2.Text := IntToStr((YYYY - Year))

else

Edit2.Text := IntToStr((YYYY - Year) - 1);

 

 

https://delphiworld.narod.

Засекание обычно нужно в двух случаях: самому программисту – узнать, как программа работает быстрее, или для информирования пользователя, сколько программа уже трудится.

 

Для засекания времени удобнее всего использовать функцию GetTickCount, но нельзя забывать о ее погрешности при измерении очень коротких промежутков времени, и о том, что программы в Windows работают с непостоянной скоростью. Поэтому не стоит засекать быстрые процессы, и не стоит делать выводы о каком-то алгоритме после одного тестирования. И еще. Если вы тестируете алгоритм, то поставьте его в цикл, выполнив его, например, тысячу раз, а потом получившееся время делите на тысячу. Так точнее. Эта программа засекает, сколько времени меняется цвет точек окна в этой программе.

Code:

procedure TForm1.Button1Click(Sender: TObject);

var

i, t: integer;

begin

t := GetTickCount;

randomize;

for i := 0to100000do

Form1.Canvas.Pixels[i mod Form1.ClientWidth, i div Form1.ClientWidth] := RGB(random(255), random(255), random(255));

Form1.Caption := IntToStr(GetTickCount - t);

end;

 

 

 

Автор советов: Даниил Карапетян

e-mail: Этот адрес электронной почты защищён от спам-ботов. У вас должен быть включен JavaScript для просмотра.

 

Автор справки: Алексей Денисов

e-mail: Этот адрес электронной почты защищён от спам-ботов. У вас должен быть включен JavaScript для просмотра.

Code:

var Min3: integer;

 

procedure TForm1.Button1Click(Sender: TObject);

begin

timer1.enabled:=true;

Min3:=3*60;

end;

 

procedure TForm1.Timer1Timer(Sender: TObject);

begin

Label1.Caption:=Format('%d : %2d',[Min3 div60, Min3 mod60 ]);

Dec(Min3);

if Min3 < 0then

// Что-то делаешь - 3 минуты закончились

end;