Home

Как правильно создавать компоненты в run-time?
Как в TTreeView построить дерево открытых окон?
Как заставить клавишу "Enter" вести себя как "Tab" в DBGrid?
Как узнать, какая ячейка при просмотре TDBGrid текущая?
Как использовать Clipboard для переноса данных в собственном формате?
Как перевести визуальный компонент, такой, как TPanel, в состояние перемещения (взять и перенести)?
Как изменить внешний вид хинтов (всплывающих подсказок)?
Как изменить цвет фона и шрифта в TDBGrid в зависимости от содержимого?
Как добавить горизонтальную полосу прокрутки в TListBox?
Как создать окна непрямоугольной формы и работать с ними?
Как обратится из одной модальной формы к другой - не активной?
Как добавить свой пункт в системное меню формы?
Как с помощью TDBGrid.RowSelected получить доступ к записям TTable, соответствующим строкам, помеченным в TDBGrid?
Можно ли задать формат/маску вывода числа в столбце DBGrid?
Использование обработчика OnHint при наличии нескольких форм.
Переход на другую страницу TabSet по имени.
Как выполнить UnDo в Memo.
Как можно определить, на какой строке в TMemo находится курсор?
Обработка исключительных ситуаций (exceptions) EDBEngineError.
Как открыть ComboBox программно.
Как программно спрятать/показать заголовок окна (caption)?
Как убрать заголовок(caption) из MDI child?
Мне нужно сделать приложение модальным, для того чтобы обезопасить систему и в то же время позволить работать с программой.
Прокрутка Memo (постранично), фокус находится на Edit1.
Как сделать окно, которое перетаскивается не за заголовок (caption), а за все поле.
Как поместить BitMap в меню?


Как правильно создавать компоненты в run-time?


Давайте создадим.
Сущность свойства Owner в том, что перед уничтожением владельца, он уничтожает (через Free) принадлежащие ему объекты. Таким образом, все зависит от того, кому Вы хотите доверить уничтожение созданных форм/компонентов. В частности, если Вы сами будете этим заниматься, то AOwner может быть, например, nil.
Для того, чтобы созданный компонент появился на экране, надо указать его родителя, заполнив свойство Parent, например:
NewButton.Parent := Form1;
Пример кода, обрабатывающего события от свежесозданных компонентов:
type
TForm1 = class(TForm)
{ ... }
private
{ эта процедура будет вызываться при нажатии на кнопку }
procedure ButtonClicked(Sender : TObject);
public
{ в этой процедуре происходит создание кнопки }
procedure CreateButton;
end;
{ ... }
procedure TForm1.CreateButton;
var
Btn : TButton;
begin
Btn := TButton.Create(Self); { Уничтожать кнопку будет форма }
Btn.Parent := Self; { Родителем кнопки будет форма }
Btn.OnClick := ButtonClicked; { Процедура, которая будет исполняться при }
Btn.Visible := true; { нажатии на кнопку }
end;

Как в TTreeView построить дерево открытых окон?


Мне стало интересно построить дерево окон и вот что у меня получилось:
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, HistEdit, Buttons, StdCtrls, ColoredGrid, TLHelp32, ComCtrls;
type
TForm1 = class(TForm)
List : TTreeView;
procedure FormCreate(Sender : TObject);
private
{ Private declarations }
procedure listlevel(N : TTreeNode; H : HWND);
public
{ Public declarations }
end;
var
Form1 : TForm1;
implementation

{$R *.DFM}

procedure TForm1.ListLevel;
var
B : array[0..128] of char;
S : String;
T : TTreeNode;
C, W : HWND;
begin
W := H;
while W <> 0 do
begin
GetClassName (W, @B, 128);
S := StrPas(B);
GetWindowText(W, @B, 128);
S := S + '(' + StrPas(B) + ')';
T := List.Items.AddChild(N, S);
C := GetWindow(W, GW_CHILD);
ListLevel(T, C);
W := GetNextWindow(W, GW_HWNDNEXT);
end;
end;
procedure TForm1.FormCreate(Sender : TObject);
var
H : HWnd;
begin
H := GetDeskTopWindow;
ListLevel(nil, H);
end;

end.

Как заставить клавишу "Enter" вести себя как "Tab" в DBGrid?



