Советы по Delphi. Версия 1.0.6 - [12]

 PathLen: integer;
begin
 { Преобразуем строку в тип PChar }
 PathLen:= Length(Path);
 Move(Path[1],Path[0],PathLen);
 Path[PathLen]:= #00;
 { Пытаемся запустить приложение }
 InstanceID:= WinExec(@Path,Visibility);
 if InstanceID < 32 then { значение меньше 32 указывает на ошибку приложения }
  WinExecAndWait:= InstanceID
 else begin
  Repeat
   Application.ProcessMessages;
  until Application.Terminated or (GetModuleUsage(InstanceID) = 0);
  WinExecAndWait:= 32;
 end;
end;

32-битная версия:

function WinExecAndWait32(FileName: String; Visibility: integer):integer;
var
 zAppName:array[0..512] of char;
 zCurDir:array[0..255] of char;
 WorkDir:String;
 StartupInfo:TStartupInfo;
 ProcessInfo:TProcessInformation;
begin
 StrPCopy(zAppName,FileName);
 GetDir(0,WorkDir);
 StrPCopy(zCurDir,WorkDir);
 FillChar(StartupInfo,Sizeof(StartupInfo),#0);
 StartupInfo.cb:= Sizeof(StartupInfo);
 StartupInfo.dwFlags:= STARTF_USESHOWWINDOW;
 StartupInfo.wShowWindow:= Visibility;
 if not CreateProcess(nil,
  zAppName,                      { указатель командной строки }
  nil,                           { указатель на процесс атрибутов безопасности }
  nil,                           { указатель на поток атрибутов безопасности }
  false,                         { флаг родительского обработчика }
  CREATE_NEW_CONSOLE or          { флаг создания }
  NORMAL_PRIORITY_CLASS,
  nil,                           { указатель на новую среду процесса }
  nil,                           { указатель на имя текущей директории }
  StartupInfo,                   { указатель на STARTUPINFO }
  ProcessInfo) then result := –1 { указатель на process_inf }
 else begin
  WaitforSingleObject(ProcessInfo.hProcess,INFINITE);
  GetExitCodeProcess(ProcessInfo.hProcess,Result);
 end;
end;

Получение имени модуля

Вот мое решение. Я использовал его во многих программах и смело рекомендую его вам.

procedure TForm1.Button1Click(Sender: TObject);
var
 szFileName: array[0..49] of char;
 szModuleName: array[0..19] of char;
 iSize : integer;
begin
 StrPCopy(szModuleName, 'NameOfModule');
 iSize:= GetModuleFileName(GetModuleHandle(szModuleName), szFileName, SizeOf(szFileName));
 if iSize > 0 then ShowMessage('Имя модуля с полным путем: ' + StrPas(szFileName))
 else ShowMessage('Имя модуля не встречено');
end;

Извлечение из EXE-файла иконки и рисование ее в TImage.

Каким образом извлечь иконку из EXE– и DLL-файлов (ExtractAssociatedIcon) и отобразить ее на компоненте Timage или небольшой области на форме?

uses ShellApi;
procedure TForm1.Button1Click(Sender: TObject);
var
 IconIndex: word;
 h: hIcon;
begin
 IconIndex:= 0;
 h:= ExtractAssociatedIcon(hInstance, 'C:\WINDOWS\NOTEPAD.EXE', IconINdex);
 DrawIcon(Form1.Canvas.Handle, 10, 10, h);
end;

Паскаль

Массивы

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

Очень простой пример…

Const MaxBooleans = (High(Cardinal) – $F) div sizeof(boolean);
Type
 TBoolArray = array[1..MaxBooleans] of boolean;
 PBoolArray = ^TBoolArray;
Var
 B: PBoolArray;
 N: integer;
BEGIN
 N:= 63579;
 {= получение памяти под динамический массив.. =}
 GetMem(B, N*sizeof(boolean));
 {= работа с массивом… =}
 B^[3477]:= FALSE;
 {= возвращение памяти в кучу =}
 {$IFDEF VER80}
  FreeMem(B, N*sizeof(boolean));
 {$ELSE}
  FreeMem(B);
 {$ENDIF}
END.

Массив в Delphi

Раздел 1

Вот несколько функций для операций с двухмерными массивами. Самый простой путь для создания собственной библиотеки. Процедуры SetV и GetV позволяют читать и сохранять элементы массива VArray (его Вы можете объявить как угодно). Например:

type
 VArray : Array[1..1] of double;
var
 X: ^VArray;
 NR, NC: Longint;
begin
 NR:= 10000;
 NC:= 100;
 if AllocArray(pointer(X), N*Sizeof(VArray)) then exit;
 SetV(X^, NC, 2000, 5, 3.27);    { X[2000,5] := 3.27 }
end;

function AllocArray(var V: pointer; const N: longint): Boolean;
begin        {распределяем память для массива v размера n}
 try
  GetMem(V, N);
 except
  ShowMessage('ОШИБКА выделения памяти. Размер:' + IntToStr(N));
  Result:= True;
  exit;
 end;
 FillChar(V^, N, 0);  {в случае включения длинных строк заполняем их нулями}
 Result:= False;
end;

procedure SetV(var X: Varray; const N,ir,ic: LongInt;const value: double);
begin    {заполняем элементами двухмерный массив x размером ? x n : x[ir,ic] := value}
 X[N*(ir-1) + ic]:= value;
end;

function GetV(const X: Varray; const N, ir,ic : Longint): double;
begin         {возвращаем величины x[ir,ic] для двухмерного массива шириной n столбцов}
 Result:= X[N*(ir-1) + ic];
end;

Раздел 2

Самый простой путь – создать массив динамически

Myarray:= GetMem(rows * cols * sizeof(byte,word,single,double и пр.)

сделайте функцию fetch_num типа

function fetch_num(r,c:integer): single;

result:= pointer + row + col*rows

и затем вместо myarray[2,3] напишите

myarray.fetch_num(2,3)

поместите эти функции в ваш объект и работа с массивами станет пустячным делом. Я экспериментировал с многомерными (вплоть до 8) динамическими сложными массивами и эти функции показали отличный результат.

Раздел 3

Вот способ создания одно– и двухмерных динамических массивов:

(*
--
–- модуль для создания двух очень простых классов обработки динамических массивов
--     TDynaArray   :  одномерный массив
--     TDynaMatrix  :  двумерный динамический массив