unit Unit2;

interface

uses

Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls;

type

TForm1 = class(TForm)

Label1: TLabel;
procedure FormCreate(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);

private

{ Private declarations }


// описание обработчиков событий


// обработка движения колеса мыши
procedure MouseWheel(Sender: TObject; Shift: TShiftState; WheelDelta: Integer; MousePos: TPoint; var Handled: Boolean);


// обработка прокрутки колеса вниз
procedure MouseWheelDown(Sender: TObject; Shift: TShiftState; MousePos: TPoint; var Handled: Boolean);


// обработка прокрутки колеса вверх
procedure MouseWheelUp(Sender: TObject; Shift: TShiftState; MousePos: TPoint; var Handled: Boolean);

public

{ Public declarations }
end;

var

Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);
begin

// Назначаем обработчики для событий:
// движение колеса мыши
Form1.OnMouseWheel:=MouseWheel;

// прокрутка колеса вниз
Form1.OnMouseWheelDown:=MouseWheelDown;

// прокрутка колеса вверх
Form1.OnMouseWheelUp:=MouseWheelUp;

end;

procedure TForm1.MouseWheelDown(Sender: TObject; Shift: TShiftState; MousePos: TPoint; var Handled: Boolean);
begin

// Детекция движения колеса вниз
ShowMessage('Колесо повернуто вниз');
end;

procedure TForm1.MouseWheelUp(Sender: TObject; Shift: TShiftState; MousePos: TPoint; var Handled: Boolean);
begin

// Детекция движения колеса вверх
ShowMessage('Колесо повернуто вверх');
end;

procedure TForm1.MouseWheel(Sender: TObject; Shift: TShiftState; WheelDelta: Integer; MousePos: TPoint; var Handled: Boolean);
begin

// Процедура реакции на движение колеса мыши
ShowMessage('Обнаружено движение колеса мыши...');
end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin

// отменяем обработку событий от колеса мыши
Form1.OnMouseWheel:=nil;
Form1.OnMouseWheelDown:=nil;
Form1.OnMouseWheelUp:=nil;

end;

end.

procedure TForm1.Button1Click(Sender: TObject);

var x: int64;
bit, i: integer;
tp: Uint;
tip: string;

begin
// Вызываем функцию WinAPI
// Функция возвращает битовую маску установленных логических дисков.
// Бит 0 определяет наличие диска А:, бит 1 - диска B и т.д.

x:=GetLogicalDrives();

if x=0 then
memo1.Lines.Add('Функция GetLogicalDrives завершилась неудачей...')
else
begin
memo1.Lines.Add('Логические диски:');

// цикл по полученным битам переменной X
for i:=1 to 64 do
begin

// Накладываем битовую маску для выделения бита с поряковым номером 0
bit:=x and 1;

// нашли логический диск...
if bit=1 then
begin

// определяем тип логического диска
tp:=GetDriveType(PChar(chr(64+i)+':'));

tip:='';
if tp=0 then tip:='drive type cannot be determined';
if tp=1 then tip:='root directory does not exist';
if tp=DRIVE_REMOVABLE then tip:='removable';
if tp=DRIVE_FIXED then tip:='fixed';
if tp=DRIVE_REMOTE then tip:='remote (network)';
if tp=DRIVE_CDROM then tip:='CDROM';
if tp=DRIVE_RAMDISK then tip:='RAM disk';

// преобразуем счетчик в букву диска и выводим в Memo1
memo1.Lines.Add(' '+chr(64+i)+': '+tip);
end;

// побитовый сдвиг вправо
x:= x shr 1;

end;
end;

end;

unit Unit1;

interface

uses

Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
Dialogs,

StdCtrls;

const

// Просто некоторая константа сообщения
PM_COMBO = WM_USER + 8001;

// 500 миллисекунд
CWantedDelay = 500;

type

TForm1 = class(TForm)
ComboBox1: TComboBox;
Label1: TLabel;
procedure ComboBox1(Sender: TObject);
private
procedure PMCombo(var message : TMessage); message PM_COMBO;
public
end;

var

Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.ComboBox1(Sender: TObject);
begin

PostMessage(Handle, PM_COMBO, 0, 0);
end;

procedure TForm1.PMCombo(var message : TMessage);
const

InProc : BOOLEAN = FALSE;
StartTick : LONGINT = 0;
begin

if InProc then begin
// Обновляем стартовое время задержки
StartTick := GetTickCount;

end else begin
// Организация цикла
InProc := TRUE;

// Инициализация стартового времени
StartTick := GetTickCount;

// Ожидаем истечения стартового времени.
// Пока стартовое время не исчерпалось, позволяем операционной системе обрабатывать сообщения
while GetTickCount - StartTick < CWantedDelay do Application.ProcessMessages;

// Иллюстративное приращение счетчика, задающее некоторую реальную работу обработчику события On
Label1.Caption := IntToStr ( StrToIntDef ( Label1.Caption, 0 ) + 1);

// Завершение цикла
InProc := FALSE;
end;
end;

end.

with StringGrid1.Canvas do
begin
{...}
Draw(Rect.Left, Rect.Top, Image1.Picture.Graphic);
{...}
end;

if Col mod 2 = 0 then
grd.Options := grd.Options + [goEditing]
else
grd.Options := grd.Options - [goEditing];

procedure TForm1.StatusBar1DrawPanel(StatusBar: TStatusBar;

Panel: TStatusPanel; const Rect: TRect);
begin

with statusbar1.Canvas do begin
Brush.Color := clRed;
FillRect(Rect);
TextOut(Rect.Left, Rect.Top, 'Панель '+IntToStr(Panel.Index));
end;
end;

procedure TMainForm.ScrollBar1Scroll(Sender: TObject;
ScrollCode: TScrollCode; var ScrollPos: Integer);
begin
ScrollBar2.Position:=ScrollPos;
end;
procedure TMainForm.ScrollBar2Scroll(Sender: TObject;
ScrollCode: TScrollCode; var ScrollPos: Integer);
begin
ScrollBar1.Position := ScrollPos;
end;

procedure Edit1On(...);
var i:integer;
begin
if not updating then exit; {сделайте обновление где-нибудь еще - например при срабатывании таймера}
updating:= false;
Table1.FindNearest([Edit1.text]);
ListBox1.clear;
i:= 0;
while (i < 5) and (not (table1.eof)) do

begin
listbox.items.add(Table1.fields[0].asString);
inc(i);
table1.next;
end;
listbox1.itemindex:= 0;
end;

unit Unit1;
interface
uses

SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls, Forms,
Dialogs;
type

TForm1 = class(TForm)
procedure FormClose(Sender: TObject; var Action: TCloseAction);
private
{}
{ Объявляем свой обработчик сообщения WM_QUERYENDSESSION }
{}
procedure WMQueryEndSession(
var Message: TWMQueryEndSession); message WM_QUERYENDSESSION;
public
{ Public declarations }
end;
var

Form1 : TForm1;

implementation
{$R *.DFM}

{}
{ Создаем процедуру обработки сообщения WM_QUERYENDSESSION. }
{ Приложение получит только это сообщение при попытке Windows }
{ завершить работу }
{}
procedure TForm1.WMQueryEndSession(var Message: TWMQueryEndSession);
begin

inherited; { сначала сообщание должен обработать наследуемый метод }
{}
{ в этой точке вы также можете сообщить Windows о неготовности }
{ приложения завершить работу... }
{ Message.Result:=0; }
{-или}
{ вызов процедуры освобождения ресурсов, предусмотренной в FormClose }
{ MyCleanUpProcedure; }
{}
end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin

MyCleanUpProcedure;
end;

end.