X11 Цитата: А можно об этом подробнее? Что здесь сочинить, я не могу понять
Нужно вычислить месторасположение кнопок FButton1, FButton2 в зависимоти от
расположения SysPanel. FPopupWindow.ViewInfo.SizeGripCorner - расположение уголка для изменения размера popup окна.
Пример (только в нем TreeList 4, и не cxPopupEdit, а cхLookupComboBox):
[more]
unit uZhpLookupTree;
interface
uses Windows, Classes, cxTL, cxDBTL, cxDBLookupComboBox, cxInplaceContainer,
cxGraphics, cxGridCustomTableView, cxDropDownEdit, ImgList, cxEdit, Controls,
cxCustomData, Messages, uZhpConsts;
type
TZhpLookupTreeList = class(TcxDBTreeList)
private
FCanSelectParents: Boolean;
FColumnKey: TcxDBTreeListColumn;
FColumnNumRec: TcxDBTreeListColumn;
FColumnParentKey: TcxDBTreeListColumn;
FColumnShortName: TcxDBTreeListColumn;
FDropDownHeight: Integer;
FDropDownWidth: Integer;
FEdit: TcxCustomLookupComboBox;
FImageIndex: Integer;
FImageIndexCollapse: Integer;
FImageIndexExpand: Integer;
FParentControl: TWinControl;
FPopupWindow: TcxCustomEditPopupWindow;
FHandlerLCBPropertiesChange: TNotifyEvent;
procedure ButtonClick(Sender: TObject);
procedure CalculatePosition;
procedure AfterSorting(Sender: TObject);
procedure CustomDrawCell(Sender: TObject; ACanvas: TcxCanvas; AViewInfo:
TcxTreeListEditCellViewInfo; var ADone: Boolean);
procedure GetNodeImageIndex(Sender: TObject; ANode: TcxTreeListNode;
AIndexType: TcxTreeListImageIndexType; var AIndex: TImageIndex);
procedure LocateByKey(AKeyValue: Variant);
procedure LCBFilterRecord(ADataController: TcxCustomDataController;
ARecordIndex: Integer; var Accept: Boolean);
procedure LCBPropertiesChange(Sender: TObject);
procedure PopupWindowResize(Sender: TObject);
procedure PopupWindowShow(Sender: TObject);
procedure WMAfterSorting(var Message: TMessage); message WM_AfterSorting;
protected
procedure CalculateColumsWidth;
procedure Click; override;
procedure DblClick; override;
function DoEditing(AItem: TcxCustomInplaceEditContainer): Boolean; override;
procedure DoOnColumnSizeChanged(AColumn: TcxTreeListColumn); override;
procedure KeyDown(var Key: Word; Shift: TShiftState); override;
procedure RecordEnter;
procedure Resize; override;
public
constructor Create(AOwner: TComponent); override;
procedure HandlerCloseUp(AEdit: TcxCustomLookupComboBox);
procedure HandlerInitPopup(AEdit: TcxCustomLookupComboBox);
property CanSelectParents: Boolean read FCanSelectParents write
FCanSelectParents;
property ColumnNumRec: TcxDBTreeListColumn read FColumnNumRec;
property ColumnShortName: TcxDBTreeListColumn read FColumnShortName;
property DropDownHeight: Integer read FDropDownHeight;
property DropDownWidth: Integer read FDropDownWidth;
property ImageIndex: Integer read FImageIndex write FImageIndex;
property ImageIndexCollapse: Integer read FImageIndexCollapse write
FImageIndexCollapse;
property ImageIndexExpand: Integer read FImageIndexExpand write
FImageIndexExpand;
property ParentControl: TWinControl read FParentControl write
FParentControl;
property PopupWindow: TcxCustomEditPopupWindow read FPopupWindow;
end;
implementation
uses SysUtils, StdCtrls, Graphics, cxControls, Dialogs, cxButtons, cxLookAndFeels;
{$R ZhpButtons.res}
var
FButtonCollapse: TcxButton;
FButtonExpand: TcxButton;
FOldHeight: Integer = 0;
FOldWidth: Integer = 0;
const
Office11BtnColorsNormal = $F5BE9E;
Office11BtnColorsHot = $D3F8FF;
Office11BtnColorsPressed = $98DDFF;
type
TcxCustomLookupComboBoxAccess = class(TcxCustomLookupComboBox);
constructor TZhpLookupTreeList.Create(AOwner: TComponent);
var
ABand: TcxTreeListBand;
begin
inherited Create(AOwner);
FCanSelectParents := True;
FImageIndex := -1;
FImageIndexCollapse := -1;
FImageIndexExpand := -1;
DataController.KeyField := 'Id';
DataController.ParentField := 'Parent_Id';
BorderStyle := cxcbsNone;
OptionsBehavior.ExpandOnIncSearch := True;
OptionsBehavior.IncSearch := True;
OptionsSelection.InvertSelect := False;
OptionsView.ColumnAutoWidth := True;
OptionsView.GridLines := tlglBoth;
OptionsView.ScrollBars := ssVertical;
// OptionsView.ScrollBars := ssBoth;
OptionsView.Headers := True;
if Bands.Count = 0 then
ABand := Bands.Add
else
ABand := Bands[0];
FColumnKey := TcxDBTreeListColumn(CreateColumn(ABand));
FColumnKey.DataBinding.FieldName := 'Id';
FColumnKey.Visible := False;
FColumnParentKey := TcxDBTreeListColumn(CreateColumn(ABand));
FColumnParentKey.DataBinding.FieldName := 'Id';
FColumnParentKey.Visible := False;
FColumnShortName := TcxDBTreeListColumn(CreateColumn(ABand));
FColumnShortName.Caption.Text := 'Наименование';
FColumnShortName.DataBinding.FieldName := 'ShortName';
FColumnShortName.Visible := True;
OptionsBehavior.IncSearchItem := FColumnShortName;
FColumnNumRec := TcxDBTreeListColumn(CreateColumn(ABand));
FColumnNumRec.Caption.Text := '№';
FColumnNumRec.DataBinding.FieldName := 'NumRec';
FColumnNumRec.Width := 35;
FColumnNumRec.Visible := False;
OnCustomDrawCell := CustomDrawCell;
OnGetNodeImageIndex := GetNodeImageIndex;
OnAfterSorting := AfterSorting;
if FButtonCollapse = nil then
begin
FButtonCollapse := TcxButton.Create(AOwner);
with FButtonCollapse do
begin
LookAndFeel.Kind := lfUltraFlat;
Colors.Normal := Office11BtnColorsNormal;
Colors.Hot := Office11BtnColorsHot;
Colors.Pressed := Office11BtnColorsPressed;
Caption := '';
CanBeFocused := False;
Height := 21;
Width := 21;
Glyph.LoadFromResourceName(HInstance, 'ZH_COLLAPSE');
Hint := 'Свернуть подуровни';
ShowHint := True;
Tag := 1;
end;
end;
if FButtonExpand = nil then
begin
FButtonExpand := TcxButton.Create(AOwner);
with FButtonExpand do
begin
LookAndFeel.Kind := lfUltraFlat;
Colors.Normal := Office11BtnColorsNormal;
Colors.Hot := Office11BtnColorsHot;
Colors.Pressed := Office11BtnColorsPressed;
Caption := '';
CanBeFocused := False;
Height := 21;
Width := 21;
Glyph.LoadFromResourceName(HInstance, 'ZH_EXPAND');
Hint := 'Раскрыть подуровни';
ShowHint := True;
Tag := 2;
end;
end;
end;
procedure TZhpLookupTreeList.AfterSorting(Sender: TObject);
begin
if HandleAllocated and (FColumnShortName.SortOrder = soNone) and
(FColumnNumRec.SortOrder = soNone) then
PostMessage(Handle, WM_AfterSorting, 0, 0);
end;
procedure TZhpLookupTreeList.ButtonClick(Sender: TObject);
var
AKeyValue: Variant;
begin
AKeyValue := DataController.GetKeyFieldsValues;
case TcxButton(Sender).Tag of
1: FullCollapse;
2: FullExpand;
end;
LocateByKey(AKeyValue);
end;
procedure TZhpLookupTreeList.CalculateColumsWidth;
begin
FColumnShortName.Width := ViewInfo.ClientRect.Right -
ViewInfo.ClientRect.Left - FColumnNumRec.Width;
end;
procedure TZhpLookupTreeList.CalculatePosition;
var
R: TRect;
DH, DW: Integer;
const
D = 10;
D1 = 2;
begin
SetBounds(1, 1, FPopupWindow.ClientWidth - 2, FPopupWindow.ClientHeight -
FPopupWindow.ViewInfo.SysPanelHeight - 3);
FDropDownWidth := FPopupWindow.ClientWidth - 2;
FDropDownHeight := FPopupWindow.ClientHeight -
FPopupWindow.ViewInfo.SysPanelHeight - 3;
R := FPopupWindow.ViewInfo.CloseButtonRect;
DH := FPopupWindow.ClientHeight - FOldHeight;
DW := FPopupWindow.ClientWidth - FOldWidth;
case FPopupWindow.ViewInfo.SizeGripCorner of
ecoTopLeft:
begin
with FButtonExpand do
SetBounds(R.Left + DW - D - Width, R.Top, Width, Height);
with FButtonCollapse do
SetBounds(FButtonExpand.Left - Width - D1, FButtonExpand.Top, Width,
Height);
end;
ecoTopRight:
begin
with FButtonCollapse do
SetBounds(R.Right + D, R.Top, Width, Height);
with FButtonExpand do
SetBounds(FButtonCollapse.Left + FButtonCollapse.Width + D1,
FButtonCollapse.Top, Width, Height);
end;
ecoBottomLeft:
begin
with FButtonExpand do
SetBounds(R.Left + DW - D - Width, R.Top + DH, Width, Height);
with FButtonCollapse do
SetBounds(FButtonExpand.Left - Width - D1, FButtonExpand.Top, Width,
Height);
end;
ecoBottomRight:
begin
with FButtonCollapse do
SetBounds(R.Right + D, R.Top + DH, Width, Height);
with FButtonExpand do
SetBounds(FButtonCollapse.Left + FButtonCollapse.Width + D1,
FButtonCollapse.Top, Width, Height);
end;
end;
FOldHeight := FPopupWindow.ClientHeight;
FOldWidth := FPopupWindow.ClientWidth;
end;
procedure TZhpLookupTreeList.Click;
begin
inherited Click;
if HitTest.HitAtNode then
begin
if HitTest.HitAtImages then
begin
if HitTest.HitNode.HasChildren then
HitTest.HitNode.Expanded := not HitTest.HitNode.Expanded;
end
else if not HitTest.HitAtButton then
begin
if FCanSelectParents then
RecordEnter
else
begin
if not HitTest.HitNode.HasChildren then
RecordEnter
else
HitTest.HitNode.Expanded := not HitTest.HitNode.Expanded;
end;
end;
end;
end;
procedure TZhpLookupTreeList.CustomDrawCell(Sender: TObject; ACanvas: TcxCanvas;
AViewInfo: TcxTreeListEditCellViewInfo; var ADone: Boolean);
begin
if AViewInfo.Node = nil then
Exit;
if AViewInfo.Node.Selected then
begin
ACanvas.Brush.Color := clHighlight;
ACanvas.Font.Color := clHighlightText;
end;
end;
procedure TZhpLookupTreeList.DblClick;
begin
inherited DblClick;
end;
function TZhpLookupTreeList.DoEditing(AItem: TcxCustomInplaceEditContainer):
Boolean;
begin
Result := False;
end;
procedure TZhpLookupTreeList.DoOnColumnSizeChanged(AColumn: TcxTreeListColumn);
begin
inherited DoOnColumnSizeChanged(AColumn);
CalculateColumsWidth;
end;
procedure TZhpLookupTreeList.GetNodeImageIndex(Sender: TObject;
ANode: TcxTreeListNode; AIndexType: TcxTreeListImageIndexType;
var AIndex: TImageIndex);
begin
if ANode.HasChildren then
begin
if ANode.Expanded then
AIndex := FImageIndexExpand
else
AIndex := FImageIndexCollapse;
end
else
AIndex := FImageIndex;
end;
procedure TZhpLookupTreeList.HandlerCloseUp(AEdit: TcxCustomLookupComboBox);
begin
FEdit := AEdit;
FPopupWindow.OnResize := nil;
FPopupWindow.OnShow := nil;
Parent := FParentControl;
FEdit.ActiveProperties.DataController.OnFilterRecord := nil;
FEdit.ActiveProperties.OnChange := FHandlerLCBPropertiesChange;
FButtonCollapse.Parent := FParentControl;
FButtonExpand.Parent := FParentControl;
if (FEdit <> nil) and not FEdit.ActiveProperties.Grid.Visible then
FEdit.Properties.Grid.Visible := True;
end;
procedure TZhpLookupTreeList.HandlerInitPopup(AEdit: TcxCustomLookupComboBox);
begin
FEdit := AEdit;
if (FEdit <> nil) and (FEdit.PopupWindow <> nil) then
begin
if not FCanSelectParents and not Assigned(FEdit.ActiveProperties.DataController.OnFilterRecord) then
FEdit.ActiveProperties.DataController.OnFilterRecord := LCBFilterRecord;
if FEdit.ActiveProperties.Grid.Visible then
FEdit.ActiveProperties.Grid.Visible := False;
FHandlerLCBPropertiesChange := FEdit.ActiveProperties.OnChange;
FEdit.ActiveProperties.OnChange := LCBPropertiesChange;
// AfterSorting(nil);
FEdit.ActiveProperties.IncrementalFiltering := False;
FPopupWindow := FEdit.PopupWindow;
FPopupWindow.OnResize := PopupWindowResize;
FPopupWindow.OnShow := PopupWindowShow;
Parent := FPopupWindow;
FullCollapse;
LocateByKey(FEdit.EditingValue);
end;
end;
procedure TZhpLookupTreeList.KeyDown(var Key: Word; Shift: TShiftState);
begin
inherited KeyDown(Key, Shift);
if Key = VK_RETURN then
RecordEnter;
end;
procedure TZhpLookupTreeList.LocateByKey(AKeyValue: Variant);
var
ANode: TcxTreeListNode;
begin
ANode := FindNodeByKeyValue(AKeyValue, FColumnKey);
if ANode <> nil then
begin
if not ANode.IsVisible then
ANode.MakeVisible;
ANode.Focused := True;
TopVisibleNode := ANode;
end;
end;
procedure TZhpLookupTreeList.LCBFilterRecord(ADataController:
TcxCustomDataController; ARecordIndex: Integer; var Accept: Boolean);
var
ANode: TcxTreeListNode;
begin
ANode := FindNodeByKeyValue(ADataController.GetValue(ARecordIndex, 2), FColumnKey);
if ANode <> nil then
Accept := not ANode.HasChildren;
end;
procedure TZhpLookupTreeList.LCBPropertiesChange(Sender: TObject);
begin
LocateByKey(FEdit.EditingValue);
if Assigned(FHandlerLCBPropertiesChange) then
FHandlerLCBPropertiesChange(FEdit);
end;
procedure TZhpLookupTreeList.PopupWindowResize(Sender: TObject);
begin
if FPopupWindow.Visible then
CalculatePosition;
end;
procedure TZhpLookupTreeList.PopupWindowShow(Sender: TObject);
begin
FButtonCollapse.Parent := FPopupWindow;
FButtonCollapse.OnClick := ButtonClick;
FButtonExpand.Parent := FPopupWindow;
FButtonExpand.OnClick := ButtonClick;
FOldHeight := FPopupWindow.ClientHeight;
FOldWidth := FPopupWindow.ClientWidth;
CalculatePosition;
end;
procedure TZhpLookupTreeList.RecordEnter;
begin
FEdit.EditValue := FColumnKey.Value;
FEdit.PostEditValue;
FPopupWindow.CloseUp;
end;
procedure TZhpLookupTreeList.Resize;
begin
inherited Resize;
CalculateColumsWidth;
end;
procedure TZhpLookupTreeList.WMAfterSorting(var Message: TMessage);
begin
FColumnNumRec.SortOrder := soAscending;
end;
end.
[/more]