Форум: "Начинающим";
Текущий архив: 2017.06.04;
Скачать: [xml.tar.bz2];
Вниз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;
Скачать: [xml.tar.bz2];
Память: 0.52 MB
Время: 0.008 c