Главная страница
    Top.Mail.Ru    Яндекс.Метрика
Форум: "Основная";
Текущий архив: 2004.05.02;
Скачать: [xml.tar.bz2];

Вниз

Проблема при минимизации окна.   Найти похожие ветки 

 
/\_A_M_E_P   (2004-04-14 23:00) [0]

Вот код:
procedure TForm1.ApplicationEvents1Minimize(Sender: TObject);
begin
 Visible:=False;
end;

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


 
WQSing   (2004-04-14 23:11) [1]

Может, попробовать визибл с дочерним окошком? Или вообще не минимизировать, а положить рядом с "закрыть" кнопку (вместо "свернуть") свою - под скрытие приложения или формы. А "свернуть" и "восстановить" убрать.


 
/\_A_M_E_P   (2004-04-14 23:14) [2]

Можно примерчик как скрыть кнопку минимизации и положить свою?


 
WQSing   (2004-04-14 23:26) [3]

Чтобы скрыть кнопки кроме креста:

bordericons:=[biSystemMenu];

А вот пример формы, где создается кнопка в заголовке и привязывается событие клика на нее:

unit main;

interface

uses
 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
 ComCtrls, ExtCtrls, StdCtrls;

const
wm_BtnClk = wm_User + 111;
type
 TForm1 = class(TForm)
   procedure FormDestroy(Sender: TObject);
 private
   { Private declarations }
 R: TRect;
 Press: Boolean;
 procedure WmNcPaint(var Msg: TWmNcPaint); message wm_NcPaint;
 procedure WMNcActivate(var msg: TwmncActivate); message wm_NcActivate;
 procedure WmNcLButtonDown( var Msg: TWMNCLBUTTONDOWN); message Wm_NCLbuttonDown;
 procedure wmnchittest(var Msg: TWMncHITTEST); message wm_NcHittest;
 procedure wmSize(var Msg: TMessage); message wm_Size;
 procedure wmncLButtonUp(var msg: TWMncLBUTTONUP); message wm_NclButtonUp;
 procedure wmLbuttonUp(var Msg: TMessage); message wm_LbuttonUp;
 procedure wmBtnClk(var msg: TMessage); message wm_BtnClk;
 public
   { Public declarations }
   procedure DrawBtn;
 end;

var
 Form1: TForm1;

implementation

{$R *.DFM}

{ TForm1 }

procedure TForm1.WmNcPaint(var Msg: TWmNcPaint);
begin
inherited;
Drawbtn;
end;

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;

procedure TForm1.WMNcActivate(var msg: TwmncActivate);
begin
inherited;
DrawBtn;
end;

procedure TForm1.WmNcLButtonDown(var Msg: TWMNCLBUTTONDOWN);
var pt: TPoint;
begin
inherited;
drawbtn;
pt := Point(msg.XCursor - Left,msg.YCursor - top);
if PtInRect(R,pt) then
begin
 Press := True;
 drawbtn;
end;
end;

procedure TForm1.wmnchittest(var Msg: TWMncHITTEST);
var pt: tpoint;
begin
inherited;
pt :=Point(msg.XPos - Left, msg.YPos - Top);
if PtinRect(r,pt) then
 msg.Result := htBorder;
end;

procedure TForm1.wmSize(var Msg: TMessage);
begin
inherited;
RedrawWindow(Handle, PRect(0), 0, RDW_FRAME or RDW_NOINTERNALPAINT or RDW_INVALIDATE);
end;

procedure TForm1.wmncLButtonUp(var msg: TWMncLBUTTONUP);
var pt: TPoint;
begin
inherited;
pt := Point(msg.XCursor - Left,msg.YCursor - top);
if PtInRect(R,pt) then
begin
 Press := False;
 drawbtn;
 PostMessage(Handle,wm_btnClk,0,0);
end;
end;

procedure TForm1.wmLbuttonUp(var Msg: TMessage);
begin
inherited;
if Press then
begin
 Press := False;
 DrawBtn;
end;
end;

procedure TForm1.wmBtnClk(var msg: TMessage);
begin
ShowMessage("***");
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
RedrawWindow(Handle, PRect(0), 0, RDW_FRAME or RDW_NOINTERNALPAINT or RDW_INVALIDATE);
end;

end.


 
/\_A_M_E_P   (2004-04-14 23:27) [4]

Благодарю.



Страницы: 1 вся ветка

Форум: "Основная";
Текущий архив: 2004.05.02;
Скачать: [xml.tar.bz2];

Наверх




Память: 0.46 MB
Время: 0.031 c
7-1079007671
Vasek
2004-03-11 15:21
2004.05.02
Регистрация типа файлов в системе и их запуск


14-1081276091
Soft
2004-04-06 22:28
2004.05.02
Зачем нужно программирование?


14-1081759781
Lexer
2004-04-12 12:49
2004.05.02
Характеристика программиста


4-1077186509
Roman79
2004-02-19 13:28
2004.05.02
как недопустить уничтожение своей программы


8-1076051433
Onward
2004-02-06 10:10
2004.05.02
SetPixel??????????





Afrikaans Albanian Arabic Armenian Azerbaijani Basque Belarusian Bulgarian Catalan Chinese (Simplified) Chinese (Traditional) Croatian Czech Danish Dutch English Estonian Filipino Finnish French
Galician Georgian German Greek Haitian Creole Hebrew Hindi Hungarian Icelandic Indonesian Irish Italian Japanese Korean Latvian Lithuanian Macedonian Malay Maltese Norwegian
Persian Polish Portuguese Romanian Russian Serbian Slovak Slovenian Spanish Swahili Swedish Thai Turkish Ukrainian Urdu Vietnamese Welsh Yiddish Bengali Bosnian
Cebuano Esperanto Gujarati Hausa Hmong Igbo Javanese Kannada Khmer Lao Latin Maori Marathi Mongolian Nepali Punjabi Somali Tamil Telugu Yoruba
Zulu
Английский Французский Немецкий Итальянский Португальский Русский Испанский