TForm

Как сделать roll-up форму?

2017-08-10T16:25:57+07:00

Code:

unit testmain;

interface

uses

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

ExtCtrls, StdCtrls, Buttons, ShellAPI;

type

TForm1 = class(TForm)

procedure FormCreate(Sender: TObject);

private

{ Private declarations }

FOldHeight: Integer;

procedure WMNCRButtonDown(var Msg: TWMNCRButtonDown);

message WM_NCRBUTTONDOWN;

public

{ Public declarations }

end;

var

Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.FormCreate(Sender: TObject);

begin

FOldHeight := ClientHeight;

end;

procedure TForm1.WMNCRButtonDown(var Msg: TWMNCRButtonDown);

var

I: Integer;

begin

if (Msg.HitTest = HTCAPTION) then

if (ClientHeight = 0) then

begin

I := 0;

while (I < FOldHeight) do

begin

I := I + 40;

if (I > FOldHeight) then

I := FOldHeight;

ClientHeight := I;

Application.ProcessMessages;

end;

end

else

begin

FOldHeight := ClientHeight;

I := ClientHeight;

while (I > 0) do

begin

I := I - 40;

if (I < 0) then

I := 0;

ClientHeight := I;

Application.ProcessMessages;

end;

end.

Подробнее...

Как сделать subform?

2017-08-10T16:28:13+07:00

