Когда пишут про сокетное программирование, конечно же, подразумевается TCP/IP. Вот тут мы и отступим от правил, поговорим про IPX/SPX.

---

А все начинается как всегда, а именно, с инициализации WINSOCK библиотеки, обработка ошибок упускается для упрощения кода:

Код

#include <winsock.h> // прототипы функции библиотеки
#include <wsipx.h> // IPX/SPX структуры
#include <wsnwlink.h> // IPX/SPX структуры и константы для NT платформ

void main ()
{
WSADATA wsaData;

// версия winsock.dll библиотеки
WORD wVersionRequested = MAKEWORD( 1, 1 );

// инициализация winsock.dll
WSAStartup( wVersionRequested, &wsaData );

// работа с сокетами



WSACleanup( ); // не забываем сообщить системе, что мы закончили работу с winsock.dll
}

Ну и собственно сокет, тут я дам только кусок, отличный от нормальных сокетов:

Код

WORD SPX_SOCKET = 0x5647

char localNetNum[IPX_NET_SIZE];
char localNodeNum[IPX_NODE_SIZE];

// открытие сокета
SOCKET spx_skt = socket (PF_IPX, SOCK_STREAM, NSPROTO_SPX));

// проверим если открылся
if (spx ==INVALID_SOCKET) MessageBox (NULL, Ошибка открытия сокета., "Error", MB_OK);
// структура для адресса нашего сокета
sockaddr_ipx addr_ipx;

/* вот так выглядит структура sockaddr_ipx в WSIPX.H
typedef struct sockaddr_ipx {
u_short sa_family;
u_char sa_netnum[4];
u_char sa_nodenum[6];
unsigned short sa_socket;

} SOCKADDR_IPX, *PSOCKADDR_IPX, FAR *LPSOCKADDR_IPX
*/

int sz = sizeof (addr_ipx);

// обнулим её
memset (&addr_ipx, 0, sz);

addr_ipx.sa_family = AF_IPX; // тип протокола
addr_ipx.sa_socket = htons(SPX_SOCKET); // номер сокета

// биндим сокет (привязываем его к номеру сокета)
bind(spx_skt, (sockaddr*) &addr_ipx, sz);
// узнаем наш адресс
getsockname (spx_skt, (sockaddr*) &addr_ipx, &sz);

// наш номер сети
memcpy (localNetNum, addr_ipx.sa_netnum, IPX_NET_SIZE);
// нашномер узла
memcpy (localNodeNum, addr_ipx.sa_nodenum, IPX_NODE_SIZE);

В остальном, работа с SPX идентична работе TCP сокетов, все выше написанное справедливо и для IPX сокетов, только не забудьте, что последние нельзя законнектить. Открываются они следующим образом:

Код

SOCKET ipx_skt = socket (PF_IPX, SOCK_DGRAM, NSPROTO_IPX);

Передача данных происходит следующим образом:

Код

// структура для хранения удалённого адреса
sockaddr_ipx addr_ipx;

// обнуляем её, хотя это не всегда нужно, но и никогда не мешает
memset (&addr_ipx, 0, sizeof (addr_ipx));

// тип протокола
addr_ipx.sa_family = AF_IPX;

// номер сокета
addr_ipx.sa_socket = htons(SOCKET_NR);

// удалённый номер сети
memcpy (addr_ipx.sa_netnum, remoteNetNum, IPX_NET_SIZE);
// удалённый номер узла
memcpy (addr_ipx.sa_nodenum, remoteNodeNum, IPX_NODE_SIZE);

char* buff = Test string;

// вот и, собственно, передача данных
sendto (ipx_skt, buff, strlen (buff), 0, (sockaddr*)&addr_ipx, sizeof (addr_ipx));

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

Приём заголовка пакета данных

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

Код

// первый вариант нужен wsnwlink.h
int rcv_header = 1;

setsockopt (spx_skt, NSPROTO_IPX, IPX_RECVHDR, (char*)&rcv_header, sizeof (rcv_header));

// второй вариант только для SPX протокола
int rcv_header = 1;

setsockopt (spx_skt, NSPROTO_SPX, SPX_RAWSPX, (char*)&rcv_header, sizeof (rcv_header));

А вот вам и структура заголовка SPX пакета, взято из WSIPX.H

Код

/* WSSpxHeader -- SPX Header structure when in SPXL_SPXRAW mode. */