Следующий пример включает также обработку "Enter" для всей формы, включая поля и т.д. Часть, относящаяся к DBGrid обрабатывается в секции Else. Приведенный код не полностью копирует поведение "Tab" в DBGrid, с последней колонки фокус переходит на первую без перехода на следующую запись.
procedure TForm1.FormKeyPress(Sender: TObject; var Key: Char);
{ Это обработчик события OnKeyPress для ФОРМЫ! }
{ Требуется так же установить св-во KeyPreview в True }
begin
if Key = #13 then { клавиша }
if not (ActiveControl is TDBGrid) then
begin { если не в TDBGrid }
Key := #0; { убрать }
Perform(WM_NEXTDLGCTL, 0, 0); { перейти дальше }
end
else
if (ActiveControl is TDBGrid) then { если в TDBGrid }
with TDBGrid(ActiveControl) do
if SelectedIndex < (FieldCount - 1) then { следующее поле }
SelectedIndex := SelectedIndex + 1
else
SelectedIndex := 0;
end;

Как узнать, какая ячейка при просмотре TDBGrid текущая?



Здесь процедура для сохранения текущего номера строки и колонки. Следующий код в методе MyDBGridDrawDataCell обновляет переменные Col и Row (которые не должны быть локальными для этого метода) каждый раз, когда таблица перерисовывается. Используя этот код, Вы можете считать, что Col и Row указывают на текущую колонку и строку соответственно.
var
Col, Row : Integer;
procedure TForm1.MyDBGridDrawDataCell(Sender: TObject; const Rect: TRect; Field: TField; State: TGridDrawState);
var
RowHeight : Integer;
begin
if gdFocused in State then
begin
RowHeight := Rect.Bottom - Rect.Top;
Row := (Rect.Top div RowHeight) - 1;
Col := Field.Index;
end;
end;

Как использовать Clipboard для переноса данных в собственном формате?



Не только возможно, именно так поступают функции Clipboard.GetComponent и Clipboard.SetComponent.
Сперва Вы должны зарегистрировать свой собственный формат данных для Clipboard с помощью функции RegisterClipboardFormat():

CF_MYFORMAT := RegisterClipboardFormat('My Format Description');

Далее вы должны выполнить эти шаги : 1. Создать поток (memory stream) и записать туда данные.
2. Создать глобальный буфер в памяти и скопировать поток туда.
3. Вызвать Clipboard.SetAsHandle(), чтобы поместить буфер в clipboard.

Пример:
var
HBuf : THandle;
BufPtr : Pointer;
MStream : TMemoryStream;
begin
MStream := TMemoryStream.Create;
try
{-- Write your data to the stream. --}
HBuf := GlobalAlloc(GMEM_MOVEABLE, MStream.Size);
try
BufPtr := GlobalLock(HBuf);
try
Move(MStream.Memory^, BufPtr^, MStream.Size);
Clipboard.SetAsHandle(CF_MYFORMAT, HBuf);
finally
GlobalUnlock(HBuf);
end;
except
GlobalFree(HBuf);
raise;
end;
finally
MStream.Free;
end;
end;

ВНИМАНИЕ: Не уничтожайте буфер, созданный с GlobalAlloc(). Поскольку Вы поместили его в Clipboard, это уже дело Clipboard'а его уничтожить. Опять же, получая буфер из Clipboard, не уничтожайте этот буфер - просто сделайте копию содержимого.

Для обратного получения потока и данных, сделайте что-нибудь вроде этого:
var
HBuf : THandle;
BufPtr : Pointer;
MStream : TMemoryStream;
begin
HBuf := Clipboard.GetAsHandle(CF_MYFORMAT);
if HBuf <> 0 then
begin
BufPtr := GlobalLock(HBuf);
if BufPtr <> nil then
begin
try
MStream := TMemoryStream.Create;
try
MStream.WriteBuffer(BufPtr^, GlobalSize(HBuf));
MStream.Position := 0;
{-- Read your data from the stream. --}
finally
MStream.Free;
end;
finally
GlobalUnlock(HBuf);
end;
end;
end;
end;

Как перевести визуальный компонент, такой, как TPanel, в состояние перемещения (взять и перенести)?


Пример:

