Советы по Delphi. Версия 1.4.3 от 1.1.2001 - Валентин Озеров

Все права на текст принадлежат автору: Валентин Озеров.
Это короткий фрагмент для ознакомления с книгой.

Что такое "Советы по Delphi"?

«Советы по Delphi» — коллекция ответов на нетрадиционные вопросы программирования на Delphi, нестандартных решений, хитростей и интересных идей. Для практической пользы дела приведены конкретные примеры кода, позволяющие донести идею или полностью ответить на заданный вопрос.

Автором предусматривается попытка на периодичность издания, подписаться на уведомления о выходе новых версий можно здесь. При составлении «Советов» не ставилась цель включить ВСЕ материалы, отбирались лишь самые интересные. Источником «Советов» служили многочисленные западные источники (FAQ), кропотливо отобранные и переведенные на русский язык.

Учитывая плачевное состояние наших линий, «Советы» практически не содержат графики. Весь приведенный код отформатирован таким образом, чтобы вы могли скопировать его прямо со странички в свое приложение. По этой же причине отсутствует online-версия «Советов».

Так, если Вы обладаете интересной информацией, и ее нет в «Советах», не поленитесь, пришлите ее мне. Пожалуйста не задавайте мне вопросов по электронной почте. У меня есть работа и я занятый человек. Помещайте свои вопросы в группу новостей, я попытаюсь ответить на них там.

Шлите примеры, советы, полезности, статьи и давайте ссылки на свои и не свои сайты. От вас самих зависит наполняемость советов. Авторы! Дайте вторую жизнь вашим произведениям! Присылайте статьи и переводы!

Не удивляйтесь, если в «Советах» Вы обнаружите код для Delphi1 или даже для TurboPascal'я. Сам Паскаль практически не изменился, а идеи, реализация и технология живы до сих пор. Для описания какой-либо функции можно заглянуть в электронную справку, а для поиска идеи — в «Советы».

Алгоритмы

Преобразования

Преобразование дробной и целой части REAL-числа в два целых

Я написал программу, которая делает это. Это DOS-программа. Вы вызываете ее с десятичным числом, передаваемым в качестве параметра. После чего программка выведет 3 колонки, в первой будет находиться исходное число, две остальные будут содержать числитель и знаменатель. Вы можете преобразовать программу в функцию и применять ее в своих приложениях, но, думаю, это несложно, и с этим вы справитесь сами.

Для ее запуска достаточно в подсказке DOS набрать ее имя и число:

CONTFRAC 3.141592654

program contfrac; { непрерывные дроби }

{$N+}

const

order = 20;

var

y, lasterr, error, x: extended;

a: array [0..order] of longint;

i, j, n: integer;

op, p, q: longint;

begin

lasterr := 1e30;

val(paramstr(1), y, n);

if n <> 0 then halt;

x := y;

a[0] := trunc(x);

writeln;

writeln(a[0]:20, a[0]:14, 1:14);

{ это может вызвать резкую головную боль и галлюцинации }

for i := 1 to order do begin

x := 1.0 / frac(x);

a[i] := trunc(x);

p := 1;

q := a[i];

for j := pred(i) downto 0 do begin

op := p;

p := q;

q := a[j] * q + op;

end;

error := abs(y – int(q) / int(p));

if abs(error) >= abs(lasterr) then halt;

writeln(a[i]:20, q:14, p:14, error:10);

if error < 1e-18 then halt;

lasterr := error;

end;

end.

Теперь попытаюсь объяснить мой алгоритм (он, по-моему, достаточно быстрый). Вот схема:

Допустим, мы используем число 23.56.

Берем наше натуральное число и производим целочисленное деление на 1.

23.56 div 1 = 23

Теперь вычитаем результат из числа, с которого мы начали.

23.56 – 23 = .56

Для преобразования значения в целое мы просто умножаем его на 100, и, при необходимости, приводим его к целому.

valA := (val div 100);

valB := (valA – val);

valB := (valA – val) * 100;

val = 23.56

ValA = 23

ValB = .56 or 56

Есть ли функция, выполняющая пpеобpазование пеpеменной real в integer?

Nomadic советует:

Hа самом деле есть две функции — Round и Trunc (округление и отсечение дробной части соответственно).

Кстати, функции эти были уже в самых ранних версиях Паскаля. Так что мой совет — изучите Паскаль — полезно.

Hy, если yж дело идет к изyчению списка фyнкций :), то yпомянy еще Ceil и Floor. Unit Math;

Кстати, втоpая из них мне очень пpигодилась для полyчения экспоненты числа. Имеется в видy экспонента: X=1E 13 [001193]

Почему непpавильно pаботает функция StrToFloat?

Nomadic советует:

Пишу даже прямо StrToFloat('32.34'), к примеру, получаю исключение «'32.34' is not valid float». Если пишу число без десятичной точки, то все ОК. А какой у тебя DecimalSeparator? В Russian settings почему-то по умолчанию считается, что разделитеь дроби – запятая. Пеpеустанови пpи запуске пpогpаммы

DecimalSeparator := '.';

Или пользуйся этой функцией так:

StrToFloat('32,24');

Число строкой X

Сергей AKA WildSery прислал свой вариант:

Привожу мой вариант, написал для своего приложения за 20 минут. В силу специфики приложения не утруждал себя прописью полностью "рублей" и "копеек", а ограничился "руб." и "коп.", а также не было необходимости в знаке числа, по это все добавляется буквально 3-4 строками.

function currency2str (value: double): string;

 const hundreds: array [0..9] of string = ('',' сто',' двести',' триста',' четыреста',' пятьсот',' шестьсот',' семьсот',' восемьсот',' девятьсот');

 tens: array [0..9] of string = ('','',' двадцать',' тридцать',' сорок',' пятьдесят',' шестьдесят',' семьдесят',' восемьдесят',' девяносто');

 ones: array [0..19] of string = ('','','',' три',' четыре',' пять',' шесть',' семь',' восемь',' девять',' десять',' одиннадцать',' двенадцать',' тринадцать',' четырнадцать',' пятнадцать',' шестнадцать',' семнадцать',' восемнадцать',' девятнадцать');

 razryad: array [0..6] of string = ('',' тысяч',' миллион',' миллиард',' триллион',' квадриллион',' квинтиллион');

var s: string; i: integer; val: int64;

function shortnum(s: string; raz: integer): string;

begin

Result:=hundreds[StrToInt(s[1])];

if strtoint(s)=0 then exit;

if s[2]<>'1' then begin

Result:=Result+tens[StrToInt(s[2])];

case strtoint(s[3]) of

1: if raz=1 then result:=result+' одна' else result:=result+' один';

2: if raz=1 then result:=result+' две' else result:=result+' два';

else result:=result+ones[strtoint(s[3])];

end;

Result:=Result+razryad[raz];

case strtoint(s[3]) of

0,5,6,7,8,9: if raz>1 then result:=result+'ов';

1: if raz=1 then result:=result+'а';

2,3,4: if raz=1 then result:=result+'и' else if raz>1 then result:=result+'а';

end;

end else begin

Result:=Result+ones[StrToInt(Copy(s,2,2))];

Result:=Result+razryad[raz];

if raz>1 then result:=result+'ов';

end;

begin

val:=Trunc(value);

if val=0 then begin result:='ноль'; exit; end;

s:=IntToStr(val); Result:=''; i:=0;

while length(s)>0 do begin

Result:=shortNum(Copy('00'+s,Length('00'+s)-2,3),i)+Result;

if length(s)>3 then s:=copy(s,1,length(s)-3) else s:='';

inc(i);

end;

s:=IntToStr(Trunc((value-val)*100+0.5));

Result:=Result+' руб. '+s+' коп.';

end;

Даты

Добавление даты и времени в компонент Memo

{ Следующий код вставляет значение даты/времени в memo-поле. }

Var

s : string;

begin

s := DateToStr( Date ) + ' ' + TimeToStr( Time ) + ' :';

Memo1.Lines.Insert(0, s);

Memo1.SetFocus;

Memo1.SelStart := Length(s);

Memo1.SelLength := 0;

Вычисление даты Пасхи II

function easter (year: integer): tdatetime;

{----------------------------------------------------------------}

{ Вычисляет и возвращает день Пасхи определенного года.          }

{ Идея принадлежит Mark Lussier, AppVision <MLussier@best.com>. }

{ Скорректировано для предотвращения переполнения целых, если по }

{ ошибке передан год с числом 6554 или более. }

{----------------------------------------------------------------}

var

nMonth, nDay, nMoon, nEpact, nSunday,

nGold, nCent, nCorx, nCorz: Integer;

begin

{ Номер Золотого Года в 19-летнем Metonic-цикле: }

nGold := (Year mod 19) + 1;

{ Вычисляем столетие: }

nCent := (Year div 100) + 1;

 { Количество лет, в течение которых отслеживаются високосные года… }

{ для синхронизации с движением солнца: }

nCorx := (3 * nCent) div 4 – 12;

{ Специальная коррекция для синхронизации Пасхи с орбитой луны: }

nCorz := (8 * nCent + 5) div 25 – 5;

{ Находим воскресенье: }

nSunday := (Longint(5) * Year) div 4 – ncorx – 10;

{ ^ Предохраняем переполнение года за отметку 6554}

{ Устанавливаем Epact – определяем момент полной луны: }

nEpact := (11 * nGold + 20 + nCorz – nCorx) mod 30;

if nepact < 0 then nEpact := nEpact + 30;

if ((nepact = 25) and (ngold > 11)) or (nepact = 24) then nEpact := nEpact + 1;

{ Ищем полную луну: }

nMoon := 44 – nEpact;

if nmoon < 21 then nMoon := nMoon + 30;

{ Позиционируем на воскресенье: }

nMoon := nMoon + 7 – ((nSunday + nMoon) mod 7);

if nmoon >l 31 then

begin

nMonth := 4;

nDay := nMoon – 31;

end

else

begin

nMonth := 3;

nDay := nMoon;

end;

Easter := EncodeDate(Year, nMonth, nDay);

end; {easter}

Преобразование даты в количество секунд

EncodeDate возвращает объект TDateTime, который просто является double-числом. Для получения количества миллисекунд с даты 1/1/0001, умножьте результат на 86400000.0 Но чтобы избежать переполнения, лучше пользоваться более поздней датой.

Преобразование даты в неделю

procedure TForm1.Button1Click(Sender: TObject);

var frstDay,toDay : TDateTime; week : Integer;

begin

frstDay := StrToDate('1/1/96');

toDay := StrToDate(Edit1.Text);

week := Trunc((toDay - frstDay) / 7) + 1;

Label1.Caption := IntToStr(week);

end;

Преобразование даты

procedure TForm1.Button1Click(Sender: TObject);

var

st,formatsave : string;

DT : TDateTime;

begin

st := Edit1.text; // '1996-06-03 00.00.00'

formatsave := ShortDateFormat;

ShortDateFormat := 'yyyy.mm.dd hh.mm.ss';

while pos ('-', st) > 0 do st [pos ('-', st)] := '.';

DT := StrToDateTime(st);

ShortDateFormat := formatsave;

Label1.Caption := DateTimeToStr(DT);

end;

Преобразование даты — добавление столетия

LongDate := FormatDateTime('ddmmyyyy', StrToDate(ShortDate));

Данный код преобразует дату, переданную в формате, определенном в виде короткой даты в Панели Управления (типа DD/MM/YY) в формат, заданный в строке Format (в нашем примере DDMMYYYY).

Если DD/MM/YY — входное поле, а DDMMYYYY — поле базы данных, то приведенный выше код может сослужить пользователю хорошую службу, если он вдруг захочет использовать другой формат даты, с его соответствующим переопределением в Панели Управления.

(Естественно, YYYYMMDD для поля базы данных при обычных обстоятельствах будет лучше чем DDMMYYYY, поскольку в настоящее время используется метод последовательной сортировки).

Приведение даты

procedure TForm1.MaskEdit1Exit(Sender: TObject);

var

y, m, d : word;

begin

decodedate(strtodate(maskedit1.text) + 11, y, m, d);

maskedit2.text := inttostr(m) + '/' + inttostr(d) + '/' + inttostr(y);

end;

Даты и недели

У меня есть программа, которая делает примерно то, что вы хотите. Она сообщает для даты текущую неделю и день недели. Вам необходимо лишь реализовать вычисление предела для дат недели. Кроме того, формат в этом коде для дат задан в виде "06/25/1996".

Вы должны создать форму с именем "Forma", компонентом TEdit с именем "Edit1", четырьмя метками и кнопкой с именем "GetWeekBtn". Убедитесь в том, что обработчиком события формы OnCreate является метод FormCreate.