typedef struct WSSpxHeaderStruc
{
WSIpxHeader IpxHdr; // 0x00
u_char ConnCtrl; // 0x1E
u_char DataStreamType; // 0x1F
u_short SrcConnId; // 0x20
u_short DstConnId; // 0x22
u_short SendSeq; // 0x24
u_short AckSeq; // 0x26
u_short AllocNum; // 0x28
} WSSpxHeader, *PWSSpxHeader,FAR *LPWSSpxHeader; // 0x2A (42)

В данном режиме Windows Sockets не будут сегментировать пакеты, ограничивая их размер до максимально допустимого протоколом.

Широковещательные пакеты

Широковещательные пакеты могут быть использованы, например, в качестве средства "принюхивания" клиента к серверу, это в случае, когда мы знаем порт нужного нам сервера, но не знаем его сетевого адресса.

Код

sockaddr_ipx addr_ipx;

char* broadcast_msg = Some broadcast stuff;

SOCKET ipx_skt = socket (PF_IPX, SOCK_DGRAM, NSPROTO_IPX);

addr_ipx.sa_family = AF_IPX;

// номер сокета, данный номер используется посылки SAP пакетов в нетваре сетях
addr_ipx.sa_socket = htons (0x0452); // = IPXSKT_SAP

// для широковещательных пакетов
memset (addr_ipx.sa_netnum, 0, IPX_NET_SIZE);
memset (addr_ipx.sa_nodenum, 0xff, IPX_NODE_SIZE);

// устанавливаем флаг для посылки широковещательных пакетов
int set_broadcast = 1;
setsockopt (ipx_skt, SOL_SOCKET, SO_BROADCAST, (char*)& set_broadcast, sizeof (set_broadcast));

// ну и, собствено, само вещание
sendto (ipx_skt, broadcast_msg, strlen (broadcast_msg), MSG_DONTROUTE, (sockaddr*)&addr_ipx, sizeof (addr_ipx));

Установка, изменение DataStreamType в заголовке SPX пакета

Это может быть использовано в собственных целях, например, для искусственной сегментации своих данных для совместимости разных реализаций протокола. Например, некоторые реализации протокола для DOS поддерживают максимальную длину пакета в 512 байт либо принудительно ограниченную сетевыми модулями, вот они и используют DataStreamType, чтобы указать последнюю порцию данных.

Устанавливается следующим образом:

Код

// Можно использовать любое значение между 0 - 0xfd
// следующие значения зарезервированы
// #define SPX_HANG_UP 0xFE
// #define SPX_HANG_UP_ACK 0xFF
int stream_type = 0x05;