{ В случае Panel1 : TPanel - обработчик события OnMouseDown }

procedure TForm1.Panel1MouseDown(Sender : TObject; Button : TMouseButton;
Shift : TShiftState; X, Y : Integer);
const
SC_DRAGMOVE = $F012; { a magic number }
begin
ReleaseCapture;
P.Perform(WM_SYSCOMMAND, SC_DRAGMOVE, 0);
end;

Как изменить внешний вид хинтов (всплывающих подсказок)?


1. Создаем свой класс - потомок от THintWindow

type
TCustomHint = class(THintWindow)
public
constructor Create(AOwner: TComponent); override;
end;
Пpимечание
Этот способ не позволит изменить цвет шpифта - для этого пpидется пеpекpывать метод Paint;
Если пеpекpыть CreateParams, то можно, напpимеp, наpисовать Hint в фоpме облачка.
2. Меняем фонт:

constructor TCustomHint.Create(AOwner : TComponent);
begin
inherited Create(AOwner);
with Canvas.Font do // Именно так, а не пpосто Font!
begin
Name := 'Times New Roman Cyr';
Style := [fsBold, fsItalic];
Size := 40;
end;
end;
3. Устанавливаем новый хинт

procedure TForm1.FormCreate(Sender : TObject); // Это может быть любой обpаботчик
begin
HintWindowClass := TMyHint; // Устанавливаем глобальную пеpеменную
Application.ShowHint := False; // Application.FHintWindow.Free
Application.ShowHint := True; // Application.FHintWindow.Create
end;
Литеpатуpа:
1. <...>\Source\VCL\Forms.pas (TApplication).
2. <...>\Source\VCL\Controls.pas (THintWindow).
3. Delphi Help (OnShowHint, THintInfo).

Как изменить цвет фона и шрифта в TDBGrid в зависимости от содержимого?


Для изменения в TDBGrid цвета фона и шрифта в зависимости от содержимого определенного поля (ячейки) необходимо воспользоваться обработчиком события onDrawColumnCell. Представим что мы хотим чтобы все записи где сумма = 0 высвечивались на красном фоне синим курсивом. Для этого в обработчик onDrawColumnCell добавляем следующий код:
procedure TForm1.DBGrid1DrawColumnCell(Sender: TObject; const Rect: TRect; DataCol: Integer; Column: TColumn; State: TGridDrawState);
begin
with DBGrid1.Canvas do
begin
if (Table1.FieldByName('summa').asString = '0') and not (gdFocused in State) then
begin
Brush.Color := clRed;
Font.Color := clBlue;
Font.Style := [fsBold,fsItalic];
FillRect(Rect);
TextOut(Rect.Left, Rect.Top, Column.Field.Text);
end
else
DBGrid1.DefaultDrawColumnCell(Rect, DataCol, Column, State);
end;
end;

А вот для закраски только определенной ячейки введите следующий код в обработчике события OnDrawDataCell:
procedure TForm1.DBGrid1DrawDataCell(Sender: TObject; const Rect: TRect; Field: TField; State: TGridDrawState);
begin
if gdFocused in State then
with (Sender as TDBGrid).Canvas do
begin
Brush.Color := clRed;
FillRect(Rect);
TextOut(Rect.Left, Rect.Top, Field.AsString);
end;
end;

Установите свойство DefaultDrawing в True. Если установить DefaultDrawing в False, то Вы должны самостоятельно перерисовать все ячейки аналогично примеру.

Как добавить горизонтальную полосу прокрутки в TListBox?


Компонент VCL TListBox автоматически реализует вертикальную полосу прокрутки. Полоска прокрутки появляется, когда окно списка слишком мало для показа всех элементов списка. Однако окно списка не показывает горизонтальной полосы прокрутки, когда какие-либо элементы списка имеют большую ширину, чем само окно списка. Конечно, есть возможность добавить горизонтальную полосу прокрутки. Добавьте следующий код в обработчик события OnCreate Вашей формы:

