Code:

 

{ .... }

 

type

VA_FN = function(const par1, par2{, ...}: Pointer): Boolean;

cdecl varargs;

 

{ .... }

 

//

// varargs without "external" keyword

//

function fn(const par1, par2{, ...}: Pointer): Boolean; cdecl;

var

last_arg: Pointer absolute par2;

ptr_args: array[0..MAXLONG shr2] of Pointer absolute last_arg;

dw_args: array[0..MAXLONG shr2] of Cardinal absolute last_arg;

s_args: array[0..MAXLONG shr2] of PChar absolute last_arg;

w_args: array[0..MAXLONG shr2] of WideString absolute last_arg;

begin

// ptr_args[1] is first optional argument

Result := (ptr_args[1] {par3} = Pointer(1)) and

(dw_args[2] {par4} = 2) and

(string(ptr_args[3]) = 'CHAR') and

(w_args[4] = 'WCHAR');

end;

 

procedure test_fn;

begin

// VA_FN typecast

VA_FN(@fn)({par1}nil, {par2}nil, {par3}Pointer(1), {par4}2, {par5}'CHAR',

{par6}WideString('WCHAR'));

end;

 

 

 

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

Code:

{©Drkb v.3(2007): www.drkb.ru,

®Vit (Vitaly Nevzorov) - Этот адрес электронной почты защищён от спам-ботов. У вас должен быть включен JavaScript для просмотра.}

 

For i:=0to Maximum doif i mod step = 0then

begin

end;

 

Переменная Step и есть нужный шаг

 

 

Автор:Vit  

Взято из https://forum.sources

В Делфи 6 (модуль Math) появилась удобная функция ifthen которая соответствует оператору "?" языка С++.

 

пример:

 

Code:

{©Drkb v.3(2007): www.drkb.ru}

procedure TForm1.Button1Click(Sender: TObject);

var k, i, j: Integer;

begin

i := 3; j := 2;

k := ifthen({If}i < j, {Then}i, {Else}k);

End;

 

 

Автор feriman

 

Взято изhttps://forum.sources

 О переносе проекта в другую папку

Кстати, данный рисунок иллюстрирует нарушение правила «один проект — одна папка»: в этом проекте, вопреки означенному правилу, многие модули хранятся во вложенных папках, в результате delphi указывает длинные маршруты доступа к соответствующим файлам. Если такой проект скопировать на дискету, то эти маршруты останутся без изменения и компилятор не сможет найти нужные файлы. Еще хуже, если скопировать проект в другую папку на том же жестком диске.

 

 

 

 

Code:

// функция Chameleon, возвращающая тип сгенерированного исключения

 

unit Unit1;

 

interface

 

uses

Windows, Messages, SysUtils, Classes, Graphics, Controls,

Forms, Dialogs, StdCtrls;

 

type

MyBoolean = class

public

Value: boolean;

end;

 

MyInteger = class

public

Value: integer;

end;

 

MyClass = class

public

Value: TStrings;

end;

 

TForm1 = class(TForm)

Button1: TButton;

procedure Button1Click(Sender: TObject);

private

{ Private declarations }

public

{ Public declarations }

procedure MyProc;

function Chameleon: boolean;

end;

 

var

 

Form1: TForm1;

 

implementation

 

{$R *.DFM}

 

function TForm1.Chameleon: boolean;

var

b: MyBoolean;

i: MyInteger;

c: MyClass;

r: integer;

begin

r := Random(3);

case r of

0:

begin

b := MyBoolean.Create;

raise b;

end;

1:

begin

i := MyInteger.Create;

raise i;

end;

2:

begin

c := MyClass.Create;

raise c;

end;

end;

end;

 

procedure TForm1.MyProc;

begin

try

Chameleon;

except

on MyBoolean do

ShowMessage('Функция возвратила класс MyBoolean');

on MyInteger do

ShowMessage('Функция возвратила класс MyInteger');

on MyClass do

ShowMessage('Функция возвратила класс MyClass');

end;

end;

 

procedure TForm1.Button1Click(Sender: TObject);

begin

Chameleon;

end;

 

end.

 

Взгляните на тип данных Variant в D2: следующий код

 

Code:

function AnyType(const TypeParm: integer): Variant;

begin

case TypeParm of

1: Result := 1;

2: Result := 2.0;

3: Result := 'Три';

4: Result := StrToDate('4/4/1944');

end;

end;

 

 

 

абсолютно бестолковый, но полностью корректный!

 

Следующий код содержит объявление трех функций, принимающих на входе один и тот же параметр, но выдающих результаты различных типов (результат физичиски один и тот же, и занимает он 4 байта). Я не думаю, что можно одурачить delphi, чтобы с помощью этого метода возвратить строку. Это может привести к разрушению менеджера кучи. Вместо этого вызывайте необходимую вам функцию. Каждый вызов передается MyFuncRetAnything, а P1 определяет возвращаемый тип. Если хотите, можете написать другую обертку, делающую для вас еще и приведение типов.

 

3 вызова, 1 код.

 

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

 

Code:

{моя форма имеет 3 метки, одну кнопку и этот код}

 

var

MyFuncRetInt: function(P1, P2: Integer): Integer;

MyFuncRetBool: function(P1, P2: Integer): LongBool;

MyFuncRetPointer: function(P1, P2: Integer): Pointer;

 

function MyFuncRetAnything(P1, P2: Integer): Integer;

var

RetPointer: Pointer;

RetBool: LongBool;

RetInteger: Integer;

begin

RetPointer := nil;

RetBool := False;

RetInteger := 4711;

case P1 of

1: Result := Integer(RetPointer);

2: Result := Integer(RetBool);

3: Result := RetInteger;

end;

end;

 

procedure TForm1.Button1Click(Sender: TObject);

begin

if MyFuncRetBool(2, 1900) then

Label1.Caption := 'True'

else

Label1.Caption := 'False';

Label2.Caption := IntToStr(MyFuncRetInt(3, 1900));

Label3.Caption := IntToHex(Integer(MyFuncRetPointer(1, 1900)), 16);

end;

 

initialization

MyFuncRetInt := @MyFuncRetAnything;

MyFuncRetBool := @MyFuncRetAnything;

MyFuncRetPointer := @MyFuncRetAnything;

 

end.

 

 

 

 

 

Взято сhttps://delphiworld.narod

Известно, что delphi создает множество файлов с расширениями pas, dfm, dpr и т.д. Обычно программиста интересуют файлы кода (pas) и описания форм (dfm), а остальные остаются вне его поля зрения, а зря — они несут важную информацию, которую можно (а в ряде случаев — нужно) изменять.

 

Начнем с файла проекта (dpr). Фактически он содержит собственно программу, в то время как связанные с проектом многочисленные файлы форм и dll представляют собой подпрограммы.

Структура файла проекта, содержащего единственную форму, такова, как показано в листинге 1.