Надеюсь, что помог вам.

unit Forma;

interface

uses

SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,Forms, Dialogs, StdCtrls;

type

TForma1 = class(TForm)

Edit1: TEdit;

Label1: TLabel;

Label2: TLabel;

Label3: TLabel;

GetWeekBtn: TButton;

Label4: TLabel;

procedure GetWeekBtnClick(Sender: TObject);

procedure FormCreate(Sender: TObject);

private { Private declarations }

Function HowManyDays(pYear,pMonth,pDay:word):integer;

public { Public declarations }

end;

var

Forma1: TForma1;

implementation

{$R *.DFM}

Uses Inifiles;

procedure TForma1.FormCreate(Sender: TObject);

var WinIni:TInifile;

begin

WinIni:=TIniFile.Create('WIN.INI');

WinIni.WriteString('intl','sShortDate','MM/dd/yyyy');

WinIni.Free;

end;

Function TForma1.HowManyDays(pYear,pMonth,pDay:word):integer;

var Sum:integer;

pYearAux:word;

begin

Sum:=0;

if pMonth>1 then Sum:=Sum+31;

if pMonth>2 then Sum:=Sum+28;

if pMonth>3 then Sum:=Sum+31;

if pMonth>4 then Sum:=Sum+30;

if pMonth>5 then Sum:=Sum+31;

if pMonth>6 then Sum:=Sum+30;

if pMonth>7 then Sum:=Sum+31;

if pMonth>8 then Sum:=Sum+31;

if pMonth>9 then Sum:=Sum+30;

if pMonth>10 then Sum:=Sum+31;

if pMonth>11 then Sum:=Sum+30;

Sum:=Sum + pDay;

if ((pYear - (pYear div 4)*4)=3D0) and (pMonth>2) then inc(Sum);

HowManyDays:=Sum;

end; { HowManyDays }

procedure TForma1.GetWeekBtnClick(Sender: TObject);

var

ADate: TDateTime;EditAux:String;

Week,year,month,day:Word;

begin

EditAux:=Edit1.Text;

ADate := StrToDate(EditAux);

Label1.Caption := DateToStr(ADate);

DecodeDate(Adate,Year,Month,Day);

Case DayOfWeek(ADate) of

1: Label4.Caption:='Воскресенье';

2: Label4.Caption:='Понедельник';

3: Label4.Caption:='Вторник';

4: Label4.Caption:='Среда';

5: Label4.Caption:='Четверг';

6: Label4.Caption:='Пятница';

7: Label4.Caption:='Суббота';

end

Week:=(HowManyDays(year,month,day) div 7) +1;

Label3.Caption:='Неделя No. '+IntToStr(Week);

end;

end.

Количество дней между двумя датами I

ПЕРЕМЕННЫЕ:

Year1, Month1, Day1,

Year2, Month2, Day2,

YearResult, MonthResult, DayResult: Word;

TDay1, TDay2, DateDiff: TDateTime;

КОД:

TDay1 := EncodeDate(Year1, Month1, Day1);

TDay2 := EncodeDate(Year2, Month2, Day2);

DateDiff := TDay2 – TDay1; {предположим, что TDay2 позднее, чем TDay1}

DecodeDate(DateDiff, YearResult, MonthResult, DayResult);

DateDiff имеет тип LongInt (хотя и является объектом TDateTime), и содержит количество дней между датами.

Количество дней между двумя датами II

Для DateDiff:

Вы смотрели на функцию DecodeDate? Это не точно именно то, что вам нужно, но на ее основе можно сделать вашу функцию именно с нужной вам функциональностью.

Для величины Present:

function PresentValue(const cashflows : array of double;    { отсортированные транзакции, начальный индекс - cashflows[0] }

n : integer; { количество транзакций в массиве }

rate : double; { оценочный процент за истекший период }

 atbegin : boolean) : double; { true, если транзакция была в начале периода,false если в конце }

var

i: integer;

factor: double;

begin

factor := (1 + rate / 100.0);

result := 0;

for i := n - 1 downto 0 do result := (result + cashflows[n]) / factor;

if atbegin then result := result * factor;

end;

Конвертирование даты

TheDateField.AsString := TheDateString;

TheDateString := TheDateField.AsString;

это делает преобразование подобно DateToStr и StrToDate. Аналогично:

TheDateField.AsDateTime := StrToDate(TheDateString);

TheDateString := DateToStr(TheDateField.AsDateTime);

Число текущей недели

Здесь включены 2 вспомогательные функции, необходимые для работы вашей функции. Одна проверяет високосный год, другая возвращает число дней месяца (с проверкой високосного года), третья, ту, что вы хотели, возвращает текущую неделю года.

{***************************************************************************}

function kcIsLeapYear(nYear: Integer): Boolean;

begin

Result := (nYear mod 4 = 0) and ((nYear mod 100 <> 0) or (nYear mod400 = 0));

end;

{***************************************************************************}

function kcMonthDays(nMonth, nYear: Integer): Integer;

const

DaysPerMonth: array[1..12] of Integer = (31, 28, 31, 30, 31, 30, 31,31, 30, 31, 30, 31);

begin

Result := DaysPerMonth[nMonth];

if (nMonth = 2) and kcIsLeapYear(nYear) then Inc(Result);

end;

{***************************************************************************}

function kcWeekOfYear(dDate: TDateTime): Integer;

var

X, nDayCount: Integer;nMonth, nDay, nYear: Word;

begin

nDayCount := 0;

deCodeDate(dDate, nYear, nMonth, nDay);

For X := 1 to (nMonth - 1) do nDayCount := nDayCount + kcMonthDays(X, nYear);

nDayCount := nDayCount + nDay;

Result := ((nDayCount div 7) + 1);

end;

Разница во времени

…я не знаю, когда вы выполняете TimeTaken… Вы делали какую-нибудь паузу перед запуском TimeTaken после выполнения SetTimeStart? Если не делали, то удивительно, что tt=Now… Я пробовал ваш код с несколькими незначительными изменениями… и я всегда получал разницу между Now и TimeStart. Но я объявляю tt как TDateTime, а не как Double, и использую событие OnTimer для запуска процедуры TimeTaken. Вы можете проверить это, запустив пример, приведенный ниже.

{*******************************************************************

ФАЙЛ : TIMEEX.PAS

ПРИМЕЧАНИЕ : Создайте форму, содержащую 1 TTimer и 6 TLabel. Установите событие OnTimer у TTimer на TForm.Timer1.Timer

********************************************************************}

unit Time;

interface

uses

SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,Forms, Dialogs, ExtCtrls, StdCtrls;

type

TForm1 = class(TForm)

Timer1: TTimer;

Label1: TLabel; {Caption : 'Старт :'}

Label2: TLabel;

Label3: TLabel; {Caption : 'Время : '}

Label4: TLabel;

Label5: TLabel; {Caption : 'Истекшее время:'}

Label6: TLabel;

procedure FormCreate(Sender: TObject);

procedure Timer1Timer(Sender: TObject);

private { Private declarations }

TimeStart : TDateTime;

public { Public declarations }

end;

var

Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.FormCreate(Sender: TObject);

begin

TimeStart := Now;

Label2.Caption := TimeToStr(Now);

end;

procedure TForm1.Timer1Timer(Sender: TObject);

var

tt : TDateTime;

begin

Label4.Caption := TimeToStr(Now);

tt:= Now - TimeStart;

Label6.Caption:= TimeToStr(tt);

end;

end.

Проблема со временем

…я нашел Time24Hour в файлах помощи, как вы и советовали. Но…

вот код для EncodeTime в SysUtils.Pas file:

function DoEncodeTime(Hour, Min, Sec, MSec: Word; var Time: TDateTime): Boolean;

begin

Result := False;

if (Hour < 24) and (Min < 60) and (Sec < 60) and (MSec < 1000) then begin

Time := (LongMul(Hour * 60 + Min, 60000) + Sec * 1000 + MSec) / MSecsPerDay;

Result := True;

end;

function EncodeTime(Hour, Min, Sec, MSec: Word): TDateTime;

begin

if not DoEncodeTime(Hour, Min, Sec, MSec, Result) then ConvertError(LoadStr(STimeEncodeError));

end;

Как вы можете видеть, проверка Time24Hour присутствует. Я думал в Browser все будет также. Ничего подобного! Я уж грешным делом подумал, что Time24Hour объявили устаревшим, исключили из поддержки, выбросили частично из кода, но забыли почистить файл помощи. Вы так не думаете?

Переменная времени

Используйте переменную типа TDateTime.

procedure TForm1.XXXXXXXClick(Sender: TObject);

var StartTime, EndTime, ElapsedTime :TDateTime;

begin

StartTime := Now;

{Здесь поместите свой код}

EndTime := Now;

ElapsedTime := EndTime - StartTime;

Label1.Caption := TimeToStr(ElapsedTime);

end;

{теперь все это в памяти, но в нашем случае это хорошее место. }

var

before,after,elapsed : TDateTime;

Ehour, Emin, Esec, Emsec : WORD;

…

before := now;

some_process();

after := now;

elapsed := after - before;

decodetime(elapsed, Ehour, Emin, Esec, Emsec);

теперь Ehour:Emin:Esec.Emsec будет содержать истекшее время.

Это то, что я хотел. fStartWhen содержит дату/время начала процесса. (fStartWhen := NOW). OneSecond — константа, определенная как 1/24/3600. (Да, эта программа может выполняться для нескольких дней. Но даже самый быстрый P5 может не справиться с большим количеством данных!)

PROCEDURE TformDBLoad.UpdateTime;

VAR Delta: TDateTime

BEGIN

fLastUpdate := NOW

IF ABS(fStartWhen - fLastUpdate ) < OneSecond THEN EXIT

Delta := fLastUpdate - fStartWhendoElapsedTime.Caption := FORMAT('%1. дней из %s', [INT(Delta),FORMATDATETIME('hh:nn:ss', FRAC(Delta))])

END;

Математика

Как научить Delphi делать правильное округление дробных чисел?

Nomadic советует:

Целая коллекция способов -

Для решения этой проблемы мною написана функция, которую можно модифицировать для всех случаев. Смысл заключается в том, что рассматривается строка. После этого все проблемы с округлением снялись.

Function RoundStr(Zn:Real;kol_zn:Integer):Real;

{Zn-значение; Kol_Zn-Кол-во знаков после запятой}

Var

snl,s,s0,s1,s2:String;

n,n1:Real;

nn,i:Integer;

begin

s:=FloatToStr(Zn);

if (Pos(',',s)>0) and (Zn>0) and (Length(Copy(s,Pos(',',s)+1,length(s)))>kol_zn) then begin

s0 := Copy(s,1,Pos(',',s)+kol_zn-1);

s1 := Copy(s,1,Pos(',',s)+kol_zn+2);

s2 := Copy(s1,Pos(',',s1)+kol_zn,Length(s1));

n := StrToInt(s2)/100;nn := Round(n);

if nn >= 10 then begin

snl := '0,';

For i := 1 to kol_zn - 1 do snl := snl + '0';

snl := snl+'1';

n1 := StrToFloat(Copy(s,1,Pos(',',s)+kol_zn))+StrToFloat(snl);

s := FloatToStr(n1);

if Pos(',',s) > 0 then s1 := Copy(s,1,Pos(',',s)+kol_zn);

end else s1 := s0 + IntToStr(nn);

if s1[Length(s1)]=',' then s1 := s1 + '0';

Result := StrToFloat(s1);

end else Result := Zn;

end;

Все-таки работа со строками здесь излишество -

function RoundEx( X: Double; Precision : Integer ): Double;

{Precision : 1 - до целых, 10 - до десятых, 100 - до сотых...}

var

ScaledFractPart, Temp : Double;

begin

ScaledFractPart := Frac(X)*Precision;

Temp := Frac(ScaledFractPart);

ScaledFractPart := Int(ScaledFractPart);

if Temp >= 0.5 then ScaledFractPart := ScaledFractPart + 1;

if Temp <= -0.5 then ScaledFractPart := ScaledFractPart - 1;

RoundEx := Int(X) + ScaledFractPart/Precision;

end;

Разное

Генерация еженедельных списков задач

Вот рабочий код (но вы должны просто понять алгоритм работы):

unit Unit1;

interface

uses Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls;

type TForm1 = class(TForm)

ListBox1: TListBox;

Edit1: TEdit;

Button1: TButton;

procedure Button1Click(Sender: TObject);

private { Private declarations }

public { Public declarations }

end;

var Form1: TForm1;

implementation

{$R *.DFM}

const maxTeams = 100;

var

Teams: Array[1..maxTeams] of integer;

