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

Вниз

Пятничная головоломка по Delphi   Найти похожие ветки 

← →
Григорьев Антон ©   (2004-11-12 11:32) [0]

Эта задачка навеяна недавним вопросом на Круглом столе Королевства Delphi. Тех, кто уже видел ответ, прошу не подсказывать - дайте другим возможность подумать, задачка-то ведь интересная.

Итак, последовательность действий такая:

1. Создаём в Delphi новый проект (подойдёт любая версия Delphi от 3 до 7).
2. Кидаем на форму компонент TUpDown с закладки Win32.
3. Обработчику UpDown1.OnClick назначаем следующий код:
procedure TForm1.UpDown1Click(Sender:TObject;Button:TUDBtnType);
begin
 Application.MessageBox(‘Text’,’Caption’,MB_OK)
end;
4. Запускаем программу.
5. Нажимаем на верхнюю кнопку UpDown1.
6. Закрываем открывшееся окно сообщения.
7. Нажимаем кнопку мыши на любом месте формы.
8. Удивляемся полученному эффекту.

Тот же эффект будет, если вместо стандартного MessageBox"а показать в обработчике свою модальную форму.

Ну и теперь вопросы:

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

---

← →
DeadMeat ©   (2004-11-12 11:42) [1]

А чего за эффект такой? Просто щас под рукой Делфи нету...

---

← →
Igorek ©   (2004-11-12 11:53) [2]

> 1. Почему так происходит?

Кривой ВЦЛ. Скорее всего проблема с CaptureMouse.

> 2. Почему, если этот код пройти по шагам в отладчике, проблем
> не возникает?

Потому шо отладчик снимает Capture.

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

Не юзать кривые компоненты.

---

← →
Григорьев Антон ©   (2004-11-12 12:03) [3]

> DeadMeat ©   (12.11.04 11:42) [1]

Снова открывается то же окно.


> Igorek ©   (12.11.04 11:53) [2]

1 - правильный ответ, но неполный. Почему эти проблемы возникают?
2 - правильно
3 - ну, если стандартный UPDOWN_CLASS считать кривым... Вообще, еть гораздо более красивое решение, позволяющее использовать TUpDown. Но чтобы его найти, нужно знать полный ответ на 1.

---

← →
Igorek ©   (2004-11-12 12:18) [4]

> Григорьев Антон ©   (12.11.04 12:03) [3]
> 1 - правильный ответ, но неполный. Почему эти проблемы возникают?

Полный ответ требует просмотра кода компонента.

> Вообще, еть гораздо более красивое решение, позволяющее
> использовать TUpDown. Но чтобы его найти, нужно знать полный
> ответ на 1.

Не зная полного ответа:
procedure TForm1.UpDown1MouseUp(Sender: TObject; Button: TMouseButton;
 Shift: TShiftState; X, Y: Integer);
begin
 Application.MessageBox("Text", "Caption", MB_OK);
end;


---

← →
Семин Алексей ©   (2004-11-12 12:23) [5]

Очевидно, не отрабатывался WM_LBUTTONUP и из-за этого были
глюки. Такой код спасает ситуацию:

procedure TForm1.UpDown1Click(Sender:TObject;Button:TUDBtnType);
begin
 Application.MessageBox("Text","Caption",MB_OK);
 PostMessage(UpDown1.Handle, WM_LBUTTONUP, 0, 0);
end;

---

← →
Григорьев Антон ©   (2004-11-12 12:31) [6]

> Igorek ©   (12.11.04 12:18) [4]
> Не зная полного ответа:

А эта проблема возникает не только при обработке OnClick, но также при OnChaging и OnChangingEx (забыл я это сразу написать, виноват), если нажатие выполняется мышью, а обработка этих событий может потребовать кода, который в OnMouseUp не вставишь (например, изменение AllowChange).


> Семин Алексей ©   (12.11.04 12:23) [5]

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

---