procedure TForm1.FormCreate(Sender : TObject);
var
I, MaxWidth : Integer;
begin
MaxWidth := 0;
for I := 0 to ListBox1.Items.Count - 1 do
if MaxWidth < ListBox1.Canvas.TextWidth(ListBox1.Items.Strings[I]) then
MaxWidth := ListBox1.Canvas.TextWidth(ListBox1.Items.Strings[I]);
SendMessage(ListBox1.Handle, LB_SETHORIZONTALEXTENT, MaxWidth + 2, 0);
end;
Этот код находит ширину, в пикселах, самой длинной строки в окне списка. Затем он использует сообщение LB_SETHORIZONTALEXTENT для установки горизонтальной прокручиваемой ширины, в пикселах, для окна списка. Два дополнительных пиксела добавлены к MaxWidth, чтобы сдвинуть оконечные символы от правой границы окна списка.

Как создать окна непрямоугольной формы и работать с ними?


Попpобуйте вот этот обpаботчик OnCreate. Hа меня это пpоизвело впечатление.:

procedure TForm1.FormCreate(Sender : TObject);
const
W = 36 * PI / 180;
var
R, R1, R2 : HRgn;
X, Y, I : Integer;

function S(A : Integer; R : Integer) : Integer;
begin
Result := round(R * sin(W * A));
end;

function C(A : Integer; R : Integer) : Integer;
begin
Result := round(R * cos(W * A));
end;

function GetStarReg(X, Y, R : Integer) : HRGN;
var
P : array[0..4] of TPoint;
begin
P[0] := Point(X, Y - R);
P[1] := Point(X - S(4, R), Y - C(4, R));
P[2] := Point(X - S(8, R), Y - C(8, R));
P[3] := Point(X - S(2, R), Y - C(2, R));
P[4] := Point(X - S(6, R), Y - C(6, R));
Result := CreatePolygonRgn(P, 5, WINDING);
end;

begin
X := Width div 2;
Y := Height div 2;
R := GetStarReg(X, Y, 100);
I := 1;
repeat
R1 := GetStarReg(X - S(I, 120), Y - C(I, 110), 40);
CombineRgn(R, R, R1, RGN_OR);
inc(I, 2);
until I > 9;
R1 := GetStarReg(X, Y, 30);
CombineRgn(R, R, R1, RGN_DIFF);
R1 := CreateEllipticRgn(3, 3, Width - 6, Height - 6);
R2 := CreateEllipticRgn(20, 10, Width - 20, Height - 10);
CombineRgn(R1, R1, R2, RGN_DIFF);
CombineRgn(R, R, R1, RGN_OR);
SetWindowRgn(Handle, R, True);
end;


Как обратится из одной модальной формы к другой - не активной?


Предлагаю вот такой способ:

procedure ShowAlmostModal(FormModal : TForm);
begin
NavigatorForm.Enabled := False;
FormModal.ShowModal
end;

И вот это пpивесь на OnShow почти модальной фоpмы

procedure FormShow(Sender : Tobject);
begin
NavigatorForm.Enabled := True;
end;


Как добавить свой пункт в системное меню формы?

Предлагаю стандартный способ:

var
SMenu : THandle;
begin
SMenu := GetSystemMenu(Handle, False);
InsertMenu(SMenu, 1, MF_Byposition, ID_NEW, 'NEW');
end;
Выгружать элемент меню по завершению работы программы не надо.
Подобное использование требует как правило написания обработчика сообщения.

Как с помощью TDBGrid.RowSelected получить доступ к записям TTable, соответствующим строкам, помеченным в TDBGrid?

Предлагаю часть из своей работающей процедуры:

Пользователь отмечает (или нет) на DBGrid некоторое число записей, а эта процедура перегоняет их в структуру SData.


with CData.SpTable, SData do
begin
nSpData := DBGrid1.SelectedRows.Count;
if nSpData > MaxnSpData then nSpData := MaxnSpData;
if nSpData = 0 then
begin
nSpData := 1;
GetSpectr(1, SData);
end
else
begin
DisableControls;
try
for I := nSpData downto 1 do
begin
Bookmark := DBGrid1.SelectedRows.Items[I - 1];
GetSpectr(I, SData);
end;
finally
EnableControls;
end;
end;
end;

Можно ли задать формат/маску вывода числа в столбце DBGrid?


