Обрабатывать событие OnCloseQuery
Сведения о программе, авторские права и т.д., лучше оформить в виде отдельной формы и показывать ее при запуске программы (как это сделано в Word).
Сделать это не сложно:
1. Создаете форму (например SplashForm).
2. Объявляете ее свободной (availableForms).
3. В Progect Source вставляете следующее (например):
program Splashin;
uses
Forms,
Main in 'MAIN.PAS',
Splash in 'SPLASH.PAS'
{$R *.RES}
begin
try
SplashForm := TSplashForm.Create(Application);
SplashForm.Show;
SplashForm.Update;
Application.CreateForm(TMainForm, MainForm);
SplashForm.Hide;
finally
SplashForm.Free;
end;
Application.Run;
end.
И форма SplashForm держится на экране пока выполняется Create в главной форме. Но иногда она появляется и пропадает очень быстро, поэтому нужно сделать задержку:
1. Добавляете на форму таймер с событием:
procedure TSplashForm.Timer1Timer(Sender: TObject);
begin
Timer1.Enabled := False;
end;
2. Событие onCloseQuery для формы:
procedure TSplashForm.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
CanClose := Not Timer1.Enabled;
end;
3. И перед SplashForm.Hide; ставите цикл:
repeat
Application.ProcessMessages;
until SplashForm.CloseQuery;
4. Все! Осталось установить на таймере период задержки 3-4 секунды.
5. На последок, у такой формы желательно убрать Caption:
SetWindowLong (Main.Handle,GWL_STYLE, GetWindowLong(Main.Handle, GWL_STYLE) AND NOT WS_CAPTION OR WS_SIZEBOX);
А вообще можно сделать и по - другому, так наверно лучше получется:
procedure TForm1.FormCreate(Sender: TObject);
var
t:integer;
begin
SplashForm:=TSplashForm.Create(nil);
SplashForm.Show;
t:=GetTickCount;
while (GetTickCount-t)<5000 do begin //пока не прошло 5000 милливек
sleep(0);
Application.ProcessMessages;
if not SplashForm.Visible then break;
end;
//Application Init Code here...
SplashForm.Free;
end;
Задача такая: Хочу в DLL создать форму (она уже есть), но не модальную, а обыкновенную. То есть я с ней хочу поработать, а "наработанный" результат (к примеру, число) вернуть в форму, в которой вызывал DLL.
Надо использовать SendMessage, а при вызове своей формы (DLL), передавать ей Handle вызывающей формы, а там обработчик события
А в принципе, можно все реализовать на трех функциях - две DLLе - открытие формы и закрытие, а третья - передача результата
Мне понравился следующий вариант: главное приложение само выполняет функции инсталлятора.
Первоначально файл называется Setup.exe. При запуске под этим именем приложение устанавливает себя, после установки программа переименовывает себя и перестает быть инсталлятором.
Пример:
Application.Initialize;
if UpperCase(ExtractFileName(Application.ExeName))='SETUP.EXE'
then Application.CreateForm(TSetupForm, SetupForm) // форма инсталлятора
else Application.CreateForm(TMainForm, MainForm); // форма основной программы
Application.Run;
Я сделал так - выбираю все DLL из каталога с программой, загружаю каждую и пытаюсь найти в ней функцию (через API GetProcAddress) с заранее определенным жестко именем (например что нибудь типа IsPluginForMyStuff). Если нашлась - DLL считается моим плагином, если нет - выгрузить и забыть.
А набор вызываемых функций по идее одинаков у всех плагинов, и программа (основная) в курсе какие именно функции она ищет в DLL. Если даже и не так, то ничего не мешает тебе определить в плагине функцию наподобие GetFeatures, возвращающую список строк-названий поддержанных плагином процедур.
Вот часть моего кода по работе с плагинами...
...
type
// Процедурные типы для хранения ссылок на функции плагинов
TGetNProc=function:shortstring;
TGetSProc=function:integer;
TProcessProc=procedure(config:pointer; request:PRequest; var reply:PReply);
TConfigProc=procedure(defcfg:PSysConfig; var config:pointer);
TSaveLoadProc=procedure(inifile:pointer; var config:pointer);
// Информация об отдельном плагине
TPlugin=record
Name:shortstring; // Полное название
Filename:shortstring; // Имя файла
Handle:integer; // Хэндл загруженной DLL
CFGSize:integer; // Размер конфигурации в RAM
ProcessProc: TProcessProc; // Адрес процедуры обработки
ConfigProc: TConfigProc; // Адрес процедуры настройки
LoadCFG,SaveCFG:TSaveLoadProc; // Адреса процедур чтения/записи cfg
end;
PPlugin=^TPlugin;
// Список загруженных плагинов
TPlugins=class(TList);
...
var
Plugins:TPlugins;
sr:TSearchRec;
lib:integer;
pgetn:TGetNProc;
pgets: TGetSProc;
plugin:PPlugin;
...
// Читаем плагины и создаем их список.
Plugins:=TPlugins.Create;
if FindFirst('*.dll',faAnyFile,sr)<>0 then begin
ShowMessage('Hе найдено подключаемых модулей.');
Close;
end;
repeat
lib:=LoadLibrary(PChar(sr.Name));
if lib<>0 then begin
@pgetn:=GetProcAddress(lib, 'GetPluginName');
if @pgetn=nil then FreeLibrary(lib) // Hе плагин
else begin
New(plugin);
@pgets:=GetProcAddress(lib, 'GetCFGSize');
plugin.Name:=pgetn;
plugin.Filename:=sr.Name;
plugin.CFGSize:=pgets;
plugin.Handle:=lib;
plugin.ConfigProc:=GetProcAddress(lib, 'Configure');
plugin.ProcessProc:=GetProcAddress(lib, 'Process');
plugin.SaveCFG:=GetProcAddress(lib, 'SaveCFG');
plugin.LoadCFG:=GetProcAddress(lib, 'LoadCFG');
Plugins.Add(plugin);
end;
end;
until
FindNext(sr)<>0;FindClose(sr);
...
Эта форма имет прозрачный фон !!!
unit unit1;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls;
type
TForm1 = class(TForm)
Button1: TButton;
Button2: TButton;
// это просто кнопка на форме - для демонстрации
protected
procedure RebuildWindowRgn;
procedure Resize;
override;
public
constructor Create(AOwner: TComponent);
override;
end;
var
Form1 : TForm1;
implementation
// ресурс этой формы
{$R *.DFM}
{ Прозрачная форма }
constructor TForm1.Create(AOwner: TComponent);
begin
inherited;
// убираем сколлбары, чтобы не мешались
// при изменении размеров формы
HorzScrollBar.Visible:= False;
VertScrollBar.Visible:= False;
// строим новый регион
RebuildWindowRgn;
end;
procedure TForm1.Resize;
begin
inherited;
// строим новый регион
RebuildWindowRgn;
end;
procedure TForm1.RebuildWindowRgn;
var
FullRgn, Rgn: THandle;
ClientX, ClientY, I: Integer;
begin
// определяем относительные координаты клиенской части
ClientX:= (Width - ClientWidth) div 2;
ClientY:= Height - ClientHeight - ClientX;
// создаем регион для всей формы
FullRgn:= CreateRectRgn(0, 0, Width, Height);
// создаем регион для клиентской части формы
// и вычитаем его из
FullRgn Rgn:= CreateRectRgn(ClientX, ClientY, ClientX + ClientWidth, ClientY +ClientHeight);
CombineRgn(FullRgn, FullRgn, Rgn, rgn_Diff);
// теперь добавляем к FullRgn регионы каждого контрольного элемента
for I:= 0 to ControlCount -1 do
with Controls[I] do begin
Rgn:= CreateRectRgn(ClientX + Left, ClientY + Top, ClientX + Left +Width, ClientY + Top + Height);
CombineRgn(FullRgn, FullRgn, Rgn, rgn_Or);
end;
// устанавливаем новый регион окна
SetWindowRgn(Handle, FullRgn, True);
end;
end.
interface
uses
Windows, Messages, SysUtils, Classes, Controls,
Forms,
StdCtrls;
type
TForm1 = class(TForm)
Button1: TButton;
Button2: TButton;
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
private
{ Private declarations }
procedure WMGetMinMaxInfo(var msg: TWMGetMinMaxInfo);
message WM_GETMINMAXINFO;
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.DFM}
procedure TForm1.WMGetMinMaxInfo(var msg:
TWMGetMinMaxInfo);
begin
inherited;
with msg.MinMaxInfo^.ptMaxTrackSize do begin
X := GetDeviceCaps( Canvas.handle, HORZRES ) +
(Width - ClientWidth);
Y := GetDeviceCaps( Canvas.handle, VERTRES ) +
(Height - ClientHeight );
end;
end;
procedure TForm1.Button1Click(Sender: TObject);
const
Rect: TRect = (Left: 0; Top: 0; Right: 0; Bottom: 0);
FullScreen: Boolean = False;
// Разворачиваем на весь экран
begin
FullScreen := not FullScreen;
if FullScreen then begin
Rect := BoundsRect;
SetBounds( Left - ClientOrigin.X,
Top - ClientOrigin.Y, GetDeviceCaps( Canvas.handle,
HORZRES )
+ (Width - ClientWidth), GetDeviceCaps( Canvas.handle,
VERTRES )
+ (Height - ClientHeight ));
end
else BoundsRect := Rect;
end;
procedure TForm1.Button2Click(Sender: TObject);
begin
Close;
end;
end.
Обрабатывайте событие OnClose для формы и выставляйте в нем параметр Action в caFree. Дело в том, что его значение по умолчанию для MDI Child форм caMinimize. Кстати, если сделать Action := caNone, то форму нельзя будет закрыть.
1. Разместите на форме TControlBar. (закладка Additional) Установите Align = Client.
2. Разместите TToolBar (закладка Win32) внутри TControlBar.
3. Установите в True свойства Flat и ShowCaptions этого TToolBar.
4. Создайте на TToolBar столько TToolButtons сколько Вам нужно. (щелкнув по TToolBar
правой кнопкой и выбрав NewButton)
5. Установите свойство Grouped = True для всех TToolButtons. Это позволит меню выпадать
при перемещении курсора между главными пунктами меню (если меню уже показано).
6. Разместите на фоме TMainMenu и убедитесь, что оно *НЕ присоденено* как меню главной
формы. (посмотрите свойство Menu формы).
7. Создайте все пункты меню (щелкнув по TMainMenu кнопкой и выбрав Menu Designer)
8. Для каждой TToolButton установите ее MenuItem равным соответсвующему пункту TMainMenu.
unit Main;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls;
type
TForm1 = class(TForm)
Button1: TButton;
Edit1: TEdit;
procedure Button1Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
private
{ Private declarations }
{Отлавливаем, сообщение о изменении разрешения экрана}
procedure WMDisplayChange(var message: TMessage); message WM_DISPLAYCHANGE;
public
{ Public declarations }
W, H: integer;
end;
var
Form1: TForm1;
implementation
{$R *.DFM}
procedure TForm1.Button1Click(Sender: TObject);
begin
Width := Round(Width * 1.5);
Height := Round(Height * 1.5);
ScaleBy(150, 100);
end;
procedure TForm1.WMDisplayChange(var message: TMessage);
begin
inherited;
Width := Round(Width * LOWORD(message.LParam) / W);
Height := Round(Height * HIWORD(message.LParam) / H);
ScaleBy(LOWORD(message.LParam), W);
W := Screen.Width;
H := Screen.Height;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
W := Screen.Width;
H := Screen.Height;
end;
end.
в библиотеке R&A Lib есть компонент tRACaptionButton
Вся основная работа по рисованию кнопки в заголовке окна происходит в процедуре DrawBtn. Рассмотрим код подробней.
procedure TForm1.DrawBtn;
var
WDc: HDc;
Cx,Cy: Integer;
XFrame, Yframe: Integer;
begin
WDc := GetWindowDc(Handle);
Cx := GetSystemMetrics(SM_CXSize);
Cy := GetSystemMetrics(SM_CYSize);
xFrame := GetSystemMetrics(SM_CXFrame);
yFrame := GetSystemMetrics(SM_CYFrame);
R := Bounds(Width - xFrame - 4*Cx + 2, yFrame + 2, Cx - 2, Cy - 4);
if Press then
DrawFrameControl(WDc,R,DFC_BUTTON,DFCS_ButtonPUSH or DFCS_PUSHED)
else
DrawFrameControl(WDc,R,DFC_BUTTON,DFCS_ButtonPUSH);
ReleaseDc(Handle,WDC);
end;
Переменная WDc содержит контекст устройства окна, полученной функцией GetWindowsDc. Он понадобится для рисования окна. С помощью нескольких вызовов функции GetSystemMetrics узнаем размер стандартной кнопки заголовка окна. Затем вычисляем положение и размер прямоугольника, в котором будет рисоваться кнопка. И самое основное вызываем функцию DrawFrameControl. Эта функция рисует стандартный Control заданного типа и стиля. Используя тип DFC_BUTTON рисуем кнопку. Задавая стиль DFCS_BUTTONPUSH рисуется кнопка в нормальном состоянии, если задать стиль DFCS_BUTTONPUSH or DFCS_PUSHED рисуется кнопка в нажатом состоянии. Переменная Press содержит состояние в котором следует рисовать кнопку. В конце работы освобождаем контекст.
Теперь о самом неприятном. Чтобы все это заработало так как надо необходимо обработать кучу сообщений которое windows посылает приложению.Куча это, конечно, громко сказано, но у меня получилось 7, плюс 1 определенное мной для отслеживания Click. Вот эти сообщения:
WM_NCPAINT
WM_NCACTIVATE
WM_NCLBUTTONDOWN
WM_NCHITTEST
WM_SIZE
WM_NCLBUTTONUP
WM_LBUTTONUP
В основном обработка сообщений сводится к вызову DrawBtn. В обработке WM_NCLBUTTONDOWN определяется, была ли опущена левая кнопка мыши в области занятой кнопкой. WM_NCHITTEST предотвращает максимизацию окна. WM_SIZE правильно отрисовывает кнопку при изменении размеров окна. WM_NCLBUTTONUP Определяет был ли щелчок кнопкой мыши. И вызывает обработчик по средствам PostMessage. Вызов PostMessage сделан для того чтобы окно успело отреагировать на другие сообщения. WM_LBUTTONUP используется, если пользователь передумал и убрал курсор с кнопки при нажатой кнопке мыши.
В приведенном примере отслеживается движение курсора мыши - при перемещении между ячейками StringGrid'а - появляется окно подсказки(hint), показываеющее номер текущей строки и колонки.
Пример:
type
TForm1 = class(TForm)
StringGrid1: TStringGrid;
procedure StringGrid1MouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
procedure FormCreate(Sender: TObject);
private
{Private declarations}
Col : integer;
Row : integer;
public
{Public declarations}
end;
var
Form1: TForm1;
implementation
{$R *.DFM}
procedure TForm1.FormCreate(Sender: TObject);
begin
StringGrid1.Hint := '0 0';
StringGrid1.ShowHint := True;
end;
procedure TForm1.StringGrid1MouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
var
r : integer;
c : integer;
begin
StringGrid1.MouseToCell(X, Y, C, R);
with StringGrid1 do
begin
if ((Row <> r) or(Col <> c)) then
begin
Row := r;
Col := c;
Application.CancelHint;
StringGrid1.Hint:=IntToStr(r)+#32+IntToStr(c);
end;
end;
end;
|
