Unit Controls;

interface
uses Windows, Messages;
var
  hParentWnd: HWND;   //Окно, в котором расположены элементф управления
  hAppInst: Cardinal;

//Функции создания элементов упраления
function CreateButton(x, y, width, height, id:Integer; caption : String):HWND;
function CreateCheck(x, y, width, height, id: Integer; caption: String;
                     checked: Boolean = False):HWND;
function CreateOption(x, y, width, height, id: Integer; caption: String;
                     group: Boolean = False; checked: Boolean = False):HWND;
function CreateFrame(x, y, width, height, id: Integer; caption: String):HWND;
function CreateCombo(x, y, width, height, id: Integer):HWND;
function CreateList(x, y, width, height, id: Integer):HWND;
function CreateLabel(x, y, width, height, id: Integer; caption: String):HWND;
function CreateEdit(x, y, width, height, id: Integer;
                    strInitText: String = ''):HWND;
function CreateMemo(x, y, width, height, id: Integer;
                    strInitText: String = ''):HWND;

//Процедуры для работы с элементами управления
//...работа с Button, Option, Check
procedure SetChecked(id: Integer; checked: BOOL);
function GetChecked(id: Integer):BOOL;
procedure SetBitmap(id: Integer; bitmap: HBITMAP);
function GetBitmap(id: Integer):HBITMAP;
//...работа с ComboBox
procedure AddToCombo(id: Integer; str: String);
procedure DeleteFromCombo(id: Integer; index: Integer);
procedure SetComboSel(id: Integer; index: Integer);
function GetComboSel(id: Integer): Integer;
function GetComboCount(id: Integer): Integer;
function GetComboItemText(id: Integer; index: Integer): String;
//...работа с ListBox
procedure AddToList(id: Integer; str: String);
procedure DeleteFromList(id: Integer; index: Integer);
procedure SetListSel(id: Integer; index: Integer);
function GetListSel(id: Integer): Integer;
function GetListCount(id: Integer): Integer;
function GetListItemText(id: Integer; index: Integer): String;
//...работа с Edit и Memo
function GetSelStart(id: Integer): Integer;
function GetSelLength(id: Integer): Integer;
procedure SetSel(id: Integer; start: Integer; length: Integer = 0);
function GetSelText(id: Integer): String;
procedure ReplaceSelText(id: Integer; newText: String);
//...общие для элементов управления функции
procedure SetText(id: Integer; str: String);
function GetText(id: Integer): String;
procedure SetEnabled(id: Integer; fEnabled: BOOL);

implementation
//Cоздание кнопки
function CreateButton(x, y, width, height, id:Integer; caption : String):HWND;
begin
  CreateButton :=
   CreateWindow('BUTTON', PAnsiChar(caption), WS_CHILD or WS_VISIBLE or
                BS_PUSHBUTTON or WS_TABSTOP, x, y, width, height, hParentWnd,
                HMENU(id), hAppInst, nil);
end;
//Cоздание флажка (с установкой параметра по умолчанию)
function CreateCheck(x, y, width, height, id: Integer; caption: String;
                     checked: Boolean):HWND;
var
  res: HWND;
begin
  res :=
   CreateWindow('BUTTON', PAnsiChar(caption), WS_CHILD or WS_VISIBLE or
                BS_AUTOCHECKBOX or WS_TABSTOP, x, y, width, height,
                hParentWnd, HMENU(id), hAppInst, nil);
  if ((res <> 0) and checked) then
    SendMessage(res, BM_SETCHECK, BST_CHECKED, 0); //Флажок поставлен
  CreateCheck := res;
end;
//Cоздание переключателя (с установкой параметра по умолчанию)
function CreateOption(x, y, width, height, id: Integer; caption: String;
                     group: Boolean; checked: Boolean):HWND;
var
  res: HWND;
  nGroup: Integer;
begin
  if (checked) then nGroup := WS_GROUP else nGroup := 0;
  res :=
   CreateWindow('BUTTON', PAnsiChar(caption), WS_CHILD or WS_VISIBLE or
                BS_AUTORADIOBUTTON or nGroup or WS_TABSTOP,
                x, y, width, height, hParentWnd,
                HMENU(id), hAppInst, nil);
  if ((res <> 0) and checked) then
    SendMessage(res, BM_SETCHECK, BST_CHECKED, 0); //Флажок поставлен
  CreateOption := res;