Those programmers who use the Win API in their programs know that Win32 allows you to insert one dialog box into another one and you'll can deal with subdialog's controls as them were in parent dialog. The good example of it is PropertySheet. I don't know why Borland hided this ability from us and why didn't it insert 'subforming' ability in TForm control. Here I can tell how to use a form as control (subform) in other one and how to create subform controls. It will work in D2, D3 and may be D4 (unfortunatelly, I have not it and can't check). The next steps shows how to make subform component:

First, we have to make the form to be a child. For this we need to override the method CreateParams.

Подробнее...

Как сделать дырку в окне?

2017-08-10T16:22:29+07:00

Code:

procedure TForm1.Button4Click(Sender: TObject);

var

HRegion1, Hreg2, Hreg3: THandle;

Col: TColor;

begin

ShowMessage ('Ready for a real crash?');

Col := Color;

Color := clRed;

PlaySound ('boom.wav', 0, snd_sync);

HRegion1 := CreatePolygonRgn (Pts,

sizeof (Pts) div 8,

alternate);

SetWindowRgn (

Handle, HRegion1, True);

ShowMessage ('Now, what have you done?');

Color := Col;

ShowMessage ('Вам лучше купить новый монитор');

end;

Как сделать форму без caption?

2017-08-10T16:20:21+07:00

Обычная форма:

Code:

TForm.Style:=bsNone

Подробнее...

Как сделать чтобы окно было на весь экран?

2017-08-10T16:18:55+07:00

Code:

PostMessage(Application.Handle, WM_SYSCOMMAND, SC_MAXIMIZE, 1);

Автор ответа: Baa

Как создавать не квадратные формы и контролы?

2017-08-10T16:21:12+07:00

Всё, что нам нужно, это HRGN и дескриптор (handle) элемента управления. SetWindowRgn имеет три параметра: дескриптор окна, которое будем менять, дескритор региона и булевый (boolean) параметр, который указывает - перерисовывать или нет после изменения. Как только у нас есть дескриптор и регион, то можно вызвать SetWindowRgn(Handle, Region, True) и вуаля!

Здесь приведён пример использования функции BitmapToRgn (описанной в примере Как создать регион(HRNG) по маске).

Заметьте, что Вы не должны освобождать регион при помощи DeleteObject, так как после вызова SetWindowRgn владельцем региона становится операционная система.

Подробнее...

Как создать круглую форму?

2017-08-10T16:22:03+07:00

Здесь приведён полный пример того, как создать круглую форму.

Не забудьте создать TButton, чтобы окно можно было закрыть.

Code:

unit Unit1;

interface

uses

Windows, Messages, SysUtils, Classes, Graphics, Controls,

Forms, Dialogs, ExtCtrls, Buttons, StdCtrls;

type

TForm1 = class(TForm)

Button1: TButton;

procedure FormCreate(Sender: TObject);

procedure Button1Click(Sender: TObject);

private

{ Private-Deklarationen}

procedure CreateParams(var Params: TCreateParams); override;

public

{ Public-Deklarationen}

end;

var

Form1: TForm1;

implementation

{$R *.DFM}

{ TForm1 }

procedure TForm1.CreateParams(var Params: TCreateParams);

begin

inherited CreateParams(Params);

{ удаляем заголовок и рамку }

Params.Style := Params.Style or ws_popup xor ws_dlgframe;

end;

procedure TForm1.FormCreate(Sender: TObject);

var

FormRgn: hRgn;

begin

{clear form}

Form1.Brush.Style := bsSolid; //bsclear;

{ делаем круг формы }

GetWindowRgn(Form1.Handle, FormRgn);

{ удаляем старый объект }

DeleteObject(FormRgn);

{ делаем прямоугольник формы }

Form1.Height := 500;

Form1.Width := Form1.Height;

{ создаём круглую форму }

FormRgn := CreateRoundRectRgn(1, 1, Form1.Width - 1,

Form1.height - 1, Form1.width, Form1.height);

{ устанавливаем новое круглое окно }

SetWindowRgn(Form1.Handle, FormRgn, TRUE);

end;

procedure TForm1.Button1Click(Sender: TObject);

begin

Form1.close;

end;

end.

Как создать форму в форме элипса?

2017-08-10T16:26:23+07:00

Code:

procedure TForm1.FormCreate(Sender: TObject);

var

Region: HRGN;

begin

Region := CreateEllipticRgn(0, 0, 300, 300);

SetWindowRgn(Handle, Region, True);

end;

Работа с регионами (статья)

2017-08-10T16:35:21+07:00

Общее описание

Windows API предоставляет набор функций, позволяющих описать произвольную (при желании - достаточно сложную) геометрическую фигуру, которая потом может использоваться при работе с окнами, или, в терминологии Delphi, элементами управления. Использование может заключаться, например, в отрисовке на холсте, в задании специфического региона обновления окна, и т.д. Помимо таких вот относительно невинных возможностей, технология регионов позволяяет также глумиться над благородными очертаниями любого потомка TWinControl (иными словами, любым контролом, имеющим Handle, aka TForm, TButton, и т.д.). Особенно широко регионы используются в формах, при их отрисовке и обновлении.

Итак, для начала, давайте разберёмся, что такое этот самый регион.

Win32 SDK регион определяет следующим образом:

Подробнее...

Создание окон произвольной формы (Статья)

2017-08-10T16:29:23+07:00

Вопрос создания непрямоугольных окон часто интересует начинающих программистов и время от времени обсуждается на форумах разработчиков в среде Delphi. А вообще, нужно ли это кому-нибудь? Ответ - да! Это уже было нужно таким известным фирмам, как Symantec (Norton Utilities, Norton CrashGuard), Microsoft (Приложение "

Часы" в Windows NT4 может принимать круглую форму, Deluxe CD Player из MS Plus! 98 имеет вид прямоугольника со скругленными краями). У Borland Jbuilder 2 в окне начальной загрузки стрела крана "выскочила" за пределы прямоугольника. Программы для видеокарт TV Capture фирмы AverMedia имитируют пульт управления. Окно переводчика Magic Goody принимает вид гуся, разгуливающего по экрану.

Подробнее...

Создание форм с закругленными краями

2017-08-10T16:35:52+07:00

Code:

{

Die CreateRoundRectRgn lasst eine Form mit abgerundeten Ecken erscheinen.

The CreateRoundRectRgn function creates a rectangular

region with rounded corners

}

procedure TForm1.FormCreate(Sender: TObject);

var

rgn: HRGN;

begin

Form1.Borderstyle := bsNone;

rgn := CreateRoundRectRgn(0,// x-coordinate of the region's upper-left corner

0, // y-coordinate of the region's upper-left corner

ClientWidth, // x-coordinate of the region's lower-right corner

ClientHeight, // y-coordinate of the region's lower-right corner

40, // height of ellipse for rounded corners

40); // width of ellipse for rounded corners

SetWindowRgn(Handle, rgn, True);

end

{ The CreatePolygonRgn function creates a polygonal region. }

procedure TForm1.FormCreate(Sender: TObject);

const

C = 20;

var

Points: array [0..7] of TPoint;

h, w: Integer;

begin

h := Form1.Height;

w := Form1.Width;

Points[0].X := C; Points[0].Y := 0;

Points[1].X := 0; Points[1].Y := C;

Points[2].X := 0; Points[2].Y := h - c;

Points[3].X := C; Points[3].Y := h;

Points[4].X := w - c; Points[4].Y := h;

Points[5].X := w; Points[5].Y := h - c;

Points[6].X := w; Points[6].Y := C;

Points[7].X := w - C; Points[7].Y := 0;

SetWindowRgn(Form1.Handle, CreatePolygonRgn(Points, 8, WINDING), True);

end;

Автор: winsoft

Добавляем дополнительную кнопку в заголовок формы

2017-08-10T16:43:07+07:00

Автор: Vimil Saju

Чтобы добавить дополнительную кнопку, нам прийдётся создать обработчики для следующих событий:

WM_NCPAINT;//вызывается, когда перерисовывается не клиентская область формы

WM_NCACTIVATE; вызывается, когда заголовок формы становится активныи

WM_NCLBUTTONDOWN; вызывается, когда кнопка мыши нажимается на не клиентской области

WM_NCMOUSEMOVE; вызывается, когда курсор мыши передвигается по не клиентской области

WM_MOUSEMOVE;вызывается, когда курсор мыши передвигается по клиентской области

WM_LBUTTONUP; вызывается, когда кнопка мыши отпушена в клиентской области

WM_NCLBUTTONUP; вызывается, когда кнопка мыши отпушена в не клиентской области

WM_NCLBUTTONDBLCLK; вызывается при двойном щелчке мышкой в не клиентской области

Подробнее...

Изменяем заголовок окна

2017-08-10T16:39:11+07:00

Автор: Christian Cristofori

В примере показывается, как изменять заголовок окна (видимый в списке задач при переключении между приложениями) при минимизации окна в иконку.

Сперва необходимо определить сообщение поумолчанию:

Code:

Const

DefMsgNorm = 'MyApp version 1.0';

DefMsgIcon = 'MyApp. (Use F12 to turn of)';

Подробнее...

Как изменить шрифт и выравнивание в заголовке формы?

2017-08-10T16:46:29+07:00

Note: The formDeactivate never gets called so when the form isn't active, sometimes the FormPaint isn't called. If anything causes the form to be repainted while in inactive, it draws correctly.

Примечание: formDeactivate никогда не вызывается, когда форма не активна, иногда FormPaint не называется. Если что-то вызывает форму, чтобы быть перекрашены в то время как в неактивном, он правильно рисует.

Подробнее...

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

2017-08-10T16:44:27+07:00

Создайте обработчик одного из сообщений WM_NC (non client - не клиентских) (посмотрите

WM_NC в Windows API help). Пример показывает как перехватить вижение мыши во всей

неклиенстской области окна (рамка и заголовок).

Подробнее...

Как скрыть кнопку [х] в заголовке окна?

2017-08-10T16:38:06+07:00

Автор: Fernando Silva

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

Code:

procedure TForm1.FormCreate(Sender: TObject);

var

hwndHandle: THANDLE;

hMenuHandle: HMENU;

iPos: Integer;

begin

hwndHandle := FindWindow(nil, PChar(Caption));

if (hwndHandle <> 0) then

begin

hMenuHandle := GetSystemMenu(hwndHandle, FALSE);

if (hMenuHandle <> 0) then

begin

DeleteMenu(hMenuHandle, SC_CLOSE, MF_BYCOMMAND);

iPos := GetMenuItemCount(hMenuHandle);

Dec(iPos);

{ Надо быть уверенным, что нет ошибки т.к. -1 указывает на ошибку }

if iPos > -1 then

DeleteMenu(hMenuHandle, iPos, MF_BYPOSITION);

end;

Избавление от скролов в MDI форме

2017-08-10T19:44:33+07:00

Code:

{ Избавление от ScrollBar'ов в MDI-форме. (С) Peter Below (TeamB) }

{ Не надо VCL переписывать :-) }

unit MainForm;

interface

uses

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

Menus;

type

TfMain = class(TForm)

MainMenu1: TMainMenu;

Newchild1: TMenuItem;

Newchild2: TMenuItem;

procedure Newchild2Click(Sender: TObject);

procedure FormCreate(Sender: TObject);

private

{ Private declarations }

public

{ Public declarations }

end;

var

fMain: TfMain;

implementation

uses ChildForm;

{$R *.DFM}

procedure TfMain.Newchild2Click(Sender: TObject);

begin

with TfChild.Create(Application) do

Show();

end;

function ClientWindowProc( wnd: HWND; msg: Cardinal; wparam, lparam: Integer ): Integer; stdcall;

var

f: Pointer;

begin

f := Pointer( GetWindowLong( wnd, GWL_USERDATA ));

case msg of

WM_NCCALCSIZE:

if ( GetWindowLong( wnd, GWL_STYLE ) and

(WS_HSCROLL or WS_VSCROLL)) <> 0 then

SetWindowLong( wnd, GWL_STYLE, GetWindowLong( wnd, GWL_STYLE )

and not (WS_HSCROLL or WS_VSCROLL));

end;

Result := CallWindowProc( f, wnd, msg, wparam, lparam );

end;

procedure TfMain.FormCreate(Sender: TObject);

begin

if ClientHandle <> 0 then begin

if GetWindowLong( ClientHandle, GWL_USERDATA ) <> 0 then

Exit; {cannot subclass client window, userdata already in use}

SetWindowLong(ClientHandle, GWL_USERDATA, SetWindowLong( ClientHandle,

GWL_WNDPROC, integer( @ClientWindowProc)));

end;

end.

Как отобразить модально MDIChild форму

2017-08-10T19:46:50+07:00

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

1.Убераешь свою MDIChild форму из автосоздания: (MainMenu) Project->Options->Forms. Там её перебрасываешь в: Available forms

2. Переключаешься на свою MDIChild форму и дописываеш в описание класса(пусть например твой класс формы для MDIChild называется TForm2):

Подробнее...

Как сделать MDI-приложение, где сливаются меню дочернего и главного окна, и полосы инструментов?

2017-08-10T19:09:09+07:00

Ваpиант 1. CoolBar.

Code:

procedure TMainForm.SetBands(AControls: array of TWinControl;

ABreaks: array of boolean);

var

i: integer;

begin

with CoolBar do

begin

for i:=0 to High(AControls) do

begin

if Bands.Count=succ(i) then

TCoolBand.Create(Bands);

with Bands[succ(i)] do

begin

if Assigned(Control) then

Control.Hide;

MinHeight:=AControls[i].Height;

Break:=ABreaks[i];

Control:=AControls[i];

Control.Show;

Visible:=true;

end

end;

for i:=High(AControls)+2 to pred(Bands.Count) do

Bands[i].Free

end

end;

Подробнее...

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

2017-08-10T19:45:21+07:00

Для того чтобы сделать это выполните следующие шаги:

Создайте новый проект.

Установите FormStyle формы в fsMDIForm

Разместите Image на форме и загрузите в него картинку.

Найдите { Private Declarations } в объявлении формы и добавьте следующие строки:

Подробнее...

Как спрятать окна MDI Child

2017-08-10T19:44:06+07:00

Code:

procedure TCustomForm.VisibleChanging;

begin

if (FormStyle = fsMDIChild) and Visible then

raise EInvalidOperation.Create(SMDIChildNotVisible);

end;

Как убрать заголовок в дочерней форме MDI?

2017-08-10T16:56:49+07:00

Если в дочерней форме MDI установить BorderStyle в bsNone, то заголовок формы не исчезнет. (Об этом сказано в хелпе). А вот следующий пример решает эту проблему:

Code:

type

... = class(TForm)

{ other stuff above }

procedure CreateParams(var Params: TCreateParams); override;

{ other stuff below }

end;

...

procedure tMdiChildForm.CreateParams(var Params: tCreateParams);

begin

inherited CreateParams(Params);

Params.Style := Params.Style and (not WS_CAPTION);

end;

Подробнее...

Как узнать что MIDI форма изменила статус?

2017-08-10T19:45:42+07:00

Code:

private

Procedure WMSize( Var msg: TWMSize ); Message WM_SIZE;

...

Procedure TChildForm.WMSize( Var msg: TWMSize );

Begin

inherited;

If msg.SizeType = SIZE_MINIMIZED Then

...

End;

Меню дочерних MDI-форм

2017-08-10T18:14:47+07:00

Так как MDI-приложения всегда объединяют меню дочерних окон с главным меню родительского окна, вы можете установить определенное значение для указания позиции элементов меню в новой, объединенной строке меню. Это называется индексом группы. Но работает оно только для видимых пунктов меню.

Так, например, если ваше MDI-меню имеет:

[Файл] [Вид] [О программе] (со значениями индексов групп 1 5 10) (Значения не имеют никакого значения (извините за невольный каламбур), они используются только лишь для сортировки),

Подробнее...

Модуль данных для каждого MDIChild

2017-08-10T19:43:45+07:00

Когда во время разработки вы устанавливаете "DataSource"-свойство в БД-компонентах для указания на модуль данных, VCL во время выполнения приложения будет пытаться создать связь с существующим TDataModule, основываясь на его свойтсве Name. Так, если вы добавите модуль данных к вашему проекту и переместите его в свойстве проекта из колонки автоматически создаваемых форм в колонку доступных, вы сможете разработать форму, содержащую элементы управления для работы с базами данных, после чего несколькими строчками кода можете создать экземпляр формы, имеющий экземпляр собственного модуля данных.

С помощью Репозитория создайте "standard MDI application" (стандартное MDI-приложение), в котором модуль TMDICHild будет похож на приведенный ниже. Добавленные строки имеют комментарий {!}. Хитрости спрятаны в конструкторе create и задании другого порядка следования операторов.

Подробнее...

Открытие MDI-окон определенного размера

2017-08-10T18:13:44+07:00

Code:

var

ProjectWindow: TWndProject;

begin

If ProjectActive=false then

begin

LockWindowUpdate(ClientHandle);

ProjectWindow:=TWndProject.Create(self);

ProjectWindow.Left:=10;

ProjectWindow.Top:=10;

ProjectWindow.Width:=373;

ProjecTwindow.Height:=222;

ProjectWindow.Show;

LockWindowUpdate(0);

end;

Используйте LockWindowUpdate перед созданием окна и после того, как создание будет завершено.

Позиция дочерних MDI-окон

2017-08-10T18:15:18+07:00

Автор: Richard Cox

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

У меня была аналогичная проблема -- она проявлялась при условии, когда свойство главной формы WindowState устанавливалось на wsMinimized.

Вот мое решение: добавьте этот небольшой метод к вашей главной форме:

Подробнее...

Почему MDI Child форма при закрывании просто минимизируется?

2017-08-10T18:12:49+07:00

Обрабатывайте событие OnClose для формы и выставляйте в нем параметр Action в caFree. Дело в том, что его значение по умолчанию

для MDI Child форм caMinimize. Кстати, если сделать Action := caNone, то форму нельзя будет закрыть

Придание MDI-формам большей трехмерности

2017-08-10T19:43:13+07:00

Code:

constructor TMainForm.Create(AOwner: TComponent);

begin

Inherited Create(AOwner);

SetWindowLong(ClientHandle, GWL_EXSTYLE,

GetWindowLong(ClientHandle,

GWL_EXSTYLE) or WS_EX_CLIENTEDGE);

SetWindowPos(ClientHandle, 0, 0, 0, 0, 0,

swp_DrawFrame or swp_NoMove or swp_NoSize

or swp_NoZOrder);

end;

Проблема всплывающих подсказок в дочерних MDI-формах

2017-08-10T18:14:15+07:00

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

Объявите следующую процедуру в классе вашей главной формы:

Code:

private

{============================================================}

{ Процедура, вызываемая приложением всякий раз, когда }

{ приложение хотело бы показать всплывающую подсказку. }

{ Добавляет хинт на панель статуса. }

{============================================================}

procedure ShowHint(Sender : TObject);

Подробнее...

Разработка MDI приложений в Delphi

2017-08-10T16:55:09+07:00

перевод одноимённой статьи с delphi.about.com)

Что такое MDI?

MDI расшифровывается как multiple document interface (многодокументный интерфейс). В приложениях с MDI, в основном (родительском) окне можно окрыть более одного дочернего окна. Данная возможность обычно используется в электронных таблицах или текстовых редакторах.

Каждое MDI приложение имеет три основные составляющие:

Одну (и только одну) родительскую форму MDI, Одну и более (обычно больше) дочерних форм MDI, и основное меню MDI.

Подробнее...

Сколько открыто дочерних окон?

2017-08-10T18:13:20+07:00

Code:

Form1.MDIChildCount

Подробнее...

Создать MDI окно с координатами 0,0

2017-08-10T19:46:01+07:00

Code:

procedure TFormX.FormCreate(Sender: TObject);

Var

r: TRect;

client: HWND;

Begin

client := application.mainform.clienthandle;

Windows.GetClientRect( client, r );

MapWindowPoints( client, HWND_DESKTOP, r, 2 );

BoundsRect := r;

End;

Фон MDI-окон

2017-08-10T17:04:07+07:00

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

(Tile - "секция, плитка" - непрерывное заполнение определенной области немасштабируемым изображением слева-направо сверху вниз - В.О.)

Подробнее...

Выводим цветной текст на форме под любым углом

2017-08-10T14:16:22+07:00

Автор: Lutfi Baran

Пример демонстрирует вывод теста случайным образом на форме под определённым углом. Добавляем в форму компонент TButton и в событие OnClick следующий код:

Code:

procedure TForm1.Button1Click(Sender: TObject);

var

logfont: TLogFont;

font: Thandle;

count: integer;

begin

LogFont.lfheight := 20;

logfont.lfwidth := 20;

logfont.lfweight := 750;

LogFont.lfEscapement := -200;

logfont.lfcharset := 1;

logfont.lfoutprecision := out_tt_precis;

logfont.lfquality := draft_quality;

logfont.lfpitchandfamily := FF_Modern;

font := createfontindirect(logfont);

Selectobject(Form1.canvas.handle, font);

SetTextColor(Form1.canvas.handle, rgb(0, 0, 200));

SetBKmode(Form1.canvas.handle, transparent);

for count := 1 to 100 do

begin

canvas.textout(Random(form1.width), Random(form1.height), 'Hello');

SetTextColor(form1.canvas.handle, rgb(Random(255), Random(255), Random

(255)));

end;

Deleteobject(font);

end;

Как изменить оконную процедуру для TForm?

2017-08-10T14:16:53+07:00

Переопределите в подклассе TForm оконную процедуру WinProc класса. В примере оконная процедура переопределяется для того чтобы реагировать на сообщение WM_CANCELMODE, показывающее, что выполняется messagebox или какой-либо еще диалог.

Code:

type

TForm1 = class(TForm)

Button1: TButton;

procedure WndProc(var Message: TMessage); override;

procedure Button1Click(Sender: TObject);

private

{Private declarations}

public

{Public declarations}

end;

var

Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.WndProc(var Message: TMessage);

begin

if Message.Msg = WM_CANCELMODE then

begin

Form1.Caption := 'A dialog or message box has popped up';

end

else

inherited // <- остальное сделает родительская процедура

end;

procedure TForm1.Button1Click(Sender: TObject);

begin

ShowMessage('Test Message');

end;

Как иммитировать появление формы как нового приложения?

2017-08-10T14:15:29+07:00

How i can create a form and this form stay in another icon in task bar ? (Looks like a new aplication).

Как я могу создать форму, и эта форма пребывания в другой значок в панель задач ? (Выглядит как новый применение).

In private clause:

Code:

type

TForm1 = class(TForm)

private

{ Private declarations }

procedure CreateParams(var Params: TCreateParams); override;

Подробнее...

Как поместить курсор мышки в нужное место на форме?

2017-08-10T14:15:56+07:00

Code:

uses

Windows;

procedure PlaceMyMouse(Sender: TForm; X, Y: word);

var

MyPoint: TPoint;

begin

MyPoint := Sender.ClientToScreen(Point(X, Y));

SetCursorPos(MyPoint.X, MyPoint.Y);

end;

Как сделать анимацию минимизации формы?

2017-08-10T14:13:59+07:00

In FormShow:

Code:

var

RecS, RecL: TRect;

begin

RecS := Rect(Screen.Width, Screen.Height, Screen.Width, Screen.Height);

RecL := ThisForm.BoundsRect;

DrawAnimatedRects(GetDesktopWindow, IDANI_CAPTION, RecS, RecL);

{ ... }

end;

Подробнее...

Как сделать форму всегда позади всех окон?

2017-08-10T14:19:01+07:00

Code:

protected

procedure CreateParams(var Params: TCreateParams); override;

//...

procedure TForm.CreateParams(var Params: TCreateParams);

begin

inherited CreateParams(Params);

if Assigned(Application.MainForm) then

begin

Params.WndParent := GetDesktopWindow;

Params.Style := WS_CHILD;

end;

Как среагировать на минимизацию-максимизацию формы перед тем как произойдет изменение?

2017-08-10T14:17:21+07:00

Перехватывать сообщение WM_SYSCOMMAND. Если это сообщение говорит о

минимизации или максимизации формы - пищит динамик.

Code:

type

TForm1 = class(TForm)

private

{Private declarations}

procedure WMSysCommand(var Msg: TWMSysCommand);

message WM_SYSCOMMAND;

public

{Public declarations}

end;

var

Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.WMSysCommand;

begin

if (Msg.CmdType = SC_MINIMIZE) or (Msg.CmdType = SC_MAXIMIZE) then

MessageBeep(0)

else

inherited;

end;

Как узнать форма активна или нет?

2017-08-10T14:18:37+07:00

Code:

type

//...

private

{ Private declarations }

procedure WMNCACTIVATE(var M: TWMNCACTIVATE); message WM_NCACTIVATE;

end;

implementation

//...

procedure TForm1.WMNCACTIVATE(var M: TWMNCACTIVATE);

begin

inherited;

if M.Active then

caption:='Form active'

else caption:='Form not active' ;

end;

Как узнать, находится ли мышка на форме?

2017-08-10T14:12:07+07:00

Для этого можно воспользоваться API функцией GetCapture().

Code:

procedure TForm1.FormDeactivate(Sender: TObject);

begin

ReleaseCapture;

end;

procedure TForm1.FormMouseMove(Sender: TObject; Shift: TShiftState; X,

Y: Integer);

begin

If GetCapture = 0 then

SetCapture(Form1.Handle);

if PtInRect(Rect(Form1.Left,

Form1.Top,

Form1.Left + Form1.Width,

Form1.Top + Form1.Height),

ClientToScreen(Point(x, y))) then

Form1.Caption := 'Мышка на форме' else

Form1.Caption := 'Мышка за пределами формы';

end;

Взято из https://forum.sources.ru

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

2017-08-10T14:11:24+07:00

Необходимо объявить обработчик события для WM_GETMINMAXINFO:

Code:

...

private

procedure WMGetMinMaxInfo(var Message : TWMGetMinMaxInfo);

message WM_GETMINMAXINFO;

А вот как выглядит сам обработчик:

procedure TForm1.WMGetMinMaxInfo(var Message : TWMGetMinMaxInfo);

begin

Message.MinMaxInfo^.ptMinTrackSize := Point(Width, Height);

Message.MinMaxInfo^.ptMaxTrackSize := Point(Width, Height);

end;

Взято из https://forum.sources.ru

Примечание от Vit:

Начиная с Дельфи 5 появилось удобное свойство Constrains - специально для ограничесния минимальных и максимальных размеров...

Масштабирование формы под разрешение экрана

2017-08-10T14:24:31+07:00

Эта подпрограмма сделает жизнь программиста намного легче. Она делает так, чтобы ваша программа корректно масштабировалась при ЛЮБОМ разрешении экрана. Обратите внимание на число 640. Дело в том, что я разрабатываю свои приложения при разрешении 640x480. Вы можете настроить подпрограмму на ваше экранное разрешение при разработке программ и больше не беспокоиться о всевозможных низких и больших разрешений ваших пользователей. Разместите в обработчике события формы (которую вы хотите автомасштабировать) OnCreate следующую строку:

Подробнее...

Мерцание формы

2017-08-10T14:17:50+07:00

Как бы это осуществить рисование в окне без его дурацкого мерцания и без помощи создания виртуального изображения в памяти? WM_SETREDRAW здесь поможет?

Попробуйте этот код. Даже если некоторые компоненты имеют пару BeginUpdate / EndUpdate, то для таких компонентов, как TTreeView, интенсивное рисование может послужить причиной перемещения полосы прокрутки и появления других "барабашек". В таких ситуаций вместо дескриптора элемента управления используйте родительский дескриптор.

Подробнее...

Наполовину активное окно

2017-08-10T14:19:22+07:00

Как сделать так, чтобы окно было неактивно? Вы скажите: "Ничего сложного. Нужно только свойство окна Enabled установить в false"... но, так как окно является владельцем компонентов, находящихся на нём, то и все компоненты станут неактивными! Но был найден способ избежать этого!

Code:

private

{ Private declarations }

procedure WMNCHitTest (var M: TWMNCHitTest); message wm_NCHitTest;

implementation

{$R *.DFM}

procedure TForm1.WMNCHitTest (var M:TWMNCHitTest);

begin

if M.Result = htClient then

M.Result := htCaption;

end;

Полноэкранный режим

2017-08-10T14:23:59+07:00

Code:

function SetFullscreenMode: Boolean;

var

DeviceMode: TDevMode;

begin

with DeviceMode do

begin

dmSize := SizeOf(DeviceMode);

dmBitsPerPel := 16;

dmPelsWidth := 640;

dmPelsHeight := 480;

dmFields := DM_BITSPERPEL or DM_PELSWIDTH or DM_PELSHEIGHT;

result := False;

if ChangeDisplaySettings(DeviceMode, CDS_TEST or CDS_FULLSCREEN) <>

DISP_CHANGE_SUCCESSFUL then

Exit;

Result := ChangeDisplaySettings(DeviceMode, CDS_FULLSCREEN) =

DISP_CHANGE_SUCCESSFUL;

end;

procedure RestoreDefaultMode;

var

T: TDevMode absolute 0;

begin

ChangeDisplaySettings(T, CDS_FULLSCREEN);

end;

procedure TForm1.Button1Click(Sender: TObject);

begin

if setFullScreenMode then

begin

sleep(7000);

RestoreDefaultMode;

end;

Привлечение внимания к окну

2017-08-10T14:18:15+07:00

Часто возникает проблема - в многооконном приложении необходимо обратить внимание пользователя на то, что какое-то из окон требует внимания (например, к нему пришло сообщение по DDE, в нем завершился какой-либо процесс, произошла ошибка ...). Это легко сделать, используя команду API FlashWindow:

Code:

procedure TForm1.Timer1Timer(Sender: TObject);

begin

FlashWindow(Handle,true);

end;

Пример градиентной заливки формы

2017-08-10T14:22:24+07:00

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

Например, нужно сложить красный и синий. Получаем

(255,0,0)+(0,0,255)=((255+0) div 2,(0+0) div 2,(0+255) div 2)=(127,0,127).

В результате получаем сиреневый цвет. Также надо поступать, если цветов более чем 2: сложить соответствующие координаты, потом каждую сумму разделить нацело на количество цветов.

Поговорим теперь о градиентной заливке. Градиентная заливка - это заливка цветом с плавным переходом от одного цвета к другому.

Итак, пусть заданы 2 цвета своими координатами ((A1, A2, A3) и (B1, B2, B3)) и линия (длиной h пикселов), по которой нужно залить. Тогда каждый цвет каждого пиксела, находящегося на расстоянии x пикселов от начала будет равен (A1-(A1-B1)/h*x, A2-(A2-B2)/h*x, A3-(A3-B3)/h*x). Теперь, имея линию с градиентной заливкой, можно таким образом залить совершенно любую фигуру: будь то прямоугольник, круг или просто произвольная фигура.

Подробнее...

Узнать класс формы

2017-08-10T14:22:46+07:00

Code:

type

PFieldClassTable = ^TFieldClassTable;

TFieldClassTable = packed record

Count: Smallint;

Classes: array[0..8191] of ^TPersistentClass;

end;

function GetFieldClassTable(AClass: TClass): PFieldClassTable; assembler;

asm

MOV EAX,[EAX].vmtFieldTable

OR EAX,EAX

JE @@1

MOV EAX,[EAX+2].Integer

@@1:

end;

procedure TForm1.Button1Click(Sender: TObject);

procedure Display( const S: String );

begin

memo1.lines.add( S );

end;

var

pFCT: PFieldClassTable;

aClass: TClass;

i: SmallInt;

begin

memo1.clear;

aClass:= Classtype;

While aClass <> TPersistent Do Begin

Display('Registered classes for class '+aClass.Classname );

pFCT := GetFieldClasstable( aClass );

If not Assigned( pFCT ) Then

Display(' No classes registered')

Else Begin

Display( format(' %d classes registered', [pFCT^.Count]));

for i:= 0 to pFCT^.Count -1 do

Display( ' '+pFCT^.Classes[i]^.ClassName );

End;

aClass := aClass.ClassParent;

End

end;

Функция, которая нарисует на форме сетку и сделает форму похожей на дизайнер форм Delphi

2017-08-10T14:23:28+07:00

Функция, которая нарисует на форме сетку и сделает форму похожей на дизайнер форм Delphi. По умолчанию в дизайнере Delphi отступы равны 8 пикселям

Code:

Procedure TForm1.DrawGrid;

Var

TmpBmp: TBitmap;

Begin

TmpBmp := TBitmap.Create;

Try

With TmpBmp Do

Begin

Width := 8;

Height := 8;

Canvas.Brush.Color := clBtnFace;

Canvas.FillRect(TmpBmp.Canvas.ClipRect);

Canvas.Pixels[0, 0] := clBlack;

Canvas.Pixels[0, Height] := clBlack;

Canvas.Pixels[Width, 0] := clBlack;

Canvas.Pixels[Width, Height] := clBlack;

End;

With Canvas, Brush Do

Begin

Bitmap := TBitmap.Create;

Try

Bitmap.Assign(TmpBmp);

Canvas.FillRect(Canvas.ClipRect);

Finally

Bitmap.Free;

End;

Finally

TmpBmp.Free;

End;

{ Использование }

Procedure TForm1.FormPaint(Sender: TObject);

Begin

DrawGrid;

End;

Подробнее...

Как запретить перемещение формы?

2017-08-10T19:53:14+07:00

Code:

type

TyourForm = class(TForm)

private

{ Private declarations }

procedure WMNCHitTest(var Message: TWMNCHitTest); message WM_NCHITTEST;

end;

procedure TyourForm.WMNCHitTest(var Message: TWMNCHitTest);

begin

inherited;

with Message do

if Result = HTCAPTION then

Result := HTNOWHERE;

end;

Взято с Delphi Knowledge Base

Как прикрепить свою форму к другому приложению?

2017-08-10T19:51:00+07:00

Для этого Вам понадобится переопределить процедуру CreateParams у желаемой формы. А в ней установить params.WndParent в дескриптор окна, к которому Вы хотите прикрепить форму.

Подробнее...

Как узнать какое окно закрывает форму

2017-08-10T19:54:26+07:00

Code:

//Find windows that may cover another window.

Var

hW: HWnd;

r: TRect;

begin

hw := Handle;

While IsWindow(hw) Do Begin

hw := GetWindow( hw, GW_HWNDPREV );

If IsWindowVisible(hw) and not IsIconic( hw ) Then Begin

... use GetWindowRect( hw, r ) to get candidate windows

rect and check if it intersects the forms BoundsRects via

IntersectRect

End;

end;

Как узнать что форма потеряла фокус?

2017-08-10T19:54:49+07:00

Code:

Application.OnDeactivate

Как узнать, была ли перемещена форма?

2017-08-10T19:50:36+07:00

Code:

type

TfrmMain = class(TForm)

private

procedure OnMove(var Msg: TWMMove); message WM_MOVE;

end;

(...)

procedure TfrmMain.OnMove(var Msg: TWMMove);

begin

inherited;

(...)

end;

(...)

Липкие окошки

2017-08-10T19:52:30+07:00

Из одноимённой статьи с сайта delphi.about.com

В статье рассматривается приём создания обработчиков сообщений, которые позволяют форме при перетаскивании "прилипать" к краям экранной области.

Конечно же в Win API такой возможности не предусмотрено, поэтому мы воспользуемся сообщениями Windows. Как нам извесно, Delphi обрабатывает сообщения через события, генерируя его в тот момент, когда Windows посылает сообщений приложению. Однако некоторые сообщения не доходят до нас. Например, при изменении размеров формы, генерируется событие OnResize, соотвествующее сообщению WM_SIZE, но при перетаскивании формы никакой реакции не происходит. Конечно же форма может получить это сообщение, но изначально никаких действий для данного сообщения не предусмотрено.

Подробнее...

Ограничить подвижность формы

2017-08-10T19:53:54+07:00

For some reason messages.pas declares no message record for this message

Code:

type

TWmMoving = record

Msg: Cardinal;

fwSide: Cardinal;

lpRect: PRect;

Result: Integer;

end;

// Add a handler to your forms private section:

procedure WMMoving(var msg: TWMMoving); message WM_MOVING;

// Implement it as

procedure TFormX.WMMoving(var msg: TWMMoving);

var

r: TRect;

begin

r := Screen.WorkareaRect;

// compare the new form bounds in msg.lpRect^ with r and modify it if

// necessary

if msg.lprect^.left < r.left then

OffsetRect(msg.lprect^, r.left - msg.lprect^.left, 0);

if msg.lprect^.top < r.top then

OffsetRect(msg.lprect^, 0, r.top - msg.lprect^.top);

if msg.lprect^.right > r.right then

OffsetRect(msg.lprect^, r.right - msg.lprect^.right, 0);

if msg.lprect^.bottom > r.bottom then

OffsetRect(msg.lprect^, 0, r.bottom - msg.lprect^.bottom);

inherited;

end;

Таскаем форму за её поверхность

2017-08-10T19:52:49+07:00

Code:

unit DragMain;

interface

uses

SysUtils, WinTypes, WinProcs, Messages,

Classes, Graphics, Controls, Forms, Dialogs, StdCrtls;

type

TForm1 = class(TForm)

Button1: TButton;

procedure ButtonClick(Sender: TObject);

private

procedure WMNCHitTest(var M: TWMNCHitTest);

message wm_NCCHitTest;

end;

var

Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1. WMNCHitTest(var M: TWMNCHitTest);

begin

inherited;

if M.Result = htClient then

M.Result := htCaption;

end;

procedure TForm1.Button1Click(Sender: TObject);

begin

Close;

end;

end.

Как выбрать и установить уровень прозрачности формы

2017-08-10T16:08:46+07:00

Code:

Form1.AlphaBlendValue := 200 {Уровень прозрачности};

Form1.AlphaBlend := True;

Delphi 6+

TForm

Как сделать roll-up форму?

Как сделать subform?

Как сделать дырку в окне?

Как сделать форму без caption?

Как сделать чтобы окно было на весь экран?

Как создавать не квадратные формы и контролы?

Как создать круглую форму?

Как создать форму в форме элипса?

Работа с регионами (статья)

Общее описание

Создание окон произвольной формы (Статья)

Создание форм с закругленными краями

Добавляем дополнительную кнопку в заголовок формы

Изменяем заголовок окна

Как изменить шрифт и выравнивание в заголовке формы?

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

Как скрыть кнопку [х] в заголовке окна?

Избавление от скролов в MDI форме

Как отобразить модально MDIChild форму

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

Как сделать MDI-приложение, где сливаются меню дочернего и главного окна, и полосы инструментов?

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

Как спрятать окна MDI Child

Как убрать заголовок в дочерней форме MDI?

Как узнать что MIDI форма изменила статус?

Меню дочерних MDI-форм

Модуль данных для каждого MDIChild

Открытие MDI-окон определенного размера

Позиция дочерних MDI-окон

Почему MDI Child форма при закрывании просто минимизируется?

Придание MDI-формам большей трехмерности

Проблема всплывающих подсказок в дочерних MDI-формах

Разработка MDI приложений в Delphi

Что такое MDI?

Сколько открыто дочерних окон?

Создать MDI окно с координатами 0,0

Фон MDI-окон

Выводим цветной текст на форме под любым углом

Как изменить оконную процедуру для TForm?

Как иммитировать появление формы как нового приложения?

Как поместить курсор мышки в нужное место на форме?

Как сделать анимацию минимизации формы?

Как сделать форму всегда позади всех окон?

Как среагировать на минимизацию-максимизацию формы перед тем как произойдет изменение?

Как узнать форма активна или нет?

Как узнать, находится ли мышка на форме?

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

Масштабирование формы под разрешение экрана

Мерцание формы

Наполовину активное окно

Полноэкранный режим

Привлечение внимания к окну

Пример градиентной заливки формы

Узнать класс формы

Функция, которая нарисует на форме сетку и сделает форму похожей на дизайнер форм Delphi

Как запретить перемещение формы?

Как прикрепить свою форму к другому приложению?

Как узнать какое окно закрывает форму

Как узнать что форма потеряла фокус?

Как узнать, была ли перемещена форма?

Липкие окошки

Ограничить подвижность формы

Таскаем форму за её поверхность

Как выбрать и установить уровень прозрачности формы

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