nTeams, ix, week, savix: integer;

function WriteBox(week: integer): string;

var

str: string;

ix: integer;

begin

Result := Format('Неделя=%d ',[week]);

for ix := 1 to nTeams do begin

if odd(ix) then Result := Result+' '

else Result := Result+'v';

Result := Result+IntToStr(Teams[ix]);

end;

procedure TForm1.Button1Click(Sender: TObject);

begin

nTeams := StrToInt(Edit1.Text);

if Odd(nTeams) then inc(nTeams); {должны иметь номера каждой группы}

ListBox1.Clear;

for ix := 1 to nTeams do Teams[ix] := ix;

ListBox1.Items.Add(WriteBox(1));

for week := 2 to nTeams-1 do begin

Teams[1] := Teams[nTeams-1]; {используем Teams[1] в качестве временного хранилища}

for ix := nTeams downto 2 do if not Odd(ix) then begin

savix := Teams[ix];

Teams[ix] := Teams[1];

Teams[1] := savix;

end;

for ix := 3 to nTeams-1 do if Odd(ix) then begin

savix := Teams[ix];

Teams[ix] := Teams[1];

Teams[1] := savix;

end;

Teams[1] := 1; {восстанавливаем известное значение}

ListBox1.Items.Add(WriteBox(week));

end;

end.

Генерация случайного пароля

The_Sprite советует:

Вам понадобилось, чтобы Ваше приложение само создавало пароли ? Возможно данный способ Вам пригодится. Всё очень просто: пароль создаётся из символов, выбираемых случайным образом из таблицы.

Совместимость: Delphi 5.x (или выше)

Собственно сам исходничек: Пароль создаётся из символов, содержащихся в таблице.

Внимание: Длина пароля должна быть меньше, чем длина таблицы!

// запускаем генератор случайных чисел (только при старте приложения).

procedure TForm1.FormCreate(Sender: TObject);

begin

Randomize;

end;

function RandomPwd(PWLen: integer): string;

// таблица символов, используемых в пароле

const StrTable: string =

'!#$%&/()=?@<>|{[]}\*~+#;:.-_' +

'ABCDEFGHIJKLMabcdefghijklm' +

'0123456789' +

'ДЦЬдцьЯ' + 'NOPQRSTUVWXYZnopqrstuvwxyz';

var

N, K, X, Y: integer;

begin

// проверяем максимальную длину пароля

if (PWlen > Length(StrTable)) then K := Length(StrTable)-1

else K := PWLen;SetLength(result, K); // устанавливаем длину конечной строки

Y := Length(StrTable); // Длина Таблицы для внутреннего цикла

N := 0; // начальное значение цикла

while N < K do begin // цикл для создания K символов

X := Random(Y) + 1; // берём следующий случайный символ

// проверяем присутствие этого символа в конечной строке

if (pos(StrTable[X], result) = 0) then begin

inc(N); // символ не найден

Result[N] :=StrTable[X]; // теперь его сохраняем

end;

procedure TForm1.Button1Click(Sender: TObject);

var

cPwd: string;

begin

// вызываем функцию генерации пароля из 30 символов

cPwd := RandomPwd(30);

// ...

end;

Проверка ISBN

ISBN (или International Standard Book Numbers, международные стандартные номера книг) - мистические кодовые числа, однозначно идентифицирующие книги. Цель этой статьи заключается в том, чтобы убрать покров таинственности, окружающий структуру ISBN, и в качестве примера разработать приложение, проверяющее правильность создания кода-кандидата на ISBN.

ISBN имеет длину тринадцать символов, которые ограничиваются в использовании символами-цифрами от "0" до "9", дефисом, и буквой "X". Этот тринадцатисимвольный код состоит из четырех частей (между которыми располагается дефис): идентификатор группы, идентификатор издателя, идентификатор книги для издателя, и контрольная цифра. Первая часть (идентификатор группы) используется для обозначения страны, географического региона, языка и пр.. Вторая часть (идентификатор издателя) однозначно идентифицирует издателя. Третья часть (идентификатор книги) однозначно идентифицирует данную книгу среди коллекции книг, выпущенных данным издателем. Четвертая, заключительная часть (контрольная цифра), используется в коде алгоритме другими цифрами для получения поддающегося проверке ISBN. Количество цифр, содержащееся в первых трех частях, может быть различным, но контрольная цифра всегда содержит один символ (расположенный между "0" и "9" включительно, или "X" для величины 10), а само ISBN в целом имеет длину тринадцать символов (десять чисел плюс три дефиса, разделяющих три части ISBN).

ISBN 3-88053-002-5 можно так разложить на части:

Группа: 3

Издатель: 88053

Книга: 002

Контрольная цифра: 5

ISBN можно проверить на правильность кода, используя простой математический алгоритм. Суть его в следующем: нужно взять каждую из девяти цифр первых трех частей ISBN (пропуская нечисловые дефисы), умножить каждую отдельную цифру на число цифр, стоящих слева от позиции числа ISBN (оно всегда будет меньше одинадцати), сложить все результаты умножения, прибавить контрольную цифру, после чего разделить получившееся число на одиннадцать. Если после деления на одинадцать никакого остатка не образуется (т.е., число по модулю 11 делится без остатка), кандидат на ISBN является верным числом ISBN. К примеру, используем предыдущий образец ISBN 3-88053-002-5:

ISBN: 3 8 8 0 5 3 0 0 2 5

Множитель: 10 9 8 7 6 5 4 3 2 1

Продукт: 30+72+64+00+30+15+00+00+04+05 = 220

Поскольку 220 на одинадцать делится без остатка, расмотренный нами кандидат на ISBN является верным кодом ISBN.

Данный алгоритм проверки легко портируется в код Pascal/Delphi. Для извлечения контрольной цифры и кода из ISDN номера используются строковые функции и процедуры, после чего они передаются в функцию проверки. Контрольная цифра преобразуется в тип целого, на основе ее формируется стартовое значение составной переменной, состоящей из добавляемых цифр, умноженных на их позицию в коде ISBN (отдельные цифры, составляющие первые три части ISBN). Для последовательной обработки каждой цифры используется цикл For, в котором мы игнорируем дефисы и умножаем текущую цифру на ее позицию в коде ISDN. В заключение, значение этой составной переменной проверяется на делимость без остатка на одиннадцать. Если остатка после деления нет, код ISBN верен, если же остаток существует, то код кандидат на ISBN имеет неправильный код.

Вот пример этой методики, изложенной на языке функций Delphi:

function IsISBN(ISBN: String): Boolean;

var

Number, CheckDigit: String;

CheckValue, CheckSum, Err: Integer;

i, Cnt: Word;

begin

{Получаем контрольную цифру}

CheckDigit := Copy(ISBN, Length(ISBN), 1);

{Получаем остальную часть, ISBN минус контрольная цифра и дефис}

Number := Copy(ISBN, 1, Length(ISBN) - 2);

 {Длина разницы ISBN должны быть 11 и контрольная цифра между 0 и 9, или X}

if (Length(Number) = 11) and (Pos(CheckDigit, '0123456789X') > 0) then begin

{Получаем числовое значение контрольной цифры}

if (CheckDigit = 'X') then CheckSum := 10

else Val(CheckDigit, CheckSum, Err);

  {Извлекаем в цикле все цифры из кода ISBN, применяя алгоритм декодирования}

Cnt := 1;

for i := 1 to 12 do begin

{Действуем, если только текущий символ находится между "0" и "9", исключая дефисы}

if (Pos(Number[i], '0123456789') > 0) then begin

Val(Number[i], CheckValue, Err);

    {Алгоритм для каждого символа кода ISBN, Cnt - n-й обрабатываемый символ}

CheckSum := CheckSum + CheckValue * (11 - Cnt);

Inc(Cnt);

end;

{Проверяем делимость без остатка полученного значения на 11}

if (CheckSum MOD 11 = 0) then IsISBN := True

else IsISBN := False;

end

else IsISBN := False;

end;

Это примитивный пример, сильно упрощенный для лучшего понимания алгоритма декодирования кода ISBN. В реальной жизни (приложении) имеется немало мелочей, которые необходимо учесть для нормальной работы. Для примера, описанная выше функция требует от кандидата ISBN строку паскалевского типа с дефисами, разделяющими четыре части кода. В качестве дополнительной функциональности можно проверять кандидата ISBNs на наличие дефисов. Другой полезной вещью могла бы быть проверка на наличие трех дефисов на нужных позициях, а не простая проверка на наличие необходимых одиннадцати символов-цифр.

API

Переменные среды

Как раскрыть строки с подстановками вида '%SystemRoot%\IOSUBSYS\'?

Nomadic советует:

Используй вызов

ExpandEnvironmentStrings(LPCTSTR lpSrc, LPTSTR lpDst, DWORD nSize);

Изменение системного времени из Delphi II

Можно. Попробуйте следующий код:

Procedure settime(hour, min, sec, hundreths : byte); assembler;

asm

mov ch, hour

mov cl, min

mov dh, sec

mov dl, hundreths

mov ah, $2d

int $21

end;

Procedure setdate(year : word; month, day : byte); assembler;

asm

mov cx, year

mov dh, month

mov dl, day

mov ah, $2b

int $21

end;

Завершение работы Windows

Определение завершения работы Windows

Существует ли возможность определения завершения работы Windows для нормального завершения работы работающего приложения Delphi?

Самым простым решением является создание обработчика события главной формы OnCloseQuery. Данное событие возникает как результат сообщения WM_QUERYENDSESSION, которое посылается всем работающим приложениям Windows в момент инициализации процесса окончания работы Windows. Логическая переменная CanClose, передаваемая обработчику как var-параметр, может позволить программе (и Windows) завершить свою работу, если имеет значение True, значение же False не позволит программе завершить свою работу.

Следующий код демонстрирует как можно воспользоваться данным событием.

Демонстрационный код

procedure TForm1.FormCloseQuery(Sender: TObject; var CanClose: Boolean);

begin

{Спрашиваем пользователя, если инициировано завершение работы.}

 if MessageDlg('Вы уверены?', mtConfirmation, mbYesNoCancel, 0) = mrYes then CanClose := true    {Разрешаем завершение работы.}

else CanClose := false; {Не разрешаем завершение работы.}

end;

Как консольное приложение может узнать, что Винды завершаются?

Nomadic рекомендует следующий код:

Все процессы получают сигналы CTRL_CLOSE_EVENT, CTRL_LOGOFF_EVENT и CTRL_SHUTDOWN_EVENT. А делается это (грубо говоря :) так:

BOOL Ctrl_Handler(DWORD Ctrl) {

if ((Ctrl == CTRL_SHUTDOWN_EVENT) || (Ctrl == CTRL_LOGOFF_EVENT)) {

// Вау! Юзер обламывает!

} else {

// Тут что-от другое можно творить. А можно и не творить :-)

}

return TRUE;

}

function Ctrl_Handler(Ctrl: Longint): LongBool;

begin

if Ctrl in [CTRL_SHUTDOWN_EVENT, CTRL_LOGOFF_EVENT] then begin

// Вау, вау

end

else begin

// Am I creator?

end;

Result := true;

end;

А где-то в программе:

SetConsoleCtrlHandler(Ctrl_Handler, TRUE);

Таких обработчиков можно навесить кучу. Если при обработке какого-то из сообщений обработчик возвращает FALSE, то вызывается следующий обработчик. Можно настроить таких этажерок, что ого-го :-)))

Короче, смотри описание SetConsoleCtrlHandler — там всё есть.

Как корректно перехватить сигнал выгрузки операционной системы, если в моей программе нет окна?

Nomadic рекомендует следующий способ:

Используй GetMessage(), в качестве HWND окна пиши NULL (на Паскале — 0). Если в очереди сообщений следующее — WM_QUIT, то эта функция фозвращает FALSE. Если ты пишешь программу для Win32, то запихни это в отдельный поток, организующий выход из программы.

Постепенное умирание

The_Sprite пишет:

Вопрос: А как реализовать в одном компоненте такие функции как выключение компьютера, перезагрузка, завершение сеанса работы пользователя, Eject CD, выключение питания монитора и т.д.? Ответ: предлагаем посмотреть следующий пример…

Совместимость: все версии Delphi

Пример:

procedure TForm1.Button1Click(Sender: TObject);

begin

PowerControl1.Action:=actCDEject;// Или...

actLogOFF, actShutDown...

PowerControl1.Execute;

end

Component Code:

unit

PowerControl;

interface

uses WinTypes, WinProcs, Messages, SysUtils, Classes, Controls,Forms, Graphics,MMSystem;

type

