Валентин Озеров - Советы по Delphi. Версия 1.4.3 от 1.1.2001
if ModalResult = mrCancel then CloseModal;
until ModalResult <> 0;
Hide;
Result := ModalResult;
SendMessage(Handle, CM_DEACTIVATE, 0, 0);
finally
Hide;
end;
end;
Конечно, в TMyForm должно быть FormStyle := fsStayOnTop;
Прозрачная форма
Dmitry V. Koreyba советует:
Высылаю прогу которая делает прозрачной форму. Может кому-нибудь поможет в его дизайнерских изысканиях.
var FullRgn, ClientRgn, CtlRgn : THandle;
procedure TForm1.DoInvisible;
var
AControl : TControl;
A, Margin, X, Y, CtlX, CtlY : Integer;
begin
Margin := (Width - ClientWidth) div 2;
FullRgn := CreateRectRgn(0, 0, Width, Height);
X := Margin;
Y := Height - ClientHeight - Margin;
ClientRgn := CreateRectRgn(X, Y, X + ClientWidth, Y + ClientHeight);
CombineRgn(FullRgn, FullRgn, ClientRgn, RGN_DIFF);
for A := 0 to ControlCount - 1 do begin
AControl := Controls[A];
if (AControl is TWinControl) or (AControl is TGraphicControl) then
with AControl do begin
if Visible then begin
CtlX := X + Left;
CtlY := Y + Top;
CtlRgn := CreateRectRgn(CtlX, CtlY, CtlX + Width, CtlY + Height);
CombineRgn(FullRgn, FullRgn, CtlRgn, RGN_OR);
end;
end;
end;
SetWindowRgn(Handle, FullRgn, TRUE);
end;
procedure TForm1.FormDestroy(Sender: TObject);
begin
DeleteObject(ClientRgn);DeleteObject(FullRgn);
DeleteObject(CtlRgn);
end;
procedure TForm1.DoVisible;
begin
FullRgn := CreateRectRgn(0, 0, Width, Height);
CombineRgn(FullRgn, FullRgn, FullRgn, RGN_COPY);
SetWindowRgn(Handle, FullRgn, TRUE);
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
DoInvisible;
end;
Каким образом можно изменить системное меню формы?
Nomadic советует:
Hе знаю как насчет акселераторов,надо поискать, а вот добавить пункт меню(Item) — пожалуйста
type TMyForm=class(TForm)
procedure wmSysCommand(var Message:TMessage); message WM_SYSCOMMAND;
end;
const
ID_ABOUT = WM_USER+1;
ID_CALENDAR=WM_USER+2;
ID_EDIT = WM_USER+3;
ID_ANALIS = WM_USER+4;
implementation
procedure TMyForm.wmSysCommand;
begin
case Message.wParam of
ID_CALENDAR:DatBitBtnClick(Self);
ID_EDIT :EditBitBtnClick(Self);
ID_ANALIS:AnalisButtonClick(Self);
end;
inherited;
end;
procedure TMyForm.FormCreate(Sender: TObject);
var SysMenu:THandle;
begin
SysMenu:=GetSystemMenu(Handle,False);
InsertMenu(SysMenu, Word(-1), MF_SEPARATOR, ID_ABOUT, '');
InsertMenu(SysMenu, Word(-1), MF_BYPOSITION, ID_Calendar, 'Calendar');
InsertMenu(SysMenu, Word(-1), MF_BYPOSITION, ID_Analis, 'Analis');
InsertMenu(SysMenu, Word(-1), MF_BYPOSITION, ID_Edit, 'Edit');
end;
Как сделать MDI-приложение, в котором способны сливаться не только меню дочернего и главного окна, но и полосы инструментов?
Nomadic советует:
Вариант 1. CoolBar.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;
и
procedure TMsgForm.FormActivate(Sender: TObject);
begin
MainForm.SetBands([ToolBar],[false])
end;
Примечание:
Оба массива равны по длине. CoolBar.Bands[0] должен существовать всегда,.. на нём я размешаю «глобальные» кнопки. СoolBar[1] тоже можно сделать в DesignTime с Break:=false и придвинуть поближе с началу. При CoolBar.AutoSize:=true возможно «мигании» (при добавлении на новую строку) так что можно добавить:
AutoSize:=false; try … finally AutoSize:=true;
Вариант 2.TMainForm
…
object SpeedBar: TPanel
...
Align = alTop
BevelOuter = bvNone
object ToolBar: TPanel
...
Align = alLeft
BevelOuter = bvNone
end
object RxSplitter1: TRxSplitter
...
ControlFirst = ToolBar
ControlSecond = ChildBar
Align = alLeft
BevelOuter = bvLowered
end
object ChildBar: TPanel
...
Align = alClient
BevelOuter = bvNone
end
end
TMdiChild {прародитель всех остальных}
..
object pnToolBar: TPanel
…
Align = alTop
BevelOuter = bvNone
Visible = False
end
end;
procedure TMDIForm.FormActivate(Sender: TObject);
begin
pnToolBar.Parent:=MainForm.ChildBar;
pnToolBar.Visible:=True;
end;
procedure TMDIForm.FormDeactivate(Sender: TObject);
begin
pnToolBar.Visible:=false;
pnToolBar.Parent:=self
{pnToolBar.Visible:=false}
end;
Заполнение изображением MDI-формы IV
Nomadic советует:
Я делал так:
type
…. = class(TForm)
....
procedure FormCreate(Sender:TObject);
procedure FormDestroy(Sender:TObject);
....
private
FHBrush: HBRUSH;
FCover: TBitmap;
FNewClientInstance: TFarProc;
FOldClientInstance: TFarProc;
procedure NewClientWndProc(var Message:TMessage);
....
protected
....
procedure CreateWnd; override;
....
end;
.....
implementation
{$R myRes.res} //ресурс с битмапом фона
procedure .FormCreate(...);
var LogBrush:TLogbrush;
begin
FCover:=TBitmap.Create;
FCover.LoadFromResourceName(hinstance,'BMPCOVER');
With LogBrush do begin
lbStyle:=BS_PATTERN;
lbHatch:=FCover.Handle;
end;
FHBrush:=CreateBrushIndirect(Logbrush);
end;
procedure .FormDestroy(...);
begin
DeleteObject(FHBrush);
FCover.Free;
end;
procedure .CreateWnd;
begin
inherited CreateWnd;
if (ClientHandle <> 0) then begin
if NewStyleControls then
SetWindowLong(ClientHandle, GWL_EXSTYLE, WS_EX_CLIENTEDGE or GetWindowLong(ClientHandle, GWL_EXSTYLE));
FNewClientInstance:=MakeObjectInstance(NewClientWndProc);
FOldClientInstance:=pointer(GetWindowLong(ClientHandle, GWL_WNDPROC));
SetWindowLong(ClientHandle, GWL_WNDPROC, longint(FNewClientInstance));
end;
end;
procedure .NewClientWndProc(var Message:TMessage);
procedure Default;
begin
with Message do
Result := CallWindowProc(FOldClientInstance, ClientHandle, Msg, wParam, lParam);
end;
begin
with Message do begin
case Msg of
WM_ERASEBKGND:
begin
FillRect(TWMEraseBkGnd(Message).DC, ClientRect,FHBrush);
Result := 1;
end;
else
Default;
end;
end;
end;
Предотвращение закрытия формы