По скольку речь идет о компоненте TDBGrid, то нельзя забывать что, ячейки этого компонента заполняются данными из полей таблицы базы данных через компонент TDataSource. А именно составляющими являются автоматически созданные по "подобию и количеству" полей таблицы - компоненты TField. В свою очередь, компонент TField имеет унаследованое от класса TCustomMaskEdit свойство DisplayFormat, которое и отвечает за форматное представление данных в других визуальных компонентах, в том числе и в TDBGrid. Важно знать что, для настройки этого свойства средствами визуальной разработки - необходимо явно создать в классе Вашей формы поля типа TField. Это можно сделать при помощи Редактора полей компонентов TTable или TQuery. Форматная строка в этом свойстве может быть выбрана по правилам форматирования данных, на пример:

'#,##0.00' выдаст результат = 94 256,00


Использование обработчика OnHint при наличии нескольких форм.

В Online Help и в Visual Component Library Reference описан пример обработчика события OnHint объекта TApplication. Пример показывает, как можно использовать панель для отображения подсказок (hint), связанных с другими компонентами. В примере обработчик OnHint устанавливается во время обработки события OnCreate для формы; в программе, включающей более чем одну форму, будет трудно использовать эту технику. Перемещение присваивания обработчика OnHint из события OnCreate формы в событие OnActivate позволит различным формам данного приложения работать с подсказками, как им нужно. Ниже приведен измененный пример из OnLine Help и VCL Reference.

type
TForm1 = class(TForm)
Button1 : TButton;
Panel1 : TPanel;
Edit1 : TEdit;
procedure FormActivate(Sender : TObject);
private
{ Private declarations }
public
procedure DisplayHint(Sender: TObject);
end;


implementation
{$R *.DFM}

procedure TForm1.DisplayHint(Sender : TObject);
begin
Panel1.Caption := Application.Hint;
end;

procedure TForm1.FormActivate(Sender : TObject);
begin
Application.OnHint := DisplayHint;
end;

Переход на другую страницу TabSet по имени.

Поместите Tabset(TabSet1) и Edit (Edit1) на форму. Добавьте 4 страницы в TabSet - свойство Tabs: Hello, World, Of, Delphi. Напишите обработчик OnChange для Edit:

procedure Tform1.Edit1Change(Sender: TObject);
var
I : Integer;
begin
for I:= 0 to TabSet1.Tabs.Count - 1 do
if Edit1.Text = TabSet1.Tabs[I] then
TabSet1.TabIndex := I;
end;
Если набрать любое имя в Edit1, фокус установится на соответствующую страницу.

Как выполнить UnDo в Memo.

Если определено всплывающее(pop-up) меню для TMemo,и заданы клавиши для операций Cut,Copy, Paste, то вы можете обрабатывать эти события вызывая CuttoClipBoard, CopytoClipBoard, и т.д. Однако, если Вы поместили пункт Undo в меню (обычно Ctrl+Z), то как дать знать TMemo, что нужно выполнить Undo? Встроенного Undo для этого достаточно:

Memo1.Perform(EM_UNDO, 0, 0);

Для переключения enable/disable опции undo:

Undo1.Enabled := Memo1.Perform(EM_CANUNDO, 0, 0)<> 0;

Как можно определить, на какой строке в TMemo находится курсор?

Весь фокус в сообщении em_LineFromChar. Попробуйте:

procedure TmyForm.BitBtn1Click(Sender: TObject);
var
iLine : Integer ;
begin
iLine := Memo1.Perform(em_LineFromChar, $FFFF, 0);
{ Внимание: номера строк начинаются с нуля }
MessageDlg('Line Number: ' + IntToStr(iLine), mtInformation, [mbOK], 0 ) ;
end;
Обработка исключительных ситуаций (exceptions) EDBEngineError.

Информация об ошибке BDE может быть получена для использования в приложении из EDBEngineError. Исключительная ситуация EDBEngineError обрабатывается в программе с помощью конструкции try ... except. Когда возникает исключительная ситуация BDE, то может быть создан объект EDBEngineError и различные поля этого объекта могут быть использованы для программного определения, что не в порядке и что требуется для исправления ситуации. Далее, для данной исключительной ситуации может быть сгенерировано несколько сообщений об ошибках. Это требует организации перебора сообщений об ошибках для получения нужной информации. Поле, наиболее важное для данного контекста - ErrorCount : Integer; показывает количество ошибок в свойстве Errors; счет начинается с нуля. Errors : TDBError; набор записей, которые содержат информацию о каждой полученной ошибке; доступ к записям происходит по индексу типа Integer. Errors.ErrorCode : DBIResult; показывает номер ошибки BDE для текущей записи об ошибках в свойстве Errors.

