Текущий архив: 2017.06.04;
Скачать: CL | DM;

Вниз

InsertControl и сообщения   Найти похожие ветки 

← →
dmk ©   (2015-09-27 20:51) [0]

Привет! Подскажите пожалуйста, если, например, TComboBox вставить в TValueListEditor через InsertControl или Parent как дочерний объект, то куда пропадают сообщения или где их можно отлавливать? Если разместить на форме, то все в порядке - сообщения проходят, а если как дочерний - сообщения исчезают. FOnChange например? Или FOnClick.

---

← →
Германн ©   (2015-09-28 01:46) [1]

> dmk ©   (27.09.15 20:51)
>
> Привет! Подскажите пожалуйста, если, например, TComboBox
> вставить в TValueListEditor через InsertControl или Parent
> как дочерний объект, то куда пропадают сообщения или где
> их можно отлавливать? Если разместить на форме, то все в
> порядке - сообщения проходят, а если как дочерний - сообщения
> исчезают. FOnChange например? Или FOnClick.
>

А учебник почитать - лень?

---

← →
dmk ©   (2015-09-28 04:42) [2]

>А учебник почитать - лень?
Такого нет в учебнике. Это глубины VCL. Там события с TObserver связаны.

---

← →
Игорь Шевченко ©   (2015-09-28 10:26) [3]

Удалено модератором

---

← →
Юрий Зотов ©   (2015-09-28 11:46) [4]

> dmk ©   (27.09.15 20:51)  

Не вполне понятен вопрос (так Вы что ловите - сообщения или события?), но рискну посоветовать следующее.

Посмотрите в исходниках, как устроен TSpinEdit. Похоже, это то, что Вам нужно.

---

← →
dmk ©   (2015-09-28 19:15) [5]