setsockopt (spx_skt, NSPROTO_IPX, IPX_DSTYPE, (char*)&stream_type, sizeof(stream_type);

Причём данную установку надо делать перед каждым send. Работает всё ОК, когда посылаются данные ДОС клиенту, ну а при приеме пакетов WIN клиентом от ДОС клиент DataStreamType не хочет устанавливатся, т.е. мы не получим установленное значение DataStreamType ДОС клиентом. Я обошел данную проблему при помощи следующего куска кода:

Код

int rcv; // количество принятых байтов за один recv
int rcv_total = 0; // общее количество принятых бйтов

do{
// прием данных
rcv = recv (spx_socket, rd_buffer + rcv_total, MAX_BUF_SIZE - rcv_total, 0);

if (rcv > 0) rcv_total += rcv; // если мы что-то получили

}while (rcv > 0); // пока принимаются данные

Данный метод хорош еще тем, что WIN клиент может принять один пакет вместо нескольких, посланных ДОС клиентом.

Другие специфические расширения для данных протоколов, используемые getsockopt/setsockopt, можно найти в файле wsnwlink.h, но, как упоминалось выше, данные расширения - для NT-платформ и могут не работать для других реализаций данных протоколов.

Очень часто при работе с запросами приходится менять SQL этого запроса. Например, при изменении порядка сортировки или при необходимости изменения фильтра, прописанного в where. Сделать это стандартными средствами можно, но довольно муторно, т.к. весь запрос хранится в одном месте (для TQuery и её потомков это свойство Sql). При желании изменить, например, количество или порядок следования полей в order by, нужно программно найти этот order by, написать свой, вставить его вместо старого и т.д. Для меня, честно говоря, загадка, зачем борланд пошла по такому ущербному пути: стандарт ANSI SQL-92, с которым (и только с которым!) работает Bde, подразумевает достаточно жёсткий синтаксис запроса, вполне допускающий обработку на уровне отдельных секций. Сегодня я хотел бы поделиться одним из вариантов реализации потомка TQuery, в котором задачи такого класса будут решаться на лету одной строчкой кода.

---

Смысл очень простой. Для того, чтобы уйти от ручной обработки текста sql-запроса, надо просто разбить его на стандартные секции. И менять их по отдельности. Ведь любой select-запрос имеет достаточно строгий синтаксис, состоя из определённого количества заранее известных секций (clauses), задаваемых в строго определённой последовательности. Рассмотрим этот синтаксис поподробнее на примере СУБД Interbase:

Код

SELECT
[TRANSACTION transaction]
[DISTINCT | ALL]
{* | <val> [, <val> ]}
[INTO :var [, :var ]]
FROM [, ...]
[WHERE <search_condition>]
[GROUP BY col [COLLATE collation] [, col [COLLATE collation] ]
[HAVING <search_condition>]
[UNION <select_expr> [ALL]]
[PLAN ]
[ORDER BY <order_list>]
[FOR UPDATE [OF col [, col ]]];

Как видим, обязательными являются две секции: SELECT и FROM.
Ещё восемь секций опциональны. Наша задача сводится к тому, чтобы значение каждой секции устанавливать отдельно, при необходимости переоткрывая запрос. Можно было бы плясать от стандартного свойства Sql, выделять нужную секцию, менять и вставлять обратно. Но зачем это, если можно сам Sql формировать на основе заданных секций? Конечно, этот подход имеет тот минус, что накрывается прямая установка Sql одной строкой, что может быть неудобно при хранении запроса в реестре, базе и т.д., но и это, при желании, можно побороть.
В общем-то, ничего заумного, реализация до смешного проста, но при использовании в проектах позволяет сэкономить массу времени и значительно увеличить читабельность кода.

Реализация

Для начала определим все секции:

const
ciClauseCount = 10;
caClauses: array [1..ciClauseCount] of string = ('SELECT',
'INTO',
'FROM',
'WHERE',
'GROUP BY',
'HAVING',
'UNION',
'PLAN',
'ORDER BY',
'FOR UPDATE');

Чтобы не писать отдельное свойство на каждую секцию, задавать их будем в виде массива строк. Для работы с этим массивом нам понадобятся индексы, которые тоже лучше определить заранее:

const
ciSelect = 1;
ciInto = 2;
ciFrom = 3;
ciWhere = 4;
ciGroupBy = 5;
ciHaving = 6;
ciUnion = 7;
ciPlan = 8;
ciOrderBy = 9;
ciForUdate = 10;

Определим тип нашего индексированного свойства и определим сам класс:

Код

type
TClauseArray = array [1..ciClauseCount] of string;
TDynQuery = class (TQuery)
private fClauses: TClauseArray;
procedure UpdateSql;
procedure SetClause(Index: integer; Value: string);
function GetClause (Index: integer): string; public
property Clause [Index: integer]:
string read GetClause write SetClause;
end;

Свойство fClauses будет содержать все секции запроса, на основе которых и будет формироваться сам запрос. Занимается этим процедура UpdateSql. Ну а методы GetClause/SetClause стандартны, и служат для установки/чтения значений отдельных секций. Поглядим на сам код:

Код

{ TDynQuery }
procedure TDynQuery.UpdateSql;
var
OldActive: boolean;
i: integer;
begin
DisableControls;
try
OldActive := Active;
Sql.Clear;
for i := 1 to ciClauseCount do begin
if fClauses [i] <> '' then
Sql.Add (caClauseNames [i] + ' ' + fClauses [i]);
end;
Active := OldActive;
finally
EnableControls;
end;
end;
function TDynQuery.GetClause (Index: integer): string;
begin
Result := fClauses [index];
end;
procedure TDynQuery.SetClause(Index: integer; Value: string);
begin
if fClauses [Index] <> Value then begin
fClauses [Index] := Value;
UpdateSql;
end;
end;

Всё достаточно прозрачно, отмечу лишь, что метод UpdateSql добавляет в текст Sql-запроса только те секции, для которых установлено начение, и переоткрывает квери, если она была открыта на момент изменения секции. Здесь есть мелкие недоработки, например, не проверяется выход индекса за пределы допустимых значений, я просто не хотел мусорить исходный код вещами, которые очевидны и принципиально не важны. Можно было бы привести код регистрации компонента в палире дельфи, но это также тривиально. Приведу лучше исходник тестового проекта, в котором используется этот квери. В этом проекте на форме находятся компоненты DbGrid1, подключенные к источнику данных DataSource1, динамически создаётся экземпляр TDynQuery, открывающий таблицу "biolife" из DbDemos, входящую в стандартную поставку Delphi. После этого изменяется по кликанью на заголовке (Title) грида меняется сортировка таблицы:

Код

unit Unit1;


interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, DB, Grids, DBGrids, DBTables, StdCtrls, DynQuery;

type
TForm1 = class(TForm)
DataSource1: TDataSource;
DBGrid1: TDBGrid;
procedure FormCreate(Sender: TObject);
procedure DBGrid1TitleClick(Column: TColumn);
private
Query1: TDynQuery;
public
{ Public declarations }
end;

var
Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);
begin
Query1 := TDynQuery.Create (Self);
DataSource1.DataSet := Query1;
Query1.DatabaseName := 'DbDemos';
Query1.Clause [ciSelect] := '*';
Query1.Clause [ciFrom] := '"biolife" b';
Query1.Clause [ciOrderBy] := 'b."category"';
Query1.Active := TRUE;
end;

Комбинации клавиш быстрого вызова Media Player

---

CTRL P: Воспроизведение файла или пауза.

CTRL S: Остановить воспроизведение.

CTRL B: Воспроизвести предыдущую запись.

CTRL F: Воспроизвести следующую запись.

CTRL ALT B: Перемотка (только DVD).

CTRL SHIFT F: Быстрая прокрутка вперед (только DVD).

CTRL E: Извлечь CD или DVD (не работает на компьютерах с несколькими накопителями CD-ROM или DVD).

CTRL U: Открыть URL или файл.

ALT ENTER: Показывать видео в полноэкранном режиме.

CTRL 1: Переключиться из режима «кожи» в полный режим.

CTRL 2: Переключиться из полного режима в режим «кожи».

CTRL M: Показать панель меню в режиме полноэкранного воспроизведения.

ALT S: Поиск в библиотеке Media Library.

F8: Отключить звук.

F9: Уменьшить громкость.

F10: Увеличить громкость.

Для повышенной степени безопасности машины пользователям следует нажимать клавиши CTRL ALT DEL в процессе входа (чтобы предотвратить захват системы «троянскими конями») и отключить режим автоматического отображения имени последнего пользователя в окне регистрации.

---

Запустите редактор Regedit и перейдите в раздел HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows\CurrentVersion\Policies\System.

Найдите или создайте элемент типа DWORD с именем Don’tDisplayLastUserName и присвойте ему значение 1.

В разделе HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows NT\CurrentVersion\Winlogon найдите или создайте элемент типа DWORD с именем DisableCAD и присвойте ему значение 0. Обратите внимание, что необходимо использовать процедуру регистрации по образцу Windows 2000.

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

---

Создайте ярлык для любой программы или папки по своему выбору. Щелкните на ярлыке правой клавишей мыши и выберите из меню пункт Properties.

Обратите внимание на текстовое поле Shortcut keys. Щелкните на нем, нажмите клавиши CTRL или ALT либо обе вместе и одновременно нажмите другую клавишу (например, CTRL ALT J).

Щелкните на кнопке OK. Теперь для быстрого вызова этой программы или папки достаточно нажать комбинацию клавиш.

К сожалению, возможности переименования нескольких файлов одной командой в Windows Explorer ограниченны.

---

Сначала нужно выделить файлы, которые необходимо переименовать. Если файлы расположены непоследовательно, то следует щелкать на именах файлов, удерживая клавишу CTRL, затем нажать клавишу F2 и ввести новое имя.

Все файлы получают одинаковое имя и разные последовательные номера. Переименование можно отменить для каждого файла в отдельности, нажимая CTRL Z. Заметим, что нельзя изменить расширения сразу нескольких файлов, можно лишь поменять имя каждого файла слева от расширения.

Мы не устаем напоминать о пользе клавишных комбинаций быстрого вызова. Несомненно, многие операции с клавиатуры выполняются быстрее, чем мышью. Мы составили список наиболее полезных комбинаций клавиш.

---

CTRL ESC: Выводит на экран меню Start (если на клавиатуре нет клавиши с логотипом Windows).

ALT ESC, ALT SHIFT ESC: Циклическое переключение между окнами всех открытых программ в обоих направлениях. Удерживая нажатыми клавиши ALT или ALT SHIFT, нажимайте ESC необходимое число раз.

ALT TAB: Циклическое переключение между пиктограммами окон открытых программ для выбора какой-то из них. Удерживая клавишу ALT, нажимайте TAB для перехода от одной программы к другой. Чтобы активизировать нужную программу, следует отпустить обе клавиши.

CTRL F6 или CTRL SHIFT F6: Циклическое переключение в обоих направлениях между окнами всех открытых документов одной программы, например Microsoft Word.

SHIFT DEL: Действительно удаляет файлы, а не просто помещает их в Корзину.

SHIFT и любая клавиша со стрелкой: Выделение нескольких последовательных элементов в списке или файлов в папке.

CTRL A: Выделение всех объектов.

В приведенном примере показано как отследить (обнаружить) движение колеса мыши.

---

Принцип работы прост - на события OnMouseWheel, OnMouseWheelDown, OnMouseWheelUp вешаются соответствующие процедуры-обработчики.

Код

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.

В случае нажатия пользователем клавиши или изменении текущего элемента компонента ComboBox, вы обратите внимание на досадную задержку, возникающую при генерации события On.

---

Так как "работа кипит", я хотел бы отреагировать на изменение ItemIndex несколько позднее, например, 100 миллисекунд спустя. Вот что у меня получилось. На простой форме располагаем компоненты ComboBox и Label. Необходимым дополнением является вызов Application.ProcessMessages, позволяющий избежать замедления работы PC, когда очередь сообщений для формы пуста.

Код

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.

Я несколько раз видел в конференциях вопросы типа "как мне добавить элементы управления в TTabbedNotebook или TNotebook во время выполнения программы?". Теперь, когда у меня выдалось несколько свободных минут, я попытаюсь осветить этот вопрос как можно подробнее.

---

TTabbedNotebook

Добавление элементов управления в TTabbedNotebook во время проектирования - красивая и простая задача. Все, что Вам нужно - это установить свойство PageIndex или ActivePage на необходимую страницу и начать заполнять ее элементами управления.

Добавление элементов управление во время выполнения приложения также очень просто. Тем не менее, в прилагаемой документации по Delphi вы не найдете рецептов типа Что-и-Как. Видимо для того, чтобы окончательно запутать начинающих программистов, фирма-изготовитель даже не удосужилась включить исходный код TTabbedNotebook в VCL-библиотеку. Таким образом, TTabbedNotebook остается для некоторых тайной за семью печатями. К счастью, я имею некоторый опыт, коим и хочу поделиться.

Первым шагом к раскрытию тайны послужит просмотр файла DELPHIDOCTABNOTBK.INT, интерфейсной секции модуля TABNOTBK.PAS, в котором определен класс TTabbedNotebook. Беглый просмотр позволяет обнаружить класс TTabPage, описанный как хранилище элементов управления отдельной страницы TTabbedNotebook.

Вторым шагом в исследовании TTabbedNotebook может стать факт наличия свойством Pages типа TStrings. В связи с этим отметим, что Delphi-классы TStrings и TStringList соорганизуются с двумя свойствами: Strings и Objects. Другими словами, для каждой строки в TStrings есть указатель на соответствующий Objects. Во многих случаях этот дополнительный указатель игнорируется, нам же он очень пригодится.

После небольшого эксперимента выясняем, что свойство Objects указывает на нашу копию TTabPage и ссылается на имя страницы в свойстве Strings. Блестяще! Всегда полезно знать что ищешь. Теперь посмотрим что мы можем сделать:

Код

{ Данная процедура добавляет кнопку в случайной позиции на }
{ текущей странице данного TTabbedNotebook. }

procedure AddButton(tabNotebook : TTabbedNotebook);
var

tabpage : TTabPage;
button : TButton;
begin

with tabNotebook do
tabpage := TTabPage(Pages.Objects[PageIndex]);
button := TButton.Create(tabpage);
try
with button do begin
Parent := tabpage;
Left := Random(tabpage.ClientWidth - Width);
Top := Random(tabpage.ClientHeight - Height);
end;
except
button.Free;
end;
end;

TNotebook

Операция по заполнению элементами управления компонента TNotebook почти такая же, как и в TTabbedNotebook - разница лишь в типе класса - TPage вместо TTabPage. Тем не менее, если вы заглянете в DELPHIDOCEXTCTRLS.INT, декларацию класса TPage вы там не найдете. По неизвестной причине Borland не включил определение TPage и в DOC-файлы, поставляемые с Delphi. Декларация TPage в EXTCTRLS.PAS (можно найти в библиотеке VCL-исходников), правда, расположена в интерфейсной части модуля. Мы восполним пропущенную информацию о классе TPage:

Код

TPage = class(TCustomControl)
private
procedure WMNCHitTest(var Message: TWMNCHitTest); message WM_NCHITTEST;
protected
procedure ReadState(Reader: TReader); override;
procedure Paint; override;
public
constructor Create(AOwner: TComponent); override;
published
property Caption;
property Height stored False;
property TabOrder stored False;
property Visible stored False;
property Width stored False;
end;

Теперь, по аналогии с вышеприведенной процедурой, попробуем добавить кнопку на TNotebook. Все, что мы должны сделать - заменить "TTabbedNotebook" на "TNotebook" и "TTabPage" на "TPage". Вот что должно получиться:

Код

{ Данная процедура добавляет кнопку в случайной позиции на }
{ текущей странице данного TNotebook. }

procedure AddButton(Notebook1 : TNotebook);
var

page : TPage;
button : TButton;
begin

with Notebook1 do
page := TPage(Pages.Objects[PageIndex]);
button := TButton.Create(page);
try
with button do begin
Parent := page;
Left := Random(page.ClientWidth - Width);
Top := Random(page.ClientHeight - Height);
end;
except
button.Free;
end;
end;

У меня есть форма с расположенными на ней компонентами TreeView и Memo. Значение свойства align обоих компонентов позволяет им занимать всю форму. Я хотел бы расположить между ними движок типа Splitter, пропорционально меняющий их размеры (один шире, другой меньше и наоборот). Какой компонент мог бы симитировать поведение Splitter и как это реализовать?

---

Предположим, Ваш TreeView расположен в левой, а Memo в правой части формы. Вам нужно сделать следующее:

* Установите свойство Align компонента TreeView на alLeft.
* Вырежьте (Ctrl-X) компонент TMemo из вашей формы.
* Добавьте компонент Panel и присвойте его свойству Align значение alClient.
* Внутри панели разместите другой компонент Panel.
* Установите его ширину, равной 8 пикселам, свойству Align присвойте значение alLeft.
* Скопируйте вырезанный компонент TMemo в панель Panel1 и присвойте свойству Align значение alClient.

Код может быть модифицирован для получения горизонтального движка - идея, надеюсь, будет вам понятна.

Panel2 - движок: теперь вам необходимо добавить процедуры, приведенные ниже. Ваш код будет выглядеть приблизительно так:

Код

type

TForm1 = class(TForm)
TreeView1: TTreeview;
Panel1: TPanel;
Panel2: TPanel;
Memo1: TMemo;
procedure Panel1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure Panel1MouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure Panel1MouseMove(Sender: TObject; Shift:TShiftState;
X, Y: Integer);
private
Resizing: Boolean;
public
...
end;

procedure TForm1.Panel2MouseDown(Sender: TObject; Button:

TMouseButton; Shift: TShiftState; X, Y: Integer);
begin

Resizing:=true;
end;

procedure TForm1.Panel2MouseUp(Sender: TObject; Button: TMouseButton;

Shift: TShiftState; X, Y: Integer);
begin

Resizing:=false;
end;

procedure TForm1.Panel2MouseMove(Sender: TObject; Shift: TShiftState;

X, Y: Integer);
begin

if Resizing then begin
TreeView1.Width:=TreeView1.Width+X;
// Предохранение от странных ошибок перерисовки при изменении размеров:
Panel1.Invalidate;
end;
end;

Один из примеров создания текстового компонента с трехмерной декоративной контурной рамкой (для создания компонента потребовалось около получаса. Он демонстрирует только принцип получения рамки. Я не стал колдовать над свойствами типа ParentFont..., т.к. это заняло бы еще немало времени и места).

---

Код

unit IDSLabel;

interface

uses

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

ExtCtrls;

type
TIDSLabel = class(TBevel)
private
{ Private declarations }
FAlignment : TAlignment;
FCaption : String;
FFont : TFont;
FOffset : Byte;

FOn : TNotifyEvent;

procedure SetAlignment( taIn : TAlignment );
procedure SetCaption( const strIn : String);
procedure SetFont( fntNew : TFont );
procedure SetOffset( bOffNew : Byte );
protected
{ Protected declarations }
constructor Create( compOwn : TComponent ); override;
destructor Destroy; override;
procedure Paint; override;
public
{ Public declarations }
published
{ Published declarations }
property Alignment : TAlignment read FAlignment write SetAlignment default taLeftJustify;
property Caption : String read FCaption write SetCaption;
property Font : TFont read FFont write SetFont;
property Offset : Byte read FOffset write SetOffset;

property On : TNotifyEvent read FOn write FOn;
end;

implementation

constructor TIDSLabel.Create;
begin

inherited Create(compOwn);

FFont := TFont.Create;
with compOwn as TForm do
FFont.Assign(Font);

Offset := 4;
Height := 15;
end;

destructor TIDSLabel.Destroy;
begin

FFont.Free;

inherited Destroy;
end;

procedure TIDSLabel.Paint;
var

wXPos, wYPos : Word;
begin

{Рисуем рамку}
inherited Paint;

{Назначаем шрифт}
Canvas.Font.Assign(Font);

{Вычисляем вертикальную позицию}
wYPos := (Height - Canvas.TextHeight(Caption)) div 2;

{Вычисляем горизонтальную позицию}
wXPos := Offset;
case Alignment of
taRightJustify: wXPos := Width - Canvas.TextWidth(Caption) - Offset;
taCenter: wXPos := (Width - Canvas.TextWidth(Caption)) div 2;
end;
Canvas.Brush := Parent.Brush;
Canvas.TextOut(wXPos,wYPos,Caption);

end;

procedure TIDSLabel.SetAlignment;
begin

FAlignment := taIn;
Invalidate;
end;

procedure TIDSLabel.SetCaption;
begin
FCaption := strIn;


if Assigned(FOn) then
FOn(Self);


Invalidate;
end;

procedure TIDSLabel.SetFont;
begin

FFont.Assign(fntNew);
Invalidate;
end;

procedure TIDSLabel.SetOffset;
begin

FOffset := bOffNew;
Invalidate;
end;

end.

Приведенный ниже код содержит функцию DuplicateComponents, позволяющую проводить клонирование любых компонентов и их потомков во время выполнения приложения. Действия ее напоминают операцию копирования/вставки (copy/paste) во время разработки приложения.

---

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

Данная функция может оказаться весьма полезной в случае наличия нескольких одинаковых областей на форме с необходимостью синхронизации изменений в течение некоторого промежутка времени. Процедура создания дубликата проста до безобразия: разместите на TPanel или на другом родительском компоненте необходимые элементы управления и сделайте: "newpanel := DuplicateComponents(designedpanel)".

Код

uses

SysUtils, Windows, Messages, Classes, Graphics, Controls,
Forms, Dialogs, ExtCtrls, StdCtrls, IniFiles, TypInfo, Debug;

type

TUniqueReader = Class(TReader)
LastRead: TComponent;
procedure ComponentRead(Component: TComponent);
procedure SetNameUnique(
Reader: TReader;
Component: TComponent;
var Name: string
);
end;

implementation

procedure TUniqueReader.ComponentRead(

Component: TComponent
);
begin

LastRead := Component;
end;

procedure TUniqueReader.SetNameUnique( // Задаем уникальное имя считываемому компоненту

Reader: TReader;
Component: TComponent; // Считываемый компонент
var Name: string // Имя компонента для дальнейшей модификации
);
var

i: Integer;
tempname: string;
begin

i := 0;
tempname := Name;
while Component.Owner.FindComponent(Name) <> nil do begin
Inc(i);
Name := Format('%s%d', [tempname, i]);
end;
end;


function DuplicateComponents(

AComponent: TComponent // исходный компонент
): TComponent; // возвращаемся к созданию нового компонента

procedure RegisterComponentClasses(
AComponent: TComponent
);
var
i : integer;
begin
RegisterClass(TPersistentClass(AComponent.ClassType));
if AComponent is TWinControl then
if TWinControl(AComponent).ControlCount > 0 then
for i := 0 to
(TWinControl(AComponent).ControlCount-1) do

RegisterComponentClasses(TWinControl(AComponent).Controls[i]);

end;

var

Stream: TMemoryStream;
UniqueReader: TUniqueReader;
Writer: TWriter;
begin

result := nil;
UniqueReader := nil;
Writer := nil;


try
Stream := TMemoryStream.Create;
RegisterComponentClasses(AComponent);


try
Writer := TWriter.Create(Stream, 4096);
Writer.Root := AComponent.Owner;
Writer.WriteSignature;
Writer.WriteComponent(AComponent);
Writer.WriteListEnd;
finally
Writer.Free;
end;


Stream.Position := 0;
try
UniqueReader := TUniqueReader.Create(Stream, 4096); // создаем поток, перемещающий данные о компоненте в конструктор
UniqueReader.OnSetName := UniqueReader.SetNameUnique;
UniqueReader.LastRead := nil;


if AComponent is TWinControl then

UniqueReader.ReadComponents(
// считываем компоненты и суб-компоненты

TWinControl(AComponent).Owner,
TWinControl(AComponent).Parent,
UniqueReader.ComponentRead
)
else

UniqueReader.ReadComponents(
// читаем компоненты

AComponent.Owner,
nil,
UniqueReader.ComponentRead
);
result := UniqueReader.LastRead;
finally
UniqueReader.Free;
end;
finally
Stream.Free;
end;
end;

Название говорит само за себя

---

Код

uses DB, DBTables, StdCtrls;

procedure TForm1.Button1Click(Sender: TObject);
var

tSource, TDest: TTable;
begin
TSource := TTable.create(self);
with TSource do begin
DatabaseName := 'dbdemos';
TableName := 'customer.db';
open;
end;
TDest := TTable.create(self);
with TDest do begin
DatabaseName := 'dbdemos';
TableName := 'MyNewTbl.db';
FieldDefs.Assign(TSource.FieldDefs);
IndexDefs.Assign(TSource.IndexDefs);
CreateTable;
end;
TSource.close;
end;

Сегодня речь пойдет о том, как преобразовать иконку в растровое изображение и о том, как из растрового изображения сделать иконку. Описанные ниже методы помогут вам разобраться с реализацией данного вопроса.

Решение 1

Код

var
Icon : TIcon;
Bitmap : TBitmap;
begin
Icon := TIcon.Create;
Bitmap := TBitmap.Create;
Icon.LoadFromFile('c:picture.ico');
Bitmap.Width := Icon.Width;
Bitmap.Height := Icon.Height;
Bitmap.Canvas.Draw(0, 0, Icon);
Bitmap.SaveToFile('c:picture.bmp');
Icon.Free;
Bitmap.Free;
end;

Решение 2

Способ преобразования изображения размером 32x32 в иконку.

Код

unit main;

interface

uses

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

type

TForm1 = class(TForm)
Button1: TButton;
Image1: TImage;
Image2: TImage;
procedure Button1Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

var

Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.Button1Click(Sender: TObject);
var winDC, srcdc, destdc : HDC;

oldBitmap : HBitmap;
iinfo : TICONINFO;
begin

GetIconInfo(Image1.Picture.Icon.Handle, iinfo);


WinDC := getDC(handle);
srcDC := CreateCompatibleDC(WinDC);
destDC := CreateCompatibleDC(WinDC);
oldBitmap := SelectObject(destDC, iinfo.hbmColor);
oldBitmap := SelectObject(srcDC, iinfo.hbmMask);


BitBlt(destdc, 0, 0, Image1.picture.icon.width,
Image1.picture.icon.height,
srcdc, 0, 0, SRCPAINT);
Image2.picture.bitmap.handle := SelectObject(destDC, oldBitmap);
DC(destDC);
DC(srcDC);
DC(WinDC);


image2.Picture.Bitmap.savetofile(ExtractFilePath(Application.ExeName)
+ 'myfile.bmp');
end;

procedure TForm1.FormCreate(Sender: TObject);
begin

image1.picture.icon.loadfromfile('c:myicon.ico');
end;

end.