← →
NAlexey ©   (2004-11-12 13:11) [7]

обрабатывать событие WM_CANCELMODE.

---

← →
NAlexey ©   (2004-11-12 13:25) [8]

Да впринципе даже этого будет достаточно:
 
UpDown1.ControlStyle := UpDown1.ControlStyle - [csCaptureMouse];


---

← →
Григорьев Антон ©   (2004-11-12 13:26) [9]

> NAlexey ©   (12.11.04 13:11) [7]

Это придётся обработчик сообщения к TUpDown приделывать, т.е. без наследования и регистрации своего компонента не обойтись. Громоздко, хотя идеологически наиболее правильно.

---

← →
Григорьев Антон ©   (2004-11-12 13:28) [10]

> NAlexey ©   (12.11.04 13:25) [8]

Да, именно это решение я имел ввиду.

---

← →
NAlexey ©   (2004-11-12 13:36) [11]

>Григорьев Антон ©   (12.11.04 13:28) [10]
Ну раз пошла такая пьянка, щас и я примерчик подкину в свое врямя с которым мне не удалось разобраться.

---

← →
Cobalt ©   (2004-11-17 10:48) [12]

> NAlexey ©   (12.11.04 13:36) [11]
> щас и я примерчик подкину
Ждём-с

---

← →
NAlexey ©   (2004-11-17 11:50) [13]

Лень было тогда описывать, щас попробую. Условия такие:
В проекте 3 формы - главная и 2 дочернии. Главная форма MDIForm одна форма MDIChild другая Normal. На той форме которая MDIChild лежит DBGrid пусть у него Align = alClient. На той которая Normal лежит Memo пусть у него Align тоже alClient. На главной ворме лежит панель Align = alBottom, DockSite = True; У той формы которая Normal свойство DragKind = dkDock и DragMode = dmAutomatic. Т.е фактически я хочу сделать окно соообщений об ошибках как в Delphi встроенное внизу формы. Открываю дочернюю форму с гридом, открываю обычное окно с Memo. Обычное окно встраиваю в панель, затем пробую изменять размеры колонок грида, ходить по ячейкам и проч. Затем ставлю курсор в Memo, и после этого грид у меня уже не доступен, я ничего не могу с ним сделать.

Главная форма:

type
 TForm1 = class(TForm)
   Panel1: TPanel;
   Button1: TButton;
   Button2: TButton;
   Splitter1: TSplitter;
   procedure Button1Click(Sender: TObject);
   procedure Button2Click(Sender: TObject);
   procedure FormCreate(Sender: TObject);
 private
   { Private declarations }
 public
   { Public declarations }
 end;

var
 Form1: TForm1;

implementation

{$R *.dfm}
uses
 Unit2, Unit3;

procedure TForm1.Button1Click(Sender: TObject);
begin
 Application.CreateForm(Tform3, form3);
 Form3.Show;
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
 Application.CreateForm(Tform2, form2);
 Form2.Show;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
 FormStyle := fsMDIForm
end;

MDIChild:

type
 TForm3 = class(TForm)
   DBGrid1: TDBGrid;
   procedure FormClose(Sender: TObject; var Action: TCloseAction);
   procedure FormCreate(Sender: TObject);
 private
   { Private declarations }
 public
   { Public declarations }
 end;

var
 Form3: TForm3;

implementation

{$R *.dfm}

procedure TForm3.FormClose(Sender: TObject; var Action: TCloseAction);
begin
 Action := caFree;
 Form3 := nil;
end;

procedure TForm3.FormCreate(Sender: TObject);
begin
 FormStyle := fsMDIChild
end;

Обычная:

type
 TForm2 = class(TForm)
   Memo1: TMemo;
 private
   { Private declarations }
 public
   { Public declarations }
 end;

var
 Form2: TForm2;


---

← →
Igorek ©   (2004-11-17 12:23) [14]

Дай лучше ДФМы.

---

← →
NAlexey ©   (2004-11-17 13:27) [15]