Вопрос в том, что если вставить ComboBox в TValueListEditor/StringGrid (тут без разницы), то событие FOnClick обрабатывается, но странно (см. http://i67.fastpic.ru/big/2015/0928/8e/32e141580b2971871285e6c9a01cab8e.jpg), а до события FOnChange вообще не доходит. Если поместить на форму, то все нормально.

Набросал примерчик:
unit FM_test_05;

interface

uses
 Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
 Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.Grids, Vcl.ValEdit, Vcl.StdCtrls;

 type
 TDmComboBox = class(TComboBox)
   private
     FOnClick: TNotifyEvent;
     FOnChange: TNotifyEvent;
     FTextChanged: TNotifyEvent;
     procedure WMLButtonUp(var Message: TWMLButtonUp); message WM_LBUTTONUP;
     procedure CMChange(var Message: TMessage); message CM_CHANGED;
     procedure CMTextChanged(var Message: TMessage); message CM_TEXTCHANGED;
     procedure ColorListClick(Sender: TObject);
     procedure ColorListChange(Sender: TObject);
     property OnClick: TNotifyEvent read FOnClick write FOnClick;
     property OnChange: TNotifyEvent read FOnChange write FOnChange;
 end;

type
 TForm1 = class(TForm)
   VLE_01: TValueListEditor;
   CheckBox1: TCheckBox;
   CheckBox2: TCheckBox;
   procedure FormShow(Sender: TObject);
   procedure FormHide(Sender: TObject);
   procedure VLE_01DrawCell(Sender: TObject; ACol, ARow: Integer; Rect: TRect; State: TGridDrawState);
   procedure CheckBox2Click(Sender: TObject);
   procedure CheckBox1Click(Sender: TObject);
 private
   { Private declarations }
   FBitmapArray: array of TBitmap;
   procedure CreateColorList;
   procedure DestroyColorList;
   procedure DrawItem(Control: TWinControl; Index: Integer; Rect: TRect; State: TOwnerDrawState);
 public
   { Public declarations }

 end;

var
 Form1: TForm1;
 FColorList: TDmComboBox;
 s: string;

const
 sclScrollBar = "clScrollBar";
 sclBackground = "clBackground";
 sclActiveCaption = "clActiveCaption";
 sclInactiveCaption = "clInactiveCaption";
 sclMenu = "clMenu";
 sclWindow = "clWindow";
 sclWindowFrame = "clWindowFrame";
 sclMenuText = "clMenuText";
 sclWindowText = "clWindowText";
 sclCaptionText = "clCaptionText";

 scWindowsColors: array[0..9] of string =
 (sclScrollBar, sclBackground, sclActiveCaption, sclInactiveCaption, sclMenu,
  sclWindow, sclWindowFrame, sclMenuText, sclWindowText, sclCaptionText);

 clWindowsColors: array[0..9] of TColor =
 (clScrollBar, clBackground, clActiveCaption, clInactiveCaption, clMenu,
  clWindow, clWindowFrame, clMenuText, clWindowText, clCaptionText);

implementation

{$R *.dfm}

procedure TDmComboBox.WMLButtonUp(var Message: TWMLButtonUp);
begin
 inherited;
 if Assigned(FOnClick) then FOnClick(Self);
end;

procedure TDmComboBox.CMChange(var Message: TMessage);
begin
 inherited;
 if Assigned(FOnChange) then FOnChange(Self);
end;

procedure TDmComboBox.CMTextChanged(var Message: TMessage);
begin
 inherited;
 if Assigned(FTextChanged) then FTextChanged(Self);
end;

procedure TDmComboBox.ColorListClick(Sender: TObject);
begin
 Form1.Caption := "Click on " + TControl(Sender).Name;;
end;

procedure TDmComboBox.ColorListChange(Sender: TObject);
begin
 Form1.Caption := "Change in " + TControl(Sender).Name;;
end;

procedure TForm1.DrawItem(Control: TWinControl; Index: Integer; Rect: TRect; State: TOwnerDrawState);
var
 Bitmap: TBitmap;
 S: string;

begin
 FColorList.Canvas.FillRect(Rect);
 if FColorList.Items.Objects[Index] <> nil then
   begin
     Bitmap := FColorList.Items.Objects[Index] as TBitmap;
     FColorList.Canvas.Draw(Rect.Left, Rect.Top, Bitmap);
     Rect := Bounds(Rect.Left + Bitmap.Width + 4, Rect.Top, Rect.Right - Rect.Left, Rect.Bottom - Rect.Top);
     S := FColorList.Items.Strings[Index];
     DrawText(FColorList.Canvas.Handle, PChar(S), Length(S), Rect, DT_VCENTER + DT_SINGLELINE);
   end;
end;

procedure TForm1.FormShow(Sender: TObject);
begin
 CreateColorList;
end;

procedure TForm1.FormHide(Sender: TObject);
begin
 DestroyColorList;
end;

procedure TForm1.VLE_01DrawCell(Sender: TObject; ACol, ARow: Integer; Rect: TRect; State: TGridDrawState);
var
 CellRect: TRect;
 str: string;

begin
 if ARow = 0 then
 begin
   Form1.VLE_01.EditorMode := True;
   Form1.VLE_01.DefaultDrawing := True;
   Exit;
 end;

 if FColorList.Parent = Self then Exit;

 Form1.VLE_01.EditorMode := False;
 Form1.VLE_01.DefaultDrawing := False;

 str := Form1.VLE_01.Cells[ACol, ARow];

 if (ACol = 1) and (ARow = 1) then
 begin
   CellRect := Form1.VLE_01.CellRect(ACol, ARow);
   FColorList.BoundsRect := CellRect;
 end;
end;

procedure TForm1.CheckBox1Click(Sender: TObject);
begin
 //На форме
 if CheckBox1.Checked then
 begin
   CheckBox2.Checked := false;
   FColorList.Parent := Self;
   FColorList.Left := 195;
   FColorList.Top := 320;
 end;
end;

procedure TForm1.CheckBox2Click(Sender: TObject);
var
 R: TRect;

begin
 //В редакторе VLE_01
 if CheckBox2.Checked then
 begin
   CheckBox1.Checked := false;
   FColorList.Parent := Form1.VLE_01;
   R := Form1.VLE_01.CellRect(1, 1);
   FColorList.BoundsRect := R;
 end;
end;

procedure TForm1.CreateColorList;
var
 i: integer;
 NumColors: integer;
 bm: TBitmap;
 R: TRect;
 S: string;

begin
 FColorList := TDmComboBox.Create(nil);
 FColorList.Style := csOwnerDrawFixed;
 FColorList.ItemHeight := 14;
 FColorList.DropDownCount := 10;
 FColorList.OnClick := FColorList.ColorListClick;
 FColorList.OnChange := FColorList.ColorListChange;
 FColorList.OnDrawItem := DrawItem;
 FColorList.Name := "FColorList";
 FColorList.Parent := Self;
 FColorList.Left := 195;
 FColorList.Top := 320;
 FColorList.Width := 185;
 FColorList.Height := 21;
 FColorList.Visible := True;

 Form1.VLE_01.Keys[1] := "Color";

 NumColors := Length(scWindowsColors);
 SetLength(FBitmapArray, NumColors);

 R.Left := 0;
 R.Top := 0;
 R.Width := FColorList.ItemHeight;
 R.Height := FColorList.ItemHeight;

 bm := TBitmap.Create;
 bm.Width := R.Width;
 bm.Height := R.Height;
 bm.PixelFormat := pf32bit;

 for i := 0 to NumColors - 1 do
 begin
   bm.Canvas.Brush.Color := clWindowsColors[i];
   bm.Canvas.FillRect(R);

   FBitmapArray[i] := TBitmap.Create;
   FBitmapArray[i].Assign(bm);

   S := scWindowsColors[i];
   FColorList.Items.AddObject(S, FBitmapArray[i]);
 end;

 bm.Free;
end;

//................................................................................ ......................................

procedure TForm1.DestroyColorList;
var
 i: integer;

begin
 for i := 0 to Length(FBitmapArray) - 1 do
 begin
   FBitmapArray[i].Free;
   FBitmapArray[i] := nil;
 end;

 if FColorList <> nil then FColorList.Free;
end;

end.

---

← →
dmk ©   (2015-09-28 19:17) [6]

DFM

object Form1: TForm1
 Left = 0
 Top = 0
 Caption = "Form1"
 ClientHeight = 371
 ClientWidth = 388
 Color = clBtnFace
 Font.Charset = DEFAULT_CHARSET
 Font.Color = clWindowText
 Font.Height = -11
 Font.Name = "Tahoma"
 Font.Style = []
 OldCreateOrder = False
 Position = poDesktopCenter
 OnHide = FormHide
 OnShow = FormShow
 DesignSize = (
   388
   371)
 PixelsPerInch = 96
 TextHeight = 13
 object VLE_01: TValueListEditor
   Left = 8
   Top = 8
   Width = 372
   Height = 300
   Anchors = [akLeft, akTop, akRight, akBottom]
   DoubleBuffered = False
   Font.Charset = DEFAULT_CHARSET
   Font.Color = clWindowText
   Font.Height = -11
   Font.Name = "Tahoma"
   Font.Style = []
   ParentDoubleBuffered = False
   ParentFont = False
   ScrollBars = ssVertical
   TabOrder = 0
   OnDrawCell = VLE_01DrawCell
   ColWidths = (
     183
     183)
 end
 object CheckBox1: TCheckBox
   Left = 20
   Top = 320
   Width = 141
   Height = 17
   Caption = "FColorList "#1085#1072" "#1092#1086#1088#1084#1077
   Checked = True
   State = cbChecked
   TabOrder = 1
   OnClick = CheckBox1Click
 end
 object CheckBox2: TCheckBox
   Left = 20
   Top = 343
   Width = 141
   Height = 17
   Caption = "FColorList "#1074" "#1088#1077#1076#1072#1082#1090#1086#1088#1077
   TabOrder = 2
   OnClick = CheckBox2Click
 end
end

---

← →
dmk ©   (2015-09-28 19:20) [7]

Меню из ComboBox уползает куда то наверх. Событие FOnChange не отлавливается. Вот и весь вопрос. Подскажите куда «копать». Рисовать поверх таблицы не очень хочется. Таких примеров пруд-пруди в интернете. CheckBox ведь удалось подружить с ValueListEditor, а ComboBox пока сопротивляется ;)