Errors.Category : Byte;//категория ошибки, относящаяся к полю ErrorCode.
Errors.SubCode : Byte;//подкод (subcode) для значения в ErrorCode.
Errors.NativeError : LongInt;//код удаленной ошибки, возвращаемый сервером; если ноль, то это ошибка не сервера; возвращаемое SQL запросом значение появляется в данном поле.
Errors.Message : TMessageStr; //сообщение об ошибке, сервера или BDE

В конструкции try..exceptобъект создается напрямую в разделе except. После создания можно работать поля обычным образом или передавать объект в другую роцедуру для исследования ошибки. Кроме того, можно создать свой собственный компонент для использования в данных целях; его набор функциональных возможностей можно легко переносить между приложениями. В примере ниже во время возникновения исключительной ситуации BDE создается объект DBEngineError, передается в процедуру и анализируется для выделения информации об ошибке. В конструкции try..except, объект DBEngineError можно создать с помощью синтаксиса, приведенного ниже:

procedure TForm1.Button1Click(Sender : TObject);
var
I : Integer;
begin
if Edit1.Text > ' ' then
begin
Table1.FieldByName('Number').AsInteger := StrToInt(Edit1.Text);
try
Table1.Post;
except
on E: EDBEngineError do
ShowError(E);
end;
end;
end;
В этой процедуре делается попытка изменить значение поля в таблице и затем вызывается метод Post соответствующей таблицы. В конструкцию try..except заключается только попытка Post. Если при этом возникает ошибка BDE, то выполняеся секция except, в которой создается объект E типа EDBEngineError и затем E передается в процедуру ShowError. Заметьте, что только EDBEngineError учитывается в данной конструкции. В реальной ситуации нужно, скорее всего, проверять и другие виды исключительных ситуаций. Процедура ShowError принимает объект EDBEngineError, передаваемый в качестве параметра и исследует содержащиеся сообщения об ошибках. В данном примере информация об ошибках показывается в компоненте TMemo. Первый шаг состоит в определении количества действительно возникших ошибок. Для этого служит свойство ErrorCount. После того, как стало известно количество ошибок, можно использовать цикл для доступа к каждой записи об ошибке в свойстве Error и помещению информацию о них в TMemo.

procedure TForm1.ShowError(AExc : EDBEngineError);
var
I : Integer;
begin
Memo1.Lines.Clear;
Memo1.Lines.Add('Number of errors: ' + IntToStr(AExc.ErrorCount));
Memo1.Lines.Add('');
{Iterate through the Errors records}
for i := 0 toAExc.ErrorCount - 1 do
begin
Memo1.Lines.Add('Message: ' + AExc.Errors[i].Message);
Memo1.Lines.Add(' Category: ' + IntToStr(AExc.Errors[i].Category));
Memo1.Lines.Add(' Error Code: ' + IntToStr(AExc.Errors[i].ErrorCode));
Memo1.Lines.Add(' SubCode: ' + IntToStr(AExc.Errors[i].SubCode));
Memo1.Lines.Add(' Native Error: ' + IntToStr(AExc.Errors[i].NativeError));
Memo1.Lines.Add('');
end;
end;
Как открыть ComboBox программно.

У ComboBox есть run-time свойство, не упомянутое в On-Line Help - DroppedDown. Для открытия ComboBox напишите:

ComboBox1.DroppedDown := True;

Естественно, False закроет его.

Как программно спрятать/показать заголовок окна (caption)?

Вы можете попробовать следующее:

