:: MVP ::
|
|
:: RSS ::
|
|
|
Как открыть CHM справку на нужной странице?
// Способ первый (для Delphi 2006 и выше)
procedure TForm1.Button1Click(Sender: TObject);
begin
HtmlHelp(0, 'mk:@MSITStore:file.chm::/path/file.html', HH_DISPLAY_TOPIC, 0);
// или
// HtmlHelp(0, 'file.chm::/path/file.html', HH_DISPLAY_TOPIC, 0);
// file.chm - файл справки
// /path/file.html - путь к файлу внутри справки
// Еисл в качестве первого параметра вместо 0 передать Handle,
// то справка будет отображаться поверх указанного окна.
// В любом случае справка будет закрываться вместе с приложением.
end;
// Способ второй (для всех версий Delphi)
uses
{...,} ShellAPI;
procedure TForm1.Button1Click(Sender: TObject);
begin
ShellExecute(Handle, 'open', 'C:\WINDOWS\hh.exe', 'file.chm::/path/file.html', nil, SW_SHOWNORMAL);
// Справка не будет закрываться вместе с приложением.
end;
|
Как конвертировать римское число в арабское?
// Способ первый
function RomanToDec(const Value: string): Integer;
var
i, lastValue, curValue: Integer;
begin
Result := 0;
lastValue := 0;
for i := Length(Value) downto 1 do
begin
case UpCase(Value[i]) of
'I': curValue := 1;
'V': curValue := 5;
'X': curValue := 10;
'L': curValue := 50;
'C': curValue := 100;
'D': curValue := 500;
'M': curValue := 1000;
else
raise Exception.CreateFmt('Invalid character: %s', [Value[i]]);
end;
if curValue < lastValue then
Dec(Result, curValue)
else
Inc(Result, curValue);
lastValue := curValue;
end;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
ShowMessage(IntToStr(RomanToDec('XVIII')));
end;
// Способ второй
function RomanToInt(num: string): Integer;
const
N = 13;
vals: array [1..N] of Word =
(4, 9, 40, 90, 400, 900, 1, 5, 10, 50, 100, 500, 1000);
roms: array [1..N] of string[2] =
('IV', 'IX', 'XL', 'XC', 'CD', 'CM', 'I', 'V', 'X', 'L', 'C', 'D', 'M');
var
i: Integer;
begin
Result := 0;
while Length(num) > 0 do
begin
for i := Low(roms) to High(roms) do
if AnsiUpperCase(Copy(num, 1, Length(roms[i]))) = roms[i] then
begin
Inc(Result, vals[i]);
Delete(num, 1, Length(roms[i]));
Break;
end;
end;
end;
// Способ третий
function Arabic(s: string): Integer;
const
R: array[1..13] of string[2] =
('I', 'IV', 'V', 'IX', 'X', 'XL', 'L', 'XC', 'C', 'CD', 'D', 'CM', 'M');
A: array[1..13] of Integer =
(1, 4, 5, 9, 10, 40, 50, 90, 100, 400, 500, 900, 1000);
var
i, p: Integer;
begin
Result := 0;
i := 13;
p := 1;
while p <= Length(s) do
begin
while Copy(s, p, Length(R[i])) <> R[i] do
begin
Dec(i);
if i = 0 then
Exit;
end;
Result := Result + A[i];
p := p + Length(R[i]);
end;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
ShowMessage(IntToStr(Arabic('LXXXI')));
end;
// Способ четвертый
function RomanToInt(const s: string): Longint;
const
RomanChars = ['C', 'D', 'I', 'L', 'M', 'V', 'X'];
RomanValues: array['C'..'X'] of Word =
(100, 500, 0, 0, 0, 0, 1, 0, 0, 50, 1000,
0, 0, 0, 0, 0, 0, 0, 0, 5, 0, 10);
var
Index, Next: Char;
i: Integer;
Negative: Boolean;
begin
Result := 0;
i := 0;
Negative := (Length(s) > 0) and (s[1] = '-');
if Negative then
Inc(i);
while (i < Length(s)) do
begin
Inc(i);
Index := UpCase(S[i]);
if Index in RomanChars then
begin
if Succ(i) <= Length(s) then
Next := UpCase(s[i+1])
else
Next := #0;
if (Next in RomanChars) and (RomanValues[Index] < RomanValues[Next]) then
begin
Inc(Result, RomanValues[Next]);
Dec(Result, RomanValues[Index]);
Inc(i);
end
else
Inc(Result, RomanValues[Index]);
end
else
begin
Result := 0;
Exit;
end;
end;
if Negative then
Result := -Result;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
ShowMessage(IntToStr(RomanToInt('LXXXI')));
end;
|
Как открыть редактора реестра на нужной ветви?
uses
{...,} ShellAPI, Registry;
function OpenRegEditAndJumpToKey(const KeyName: String): Boolean;
begin
with TRegistry.Create do
try
RootKey := HKEY_CURRENT_USER;
Result := OpenKey('Software\Microsoft\Windows\CurrentVersion\Applets\Regedit', False);
if Result then
try
try
WriteString('LastKey', KeyName);
except
Result := False;
Exit;
end;
finally
CloseKey;
end;
finally
Free;
end;
Result := ShellExecute(0, 'open', 'regedit.exe', nil, nil, SW_SHOWNORMAL) > HINSTANCE_ERROR;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
if not OpenRegEditAndJumpToKey('HKEY_LOCAL_MACHINE\SYSTEM\CurrentControlSet\Services\Cdrom') then
RaiseLastOSError;
end;
|
Как уведомить все приложения, что реестр был изменён?
procedure TForm1.Button1Click(Sender: TObject);
begin
SendMessage(HWND_BROADCAST, WM_WININICHANGE, 0,
LongInt(PChar('RegistrySection')));
end;
// Вместо 'RegistrySection' укажите ту секцию реестра,
// которую вы изменили.
|
Как быстро обменять значения 2х переменных?
// Способ первый
procedure SwapVars(var u, v; Size: Integer);
var
x: Pointer;
begin
GetMem(x, Size);
try
System.Move(u, x^, Size);
System.Move(v, u, Size);
System.Move(x^, v, Size);
finally
FreeMem(x);
end;
end;
procedure TForm1.Button1Click(Sender: TObject);
var
a, b: Integer;
begin
a := 1;
b := 2;
SwapVars(a, b, SizeOf(Integer));
ShowMessage(Format('%d, %d', [a, b]));
end;
// Способ второй
procedure SwapVars(var Source, Dest; Size: Integer);
asm
push edi
push esi
mov esi, Source
mov edi, Dest
mov ecx, Size
cld
@1:
mov al, [edi]
xchg [esi], al
inc si
stosb
loop @1
pop esi
pop edi
end;
procedure TForm1.Button1Click(Sender: TObject);
var
a, b: Integer;
begin
a := 8;
b := 4;
SwapVars(a, b, SizeOf(Integer));
ShowMessage(Format('%d, %d', [a, b]));
end;
|
Как преобразовать .swf в .exe?
// S = Путь к преобразовываемому .swf файлу
// D = Путь к выходному .exe файлу
// F = Путь к проигрывателю "Flash Player"
function Swf2Exe(S, D, F: string): Boolean;
var
SourceStream, DestinyStream, LinkStream: TFileStream;
Flag: Cardinal;
SwfFileSize: Integer;
begin
Result := false;
DestinyStream := TFileStream.Create(D, fmCreate);
try
LinkStream := TFileStream.Create(F, fmOpenRead or fmShareExclusive);
try
DestinyStream.CopyFrom(LinkStream, 0);
finally
LinkStream.Free;
end;
SourceStream := TFileStream.Create(S, fmOpenRead or fmShareExclusive);
try
DestinyStream.CopyFrom(SourceStream, 0);
flag := $FA123456;
DestinyStream.WriteBuffer(Flag, SizeOf(Integer));
SwfFileSize := SourceStream.Size;
DestinyStream.WriteBuffer(SwfFileSize, SizeOf(Integer));
Result := True;
finally
SourceStream.Free;
end;
finally
DestinyStream.Free;
end;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
if not Swf2Exe('C:\somefile.swf', 'C:\somefile.exe',
'D:\Program Files\Flash 5\Players\FlashPla.exe') then
ShowMessage( 'Преобразование не выполнено...' );
end;
|
При использовании материала - ссылка на сайт обязательна
|
|