---

← →
Германн ©   (2015-09-29 01:20) [8]

> Игорь Шевченко ©   (28.09.15 10:26) [3]
>
>
> > А учебник почитать - лень?
>
>
> Ты наверное уже прочитал

Прочитал. И понимаю разницу между сообщениями и обработчиками событий

Ты вообще не дал никакого ответа. Сноб.

---

← →
dmk ©   (2015-09-29 03:57) [9]

Если в ControlStyle нет флага csAcceptsControls, то сообщения не передаются.
Только через подмену оконной процедуры. Там жутко все запутано. Сообщение идет через TControl, а не от TCustomCombo даже. Посылает CN сообщения.

---

← →
Leonid Troyanovsky ©   (2015-09-29 18:46) [10]

> dmk ©   (28.09.15 19:20) [7]

> пруд-пруди в интернете. CheckBox ведь удалось подружить
> с ValueListEditor, а ComboBox пока сопротивляется ;)

Если особо не  извращаться, то ОРД может спасти пиклист.
Т.е.,

type
 TForm1 = class(TForm)
   ValueListEditor1: TValueListEditor;
   SpeedButton1: TSpeedButton;
   procedure FormCreate(Sender: TObject);
   procedure ValueListEditor1EditButtonClick(Sender: TObject);
   procedure ValueListEditor1GetPickList(Sender: TObject;
     const KeyName: String; Values: TStrings);
   procedure SpeedButton1Click(Sender: TObject);
   procedure ValueListEditor1Validate(Sender: TObject; ACol,
     ARow: Integer; const KeyName, KeyValue: String);
 private
   { Private declarations }
 public
   { Public declarations }
 end;

