:: MVP ::
|
|
:: RSS ::
|
|
|
Как изменить значение константы в runtime?
// Способ первый
const
{$J+}
N: Byte = 10;
{$J-}
procedure TForm1.Button1Click(Sender: TObject);
begin
Inc(N, 10);
ShowMessage(IntToStr(N));
end;
// Способ второй
const
N: Integer = 10;
S: string = 'text sample';
procedure ChangeConst(const Constant; var Value; Size: Integer);
begin
Move((@Value)^, (@Constant)^, Size);
end;
procedure TForm1.Button1Click(Sender: TObject);
var
NewN: Integer;
NewS: string;
begin
// String Demo:
NewS := 'new text';
ChangeConst(S, NewS, SizeOf(string));
ShowMessage(S);
// Integer Demo:
NewN := 20;
ChangeConst(N, NewN, SizeOf(Integer));
ShowMessage(IntToStr(N));
end;
|
Как передать часть массива в процедуру в качестве параметра?
procedure TForm1.Button1Click(Sender: TObject);
procedure Report(a: array of Integer);
var
i: Integer;
Msg: string;
begin
Msg := '';
for i := 0 to Length(a)-1 do
Msg := Format('%s a[%d] = %d ', [Msg, i, a[i]]);
ShowMessage(Msg);
end;
type
TMyType = array[0..4] of Integer;
PMyType = ^TMyType;
var
MyArray: TMyType;
begin
MyArray[0] := 0;
MyArray[1] := 1;
MyArray[2] := 2;
MyArray[3] := 3;
MyArray[4] := 4;
Report(Slice(PMyType(@MyArray[2])^, 2));
end;
|
Как измерить время выполнения участка кода?
// Способ первый
uses
{...,} System.DateUtils;
procedure TForm1.Button1Click(Sender: TObject);
var
Start, Stop: TDateTime;
begin
Start := Now;
Sleep(1000); // Выполняем что-либо
Stop := Now;
// Время в секундах
ShowMessage((MilliSecondsBetween(Start, Stop) / 1000).ToString);
end;
// Способ второй
uses
{...,} System.DateUtils;
procedure TForm1.Button1Click(Sender: TObject);
var
Start, Stop: Cardinal;
begin
Start := GetTickCount;
Sleep(1000); // Выполняем что-либо
Stop := GetTickCount;
// Время в секундах
ShowMessage(((Stop-Start) / 1000).ToString);
end;
// Способ третий
procedure TForm1.Button1Click(Sender: TObject);
var
StartTime, EndTime, Freq: Int64;
begin
QueryPerformanceFrequency(Freq);
QueryPerformanceCounter(StartTime);
Sleep(1000); // Выполняем что-либо
QueryPerformanceCounter(EndTime);
// Время в секундах
ShowMessage(FloatToStrF((EndTime - StartTime) / Freq, ffFixed, 10, 3));
end;
// Способ четвертый
uses
{...,} System.Diagnostics;
procedure TForm1.Button1Click(Sender: TObject);
var
Stopwatch: TStopwatch;
begin
Stopwatch := TStopwatch.Create;
Stopwatch.Start;
Sleep(1000); // Выполняем что-либо
Stopwatch.Stop;
ShowMessage((Stopwatch.ElapsedMilliseconds / 1000).ToString);
end;
|
Как сгенерировать случайное значение с заданной вероятностью?
type
TValue = record
Name: string;
Weight: Integer;
end;
TValues = array of TValue;
function SmartRandom(const Val: TValues): Integer;
var
i, r, Summ: Integer;
Interval: array of Integer;
begin
if Length(Val) = 0 then
raise Exception.Create('Массив значений пуст.');
Summ := 0;
// Формирование массива с интервалами
SetLength(Interval, Length(Val));
for i := Low(Val) to High(Val) do
begin
Inc(Summ, Val[i].Weight);
Interval[i] := Summ;
end;
// Случайное число от 0 до суммы
// всех весовых коэффициентов
r := Random(Summ+1);
// Найти интервал, в который попадает
// случайное число
for i := Low(Interval) to High(Interval) do
if r <= Interval[i] then
Exit(i);
end;
procedure TForm1.Button1Click(Sender: TObject);
var
i: Integer;
Val: TValues;
begin
// Формирование массива значений и весовых коэффициентов
SetLength(Val, 3);
Val[0].Weight := 3; Val[0].Name := 'Купить';
Val[1].Weight := 6; Val[1].Name := 'Заказать';
Val[2].Weight := 1; Val[2].Name := 'Приобрести';
for i := 1 to 10 do
ShowMessage(Val[SmartRandom(Val)].Name);
end;
|
Как включить/выключить Just-In-Time debugging?
function IsDebugEnable: Boolean;
begin
Result := False;
with TRegistry.Create do
try
RootKey := HKEY_CURRENT_USER;
if OpenKeyReadOnly('Software\Microsoft\Windows Script\Settings') then
begin
if ValueExists('JITDebug') then
Result := ReadInteger('JITDebug') <> 0;
CloseKey;
end;
finally
Free;
end;
end;
function SetDebug(const Enable: Boolean): Boolean;
const
Value: array[Boolean] of Integer = (0, 1);
begin
Result := False;
with TRegistry.Create do
try
RootKey := HKEY_CURRENT_USER;
if OpenKey('Software\Microsoft\Windows Script\Settings', True) then
try
try
WriteInteger('JITDebug', Value[Enable]);
Result := True;
except
end;
finally
CloseKey;
end;
finally
Free;
end;
end;
|
Как перебрать соседние клетки на двухмерном ограниченном поле?
type
TForm1 = class(TForm)
procedure FormCreate(Sender: TObject);
private
FArea: array of array of Boolean;
function CountWithBorder(ARow, AColumn, ATotlaRows, ATotalColumns: Integer): Integer;
end;
implementation
const
AREA_ROWS = 5;
AREA_COLUMNS = 7;
procedure TForm1.FormCreate(Sender: TObject);
begin
SetLength(FArea, AREA_ROWS, AREA_COLUMNS);
end;
function TForm1.CountWithBorder(ARow, AColumn, ATotlaRows,
ATotalColumns: Integer): Integer;
var
RowDelta, ColumnDelta: Integer;
CurRow, CurColumn: Integer;
begin
Result := 0;
for RowDelta := -1 to 1 do
for ColumnDelta := -1 to 1 do
begin
if (RowDelta = 0) and (ColumnDelta = 0) then
Continue;
CurRow := ARow + RowDelta;
CurColumn := AColumn + ColumnDelta;
//if (0 <= CurColumn) and (CurColumn < ATotalColumns) and
// (0 <= CurLine) and (CurLine < ATotlaLines) then
if (CurColumn in [0..ATotalColumns-1]) and (CurRow in [0..ATotlaRows-1]) then
if FArea[CurRow, CurColumn] then
Inc(Result);
end;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
ShowMessage(IntToStr(CountWithBorder(0, 0, AREA_ROWS, AREA_COLUMNS)));
end;
|
Как перебрать соседние клетки на двухмерном неограниченном поле?
type
TForm1 = class(TForm)
procedure FormCreate(Sender: TObject);
private
FArea: array of array of Boolean;
function CountWithoutBorder(ARow, AColumn, ATotlaRows, ATotalColumns: Integer): Integer;
end;
implementation
const
AREA_ROWS = 5;
AREA_COLUMNS = 7;
procedure TForm1.FormCreate(Sender: TObject);
begin
SetLength(FArea, AREA_ROWS, AREA_COLUMNS);
end;
function TForm1.CountWithoutBorder(ARow, AColumn, ATotlaRows,
ATotalColumns: Integer): Integer;
function ModEx(a, b: Integer): Integer;
begin
Result := a - Floor(a/b) * b;
end;
var
RowDelta, ColumnDelta: Integer;
CurRow, CurColumn: Integer;
begin
Result := 0;
for RowDelta := -1 to 1 do
for ColumnDelta := -1 to 1 do
begin
if (RowDelta = 0) and (ColumnDelta = 0) then
Continue;
CurRow := ModEx(ARow + RowDelta, ATotlaRows);
CurColumn := ModEx(AColumn + ColumnDelta, ATotalColumns);
if FArea[CurRow, CurColumn] then
Inc(Result);
end;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
ShowMessage(IntToStr(CountWithBorder(0, 0, AREA_ROWS, AREA_COLUMNS)));
end;
|
Как вывести элементы словаря отсортированными по ключу?
uses
Generics.Collections;
procedure TForm1.Button1Click(Sender: TObject);
var
s: string;
i, j: Integer;
LArray: TArray;
LDict: TDictionary;
begin
LDict := TDictionary.Create;
try
Randomize; // Generate some values
for i := 0 to 20 do
begin
j := Random(1000);
LDict.AddOrSetValue(j, Format('The Value : %d', [j]));
end;
s := '';
for i in LDict.Keys do
s := s + LDict.Items[i] + #13;
ShowMessage(s);
// Sort
s := '';
LArray := LDict.Keys.ToArray;
TArray.Sort(LArray);
for i in LArray do
s := s + LDict.Items[i] + #13;
ShowMessage(s);
finally
LDict.Free;
end;
end;
|
Как преобразовать TStream в IStream?
uses
Winapi.ActiveX;
procedure TForm1.Button1Click(Sender: TObject);
var
COMStream: IStream;
ResStream: TResourceStream;
begin
ResStream := TResourceStream.Create(HInstance, '...', RT_RCDATA);
try
COMStream := TStreamAdapter.Create(ResStream, soReference);
try
{...}
finally
COMStream := nil;
end;
finally
ResStream.Free;
end;
end;
|
Как создать невидимый (пустой) курсор?
var
Cur: TCursor;
MaskAnd: array [0..0] of Byte = ($FF);
MaskXor: array [0..0] of Byte = ($00);
procedure TForm1.Button1Click(Sender: TObject);
begin
Cur := CreateCursor(0, 0, 0, 1, 1, @MaskAnd[0], @MaskXor[0]);
end;
|
При использовании материала - ссылка на сайт обязательна
|
|