TAction =(actLogOFF,actShutDown,actReBoot,actForce,actPowerOFF,

actForceIfHung,actMonitorOFF,actMonitorON,actCDEject,actCDUnEject);

type TPowerControl = class(TComponent)

private

FAction : TAction;

procedure SetAction(Value : TAction); protected

public

function Execute :Boolean;

published

property Action :TAction read FAction write SetAction;

end;

procedure Register;

implementation

procedure Register;

begin

RegisterComponents('K2',[TPowerControl]);

end;

procedure TPowerControl.SetAction(Value : TAction);

begin

FAction := Value;

end;

function TPowerControl.Execute : Boolean;

begin

with (Owner as TForm) do case FAction of

actLogOff: ExitWindowsEx(EWX_LOGOFF, 1);

actShutDown: ExitWindowsEx(EWX_SHUTDOWN, 1);

actReBoot:ExitWindowsEx(EWX_REBOOT, 1);

actForce:ExitWindowsEx(EWX_FORCE, 1);

actPowerOff:ExitWindowsEx(EWX_POWEROFF, 1);

actForceIfHung:ExitWindowsEx(EWX_FORCEIFHUNG, 1);

actMonitorOFF:SendMessage(Application.Handle, WM_SYSCOMMAND, SC_MONITORPOWER, 0);

actMonitorON: SendMessage(Application.Handle, WM_SYSCOMMAND, SC_MONITORPOWER, -1);

actCDEject: mciSendstring('SET CDAUDIO DOOR OPEN WAIT', nil, 0, Handle);

actCDUnEject: mciSendstring('SET CDAUDIO DOOR CLOSED WAIT', nil, 0, Handle);

end; {Case}

Result := True;

end;

end.

Разное

Как не допустить запуск второй копии программы VIII

Игорь Пролис рекомендует следующий код:

{*******************************************************}

{ }

{ HTMLCoolEdit }

{ }

{*******************************************************}

unit multinst;

interface

uses Forms, Windows, Dialogs, SysUtils;

const

MI_NO_ERROR = 0;

MI_FAIL_SUBCLASS = 1;

MI_FAIL_CREATE_MUTEX = 2;

function GetMIError: Integer;

function InitInstance : Boolean;

implementation

uses RegWork, FileWork;

var

UniqueAppStr : PChar;

MessageId: Integer;

WProc: TFNWndProc = Nil;

MutHandle: THandle = 0;

MIError: Integer = 0;

function GetMIError: Integer;

begin

Result := MIError;

end;

function NewWndProc(Handle: HWND; Msg: Integer; wParam, lParam: Longint): Longint; StdCall;

begin

Result := 1;

if Msg = MessageID then begin

if IsIconic(Application.Handle) then OpenIcon(Application.Handle)

else SetForegroundWindow(Application.Handle);

FileWork.LoadFileName(RegWork.RWGetParamStr1);

end

else Result := CallWindowProc(WProc, Handle, Msg, wParam, lParam);

end;

procedure SubClassApplication;

begin

WProc := TFNWndProc(SetWindowLong(Application.Handle, GWL_WNDPROC, Longint(@NewWndProc)));

if WProc = Nil then MIError := MIError or MI_FAIL_SUBCLASS;

end;

procedure DoFirstInstance;

begin

SubClassApplication;

MutHandle := CreateMutex(Nil, False, UniqueAppStr);

if MutHandle = 0 then MIError := MIError or MI_FAIL_CREATE_MUTEX;

end;

procedure BroadcastFocusMessage;

begin

Application.ShowMainForm := False;

PostMessage(HWND_BROADCAST, MessageId, 0, 0);

end;

function InitInstance : Boolean;

begin

MutHandle := OpenMutex(MUTEX_ALL_ACCESS, False, UniqueAppStr);

if MutHandle = 0 then begin

ShowWindow(Application.Handle, SW_ShowNormal);

Application.ShowMainForm:=True;

DoFirstInstance;

result := True;

end

else begin

RegWork.RWSetParamStr1;

BroadcastFocusMessage;

result := False;

end;

initialization

begin

UniqueAppStr := PChar(Application.ExeName);

MessageID := RegisterWindowMessage(UniqueAppStr);

ShowWindow(Application.Handle, SW_Hide);

Application.ShowMainForm:=FALSE;

end;

finalization

begin

if WProc <> Nil then SetWindowLong(Application.Handle, GWL_WNDPROC, LongInt(WProc));

end;

end.

Как не допустить запуск второй копии программы IX

YoungHacker рекомендует следующий код:

Был взят из кулибы и доработан, поскольку возникали ситуации когда программа, по HotKey назначенным на ярлык, запускалась дважды и более раз. Связано с тем что поиск мутекса и его создание разнесены во времени и пока в одном приложении мутекс не нашелся но еще не создался второе приложение тоже не находит мутекса и инициирует его создание

Поиск окон и создание их нарываются на те-же проблемы. Из RxLib Функция тоже не обходит этой ситуации.

Мой вариант немного дорабатывает уже значительно переработанное то что предоставили разработчики Delphi 2 Пачека (Pacheco) и Тайхайра (Teixeira). и находится в файле TPrevInstUnit. В файле проекта пишется следующий вызов:

begin

//– Найти предыдущую версию программы

if (initinstance) then begin

…

Application.Initialize;

…

Application.CreateForm(…);

…

Application.Run;

end;

end.

Файл TPrevInstUnit

unit TPrevInstUnit;

interface

uses Forms, Windows, Dialogs, SysUtils;

function InitInstance : Boolean;

implementation

const

UniqueAppStr : PChar = #0; // Различное для каждого приложения

                            // Но одинаковое для каждой копии программы

var

MessageId : Integer;

OldWProc : TFNWndProc = Nil;

MutHandle : THandle = 0;

SecondExecution : Boolean = False;

function NewWndProc(Handle: HWND; Msg: Integer; wParam, lParam: Longint): Longint; StdCall;

begin

//- Если это - сообщение о регистрации... }

if (Msg = MessageID) then begin

//- если основная форма минимизирована

if IsIconic(Application.Handle) then begin

//- восстанавливаем

ееApplication.Restore;

end

else begin

//- вытаскиваем на перед

ShowWindow(Application.Handle, SW_SHOW);

SetForegroundWindow(Application.Handle);

Application.BringToFront;

end;

Result := 0;

end

else

{ В противном случае посылаем сообщение предыдущему окну }

Result := CallWindowProc(OldWProc, Handle, Msg, wParam, lParam);

end;

function InitInstance : Boolean;

var

BSMRecipients: DWORD;

begin

Result := False;

//- пробуем открыть MUTEX созданный предыдущей копией программы

MutHandle := CreateMutex(Nil, True, UniqueAppStr);

//- Мутекс уже был создан ?

SecondExecution := (GetLastError = ERROR_ALREADY_EXISTS);

if (MutHandle = 0) then begin

ShowMessage('Ошибка создания Mutex.');

Exit;

end;

if Not (SecondExecution) then begin

//- назначаем новый обработчик сообщений приложения, а старый сохраняем

OldWProc := TFNWndProc(SetWindowLong(Application.Handle, GWL_WNDPROC, Longint(@NewWndProc)));

//- если обработчик не найден устанавливаем ошибку

if (OldWProc = Nil) then begin

ShowMessage('Ошибка поиска стандартного обработчика сообщений приложения.');

Exit;

end;

//- Установить "нормальный" статус основного окна приложения

ShowWindow(Application.Handle, SW_ShowNormal);

//- покажем основную форму приложения

Application.ShowMainForm := True;

//- все нормально мама трын тин тин тин тири тын тын

Result := True;

end

else begin

//- установить статус окна приложения "невидимый"

ShowWindow(Application.Handle, SW_Hide);

//- Не покажем основную форму приложения

Application.ShowMainForm := False;

  //- Посылаем другому приложению сообщение и информируем о необходимости

// перевести фокус на себя

BSMRecipients := BSM_APPLICATIONS;

BroadCastSystemMessage(BSF_IGNORECURRENTTASK or BSF_POSTMESSAGE, @BSMRecipients, MessageID, 0, 0);

end;

initialization

begin

//- Создать ункальную строку для опознания приложения

UniqueAppStr := PChar('YoungHackerNetworkDataBaseProgramm');

//- Зарегистрировать в системе уникальное сообщение

MessageID := RegisterWindowMessage(UniqueAppStr);

end;

finalization

begin

if (OldWProc <> Nil) then

{ Приводим приложение в исходное состояние }

SetWindowLong(Application.Handle, GWL_WNDPROC, LongInt(OldWProc));

end;

end.

Как не допустить запуск второй копии программы X

Nomadic рекомендует следующий код:

FindWindow является неполным решением (если меняется заголовок окна или если есть другая программа с таким же заголовком или типом окна).

Вторично: Это работает медленно.

Правильно — использовать обьекты синхронизации Win32 API.

Лениво пользовать семафоры, покажу на именованных мутексах (семафоры с двумя состояниями).

Unit OneInstance32;

interface

implementation

uses

Forms;

var

g_hAppMutex: THandle;

function OneInstance: boolean;

var

g_hAppCritSecMutex: THandle;

dw: Longint;

begin

g_hAppCritSecMutex := CreateMutex(nil, true, PChar(Application.Title + '.OneInstance32.CriticalSection'));

// if GetLastError - лениво писать

g_hAppMutex := CreateMutex(nil, false, PChar(Application.Title + 'OneInstance32.Default'));

dw := WaitForSingleObject(g_hAppMutex, 0);

Result := (dw <> WAIT_TIMEOUT);

 ReleaseMutex(g_hAppCritSecMutex); // необязательно вследствие последующего закрытия

CloseHandle(g_hAppCritSecMutex);

end;

initialization

g_hAppMutex := 0;

finalization

if LongBool(g_hAppMutex) then begin

ReleaseMutex(g_hAppMutex); // необязательно

CloseHandle(g_hAppMutex);

end;

end.

Как не допустить запуск второй копии программы XI

Михаил Чумак рекомендует следующий код:

Есть такая штука Atom (см. Help).

program SelfCheck;

uses

Windows,Forms,Unit1 in 'Unit1.pas' {Form1};

const

AtStr='MyProgram';

function CheckThis : boolean;

var

Atom: THandle;

begin

Atom:= GlobalFindAtom(AtStr);

Result:= Atom <> 0;

if not result then GlobalAddAtom(AtStr);

end;

begin

if not CheckThis then begin

// Запуск программмы

Application.Initialize;

Application.CreateForm(TForm1, Form1);

Application.Run;

GlobalDeleteAtom(GlobalFindAtom(AtStr));

// !!!

end

else begin

MessageBox(0,'Нельзя запустить две копии','Моя программа',0);

end;

end.

Элегантно и работает однозначно. Спасибо Славе Шубину.

Как не допустить запуск второй копии программы XII

Nomadic рекомендует следующее:

A: Воспользуйтесь функцией ActivatePrevInstance из библиотеки rxLib. Для завершения второго экземпляра используйте Application.Terminate.

(AS): Другой вариант: X:\DELPHI2\DEMOS\IPCDEMOS\ipcthrd.pas, функция IsMonitorRunning().

Как правильно завершить некое приложение?

Nomadic рекомендует следующий код:

Если не принудительно, то можно послать на его Instance сообщение WM_QUIT. Если же необходимо принудительно терминировать приложение, то смотрите ниже — под Windows NT процесс можно терминировать через специально предназначенный для этого хэндл. Иначе гарантии нет. Предположим, что процесс создаем мы, ожидая его завершения в течение maxworktime. Тогда —

var

dwResult: Longint; // This example was converted from C source.

begin

// Not tested. Some 'nil' assignments must be applied

// as zero assignments in Pascal. Some vars need to

// be declared (maxworktime, si, pi). AA.

if CreateProcess(nil, CmdStr, nil, nil, FALSE,CREATE_NEW_CONSOLE, nil, nil, si, pi) then begin

CloseHandle(pi.hThread);

dwResult := WaitForSingleObject(pi.hProcess, maxworktime*1000*60);

CloseHandle(pi.hProcess);

if dwResult <> WAIT_OBJECT_0 then begin

pi.hProcess := OpenProcess(PROCESS_TERMINATE, FALSE, pi.dwProcessId);

if pi.hProcess <> nil then begin

TerminateProcess(pi.hProcess, 0);

CloseHandle(pi.hProcess);

end;

Как отчитывать промежутки времени с точностью, большей чем 60 мсек?

Nomadic рекомендует следующий код:

Для начала описываешь процедуру, которая будет вызываться по сообщению от таймера :

procedure FNTimeCallBack(uTimerID, uMessage: UINT;dwUser, dw1, dw2: DWORD); stdcall;

begin

//// Тело процедуры.