var
 Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);
begin
 with ValueListEditor1 do
   begin
     InsertRow("Key1", "", True);
     InsertRow("Key2", "", True);
     InsertRow("Key3", "", True);
     FixedCols := 1;
   end;
end;

procedure TForm1.ValueListEditor1EditButtonClick(Sender: TObject);
begin
 with Sender as TValueListEditor do
   Cells[Col, Row] := "Value2";
end;

procedure TForm1.ValueListEditor1GetPickList(Sender: TObject;
 const KeyName: String; Values: TStrings);
begin
 if KeyName = "Key3" then
   Values.CommaText :=  "4,5,6,7,8,9,10,11,12";
end;

procedure TForm1.SpeedButton1Click(Sender: TObject);
begin
 with  ValueListEditor1 do
   begin
     with ItemProps["key1"] do
       begin
         EditStyle := esPickList;
         PickList.CommaText :=  "1,2,3";
         ReadOnly := True;
       end;
     with ItemProps["Key2"] do
       begin
         EditStyle := esEllipsis;
       end;
     with ItemProps["key3"] do
       begin
         EditStyle := esPickList;
         ReadOnly := True;
       end;
   end;

end;

--
Regards, LVT.

---

← →
Leonid Troyanovsky ©   (2015-09-29 18:52) [11]

> Leonid Troyanovsky ©   (29.09.15 18:46) [10]

Чего-то я давно не постил код, забыл уж куда жать.
Т.е., без подсветки:

uses
 Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
 Dialogs, Grids, ValEdit, StdCtrls, Buttons;