end;
//Cоздание рамки (для группировки элементов управления)
function CreateFrame(x, y, width, height, id: Integer; caption: String):HWND;
begin
  CreateFrame:=
   CreateWindow('BUTTON', PAnsiChar(caption), WS_CHILD or WS_VISIBLE or
                BS_GROUPBOX, x, y, width, height, hParentWnd,
                HMENU(id), hAppInst, nil);
end;
//Cоздание раскрывающегося списка (ComboBox)
function CreateCombo(x, y, width, height, id: Integer):HWND;
begin
  CreateCombo:=
   CreateWindow('COMBOBOX', nil, WS_CHILD or WS_VISIBLE or CBS_DROPDOWN
                or CBS_AUTOHSCROLL or WS_TABSTOP,
                x, y, width, height, hParentWnd,
                HMENU(id), hAppInst, nil);
end;
//Cоздание списка (ListBox)
function CreateList(x, y, width, height, id: Integer):HWND;
begin
  CreateList:=
   CreateWindowEx(WS_EX_CLIENTEDGE, 'LISTBOX', nil, WS_CHILD or WS_VISIBLE or LBS_NOTIFY or
                WS_BORDER or WS_TABSTOP,
                x, y, width, height, hParentWnd,
                HMENU(id), hAppInst, nil);
end;
//Cоздание надписи
function CreateLabel(x, y, width, height, id: Integer; caption: String):HWND;
begin
  CreateLabel:=
   CreateWindow('STATIC', PAnsiChar(caption), WS_CHILD or WS_VISIBLE,
                x, y, width, height, hParentWnd,
                HMENU(id), hAppInst, nil);
end;
//Cоздание текстового поля (однострочного)
function CreateEdit(x, y, width, height, id: Integer;
                    strInitText: String):HWND;
begin
  CreateEdit:=
   CreateWindowEx(WS_EX_CLIENTEDGE, 'EDIT', PAnsiChar(strInitText),
                  WS_CHILD or WS_VISIBLE or ES_AUTOHSCROLL or WS_TABSTOP,
                  x, y, width, height, hParentWnd,
                  HMENU(id), hAppInst, nil);
end;
//Cоздание текстового поля (многострочного)
function CreateMemo(x, y, width, height, id: Integer;
                    strInitText: String):HWND;
begin
  CreateMemo:=
   CreateWindowEx(WS_EX_CLIENTEDGE, 'EDIT', PAnsiChar(strInitText),
                  WS_CHILD or WS_VISIBLE or ES_AUTOVSCROLL or ES_MULTILINE
                  or WS_TABSTOP,
                  x, y, width, height, hParentWnd,
                  HMENU(id), hAppInst, nil);
end;

///////////////////////////////////////////////////////////////////////////
//Манипулирование элементами управления
//...работа с Button, Option, Check
//Установка/снятие галочки (включение/выключение переключателя)
procedure SetChecked(id: Integer; checked: BOOL);
var state: Integer;
begin
  if (checked) then state := BST_CHECKED
  else state := BST_UNCHECKED;
  SendDlgItemMessage(hParentWnd, id, BM_SETCHECK, state, 0);
end;
//Получение информации о том, установлена ли галочка (включен и переключатель)
function GetChecked(id: Integer):BOOL;
begin
  if (SendDlgItemMessage(hParentWnd, id, BM_GETCHECK, 0, 0) = BST_CHECKED)
  then GetChecked := TRUE
  else GetChecked := FALSE;
end;
//Установка изображения на кнопку (ВНИМАНИЕ: прошлое изображение нужно
//удалить самостоятельно)
procedure SetBitmap(id: Integer; bitmap: HBITMAP);
begin
  SendDlgItemMessage(hParentWnd, id, BM_SETIMAGE,
                     IMAGE_BITMAP, Integer(bitmap));
end;
//Получение дескриптора изображения
function GetBitmap(id: Integer):HBITMAP;
begin
  GetBitmap := SendDlgItemMessage(hParentWnd, id, BM_GETIMAGE,
                                  IMAGE_BITMAP, 0);
end;
//...работа с ComboBox
//Добавление строки с список
procedure AddToCombo(id: Integer; str: String);
begin
  SendDlgItemMessage(hParentWnd, id, CB_ADDSTRING, 0, Integer(PAnsiChar(str)));
end;
//Удаление строки из списка
procedure DeleteFromCombo(id: Integer; index: Integer);
begin
  SendDlgItemMessage(hParentWnd, id, CB_DELETESTRING, index, 0);
end;
//Выделение строки с заданным номером
procedure SetComboSel(id: Integer; index: Integer);
begin
  SendDlgItemMessage(hParentWnd, id, CB_SETCURSEL, index, 0);
