Tips and Trics in Win32API

FAQ по Delphi

Воспользуйтесь свойством KeyValue. Это свойство содержит индекс выбранного пункта. Явное присвоение этому свойству значения выводит в свойство Text выбранный пункт.
Example:
DBLookupComboBox1.KeyValue := 1 // выбираем первый элемент из списка.

Как заставить DBGrid отображать только нужные мне поля таблицы

Ниже представлен код, с помощью которого мы сначала получаем листинг всех полей, а затем добавляем их в DBGrid все кроме первого. Необходимо помнить, что DBGrid ведет себя также как и компонент TTable. То есть, если мы создадим руками хоть одинTField, то оставшиеся поля таблицы будут проигнорированы

procedure ChooseFields(TheTable: TTable);
var
  MyList: TStringList;
  I: Integer;

begin
  MyList := TStringList.Create;

  TheTable.GetFieldNames(MyList);

  ManagerForm.DBGrid.Columns.Clear;

  for I := 1 to MyList.Count - 1 do begin
    ManagerForm.DBGrid.Columns.Add;
    ManagerForm.DBGrid.Columns.Items[I-1].FieldName := MyList[I];
  end;

end;

Могу ли я в коде изменить путь в Alias?

Это не сложно, если знать как. Ключевым словом является ModifyAlias. Это метод объекта TSession. К сожалению автору этих строк не удалось обратиться к объекту TSession, создаваемого по умолчанию, как впрочем и через объект TTable.Session. Пришлось вытащить на форму TSession явно.
...


List := TStringList.Create;
 with List do begin
   Clear;
   Add('PATH='+'Your new path');
 end;
 with dm.MicroLib.Database do begin // Здесь происходит обращение к св-ву

Database таблицы Так как нам очень хочется изменить путь в Alias именно сейчас, а не при повторной загрузке приложения. Применим силовой прием. Маленькое отступление: Ниже следующие ф-ции, я отыскал сразу, но был сильно разочарован так как они меняли путь только на текущую сессию. Но позже эти ф-ции были реабилитированы, когда выяснилось, что ModifyAlias не вносит изменения в текущую сессию, то есть немедленно. Следовательно если мы хотим программно поменять путь то необходимо использовать эти ф-ции вместе.

if DM.MicroLib.Active then begin
     fDbiSetDirectory(DM.MicroLib.DBHandle,PChar(ParamFrm.DataDE.Text));
     fDbiSetDirectory(DM.DipPs.DBHandle,PChar(ParamFrm.DataDE.Text));
   end;
// Здесь мне пришлось использовать компонент TSession
   DM.MySession.ModifyAlias('MAXBASE', List);
   DM.MySession.SaveConfigFile;
 end;

 List.Free;
... 
function fDbiGetDirectory(hDB: hDbiDb): String;
var
  Dir: String;
begin
  SetLength(Dir, dbiMaxPathLen + 1);

  Check(DbiGetDirectory(hDB, False, PChar(Dir)));
  SetLength(Dir, StrLen(PChar(Dir)));
  Result:= Dir;
end;

procedure fDbiSetDirectory(hdb: hDbiDb; Dir: String);
begin
  Check(DbiSetDirectory(hdb, PChar(Dir)));
end;

Win32 API.

Как на TrayIcon создать свою иконку?

Ниже приведен паскалевский файл. Внимательно просмотрите его. Он содержит код приложения позволяющего при сворачивании окна убирать с TaskBar большую кнопку, а вместо нее создавать иконку на Tray. Помимо этого при нажатии правой клавиши мышки над нашей TrayIcon выводится Pop-up меню из двух пунктов, с обработкой.

//------------

unit Main;

interface

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

const
 Msg_FromIcon = WM_USER + 400;