type
 TForm1 = class(TForm)
   ValueListEditor1: TValueListEditor;
   SpeedButton1: TSpeedButton;
   procedure FormCreate(Sender: TObject);
   procedure ValueListEditor1EditButtonClick(Sender: TObject);
   procedure ValueListEditor1GetPickList(Sender: TObject;
     const KeyName: String; Values: TStrings);
   procedure SpeedButton1Click(Sender: TObject);
   procedure ValueListEditor1Validate(Sender: TObject; ACol,
     ARow: Integer; const KeyName, KeyValue: String);

 private
   { Private declarations }
 public
   { Public declarations }
 end;

var
 Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);
begin
 with ValueListEditor1 do
   begin
     InsertRow("Key1", "", True);
     InsertRow("Key2", "", True);
     InsertRow("Key3", "", True);
     FixedCols := 1;
   end;
end;

procedure TForm1.ValueListEditor1EditButtonClick(Sender: TObject);
begin
 with Sender as TValueListEditor do
   Cells[Col, Row] := "Value2";
end;

procedure TForm1.ValueListEditor1GetPickList(Sender: TObject;
 const KeyName: String; Values: TStrings);
begin
 if KeyName = "Key3" then
   Values.CommaText :=  "4,5,6,7,8,9,10,11,12";
end;

procedure TForm1.SpeedButton1Click(Sender: TObject);
begin
 with  ValueListEditor1 do
   begin
     with ItemProps["key1"] do
       begin
         EditStyle := esPickList;
         PickList.CommaText :=  "1,2,3";
         ReadOnly := True;
       end;
     with ItemProps["Key2"] do
       begin
         EditStyle := esEllipsis;
       end;
     with ItemProps["key3"] do
       begin
         EditStyle := esPickList;
         ReadOnly := True;
       end;
   end;

end;

--
Regards, LVT.

---

← →
dmk ©   (2015-09-29 18:55) [12]

Leonid Troyanovsky ©   (29.09.15 18:52) [11]
Да, пробовал. Спасибо!
Только он там так позорно реализован :( Задержка при нажатии + задержка при открытии.
Че то VCL стало напоминать большую помойку :(

---

← →
Leonid Troyanovsky ©   (2015-09-29 19:16) [13]

> dmk ©   (29.09.15 18:55) [12]

>  Спасибо!Только он там так позорно реализован :( Задержка
> при нажатии + задержка при открытии.

И в свежесозданном проекте?
Случаем не стороннее ПО тормозит?

--
Regards, LVT.

---

← →
dmk ©   (2015-09-29 19:30) [14]

Leonid Troyanovsky ©   (29.09.15 19:16) [13]
Нет, даже в пустом проекте то же самое. TValueListEditor - тормоз страшный.
Некоторые сообщения реализованы через TObservers, которые отсылают классам-предкам сообщения. Перекрыть методы нельзя, т.к. их просто нет в данном классе. Наследование прерывается. Надо перекрывать методы предков. TValueListEditor отправляет VCL-сообщения в TControl. Жуть ;)

---

← →
dmk ©   (2015-09-29 19:33) [15]

Надо либо через WndProc TControl"а их отслеживать, либо писать свой компонент. Склоняюсь к последнему. А там всего то 2 события: OnClick и OnChange + 8 внутренних VCL-события.

---

← →
dmk ©   (2015-09-29 19:35) [16]

В TValueListEditor можно вставлять только компоненты, которые реагируют на OnClick. Остальные идут лесом.

---

← →
dmk ©   (2015-09-29 20:47) [17]

И самое противное в PeekList - пропуск сообщений. Не всегда реагирует на клик. Может в Delphi XE6 такая лажа? В семерке и 2005-м такого не было.

---

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

Текущий архив: 2017.06.04;
Скачать: CL | DM;

Наверх

Память: 0.54 MB
Время: 0.005 c