>Igorek ©   (17.11.04 12:23) [14]
Держи:

Главная:

object Form1: TForm1
 Left = 371
 Top = 225
 Width = 632
 Height = 447
 Caption = "Form1"
 Color = clBtnFace
 Font.Charset = DEFAULT_CHARSET
 Font.Color = clWindowText
 Font.Height = -11
 Font.Name = "MS Sans Serif"
 Font.Style = []
 FormStyle = fsMDIForm
 OldCreateOrder = False
 PixelsPerInch = 96
 TextHeight = 13
 object Splitter1: TSplitter
   Left = 0
   Top = 363
   Width = 624
   Height = 5
   Cursor = crVSplit
   Align = alBottom
 end
 object Panel1: TPanel
   Left = 0
   Top = 368
   Width = 624
   Height = 52
   Align = alBottom
   DockSite = True
   TabOrder = 0
 end
 object Button1: TButton
   Left = 248
   Top = 264
   Width = 75
   Height = 25
   Caption = "Gridform"
   TabOrder = 1
   OnClick = Button1Click
 end
 object Button2: TButton
   Left = 336
   Top = 264
   Width = 75
   Height = 25
   Caption = "ListForm"
   TabOrder = 2
   OnClick = Button2Click
 end
end

MDIChild:

object Form3: TForm3
 Left = 313
 Top = 147
 Width = 551
 Height = 259
 Caption = "Form3"
 Color = clBtnFace
 Font.Charset = DEFAULT_CHARSET
 Font.Color = clWindowText
 Font.Height = -11
 Font.Name = "MS Sans Serif"
 Font.Style = []
 FormStyle = fsMDIChild
 OldCreateOrder = False
 Position = poDefault
 Visible = True
 OnClose = FormClose
 PixelsPerInch = 96
 TextHeight = 13
 object DBGrid1: TDBGrid
   Left = 0
   Top = 0
   Width = 543
   Height = 232
   Align = alClient
   TabOrder = 0
   TitleFont.Charset = DEFAULT_CHARSET
   TitleFont.Color = clWindowText
   TitleFont.Height = -11
   TitleFont.Name = "MS Sans Serif"
   TitleFont.Style = []
 end
end

Normal:

object Form2: TForm2
 Left = 522
 Top = 192
 Width = 537
 Height = 197
 Caption = "Form2"
 Color = clBtnFace
 DragKind = dkDock
 DragMode = dmAutomatic
 Font.Charset = DEFAULT_CHARSET
 Font.Color = clWindowText
 Font.Height = -11
 Font.Name = "MS Sans Serif"
 Font.Style = []
 OldCreateOrder = False
 PixelsPerInch = 96
 TextHeight = 13
 object Memo1: TMemo
   Left = 0
   Top = 0
   Width = 529
   Height = 170
   Align = alClient
   Lines.Strings = (
     "Memo1")
   TabOrder = 0
 end
end


---

← →
Yanis ©   (2004-11-17 14:05) [16]

А это ШО за прикол?

 while true do
   begin
     ShowMEssage("");
     Close;
   end;


После первого нажатия на Ok в message начнется глюк. Попробуйте.

---

← →
Yanis ©   (2004-11-17 14:06) [17]

А это ШО за прикол?

 while true do
   begin
     ShowMEssage("");
     Close;
   end;


После первого нажатия на Ok в message начнется глюк. Попробуйте.

---

← →
NAlexey ©   (2004-11-17 15:28) [18]

GetSystemMetrics->SM_CXDOUBLECLK, SM_CYDOUBLECLK

---

← →
NAlexey ©   (2004-11-17 16:01) [19]

>NAlexey ©   (17.11.04 15:28) [18]
Не туда...
>Yanis ©   (17.11.04 14:06) [17]
Совершенно не понятно что ты хотел сказать.

---

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

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

Наверх

Память: 0.51 MB
Время: 0.045 c