end;

а дальше в программе (например по нажатию кнопки) создаешь Таймер и вешаешь на него созданную процедуру

uTimerID:=timeSetEvent(10, 500, @FNTimeCallBack, 100, TIME_PERIODIC);

Подробности смотри в Help. Hу и в конце убиваешь таймер

timeKillEvent(uTimerID);

И все. Точность этого способа до 1 мсек. минимальный интервал времени можно задавать 1 мсек.

Обратите внимание на то, что все CALLBACK-функции, вызываемые Windows, должны использовать соглашение о вызовах stdcall.

Как сделать чтобы при событиях моя программа отпpавляла кому-либо сообщение на мой компьютеp?

Nomadic рекомендует следующий код:

Если только послать, то проще всего, пожалуй…

W32: F1 «NetMessageBufferSend»;

Win16: Почему-то не описан, но руками наковырял…

function NetMessageBufferSend(Zero1, Zero2: Word; WhoTo: PChar; Buffer: PChar; BufSize: Word): Integer; external 'netapi' index 525;

«Кому» может быть '*' == всем.

Что нужно давать WSAAsyncSelect в качестве параметра handle, если тот запускается и используется в dll (init), и никакой формы (у которой можно было бы взять этот handle) в этой dll не создается?

Nomadic рекомендует следующий код:

const WM_ASYNCSELECT = WM_USER+0;

type TNetConnectionsManager = class(tobject)

protected

FWndHandle : HWND;

procedure WndProc(var MsgRec : TMessage);

…

end;

constructor TNetConnectionsManager.Create

begin

inherited Create;

FWndHandle := AllocateHWnd(WndProc);

…

end;

destructor TNetConnectionsManager.Destroy;

begin

…

if FWndHandle<>0 then DeallocateHWnd(FWndHandle);

inherited Destroy;

end;

procedure TNetConnectionsManeger.WndProc(var MsgRec : TMessage);

begin

with MsgRec do

if Msg = WM_ASYNCSELECT then WMAsyncSelect(MsgRec)

else DefWindowProc(FWndHandle, Msg, wParam, lParam);

end;

Hо pекомендую посмотpеть WinSock2, в котоpом можно:

WSAEventSelect(FSocket, FEventHandle, FD_READ or fd_close);

WSAWaitForMultipleEvents(…);

WSAEnumNetworkEvents(FSocket, FEventHandle, lpNetWorkEvents);

То есть, обойтись без окон и без очеpеди сообщений windows, а заодно иметь возможность pаботать и с IPX/SPX, и с netbios.

Вызов других программ

VRSLazy@mail.ru пишет:

Доброго времени суток,

Вот посмотрел Ваше произведение Советы по делфи, мне очень понравилось :-)