type
  TForm1 = class(TForm)
    Button1: TButton;
    Button2: TButton;
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    Label4: TLabel;
    LParam: TLabel;
    WParam: TLabel;
    Msg: TLabel;
    Result: TLabel;
    Label5: TLabel;
    Label6: TLabel;
    LParamHi: TLabel;

    LParamLo: TLabel;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
  private
    { Private declarations }
  public
{ Public declarations }

  protected
    procedure MyHandler(var Message: TMessage); message Msg_FromIcon;
    procedure WMSYSCOMMAND(var Message: TMessage); message WM_SYSCOMMAND;
    procedure WMCOMMAND(var Message: TMessage); message WM_COMMAND;
 end;

var

  Form1: TForm1;
  Hidden: Boolean;
  hm: HMenu;
  uIDNewItem,uIDNewItem2,uFlags : uINT;

implementation

{$R *.DFM}
{$R Myres.res}

function CreateTaskBarIcon : Boolean ;
var
 nid: TNOTIFYICONDATA;
// hm: HMenu;
// uIDNewItem,uFlags : uINT;
 S : String;
begin

 nid.cbSize := sizeof(TNOTIFYICONDATA);
 nid.Wnd := Form1.Handle;
 nid.uID := 1;
 nid.szTip := 'Моя иконка';
 nid.uFlags := (NIF_ICON OR NIF_MESSAGE OR NIF_TIP);
 nid.uCallbackMessage := Msg_FromIcon;

 nid.hIcon := LoadIcon(hInstance,'myicon');
 result := Shell_NotifyIcon(NIM_ADD, @nid);

// Создание меню
 hm := CreatePopupMenu;

 uFlags := MF_STRING;
 AppendMenu(hm,uFlags,1,PChar('Exit'));
 AppendMenu(hm,uFlags,2,PChar('Win'));

end;

procedure RemoveTaskBarIcon;
var
 nid: TNOTIFYICONDATA;
begin
 nid.cbSize := sizeof(TNOTIFYICONDATA);
 nid.Wnd := Form1.Handle;
 nid.uID := 1;
 Shell_NotifyIcon(NIM_DELETE, @nid);

end;

procedure TForm1.WMCOMMAND(var Message: TMessage);

begin
 inherited;

 with Message do begin
  if WParamHi = 1 then Exit;

  if WParamLo = 1 then begin
    RemoveTaskBarIcon;
    Close;

  end;
  if WParamLo = 2 then ShowMessage('Win');
 end;
end;

procedure TForm1.WMSYSCOMMAND(var Message: TMessage);
begin
 inherited;
 if Message.WParam = SC_MINIMIZE then begin
   CreateTaskBarIcon;

   Form1.Hide;
   Hidden := True;
 end;
end;

procedure TForm1.MyHandler(var Message: TMessage);
var
 P : TPoint;

begin
   LParam.Caption := IntToStr(Message.LParam);
   WParam.Caption := IntToStr(Message.WParam);
   Msg.Caption := IntToStr(Message.Msg);
   Result.Caption := IntToStr(Message.Result);
   LParamHi.Caption := VarToStr(Message.LParamHi);
   LParamLo.Caption := VarToStr(Message.LParamLo);

   if ((Message.LParam <> 513) AND (Message.LParam <> 516)) then Exit;
   if Message.LParam = 513 then begin
     Form1.Show;
     RemoveTaskBarIcon;
     Hidden := False;
   end;

   if Message.LParam = 516 then begin

      GetCursorPos(P);

      TrackPopupMenu(hm,TPM_RIGHTALIGN,P.x,P.y,0,Form1.Handle,Nil);
   end;

end;

procedure TForm1.Button1Click(Sender: TObject);
begin
 CreateTaskBarIcon;

end;


procedure TForm1.Button2Click(Sender: TObject);
begin
 RemoveTaskBarIcon;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
 Hidden := False;
end;

end.

//------------

Как, используя API, создать Pop-up меню?

Смотри пункт Как на TrayIcon создать свою иконку?

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