end;
//Получение номера выделенной строки (CB_ERR, если нет выделения)
function GetComboSel(id: Integer): Integer;
begin
  GetComboSel := SendDlgItemMessage(hParentWnd, id, CB_GETCURSEL, 0, 0);
end;
//Получение количества строк
function GetComboCount(id: Integer): Integer;
begin
  GetComboCount := SendDlgItemMessage(hParentWnd, id, CB_GETCOUNT, 0, 0);
end;
//Получение текста строки по ее индексу
function GetComboItemText(id: Integer; index: Integer):String;
var buffer: String;
begin
  SetLength(buffer,
            SendDlgItemMessage(hParentWnd, id, CB_GETLBTEXTLEN, index, 0)
            );
  SendDlgItemMessage(hParentWnd, id, CB_GETLBTEXT, index,
                     Integer(Addr(buffer)));
  GetComboItemText := buffer;
end;
//...работа с ListBox
//Добавление строки с список
procedure AddToList(id: Integer; str: String);
begin
  SendDlgItemMessage(hParentWnd, id, LB_ADDSTRING, 0, Integer(PAnsiChar(str)));
end;
//Удаление строки из списка
procedure DeleteFromList(id: Integer; index: Integer);
begin
  SendDlgItemMessage(hParentWnd, id, LB_DELETESTRING, index, 0);
end;
//Выделение строки с заданным номером
procedure SetListSel(id: Integer; index: Integer);
begin
  SendDlgItemMessage(hParentWnd, id, LB_SETCURSEL, index, 0);
end;
//Получение номера выделенной строки (LB_ERR, если нет выделения)
function GetListSel(id: Integer): Integer;
begin
  GetListSel := SendDlgItemMessage(hParentWnd, id, LB_GETCURSEL, 0, 0);
end;
//Получение количества строк
function GetListCount(id: Integer): Integer;
begin
  GetListCount := SendDlgItemMessage(hParentWnd, id, LB_GETCOUNT, 0, 0);
end;
//Получение текста строки по ее индексу
function GetListItemText(id: Integer; index: Integer):String;
var buffer: String;
begin
  SetLength(buffer,
            SendDlgItemMessage(hParentWnd, id, LB_GETTEXTLEN, index, 0)
            );
  SendDlgItemMessage(hParentWnd, id, LB_GETTEXT, index,
                     Integer(Addr(buffer)));
  GetListItemText := buffer;
end;
//...работа с Edit и Memo
//Получение позиции первого выделенного символа (нумерация с нуля)
function GetSelStart(id: Integer): Integer;
var selStart, selEnd: Integer;
begin
  SendDlgItemMessage(hParentWnd, id, EM_GETSEL, Integer(Addr(selStart)),
                                                Integer(Addr(selEnd)));
  GetSelStart := selStart;
end;
//Получение длины выделенного фрагмента текста
function GetSelLength(id: Integer): Integer;
var selStart, selEnd: Integer;
begin
  SendDlgItemMessage(hParentWnd, id, EM_GETSEL, Integer(Addr(selStart)),
                                                Integer(Addr(selEnd)));
  GetSelLength := selEnd - selStart;
end;
//Выделение фрагмента текста (позиция первого символа с нуля)
procedure SetSel(id: Integer; start, length: Integer);
begin
  SendDlgItemMessage(hParentWnd, id, EM_SETSEL, start, start + length);
end;
//Получение выделенного фрагмента текста
function GetSelText(id: Integer): String;
var allText: String;
begin
  allText := GetText(id);
  GetSelText := Copy(allText, GetSelStart(id)+1,GetSelLength(id));
end;
//Замена выделенного текста
procedure ReplaceSelText(id: Integer; newText: String);
begin
  SendDlgItemMessage(hParentWnd, id, EM_REPLACESEL,
                     0, Integer(PAnsiChar(newText)));
end;
//...общие для элементов управления функции
//Установка текста окна
procedure SetText(id: Integer; str: String);
begin
  SetWindowText(GetDlgItem(hParentWnd, id), PAnsiChar(str));
end;
//Получение текста окна
function GetText(id: Integer): String;
var buffer: String;
begin
  SetLength(buffer, GetWindowTextLength(hParentWnd));
  GetWindowText(hParentWnd, PAnsiChar(buffer), Length(buffer));
  GetText := buffer;
end;
//Активация/деактивация окна
procedure SetEnabled(id: Integer; fEnabled: BOOL);
begin
  EnableWindow(GetDlgItem(hParentWnd, id), fEnabled);
end;

end.