procedure TForm1.HideTitlebar;
var
Save : Longint;
begin
if BorderStyle = bsNone then Exit;
Save := GetWindowLong(Handle, GWL_STYLE);
if (Save and WS_CAPTION) = WS_CAPTION then
begin
case BorderStyle of
bsSingle, bsSizeable : SetWindowLong(Handle, GWL_STYLE, Save and(Not WS_CAPTION) orWS_BORDER);
bsDialog : SetWindowLong(Handle, GWL_STYLE, Save and (Not WS_CAPTION) or DS_MODALFRAME orWS_DLGFRAME);
end;
Height := Height - GetSystemMetrics(SM_CYCAPTION);
Refresh;
end;
end;
procedure TForm1.ShowTitlebar;
var
Save : Longint;
begin
if BorderStyle = bsNone then Exit;
Save := GetWindowLong(Handle, GWL_STYLE);
if (Save and WS_CAPTION) <> WS_CAPTION then
begin
case BorderStyle of
bsSingle, bsSizeable : SetWindowLong(Handle, GWL_STYLE, Save or WS_CAPTION or WS_BORDER);
bsDialog : SetWindowLong(Handle, GWL_STYLE, Save or WS_CAPTION or DS_MODALFRAME or WS_DLGFRAME);
end;
Height := Height + getSystemMetrics(SM_CYCAPTION);
Refresh;
end;
end;

Как убрать заголовок(caption) из MDI child?

Для MDI child установка свойства BorderStyle = bsNone НЕ убирает заголовок. Это можно сделать так:

procedure TMDIChildForm.CreateParams(var Params : TCreateParams);
begin
inherited;
Params.Style := Params.Style and (not WS_CAPTION);
end;

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

Ok, пара предложений на эту тему:

a) Создайте форму, занимающую весь экран (maximized) без системных кнопок (maximize, minimize, system).

b) В обработчике FormDeactivate для формы вызовите метод setFocus - это предотвратит
Ctrl + Esc: Form1.SetFocus;

c) В обработчике события FormActivate, нужно присвоить метод Deactivate для приложения :
Application.onDeactivate := FormDeactivate;

d) Создайте всплывающее меню (popup) с единственным пунктом. В свойствах данного пункта нужно установить Visible = False. Создайте процедуру для этого пункта меню, делающую что-нибудь тривиальное типа x := 1 (для того, чтобы Delphi не удалил эту процедуру).

e) Присвойте созданное Popup меню форме (свойство Popupmenu).

f) Задайте горячую клавишу (shortcut) для Popup меню в методе FormActivate как показано ниже:
NullItem1.shortcut := ShortCut(VK_Tab, [ssAlt]);

(!!!: NullItem1 нужно заменить на название созданного вами объекта - пункта меню)

Шаги d, e и f предотвращают Alt-Tab.

Прокрутка Memo (постранично), фокус находится на Edit1.

procedure TForm1.Edit1KeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
begin
if Key = VK_F8 then
SendMessage(Memo1.Handle, { HWND для Memo }
WM_VSCROLL, { сообщение Windows }
SB_PAGEDOWN, {на страницу вниз }
0) { не используется }
else
if Key = VK_F7 then
SendMessage(Memo1.Handle, WM_VSCROLL, SB_PAGEUP, 0);
end;

Как сделать окно, которое перетаскивается не за заголовок (caption), а за все поле.

Нужно обрабатывать сообщение WM_NCHITTEST:

TForm1 = class(TForm)
...
private
...
procedure WMNCHitTest(var M: TWMNCHitTest); message wm_NCHitTest;
...
end;

...

procedure TForm1.WMNCHitTest(var M: TWMNCHitTest);
begin
inherited; { вызов унаследованного обработчика }
if M.Result = htClient then{ Мышь сидит на окне? }
M.Result := htCaption; { Если да - то пусть Windows думает, что мышь на caption bar }
end;
...

Окно можно сделать вообще без caption.

Как поместить BitMap в меню?

Может быть так:

var Bmp1 : TBitmap;
...

Bmp1 := TBitmap.Create;
Bmp1.LoadFromFile('C:\Where\B1.BMP');
SetMenuItemBitmaps( MenuItemTest.Handle, 0, MF_BYPOSITION, Bmp1.Handle, Bmp1.Handle);
...

Параметры:

- MenuItemTest - имя пункта меню /горизонтальная строка/.
- 0,1 ... позиция пункта меню, в который надо вставить BMP.
- первый из двух handl'ов - для показа невыбранного пункта меню (unchecked).
- второй - для выбранного (checked). Они могут быть разные.
Код можно вставить в обработчик OnCreate для формы.

!!! При уничтожении меню BitMap не уничтожается, это надо делать отдельно.