HANDLE hProcess, hThread;

  if(MessageBox(NULL, "Ну что, повисим ?", "Вопрос", 
                MB_YESNO | MB_ICONQUESTION | MB_SYSTEMMODAL) == IDYES)
   { hProcess = GetCurrentProcess();
     hThread = GetCurrentThread();
     SetPriorityClass(hProcess, REALTIME_PRIORITY_CLASS);
     SetThreadPriority(hThread, THREAD_PRIORITY_TIME_CRITICAL);
HANG:    goto HANG;

Из под какой операционки нас запустили?

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

Есть такая глобальная переменная Win32Platform. В справке перечислены ее значения. А так можно узнать объем Физ. памяти

var
  MS: TMemoryStatus;

MS.dwLength := SizeOf(TMemoryStatus);
GlobalMemoryStatus(MS);
PhysMem.Caption := FormatFloat('#,###" KB"', MS.dwTotalPhys div 1024);

Подробный пример можно найти в демосах по адресу Delphi 3\Demos\Coolstuf

Разное.

Несколько слов об операторе присваивания

var
I,J: Integer;

I := 5;
J := I;

В выше приведенном примере все ясно. Но как быть с этим кодом?

Type
TSomeArray: array[0..5] of Integer;
var
A1,A2,A3: TSomeArray;
implementation
...
A1[3] := 77
A2 := A1;
A3 := A1;

Неужели A1,A2,A3 ссылаются на один и тот же участок памяти? Вовсе нет. Происходит операция копирования. Но это возможно только благодаря тому что A1,A2,A3 переменные некого типа а не являются массивами явно.

Если же мы хотим передать адрес то напишем так:

A2 := @A1;

Теперь обе переменные ссылаются на один участок памяти.

Как создать динамический массив?

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

Dynamic Arrays

Is it possible to create a dynamically-sized array in Delphi?

Yes. First, you need to create an array type using the largest size you might possibly need. When creating a type, no memory is actually allocated. If you created a variable of that type,

then the compiler will attempt to allocate the necessary memory for you. Instead, create a variable which is a pointer to that

type. This causes the compiler to only allocate the four bytes needed for the pointer.

Before you can use the array, you need to allocate memory for it. By using AllocMem, you will be able to control exactly how many bytes are allocated. To determine the number of bytes you'll need to allocate, simply multiply the array size you

want by the size of the individual array element. Keep in mind that the largest block that can be allocated at one time in a

16-bit environment is 64KB. The largest block that can be allocated at one time in a 32-bit environment is 4GB. To determine the maximum number of elements you can have in your particular array (in a 16-bit environment), divide 65,520 by the size of the individual element. Example: 65520 div SizeOf(LongInt)

Example of declaring an array type and pointer:

  type
    ElementType = LongInt;

  const
    MaxArraySize = (65520 div SizeOf(ElementType));

      (* under a 16-bit environment *)

  type
    MyArrayType = array[1..MaxArraySize] of ElementType;

  var
    P: ^MyArrayType;

  const
    ArraySizeIWant: Integer = 1500;

  Then when you wish to allocate memory for the array, you could
  use the following procedure:

  procedure AllocateArray;
  begin
    if ArraySizeIWant <= MaxArraySize then
      P := AllocMem(ArraySizeIWant * SizeOf(LongInt));

  end;

  Remember to make sure that the value of ArraySizeIWant is less

  than or equal to MaxArraySize.

  Here is a procedure that will loop through the array and set a
  value for each member:

  procedure AssignValues;
  var
    I: Integer;
  begin
    for I := 1 to ArraySizeIWant do
      P^[I] := I;
  end;

Keep in mind that you must do your own range checking. If you have allocated an array with five members and you try to assign a value to the sixth member of the array, you will not receive an error message. However, you will get memory corruption. Remember that you must always free up any memory that you allocate. Here is an example of how to dispose of this array:

  procedure DeallocateArray;
  begin
    P := AllocMem(ArraySizeIWant * SizeOf(LongInt));
  end;

  Below is an example of a dynamic array:

  }

  unit Unit1;

  interface

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

  type
    ElementType = Integer;

  const

    MaxArraySize = (65520 div SizeOf(ElementType));
      { in a 16-bit environment }

  type
    { Create the array type.  Make sure that you set the range to
      be the largest number you would possibly need. }
    TDynamicArray = array[1..MaxArraySize] of ElementType;
    TForm1 = class(TForm)
      Button1: TButton;
      procedure FormCreate(Sender: TObject);
      procedure Button1Click(Sender: TObject);
      procedure FormDestroy(Sender: TObject);

    private

      { Private declarations }
    public
      { Public declarations }
    end;

  var
    Form1: TForm1;
    { Create a variable of type pointer to your array type. }
    P: ^TDynamicArray;

  const
    { This is a typed constant.  They are actually static
      variables hat are initialized at runtime to the value taken
      from the source code.  This means that you can use a typed
      constant just like you would use any other variable.  Plus

      you get the added bonus of being able to automatically

      initialize it's value. }
    DynamicArraySizeNeeded: Integer = 10;

  implementation

  {$R *.DFM}

  procedure TForm1.FormCreate(Sender: TObject);
  begin
    { Allocate memory for your array.  Be very careful that you
      allocate the amount that you need.  If you try to write
      beyond the amount that you've allocated, the compiler will
      let you do it.  You'll just get data corruption. }

    DynamicArraySizeNeeded := 500;
    P := AllocMem(DynamicArraySizeNeeded * SizeOf(Integer));

    { How to assign a value to the fifth member of the array. }
    P^[5] := 68;
  end;

  procedure TForm1.Button1Click(Sender: TObject);
  begin
    { Displaying the data. }
    Button1.Caption := IntToStr(P^[5]);
  end;

  procedure TForm1.FormDestroy(Sender: TObject);
  begin
    { Free the memory you allocated for the array. }
    FreeMem(P, DynamicArraySizeNeeded * SizeOf(Integer));

  end;

  end.

DISCLAIMER: You have the right to use this technical information subject to the terms of the No-Nonsense License Statement that you received with the Borland product to which this information pertains.

Каким образом дождаться завершения работы MS DOS приложения ?

Скомпилируйте, приведенный ниже код, и включите его в Uses. Затем обращайтесь к последней функции этого модуля.

// ------------------------------- //

unit myShell;
interface
uses Windows,forms,Messages,Classes, Graphics, SysUtils, Controls, Menus, ShellAPI;
function FileExecute(const FileName, Params, StartDir: string;
  InitialState: integer): THandle;
function FileExecuteWait(const FileName, Params, StartDir: string;
  InitialState: integer): Integer;
implementation
(SW_SHOWNORMAL, SW_MINIMIZE, SW_SHOWMAXIMIZED, SW_HIDE)
}
function FileExecute(const FileName, Params, StartDir: string;
  InitialState: integer): THandle;

begin
  Result := ShellExecute(Application.Handle, nil, PChar(FileName),
    PChar(Params), PChar(StartDir), InitialState);
end;
function FileExecuteWait(const FileName, Params, StartDir: string;
  InitialState:integer): Integer;
var
  Info: TShellExecuteInfo;
  ExitCode: DWORD;
begin
  FillChar(Info, SizeOf(Info), 0);
  Info.cbSize := SizeOf(TShellExecuteInfo);
  with Info do begin
    fMask := SEE_MASK_NOCLOSEPROCESS;
    Wnd := Application.Handle;
    lpFile := PChar(FileName);

    lpParameters := PChar(Params);
    lpDirectory := PChar(StartDir);
    nShow :=InitialState;
  end;
  if ShellExecuteEx(@Info) then begin
    repeat
      Application.ProcessMessages;
      GetExitCodeProcess(Info.hProcess, ExitCode);
    until (ExitCode <> STILL_ACTIVE) or Application.Terminated;
    Result := ExitCode;
  end
  else Result := -1;
end;
end.
// ------------------------------- //

Базы данных.

Win32 API.

Разное.

Базы данных.

Win32 API.

Разное.