Правда в вопросе/решении запустить другую программу просто обалдел :-( Я как то долго мучился с этим самым ShellExecute пока не пришёл к следующему:

uses …ToolWin, Windows …

procedure Run(App: String);

var

ErrStr : String;

PMSI: TStartupInfo;

PMPI: TProcessInformation;

begin

try

CreateProcess(nil, @App[1] , nil, nil, False, NORMAL_PRIORITY_CLASS, nil, nil, PMSI, PMPI);

except

ErrStr := 'Fault run process: '''+App+'''';

Application.MessageBox(@ErrStr[1],'Failure process', MB_OK+MB_ICONERROR);

end;

разумеется это одно из самых корявых решений, но всё же работает, как вариант сойдет?

Получение списка запущеных приложений

Igor Nikolaev aKa The Sprite предлагает следующий код:

procedure TForm1.Button1Click(Sender: TObject);

VAR

Wnd : hWnd;

buff: ARRAY [0..127] OF Char;

begin

ListBox1.Clear;

Wnd := GetWindow(Handle, gw_HWndFirst);

WHILE Wnd <> 0 DO BEGIN {Hе показываем:}

IF (Wnd <> Application.Handle) AND {-Собственное окно}

IsWindowVisible(Wnd) AND {-Hевидимые окна}

(GetWindow(Wnd, gw_Owner) = 0) AND {-Дочернии окна}

(GetWindowText(Wnd, buff, sizeof(buff)) <> 0)

THEN BEGIN

GetWindowText(Wnd, buff, sizeof(buff));

ListBox1.Items.Add(StrPas(buff));

END;

Wnd := GetWindow(Wnd, gw_hWndNext);

END;

ListBox1.ItemIndex := 0;

end;

Как мне запустить какую-нибудь программу? А как подождать, пока эта программа не отработает? Как выяснить, работает ли программа или уже завершилась? Как принудительно закрыть выполняющуюся программу?

Nomadic рекомендует следующее:

A: WinExec() или ShellExecute. У второй больше возможностей.

(SO): CreateProcess() в параметре process info возвращает handle запущенного процесса. Вот и делаешь WaitForSingleObject(pi.hProcess, INFINITE);

(AA): (Win16) Delay можно взять из rxLib.

handle := WinExec(…);

if handle >= 32 then

while GetModuleUsage(handle) > 0 do Delay(nn);

else raise …

(AM): Чтобы выяснить, работает ли программа, используйте GetProcessTimes(), параметр lpExitTime.

(Win32) Для принудительного завершения процесса — TerminateProcess.

(Win16) (RR): Надо послать программе сообщение WM_QUIT:

Handle := Winexec(App, 0);

PostMessage(Handle, WM_QUIT, 0, 0);

Открытие выбранного файла в работающем приложении

Пангин Дмитрий Викторович прислал письмо следующего содержания:

При программировании MDI-приложений возникает следующая задача: Если пользователь кликнул на файле, тип которого поддерживается создаваемым приложением, то, если приложение уже запущено, не нужно запускать новую копию приложения, а нужно открыть выбранный файл в уже работающем приложении. Я сделал это так (возможно есть более красивое решение):

\\ В файле проекта:

var

i: integer;

hMainForm:hwnd;

copyDataStruct:TCopyDataStruct;

ParamString:string;

WParam,LParam:integer;

begin

\\ ищем главное окно приложения, вместо Caption - nil,

 \\ поскольку к заголовку главного окна может добавиться заголовок MDIChild

 \\ (нужно позаботиться об уникальности имени класса главной формы)

hMainForm:= FindWindow('TMainForm', nil);

if hMainForm = 0 then begin

Application.Initialize;

Application.CreateForm(TFrmMain, frmMain);

for i:=1 to ParamCount do TMainForm(Application.MainForm).OpenFile(ParamStr(i));

Application.Run;

end

else begin

ParamString:='';

for i:=1 to ParamCount do begin

\\ запихиваем все параметры в одну строку с разделителями ?13

ParamString:=ParamString+ParamStr(i)+ #13;

end;

\\ создаем запись типа TCopyDataStruct

CopyDataStruct.lpData:=PChar(ParamString);

CopyDataStruct.cbData:=Length(ParamString);

CopyDataStruct.dwData:=0;

WParam:=Application.Handle;

LParam:=Integer(@CopyDataStruct);

\\ отсылаем сообщение WM_COPYDATA главному окну открытого приложения

SendMessage(hMainForm,WM_CopyData,WParam,LParam);

Application.Terminate;

end;

end.

\\ Обработчик сообщения WM_COPYDATA

procedure TMainForm.CopyData(var Msg: TWMCopyData);

var

ParamStr:string;

CopyDataStructure:TCopyDataStruct;

i:integer;

len:integer;

begin

CopyDataStructure:= Msg.CopyDataStruct^;

ParamStr:='';

len:= CopyDataStructure.cbData;

for i:=0 to len-1 do begin

ParamStr:=ParamStr+(PChar(CopyDataStructure.lpData)+i)^;

end;

i:=0;

while not(Length(ParamStr)=0) do begin

if isDelimiter(#13,ParamStr,i) then begin

OpenFile(Copy(ParamStr,0,i-1));

ParamStr:=Copy(ParamStr,i+1,Length(ParamStr)-i-1);

end;

inc(i);

end;

inherited;

end;

Убиваем активное приложение

The_Sprite прислал письмо следующего содержания:

Данная функция позволяет завершить выполнение любой активной программы по её classname или заголовку окна.

Совместимость: Все версии Delphi

Исходный код функции

procedure KillProgram(Classname : string; WindowTitle : string);

const

PROCESS_TERMINATE = $0001;

var

ProcessHandle : THandle;

ProcessID: Integer;

TheWindow : HWND;

begin

TheWindow := FindWindow(Classname, WindowTitle);

GetWindowThreadProcessID(TheWindow, @ProcessID);

ProcessHandle := OpenProcess(PROCESS_TERMINATE, FALSE, ProcessId);

TerminateProcess(ProcessHandle, 4);

end;

Pascal

Объекты

Проблема циклических ссылок

У меня имеется объект A и объект B, и им обоим нужно вызывать методы друг друга…

Создание множества экземпляров

list:=Tlist.create;

For i:= 1 to 1000 do begin

SSObject:=TSSObject.create;

 {поместите куда-нибудь ссылку на созданный объект - например, в Tlist}

list.add(SSObject);

end;

Параметры

Передача функции как параметра

В нашем случае лучшим решением будет использование процедурного типа. Допустим, что DllFunction() на входе хочет получить определенную функцию, поясним это на примере кода:

type TMyFuncType = function: integer;

var MyFunc : TMyFuncType;

function foo: integer;

begin

result := 1;

end;

begin

MyFunc := foo;

DllFunction(longint(MyFunc));

Вы можете это сделать и так:

DllFunction(longint(@foo));

Все же я не уверен в вопросах корректности использования таким образом в вызовах DLL памяти (для меня пока неясна работа с памятью, находящейся в другом сегменте), как в этом примере, так что возможно для корректной работы вам придется объявить foo с директивой far, экспортировать ее в модуле, или что-то еще.

Также, в зависимости от того, как написана DllFunction(), вы можете в вызове подразумевать приведение типа:

function DllFunction(p: TMyFuncType): Integer; far; external 'mydll';

В этом случае вам не нужна будет переменная MyFunc или оператор @.

В Delphi/Pascal вы можете передавать функции как параметры. Тем не менее, чтобы этим воспользоваться, необходимо для компилятора установить тип. Попробуйте следующий код (я реально его компилил и тестировал):

unit Unit1;

interface

uses

SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,Forms, Dialogs, StdCtrls;

type

TForm1 = class(TForm)

Button1: TButton;

Button2: TButton;

procedure Button1Click(Sender: TObject);

procedure Button2Click(Sender: TObject);

private { Private declarations }

public { Public declarations }

end;

var

Form1: TForm1;

implementation

{$R *.DFM}

type

IntFunc = function: integer;

function DllFunction(iFunc: IntFunc): integer; far;

begin

DllFunction := iFunc; {Обратите внимание на то, что это вызов функции}

end;

function iFoo: integer; far;

begin

iFoo := 1;

end;

procedure TestIFunc;

var

i: integer;

begin

i := DllFunction(iFoo);

end;

procedure TForm1.Button1Click(Sender: TObject);

begin

TestIFunc;

end;

procedure TForm1.Button2Click(Sender: TObject);

begin

Close;

end;

end.

Вы можете сделать две вещи. Во-первых, если вы хотите использовать для передачи longint, напишите следующий код:

i := longint(@foo)

Другая вещь, которую вы можете сделать — исключить работу с longint и вызывать функцию dll следующим образом:

DLLfunction(@foo);

Имейте в виду, что если вы собираетесь вызывать foo из DLL, то необходимо предусмотреть вопросы совместимости, для получения дополнительной информации почитайте описание функции MakeProcInstance.

Проблема передачи записи

Может это не то, что вы ищете, но идея такая:

Определите базовый класс с именем, скажем, allrecs:

tAllrecs = class

function getVal(field: integer): string; virtual;

end;

Затем создаем классы для каждой записи:

recA = class(tAllrecs)

this: Integer;

that: String;

the_other: Integer;

function getVal(field: integer): string; virtual;

end;

Затем для каждой функции класса определите возвращаемый результат:

function recA.getVal(field: integer); string;

begin

case field of

1: getVal := intToStr(this);

2: getVal := that;

3: getVal := intToStr(the_other);

end;

Затем вы можете определить

function myFunc(rec: tAllrecs; field: integer);

begin

label2.caption := allrecs.getVal(field);

end;

затем вы можете вызвать myFunc с любым классом, производным от tAllrecs, например:

myFunc(recA, 2);

myFunc(recB, 29);

(getVal предпочтительно должна быть процедурой (а не функцией) с тремя var-параметрами, возвращающими имя, тип и значение.)

Все это работает, т.к. данный пример я взял из моего рабочего проекта.

[Sid Gudes, cougar@roadrunner.com]

Если вы хотите за один раз передавать целую запись, установите на входе ваших функций/процедур тип 'array of const' (убедитесь в правильном приведенни типов). Это идентично 'array of TVarRec'. Для получения дополнительной информации о системных константах, определяемых для TVarRec, смотри электронную справку по Delphi.

Указатели

Указатель на функцию I

Это то, что я нашел при создании простой машины состояний:

Ниже приведен простой пример для Borland Delphi, использующий указатели функций для управления программным потоком. Просто создайте простую форму с единственной кнопкой и скопируйте код из Unit1 во вновь созданный модуль. Добавьте к проекту Unit2 и скомпилируйте проект. Дайте мне знать, если у вас возникнут какие-либо проблемы.

interface

uses

SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,Forms, Dialogs, StdCtrls;

type

TForm1 = class(TForm)

Button1: TButton;

procedure Button1Click(Sender: TObject);

private { Private declarations }

public { Public declarations }

end;

var

Form1: TForm1;

CurrProc : LongInt;

MyVal : LongInt;

implementation

uses Unit2;

{$R *.DFM}

procedure TForm1.Button1Click(Sender: TObject);

var

NewProc : LongInt;

MyString : string;

begin

CurrProc := 2; { начальная точка в таблице методов }

MyVal := 0; { вспомогательная переменная }

 NewProc := 0; { возвращаемое значение для следующего индекса в таблице методов }

while CurrProc < 6 do begin

{ выполняем текущий индекс в таблице методов и получаем следующую процедуру }

NewProc := ProcTable[CurrProc](MyVal);

{ просто показываем значения NewProc и CurrProc }

FmtStr(MyString, 'NewProc [%d] CurrProc [%d]', [NewProc, CurrProc]);

MessageDlg(MyString, mtInformation, [mbOK], 0);

{ присваиваем текущую процедуру возвращаемой процедуре }

CurrProc := NewProc;

end;

end.

{ Это простой пример, определяющий массив указателей на функции }

interface

type

{ определяем Procs как функцию }

Procs = function(var ProcNum : LongInt): LongInt;

var

{ объявляем массив указателей на функции }

ProcTable : Array [1..5] of Procs;

{ определения интерфейсов функций }

function Proc1(var MyVal : LongInt) : LongInt; far;

function Proc2(var MyVal : LongInt) : LongInt; far;

function Proc3(var MyVal : LongInt) : LongInt; far;

function Proc4(var MyVal : LongInt) : LongInt; far;

function Proc5(var MyVal : LongInt) : LongInt; far;

implementation

uses Dialogs;

function Proc1(var MyVal : LongInt) : LongInt;

begin

MessageDlg('Процедура 1', mtInformation, [mbOK], 0);

Proc1 := 6;

end;

function Proc2(var MyVal : LongInt) : LongInt;

begin

MessageDlg('Процедура 2', mtInformation, [mbOK], 0);

Proc2 := 3;

end;

function Proc3(var MyVal : LongInt) : LongInt;

begin

MessageDlg('Процедура 3', mtInformation, [mbOK], 0);

Proc3 := 4;

end;

function Proc4(var MyVal : LongInt) : LongInt;

begin

MessageDlg('Процедура 4', mtInformation, [mbOK], 0);

Proc4 := 5;

end;

function Proc5(var MyVal : LongInt) : LongInt;

begin

MessageDlg('Процедура 5', mtInformation, [mbOK], 0);

Proc5 := 1;

end;

initialization

{ инициализируем содержание массива указателей на функции }

@ProcTable[1] := @Proc1;

@ProcTable[2] := @Proc2;

@ProcTable[3] := @Proc3;

@ProcTable[4] := @Proc4;

@ProcTable[5] := @Proc5;

end.

Я думаю это можно сделать приблизительно так: объявите в каждой форме процедуры, обрабатывающие нажатие кнопки, типа процедуры CutButtonPressed(Sender:TObject) of Object; затем просто назначьте события кнопок OnClick этим процедурам при наступлении событий форм OnActivate. Этот способ соответствует концепции ОО-программирования, но если вам не нравится это, то вы все еще можете воспользоваться указателями функций, которая предоставляет Delphi.

Объявите базовый класс формы с объявлениями абстрактных функций для каждой функции, которую вы хотите вызывать из вашего toolbar. Затем наследуйте каждую вашу форму от базового класса формы и создайте определения этих функций.

Пример: (Здесь может встретиться пара синтаксических ошибок — я не компилил это)

type

TBaseForm = class(TForm)

public

procedure Method1; virtual; abstract;

end;

type

TDerivedForm1= class(TBaseForm)

public

procedure Method1; override;

end;

TDerivedForm2= class(TBaseForm)

public

procedure Method1; override;

end;

procedure TDerivedForm1.Method1;

begin

…

end;

procedure TDerivedForm2.Method1;

begin

…

end;

{Для вызова функции из вашего toolbar, получите активную в настоящий момент форму и вызовите Method1}

procedure OnButtonClick;

var

AForm: TBaseForm;

begin

AForm := ActiveForm as TBaseForm;

AForm.Method1;

end

Указатель на функцию II

Что лично я использую, чтобы вызвать какую-то функцию из DLL:

1. Объявите тип:

type TYourDLLFunc = function(Parm1: TParm1; Parm2: TParm2): TParm3;

2. Объявите переменную этого типа:

var YourDllFunc: TYourDLLFunc;

3. Получаем дескриптор DLL:

DLLHandle := LoadLibrary('YourDLL.DLL');

Получаем адрес функции:

@YourDLLFunc := GetProcAddress(DLLHandle, 'YourDLLFuncName');

Для использования функции теперь используйте переменную YourDLLFunc, например:

Parm3 := YourDLLFunc(Parm1, Parm2);

Использование указателей на целое

Сначала вы должны создать тип:

Type Pinteger: ^Integer;

Var MyPtr: Pinteger;

Мне кажется, что в начале вы использовали плохой пример, имеет смысл использовать 32-битный указатель для 16-битной величины или распределять 10 байт для переменной.

Pascal позволяет вам использовать методы NEW и DISPOSE, которые автоматически распределяют и освобождают правильные размеры блока.

Например,

NEW(MyPtr) = GetMem(MyPtr, Sizeof(MyPtr)).

Возможно, вы захотите подсчитать количество целочесленных переменных. В этом случае ознакомьтесь с возможностями TList. Пока лучше используйте линейный массив (или указатель на первый элемент, чтобы вычислить их количество, достаточно разделить количество занимаемой массивом памяти на количество элементов).

Для полноты, это должно быть:

NEW(MyPtr) = GetMem(MyPtr, SizeOf(MyPtr^));

SizeOf(MyPtr) всегда будет равен 4 байта, как 16-битный указатель.

Если я правильно разобрался в том, что вы хотите (динамический массив целых, количество элеметнов которого может быть известно только во время выполнения приложения), вы можете сделать так:

Type

pIntArr = ^IntArr;

IntArr = Array[1..1000] of Integer;

Var

MyPtr : pIntArr;

Begin

GetMem(MyPtr, 10); { 10 = SizeOf(Integer) * 5 !!}

{ MyPtr[2]:=1; }

<<<< Заполняем массив >>>>

MyPtr[2]^:=1;

FreeMem(MyPtr,10);

End;

Технология похожа на ту, которуя Delphi использует при работе с pchar. Синтаксис очень похож:

type intarray = array[0..20000] of integer;

procedure TForm1.Button1Click(Sender: TObject);

var

xptr: ^IntArray;

begin

GetMem(xptr, 10);

xptr^[idx] := 1; { где idx от 0 до 4, поскольку мы имеем 10 байте = 5 целых }

FreeMem(xptr, 10);

end;

Обратите внимание на то, в вам в действительности нет необходимости распределять массив для 20,000 элементов, но проверка диапазона Delphi не будет работать, если диапазон равен 20,000. (Предостережение будущим пользователям!)

Память

Функция MemAvail для Delphi2?

В Delphi 1, для того, чтобы получить самый большой возможный участок памяти, мы могли использовать функцию MemAvail, существует ли эквивалент этой функции в Delphi 2?

Нет. Но чтобы получить аппроксимированную сумму доступной памяти, можно воспользоваться функцией API GlobalMemoryStatus (через поле dwAvailVirtual возвращаемой структуры TMemoryStatus).

Steve Schafer

Как работать с блоками памяти размером более 64K?

Nomadic советует:

Так можно помещать в один блок памяти записи из TList (TCollection):

imlementation

{ To use the value of AHIncr, use Ofs(AHIncr). }

procedure AHIncr; far; external 'KERNEL' index 114;

const

NEXT_SELECTOR: string[13] = 'NEXT_SELECTOR';

function WriteData: THandle;

var

DataPtr: PChar;

i: Integer;

begin

Result := GlobalAlloc(GMEM_SHARE or GMEM_ZEROINIT, {pазмеp большого блока});

if Result = 0 then Exit;

DataPtr := GlobalLock(Result);

{записываем кол-во эл-тов}

Inc(DataPtr, {pазмеp счетчика эл-тов})

for i := 0 to {некий}Count-1 do begin

if LongInt(PtrRec(DataPtr).Ofs) + {pазмеp подблока} >l= $FFFF then begin

Move(NEXT_SELECTOR, DataPtr^, SizeOf(NEXT_SELECTOR)); {некая константа}

{ коppекция сегмента }

PtrRec(DataPtr).Seg := PtrRec(DataPtr).Seg + Ofs(AHIncr);

PtrRec(DataPtr).Ofs := $0;

end;

Inc(DataPtr, {pазмеp нового блока});

end; { for i }

GlobalUnlock(Result);

end;

procedure ReadData(DataHdl: THandle);

var

DataPtr : PObjectCfgRec;

RecsCount: Integer;

i: Integer;

begin

if DataHdl = 0 then Exit;

DataPtr := GlobalLock(DataHdl);

RecsCount := PInteger(DataPtr)^;

Inc(PInteger(DataPtr));

for i := 1 to RecsCount do begin

{ обpаботать данные }

Inc(DataPtr);

if PString(DataPtr)^ = NEXT_SELECTOR then begin

PtrRec(DataPtr).Seg := PtrRec(DataPtr).Seg + Ofs(AHIncr);

PtrRec(DataPtr).Ofs := $0;

end;

end; { for i }

GlobalUnlock(DataHdl);

end;

События

Назначение обработчика события OnClick пункту меню, созданному во время выполнения программы

Поскольку метод OnClick является свойством, то при динамическом создании элемента меню вы можете назначить имя метода обработчику OnClick:

theMenuitem.OnClick := TheOnClickHandler;

Затем, в обработчике OnClick, вы приводите sender к TMenuItem и читаете имя:

procedure theform.TheOnClickHandler(Sender: TObject);

var

fName: String;

begin

fName := TMenuItem(Sender).name;

…

end;

События для компонентов, созданных во время работы программы I

Вы должны вручную создать метод, который будет иметь тот же самый набор параметров, как и у события, которое вы хотите обработать. Затем вы должны вручную установить свойство OnXXX, чтобы она указывала на метод, который вы создали.

Пример:

TForm1 = class(TForm)

procedure FormCreate(Sender: TObject);

private

FMyButton: TButton;

protected

procedure Button1Click(Sender: TObject);

{Кодируем это вручную,для соответствия}

{структуреTNotifyEvent}

end;

procedure TForm1.FormCreate(Sender: TObject);

begin

FMyButton := TButton.Create;

{Здесь устанавливаем позицию, заголовок и все остальное}

FMyButton.OnClick := MyButtonClick;

end;

procedure TForm1.MyButtonClick(Sender: TObject);

begin

ShowMessage('Эй! Ты нажал на мою кнопку!');

end;

События для компонентов, созданных во время работы программы II

Вот простейший код для нового проекта с одной кнопкой и меню. (Надеюсь, в этом ничего сложного нет ... :)

procedure TForm1.Button1Click(Sender: TObject);

var

NewItem: TMenuItem;

begin

NewItem := TMenuItem.Create(Form1);

NewItem.Caption := 'Динамический элемент ...';

 NewItem.OnClick := xyz;MainMenu1.Items.Insert(0, NewItem); ←Примечание: рекомендую бегло ознакомиться с Delphi-примером для команды Insert…

end;

{Любая старая 'xyz'-процедура (в настоящее время может быть определена одна, например, Form1.DblClick)}

procedure TForm1.xyz(Sender: TObject);

begin

showmessage('Запусти эту процедуру !!');

end;

Примечание: Если вы пользуетесь неопределенной процедурой, вам понадобиться объявить ее. Лично я все это сделал в «верхнем правом углу» объявления типа формы, примерно так:

private

{ Private declarations }

public

{ Public declarations }

procedure xyz(Sender: TObject); ←К этой процедуре могут иметь доступ не только события Form1 …

Установите свойство обработчика события (например, OnClick, OnDblClick, OnMouseDown и пр.) на процедуру, которую вы создали для обработки этого события. Вам нужно убедиться в том, что параметры в точности соответствуют параметрам ожидаемого заданного обработчика события.

Например:

MySpeedButton.OnClick := MyClickEventHandler;

где…

procedure MyClickEventHandler(Sender: TObject);

begin

end;

Массивы

Динамические массивы V

SottNick пишет:

Если хочется, чтобы в многомерном массиве был разный размер у разных измерений например: VarArray: array[1..2, 1..?] of TType , где ? зависит от "строки" массива (1..2)

То дозволяется сделать так:

1. Объявление

Var VarArray: array of array of array…………

2. Установка длин

SetLength(VarArray, Razmernost1); // У первого измерения

SetLength(VarArray[1], Razmernost2); // У второго измерения первой «строки»

SetLength(VarArray[2], Razmernost3); // У второго измерения второй «строки»

SetLength(VarArray[n], Razmernost4); // У второго измерения n-ной «строки»

SetLength(VarArray[1][1], Razmernost5); // У третьего измерения первой «строки» первого «столбца»

SetLength(VarArray[1][2], Razmernost6); // У третьего измерения первой «строки» второго «столбца»

SetLength(VarArray[n][m], Razmernost7); // У третьего измерения n-ной «строки» m-ного «столбца»

т.д.

Все можно изменять в процессе естественно.

3. Получение длин

Razmernost1:=Length(VarArray); // У первого измерения (количество строк)

Razmernost2:=Length(VarArray[1]); // У второго измерения первой «строки» (количество столбцов)

Razmernost3:=Length(VarArray[2]); // У второго измерения второй «строки» (количество столбцов)

Razmernost4:=Length(VarArray[n]); // У второго измерения n-ной «строки» (количество столбцов)

Razmernost5:=Length(VarArray[1][1]); // У третьего измерения первой «строки» первого «столбца»

Razmernost6:=Length(VarArray[1][2]); // У третьего измерения первой «строки» второго «столбца»

Razmernost7:=Length(VarArray[n][m]); // У третьего измерения n-ной «строки» m-ного «столбца»

4. Обращение

VarArray[n][m][o][p][r]:=1; // :Integer // К элементу n-ной «строки», m-ного «столбца», // o-того «?», p-того «?», r-того «?»

5. Обнуление (освобождение памяти)

SetLength (VarArray, 0); // Всех сразу

Динамические массивы VI

Например, если вам необходимо сохранить «GIZMOS» в вашем массиве, сделайте следующее:

CONST

 MaxGIZMOS = $FFFF Div (SizeOf(GIZMOS)) { или что-то другое, смотря какой максимальный размер GIZMOS вы планируете...}

TYPE

pGIZMOArray = ^GIZMOArray;

GIZMOArray = Array[1..MaxGIZMOS] of GIZMOS;

VAR

TheGIZMOS: pGIZMOArray;

GIZMOcount: integer;

BEGIN

 GetMem(TheGIZMOS,(GIZMOcount+1)*SizeOf(GIZMO)); {Нужна дополнительная единица, поскольку массив GetMem ведет отсчет с нуля…}

TheGIZMOS^[index] := Whatever;

ну и так далее…

TList — такой динамический массив. Для получения дополнительной информации обратитесь к электронной справке. Если вы хотите это делать сами, то вам необходимо использовать GetMem для получения указателя на распределенную динамическую память, и затем FreeMem для освобождения памяти, занятой динамическим массивом. Tlist сделает это за вас самым надежным образом.

Динамические массивы VII

Существует несколько способов сделать это. Применять тот или иной способ зависит от того, какой массив вы используете — массив строк или массив чисел (целые, натуральные и пр.).

1. Если вам необходим простой динамический одномерный массив строк, я предлагаю вам взглянуть на компонент tStringList, он сам заботится о функциях управления и легок в использовании.

2. Если вам необходим динамический многомерный массив строк, вы также можете воспользоваться tStringList (в случае, если число элементов вашего массива не превышает лимит для tStringList, я полагаю он равен 16,000). Чтобы сделать это, создайте функцию линейного распределения как показано ниже:

Допустим у вас есть трехмерный массив строк, текущее измерение [12,80,7], и вы хотите найти элемент [n,m,x]. Вы можете найти этот элемент в приведенном одномерном массиве с помощью формулы ((n-1)*80*7 + (m-1)*80 + x). Затем вы можете использовать это в качестве индекса в tStringList. Для диманического изменения одной из границ массива, используйте метод tStringList Move, служащий как раз для таких целей. (Метод состоит из некоторых технологических внутренних циклов, но выполняются они очень быстро, поскольку tStringList манипулирует не с самими строками, а с указателями на них.)

3. Если вам необходим динамический одномерный массив чисел, то в общих словах я приведу его ниже, но есть масса мелких деталей. Объявите указатель на тип массива, имеющего максимальное количество элементов данного типа (помните о том, что Delphi-16 позволяет иметь типам область памяти, ограниченной 64K), например так:

type

bigArray: array[1..32000] of integer; {или ^double, или что-то еще}

pMyArray: ^bigArray;

затем распределите сам массив:

getMem (pMyArray, sizeof(integer) * n);

где n — количество элементов. После этого вы можете ссылаться на элементы массива следующим образом:

pMyArray^[51]

Не забудьте освободить массив с помощью FreeMem после того, как вы его использовали.

Изменить размер массива, определить новый указатель, перераспределить или обменяться с другим массивом можно так:

pTemp: ^bigArray;

getMem(pTemp, sizeof(integer) * newnumelements);

memcopy(pTemp, pMyArray, sizeof(integer)*n);

{n – количество элементов в pMyArray}

freeMem(pMyArray, sizeof(integer)*n);

pMyArray := pTemp;

4. Если вам необходим многомерный массив чисел, скомбинируйте технику, описанную в пункте (3), с функцией распределения, описанной в пункте (2).

5. Если для вашего массива необходим участок памяти больше чем 64K, вам необходимо разработать список указателей на участки памяти, но эта тема выходит за рамки данной статьи.

Лично я инкапсулировал все в своем объекте. Я использую, как я это называю, «Basic String Object» (BSO), базовый строковый объект, который осуществляет динамическое распределение и освобождение памяти для строк любого размера. Непосредственно это PChar, указывающий на распределенную память. У меня существует два внешних свойства: AsString и AsPChar. Также у меня есть различные свойства и методы, позволяющие иметь различные способы доступа и манипулировать строками.

Я написал свои собственные malloc(), calloc() и realloc(), используя частные методы объекта TString для сканирования распределенной памяти. Это классно работает, когда мне нужно «захватить» блок памяти.

С помощью двух методов я могу распределить необходимую мне память (блоками, так что это не занимает много процессорного времени), и освобождать ее (когда существует определенный резерв – и снова так, чтобы не тратить много процессорного времени).

О другой идее я уже рассказывал (открытый массив). Если вам нужна проверка выхода за границы и/или динамическое изменение размера массива, вы можете использовать метод, аналогичный методу работы со строковым объектом (описанный мною выше), но вам необходимо будет интегрировать свойство-массив по умолчанию, чтобы иметь к нему простой доступ. Это позволит вам иметь индексы и использовать нужный вам тип.

TMyDynamicObject =

…

PROPERTY Array[idx:LONGINT]:TMyType READ GetArray WRITE PutArray DEFAULT;

…

VAR Mine :TMyDynamicObject;

…

Mine := TMyDynamicObject.Create;

FOR i := 10 TO 20 DO Mine[i] := {значение}

{ЧУДОВИЩНАЯ РАСТРАТА ПАМЯТИ - если вы действительно используете такие большие массивы и хэш-таблицы }

Mine[-100000] := {значение}

Mine[+100000] := {значение}

Если в вашем распоряжении находится «редкозаполненный» массив, использование хэш-таблицы дало бы существенный выигрыш. Я преобразую индексные значения в строки, а все остальное перепоручаю TStrings, но не из-за того, что я такой ленивый, а из-за того, что он сделает это лучше меня, мне нужно всего лишь осуществить преобразование в строки.

Для того, чтобы хранить все, что вы хотите, вы можете использовать TList (или TStringList.Objects)! TList.Items хранят указатели на объекты или записи, но они ничего не могут сделать с ними, поэтому вы можете привести их к типу longint, и больше о них не беспокоиться! Вот пример хранения в TList списка целых:

var

aList: TList;

I : Integer;

L : Longint;

begin

aList := TList.Create;

L := 93823;

aList.Add(Pointer(L));

aList.Add(Pointer(83293));

for I := 1 to aList.Count do L := L + Longint(aList.Items[I-1]);

aList.Free;

end;

В TList и TStringList вы можете иметь до 16380 элементов. А теперь обещанный пример того, как можно хранить в TList записи (или объекты), вернее, указатели на них:

type

PMyRec = TMyRec;

TMyRec = record

Name: string[40];

Addr : string[25];

Comments: string;

salary: Double;

end;

var

aList: TList;

aRecPtr: PMyRec;

I : Integer;

begin

aList := TList.Create;

New(aRecPtr);

with aRecPtr^ do begin

Name := 'Валентин';

Addr := 'неизвестен';

Comments := 'Автор Советов по Delphi';

Salary := 999000.00;

end;

aList.Add(aRecPtr);

aList.Add(…);

…

for I := 1 to aList.Count do begin

aRecPtr := PMyRec(aList.Items[I-1]);

{что-то делаем с записью}

end;

{теперь избавляемся от всех записей и самого списка-объекта}

for I := 1 to aList.Count do Dispose(PMyRec(aList.Items[I-1]));

aList.Free;

end;

Динамические массивы VIII

Иногда разработчик, работая с массивами, не знает какого размера массив ему нужен. Тогда Вам пригодится использование динамических массивов.

var intArray : array of integer;

При таком объявлении размер массива не указывается. Что бы использовать его дальше необходимо определить его размер (обратите внимание, что размер динамического массива можно устанавливать в программе):

begin

intArray:=(New(IntArray,100); //Размер массива? 100

end;

Igor Nikolaev aKa The Sprite

Пример массива констант (Array of Const) III

procedure foo(a : array of const);

implementation

var

var1: longint;

var2: pointer;

var3: integer;

begin

var1 := 12345678;

var2 := @var1;

var3 := 1234;

foo([var1, var2, var3]);

В действительности, массив array of const более корректным было бы назвать массивом array of tvariant. Tvariant — множественный выбор типов переменной, в которой можно задать номер типа. В Visual Basic у него имеется наследник. Delphi также позволяет использовать имена.

Определите тип, например, так:

TYPE NAME1 = Array[1..4,1..10] of Integer;

Затем, в вашей секции CONST:

NAME2: NAME1 = ((1,2,3,4,5,6,7,8,9,10),

(1,2,3,4,5,6,7,8,9,10),

(1,2,3,4,5,6,7,8,9,10));

Массив объектов-изображений

Вы не сможете сделать это напрямую и "визуально", но если вы не возражаете против нескольких строк кода, то я покажу как это может быть просто:

type

TForm1 = class(TForm)

…

public

images: array [1..10] of TImage;

…

end;

procedure TForm1.FormCreate(…);

var i: integer;

begin

…

for i := 1 to 10 do begin

images[i] := TImage.Create(self);

with images[i] do begin

parent := self;

tag := i; { это облегчит идентификацию изображения }

… установите другие необходимые свойства, например:

OnClick := MyClickEventHndlr;

end;

…

end;

Для того, чтобы убедиться, что все модули в секции «uses» установлены правильно, бросьте на форму один такой динамический компонент, и затем удалите его, или установите его видимость в False. Более сложный способ заключается в разработке собственного компонента, делающего описанное выше.

Массив TPOINT

Const ptarr : Array[0..4] Of TPoint =((x:0; y:4), … (x:4; y:4));

Создание больших массивов

В 16-битной версии Delphi нельзя сделать это непосредственно. В новой, 32-битной версии, это как-то можно сделать, но за два месяца колупания я так и не понял как. (Некоторые бета-тестеры знают как. Не могли бы они сообщить нам всю подноготную этого дела?)

В 16-битной версии Delphi вам необходимо работать с блоками по 32K или 64K и картой. Вы могли бы сделать приблизительно следующее:

type

chunk: array[0..32767] of byte;

pchunk: ^chunk;

var BigArray: array[0..31] of pChunk;

Для создания массива:

for i := 0 to high(bigarray) do new (bigArray[i]);

Для получения доступа к n-ному байту в пределах массива (n должен иметь тип longint):

bigArray[n shr 15]^[n and $7fff] := y;

x := bigArray[n shr 15]^[n and $7fff];

Это даже осуществляет проверку выхода за границы диапазона, если вы установили в ваших настройках опцию «range checking»!

n должен находиться в диапазоне [0..32*32*1024] = [0..1024*1024] = [0..1048576].

Для освобождения массива после его использования необходимо сделать следующее:

for i := 0 to high(bigarray) do dispose (bigArray[i]);

Свойства

Редактор свойств для точки

TPoint не имеет информацию о типе, следовательно, вы не можете зарегистрировать для него редактор свойства. Вы можете иметь редактор свойств только для строк, реальных, порядковых чисел или указателей на объекты. Дело в том, что редактор свойств имеет только следующие методы, чтобы иметь доступ к свойствам через RTTI:

GetValue/SetValue для строк (strings)

GetFloatValue/SetFloatValue для натуральных чисел (floats)

GetOrdValue/SetOrdValue для порядковых (и указателей)

Решением может быть создание класса TPersistentPoint, являющегося наследником TPersistent и имеющего те же свойства, что и TPoint. Вы можете просто «обернуть» TPoint для хранения значений, или создать явные поля. Непосредственное использование TPoint сделает использование метода Assign легким и быстрым для кодирования. Для процедур чтения и записи вы можете использовать поля записи, как показано ниже:

type TPersistentPoint = class(TPersistent)

private

FPoint: TPoint;

published

property X : integer read FPoint.X write FPoint.X;

property Y : integer read FPoint.Y write FPoint.Y;

end;

– Mike Scott

Хитрость вызова редактора свойств

Сделайте ваш редактор свойства наследником TStringListProperty (добавьте STREDIT в список используемых модулей) и согласно вашим обстоятельствам вызывайте метод предка Edit:

Unit MyEditor;

interface

uses STREDIT;

type TMyStringListProperty = class(TStringListProperty)

procedure Edit; override;

end;

implementation

procedure TMyStringListProperty.Edit;

begin

if { какие-то условия } then { что-то делаем }

else inherited Edit;

end;

end.

- Pat Ritchey

Как убрать публичное свойство компонента/формы из списка видимых/редактируемых свойств в Инспекторе Обьектов?

Nomadic советует:

Из TForm property не убиpал, но из TWinControl было дело. А дело было так:

interface

type TMyComp = class(TWinControl)

…

end;

procedure Register;

implementation

procedure Register;

begin

RegisterComponents('MyPage', [TMyComp]);

RegisterPropertyEditor(TypeInfo(String),TMyComp,'Hint',nil);

end;

[ и т.д.]

Тепеpь property 'Hint' в Object Inspector не видно. Рад, если чем-то помог. Если будут глюки, умоляю сообщить. Такой подход у меня сплошь и pядом.

Свойство FileName в невизуальном компоненте

Следующий код взят из dsgnintf.pas (иногда стоит покопаться в файлах!) для свойства TMPLayer.filename, с помощью C.Calvert…

В заголовке модуля компонента…

TFileNameProperty = class(TStringProperty)

public

function getattributes: TPropertyattributes; override;

procedure Edit; override;

end;

добавьте функцию регистрации…

RegisterPropertyEditor(Typeinfo(String), TMyComponent, 'Filename', TFileNameProperty);

и код…

function TFileNameProperty.GetAttributes;

begin

Result := [paDialog];

end;

Procedure TFilenameProperty.edit;

var

MFileOpen: TOpenDialog;

begin

MFileOpen := TOpenDialog.Create(Application);

MFileOpen.Filename := GetValue;

 MFileOpen.Filter := 'Правильный тип файлов|*.*'; (* Поместите здесь ваш собственный фильтр...*)

MFileOpen.Options := MFileOpen.Options + [ofPathMustExist,ofFileMustExist];

try

if MFileOpen.Execute then SetValue(MFileOpen.Filename);

finally

MFileOpen.Free;

end;

Записи

Пример переменной записи

В Delphi 2.0 я пытаюсь прочесть текстовый файл и получаю проблему. Текстовый файл, который я хочу прочесть, имеет записи фиксированной длины, но в самих записях могут располагаться различные типы с различной длиной, и оканчиваться в различных позициях, в зависимости от типа.

Файл выглядит примерно так:

TFH.......<First record type, первый тип записи>

TBH.......<Second record type, второй тип записи>

TAB........<Third record type, третий тип записи>

TAA........<Fourth record type, четвертый тип записи>

Вы можете поймать больше одного зайца в случае объявления переменной записи, но если сделаете это правильно.

Type

TDataTag = Array [1..3] of Char;

TDataTags = Array [0..NumOfTags-1] of TDataTag;

TDataRec = packed Record

tagfield: TDataTag;

case integer of

0: ( поля для тэга TFH );

1: ( поля для тэга TBH );

2: …

…

end;

TMultiRec = packed Record

Case Boolean of

false: (строка: Array [0..1024] of Char);

{ должно установать строку максимально возможной длины }

true : ( data: TDataRec );

End;

Const DataTags: TDataTags = ('TFH', 'TBH', …);

var rec: TMultirec;

ReadLn(datafile, rec.line);

Case IndexFromDataTag(rec.data.tagfield) Of

0: …

1: …

IndexFromDataTag должен искать передаваемый тэг поля в массиве DataTags. Определите все поля в TDataRec как Array [1..someUpperBound] of Char.

– Peter Below

Передача массива записей символов в Memo

Тема: Передача массива записей символов в Memo.

Обработка больших строк в 16-битной версии Delphi задача далеко непростая. Особенно когда строки являются частью структуры записи и вы хотите передать их в TMemo. В данном совете показано как создать структуру записи размером 1000 символов, прочесть в нее содержимое Memo и затем записать ее обратно в Memo. Основной метод, который мы здесь используем — метод Memo GetTextBuf. Используемая структура записи представляет собой простую строку и массив из 1000 символов, но структура могла бы быть сложнее.

unit URcrdIO;

interface

uses

SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,Forms, Dialogs, StdCtrls,dbtables;

type

TForm1 = class(TForm)

Button1: TButton;

Memo1: TMemo;

Button2: TButton;

procedure Button1Click(Sender: TObject);

procedure Button2Click(Sender: TObject);

private { Private declarations }

public { Public declarations }

end;

type

TMyRec = record

MyArray: array [1..1000] of char;

mystr: string;

end;

var

Form1: TForm1;

MyRec : TMyRec;

mylist : TStringlist;

PMyChar : PChar;

myfile : file;

mb : TStream;

implementation

{$R *.DFM}

procedure TForm1.Button1Click(Sender: TObject);

begin

assignfile(myfile, 'c:\testblob.txt');

rewrite(myfile,1);

fillchar(MyRec.MyArray,sizeof(MyRec.MyArray),#0);

pmychar:=@MyRec.MyArray;

StrPCopy(pmychar,memo1.text);

Blockwrite(MyFile,MyRec,SizeOf(MyRec));

closefile(MyFile);

end;

procedure TForm1.Button2Click(Sender: TObject);

begin

assignfile(myfile, 'c:\testblob.txt');

reset(myfile,1);

fillchar(MyRec.MyArray, sizeof(MyRec.MyArray),#0);

Blockread(MyFile, MyRec, SizeOf(MyRec));

pmychar:=@MyRec.MyArray;

Memo1.SetTextBuf(pmychar);

end;

end.

Освобождение записей

Для начала необходимо привести объект к нужному типу, например, так:

var

i: integer;

begin

…

for

i := 0 to MyList.Count - 1 do dispose(PMyRecord(MyList[i]));

MyList.Free;

end;

или

begin

for i := 0 to MyList.Count - 1 do dispose(PMyRecord(MyList.items[i]));

MyList.Free;

end;

Items — свойство по умолчанию, поэтому вам нет необходимости определять это, хотя обратное не помешает.

Теперь можно заняться созданием работоспособной и полезной функцией. В форме:

var p : ^mystruct;

begin

new(p);

…

dispose(p);

end;

операторы new() и dispose() в точности соответствуют процедурам getmem() и freemem(), за исключением того, что компилитор распределяет количество байт под размер структуры, на которую ссылается переменная-указатель. По этой причине указатель должен быть типизированным указателем, и следущий код неверен:

var

p: pointer;

begin

new(p);

end;

поскольку невозможно установить размер памяти, на которую должен ссылаться указатель. С другой стороны, если вы используете getmem() и freemem(), вы можете распределять байты для нетепизированного указателя, например:

var p : pointer;

begin

getmem(p, 32767);

…

freemem(p, 32767);

end;

Строки

StrTok для Delphi 2

Я передалал это для работы в Delphi 2.0, код приведен ниже (эта функция первоначально была написана John Cooper 76356,3601 и модифицирована мной для адаптации под Delphi 2.0).

…вот этот код:

function StrTok(Phrase: Pchar; Delimeter: PChar): Pchar;

const

tokenPtr: PChar = nil;

workPtr: PChar = nil;

var

delimPtr: Pchar;

begin

if (Phrase <> nil) then workPtr := Phrase

else workPtr := tokenPtr;

if workPtr = nil then begin

Result := nil;

Exit;

end;

delimPtr := StrPos(workPtr, Delimeter);

if (delimPtr <> nil) then

begin

delimPtr^ := Chr(0);

tokenPtr := delimPtr + 1

end else tokenPtr := nil;

Result := workPtr;

end;

– Ralph Friedman

Как мне перекодировать строки из Win-кодировки в Dos-кодировку и наоборот?

Как мне перекодировать строки из Win-кодировки в Dos-кодировку и наоборот?

Nomadic отвечает:

A: CharToOEM, OEMToChar, CharToOEMBuff, OEMToCharBuff. Заметьте однако, что эти функции не умеют делать таких, например, вещей, как koi8-r в DOS и т. п. ...

Все права на текст принадлежат автору: Валентин Озеров.
Это короткий фрагмент для ознакомления с книгой.

Скачать или читать эту книгу на КулЛиб

Что такое "Советы по Delphi"?

Предупреждение

Алгоритмы

Преобразования

Преобразование дробной и целой части REAL-числа в два целых

Есть ли функция, выполняющая пpеобpазование пеpеменной real в integer?

Почему непpавильно pаботает функция StrToFloat?

Число строкой X

Даты

Добавление даты и времени в компонент Memo

Вычисление даты Пасхи II

Преобразование даты в количество секунд

Преобразование даты в неделю

Преобразование даты

Преобразование даты — добавление столетия

Приведение даты

Даты и недели

Количество дней между двумя датами I

Количество дней между двумя датами II

Конвертирование даты

Число текущей недели

Разница во времени

Проблема со временем

Переменная времени

Математика

Как научить Delphi делать правильное округление дробных чисел?

Разное

Генерация еженедельных списков задач

Генерация случайного пароля

Проверка ISBN

API

Переменные среды

Как раскрыть строки с подстановками вида '%SystemRoot%\IOSUBSYS\'?

Изменение системного времени из Delphi II

Завершение работы Windows

Определение завершения работы Windows

Как консольное приложение может узнать, что Винды завершаются?

Как корректно перехватить сигнал выгрузки операционной системы, если в моей программе нет окна?

Постепенное умирание

Разное

Как не допустить запуск второй копии программы VIII

Как не допустить запуск второй копии программы IX

Файл TPrevInstUnit

Как не допустить запуск второй копии программы X

Как не допустить запуск второй копии программы XI

Как не допустить запуск второй копии программы XII

Как правильно завершить некое приложение?

Как отчитывать промежутки времени с точностью, большей чем 60 мсек?

Как сделать чтобы при событиях моя программа отпpавляла кому-либо сообщение на мой компьютеp?

Вызов других программ

Получение списка запущеных приложений

Открытие выбранного файла в работающем приложении

Убиваем активное приложение

Комментарии

Pascal

Объекты

Проблема циклических ссылок

Создание множества экземпляров

Параметры

Передача функции как параметра

Проблема передачи записи

Указатели

Указатель на функцию I

Указатель на функцию II

Использование указателей на целое

Память

Функция MemAvail для Delphi2?

Как работать с блоками памяти размером более 64K?

События

Назначение обработчика события OnClick пункту меню, созданному во время выполнения программы

События для компонентов, созданных во время работы программы I

События для компонентов, созданных во время работы программы II

Массивы

Динамические массивы V

Динамические массивы VI

Динамические массивы VII

Динамические массивы VIII

Пример массива констант (Array of Const) III

Массив объектов-изображений

Массив TPOINT