david
47aaf11578
git-svn-id: https://192.168.0.254/svn/Componentes.Terceros.DevExpressVCL@38 05c56307-c608-d34a-929d-697000501d7a
1433 lines
41 KiB
ObjectPascal
1433 lines
41 KiB
ObjectPascal
|
|
{*******************************************************************}
|
|
{ }
|
|
{ Developer Express Visual Component Library }
|
|
{ ExpressBars extended DB items }
|
|
{ }
|
|
{ Copyright (c) 1998-2009 Developer Express Inc. }
|
|
{ ALL RIGHTS RESERVED }
|
|
{ }
|
|
{ The entire contents of this file is protected by U.S. and }
|
|
{ International Copyright Laws. Unauthorized reproduction, }
|
|
{ reverse-engineering, and distribution of all or any portion of }
|
|
{ the code contained in this file is strictly prohibited and may }
|
|
{ result in severe civil and criminal penalties and will be }
|
|
{ prosecuted to the maximum extent possible under the law. }
|
|
{ }
|
|
{ RESTRICTIONS }
|
|
{ }
|
|
{ THIS SOURCE CODE AND ALL RESULTING INTERMEDIATE FILES }
|
|
{ (DCU, OBJ, DLL, ETC.) ARE CONFIDENTIAL AND PROPRIETARY TRADE }
|
|
{ SECRETS OF DEVELOPER EXPRESS INC. THE REGISTERED DEVELOPER IS }
|
|
{ LICENSED TO DISTRIBUTE THE EXPRESSBARS AND ALL ACCOMPANYING VCL }
|
|
{ CONTROLS AS PART OF AN EXECUTABLE PROGRAM ONLY. }
|
|
{ }
|
|
{ THE SOURCE CODE CONTAINED WITHIN THIS FILE AND ALL RELATED }
|
|
{ FILES OR ANY PORTION OF ITS CONTENTS SHALL AT NO TIME BE }
|
|
{ COPIED, TRANSFERRED, SOLD, DISTRIBUTED, OR OTHERWISE MADE }
|
|
{ AVAILABLE TO OTHER INDIVIDUALS WITHOUT EXPRESS WRITTEN CONSENT }
|
|
{ AND PERMISSION FROM DEVELOPER EXPRESS INC. }
|
|
{ }
|
|
{ CONSULT THE END USER LICENSE AGREEMENT FOR INFORMATION ON }
|
|
{ ADDITIONAL RESTRICTIONS. }
|
|
{ }
|
|
{*******************************************************************}
|
|
|
|
unit dxBarExtDBItems;
|
|
|
|
{$I cxVer.inc}
|
|
|
|
interface
|
|
|
|
uses
|
|
Windows, Messages, SysUtils, Classes, Graphics, Controls, Db, StdCtrls, Forms,
|
|
dxCommon, dxBar;
|
|
|
|
type
|
|
TdxBarLookupCombo = class;
|
|
TdxBarPopupLookupControl = class;
|
|
|
|
TdxBarLookupLink = class(TDataLink)
|
|
private
|
|
FBarLookupCombo: TdxBarLookupCombo;
|
|
protected
|
|
procedure ActiveChanged; override;
|
|
procedure DataSetChanged; override;
|
|
procedure LayoutChanged; override;
|
|
end;
|
|
|
|
TdxBarLookupCombo = class(TCustomdxBarCombo)
|
|
private
|
|
FAllowResizing: Boolean;
|
|
FCurKeyValue: Variant;
|
|
FListLink: TdxBarLookupLink;
|
|
FPopupList: TdxBarPopupLookupControl;
|
|
FKeyFieldName: string;
|
|
FListFieldName: string;
|
|
FListFieldIndex: Integer;
|
|
FKeyField: TField;
|
|
FListField: TField;
|
|
FListFields: TList;
|
|
FKeyValue: Variant;
|
|
FSetValue: Boolean;
|
|
FListActive: Boolean;
|
|
FColor: TColor;
|
|
FImmediateDropDown : Boolean;
|
|
FPopupWidth: Integer;
|
|
|
|
FRowCount: Integer;
|
|
|
|
FListVisible: Boolean;
|
|
FFindSelection: Boolean;
|
|
FFindStr: string;
|
|
FInFindSelection: Boolean;
|
|
|
|
FLocateEdit: TEdit;
|
|
FLocateList: TdxBarPopupLookupControl;
|
|
|
|
FOnKeyValueChange: TNotifyEvent;
|
|
|
|
FForm: TForm;
|
|
ButtonOk, ButtonCancel: TButton;
|
|
|
|
function GetListSource: TDataSource;
|
|
procedure SetKeyFieldName(const Value: string);
|
|
procedure SetKeyValue(const Value: Variant);
|
|
procedure SetListFieldIndex(Value: Integer);
|
|
procedure SetListFieldName(const Value: string);
|
|
procedure SetListSource(Value: TDataSource);
|
|
procedure SetRowCount(Value: Integer);
|
|
|
|
function GetEditHandle : Integer;
|
|
function GetEditText : String;
|
|
procedure SetEditText(AText : String);
|
|
procedure DoKeyPress(Sender: TObject; var Key: Char);
|
|
procedure DoKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
|
|
|
|
procedure FormSize(Sender: TObject);
|
|
protected
|
|
procedure CloseUp; override;
|
|
procedure DoEnter; override;
|
|
procedure DropDown(X, Y: Integer); override;
|
|
function GetDropDownWindow: HWND; override;
|
|
function CheckKeyForDropDownWindow(Key: Word; Shift: TShiftState): Boolean; override;
|
|
procedure KeyDown(var Key: Word; Shift: TShiftState); override;
|
|
procedure KeyPress(var Key: Char); override;
|
|
|
|
procedure UpdateListFields;
|
|
procedure ListLinkDataChanged;
|
|
procedure KeyValueChanged;
|
|
function LocateKey: Boolean;
|
|
procedure ResetFindStr;
|
|
|
|
property EditText: string read GetEditText write SetEditText;
|
|
property ListFields: TList read FListFields;
|
|
property ListLink: TdxBarLookupLink read FListLink;
|
|
public
|
|
constructor Create(AOwner: TComponent); override;
|
|
destructor Destroy; override;
|
|
procedure DoClick; override;
|
|
procedure Notification(AComponent: TComponent; Operation: TOperation); override;
|
|
|
|
property KeyValue: Variant read FKeyValue write SetKeyValue;
|
|
published
|
|
property AllowResizing: Boolean read FAllowResizing write FAllowResizing default True;
|
|
property Color: TColor read FColor write FColor default clWindow;
|
|
property ImmediateDropDown: Boolean read FImmediateDropDown write FImmediateDropDown default False;
|
|
property KeyField: string read FKeyFieldName write SetKeyFieldName;
|
|
property ListField: string read FListFieldName write SetListFieldName;
|
|
property ListFieldIndex: Integer read FListFieldIndex write SetListFieldIndex default 0;
|
|
property ListSource: TDataSource read GetListSource write SetListSource;
|
|
property RowCount: Integer read FRowCount write SetRowCount;
|
|
property Text stored False;
|
|
property PopupWidth: Integer read FPopupWidth write FPopupWidth default 0;
|
|
|
|
property OnKeyValueChange: TNotifyEvent read FOnKeyValueChange write FOnKeyValueChange;
|
|
end;
|
|
|
|
TdxBarLookupComboControl = class(TCustomdxBarComboControl)
|
|
protected
|
|
procedure SetFocused(Value: Boolean); override;
|
|
procedure WndProc(var Message: TMessage); override;
|
|
end;
|
|
|
|
TdxBarPopupLookupLink = class(TDataLink)
|
|
private
|
|
FBarPopupLookup: TdxBarPopupLookupControl;
|
|
protected
|
|
procedure ActiveChanged; override;
|
|
procedure DataSetChanged; override;
|
|
procedure LayoutChanged; override;
|
|
procedure DataSetScrolled(Distance: Integer); override;
|
|
end;
|
|
|
|
TdxBarPopupLookupControl = class(TCustomControl)
|
|
private
|
|
FListLink: TdxBarPopupLookupLink;
|
|
FListFieldName: string;
|
|
FListFieldIndex: Integer;
|
|
FListField: TField;
|
|
FListFields: TList;
|
|
FListActive : Boolean;
|
|
|
|
FRecordIndex: Integer;
|
|
FRecordCount: Integer;
|
|
FRowCount: Integer;
|
|
FTracking: Boolean;
|
|
FTimerActive: Boolean;
|
|
FMousePos: Integer;
|
|
FSelectedItem: string;
|
|
|
|
FHScrollWidth : Integer;
|
|
FVScrollWidth : Integer;
|
|
FCloseBtnDown : Boolean;
|
|
FCloseBtnPaint : Boolean;
|
|
FComboTop : Integer;
|
|
|
|
FCombo: TdxBarLookupCombo;
|
|
FCorner: TdxCorner;
|
|
FCloseButtonRect, FGripRect: TRect;
|
|
FCloseButtonIsTracking: Boolean;
|
|
FMouseAboveCloseButton: Boolean;
|
|
|
|
function GetListSource: TDataSource;
|
|
procedure SetListFieldName(const Value: string);
|
|
procedure SetListSource(Value: TDataSource);
|
|
|
|
procedure SelectCurrent;
|
|
procedure SelectItemAt(X, Y: Integer);
|
|
procedure SetRowCount(Value: Integer);
|
|
procedure StopTimer;
|
|
procedure StopTracking;
|
|
procedure TimerScroll;
|
|
procedure UpdateScrollBar;
|
|
|
|
procedure WMCancelMode(var Message: TMessage); message WM_CANCELMODE;
|
|
procedure WMCaptureChanged(var Message: TMessage); message WM_CAPTURECHANGED;
|
|
procedure WMEraseBkgnd(var Message: TWmEraseBkgnd); message WM_ERASEBKGND;
|
|
procedure WMGetDlgCode(var Message: TMessage); message WM_GETDLGCODE;
|
|
procedure WMGetMinMaxInfo(var Message: TWMGetMinMaxInfo); message WM_GETMINMAXINFO;
|
|
procedure WMLButtonUp(var Message: TWMLButtonUp); message WM_LBUTTONUP;
|
|
procedure WMNCCalcSize(var Message: TWMNCCalcSize); message WM_NCCALCSIZE;
|
|
procedure WMNCHitTest(var Message: TWMNCHITTEST); message WM_NCHITTEST;
|
|
procedure WMNCLButtonDown(var Message: TWMNCLButtonDown); message WM_NCLBUTTONDOWN;
|
|
procedure WMNCPaint(var Message: TWMNCPaint); message WM_NCPAINT;
|
|
procedure WMSize(var Message: TWMSize); message WM_SIZE;
|
|
procedure WMTimer(var Message: TMessage); message WM_TIMER;
|
|
procedure WMVScroll(var Message: TWMVScroll); message WM_VSCROLL;
|
|
procedure WMWindowPosChanging(var Message : TWMWINDOWPOSCHANGING); message WM_WINDOWPOSCHANGING;
|
|
procedure CMMouseLeave(var Message: TMessage); message CM_MOUSELEAVE;
|
|
protected
|
|
procedure CreateParams(var Params: TCreateParams); override;
|
|
procedure CreateWnd; override;
|
|
procedure DblClick; override;
|
|
procedure Notification(AComponent: TComponent;
|
|
Operation: TOperation); override;
|
|
procedure KeyDown(var Key: Word; Shift: TShiftState); override;
|
|
procedure ListLinkDataChanged;
|
|
procedure MouseDown(Button: TMouseButton; Shift: TShiftState;
|
|
X, Y: Integer); override;
|
|
procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;
|
|
procedure MouseUp(Button: TMouseButton; Shift: TShiftState;
|
|
X, Y: Integer); override;
|
|
procedure Paint; override;
|
|
|
|
function GetTextHeight: Integer;
|
|
procedure UpdateListFields;
|
|
|
|
property ListField: string read FListFieldName write SetListFieldName;
|
|
property ListFieldIndex: Integer read FListFieldIndex write FListFieldIndex default 0;
|
|
property ListFields: TList read FListFields;
|
|
property ListLink: TdxBarPopupLookupLink read FListLink;
|
|
property ListSource: TDataSource read GetListSource write SetListSource;
|
|
public
|
|
IsPopup: Boolean;
|
|
constructor Create(AOwner: TComponent); override;
|
|
destructor Destroy; override;
|
|
|
|
property ComboTop: Integer read FComboTop write FComboTop;
|
|
property RowCount: Integer read FRowCount write SetRowCount stored False;
|
|
property SelectedItem: string read FSelectedItem;
|
|
end;
|
|
|
|
implementation
|
|
|
|
{$R dxBarExtDBItems.res}
|
|
|
|
uses
|
|
{$IFDEF DELPHI6}Variants,{$ENDIF} dxBarCommon, cxClasses, dxBarStrs;
|
|
|
|
function VarEquals(const V1, V2: Variant): Boolean;
|
|
begin
|
|
Result := False;
|
|
try
|
|
Result := V1 = V2;
|
|
except
|
|
end;
|
|
end;
|
|
|
|
{ TdxBarLookupLink }
|
|
|
|
procedure TdxBarLookupLink.ActiveChanged;
|
|
begin
|
|
if FBarLookupCombo <> nil then FBarLookupCombo.UpdateListFields;
|
|
end;
|
|
|
|
procedure TdxBarLookupLink.DataSetChanged;
|
|
begin
|
|
if FBarLookupCombo <> nil then FBarLookupCombo.ListLinkDataChanged;
|
|
end;
|
|
|
|
procedure TdxBarLookupLink.LayoutChanged;
|
|
begin
|
|
if FBarLookupCombo <> nil then FBarLookupCombo.UpdateListFields;
|
|
end;
|
|
|
|
{ TdxBarLookupCombo }
|
|
|
|
constructor TdxBarLookupCombo.Create(AOwner: TComponent);
|
|
begin
|
|
inherited Create(AOwner);
|
|
Glyph.LoadFromResourceName(HInstance, 'DXBARLOOKUPCOMBO');
|
|
|
|
FAllowResizing := True;
|
|
FListLink := TdxBarLookupLink.Create;
|
|
FListLink.FBarLookupCombo := Self;
|
|
FListFields := TList.Create;
|
|
FKeyValue := Null;
|
|
FRowCount := 7;
|
|
FPopupList := TdxBarPopupLookupControl.Create(nil);
|
|
FColor := clWindow;
|
|
with FPopupList do
|
|
begin
|
|
FCombo := Self;
|
|
end;
|
|
end;
|
|
|
|
destructor TdxBarLookupCombo.Destroy;
|
|
begin
|
|
FPopupList.Free;
|
|
FListFields.Free;
|
|
FListLink.FBarLookupCombo := nil;
|
|
FListLink.Free;
|
|
|
|
inherited Destroy;
|
|
end;
|
|
|
|
procedure TdxBarLookupCombo.Notification(AComponent: TComponent; Operation: TOperation);
|
|
begin
|
|
inherited Notification(AComponent, Operation);
|
|
if Operation = opRemove then
|
|
if (FListLink <> nil) and (AComponent = ListSource) then ListSource := nil;
|
|
end;
|
|
|
|
procedure TdxBarLookupCombo.CloseUp;
|
|
begin
|
|
if GetCapture = FPopupList.Handle then ReleaseCapture;
|
|
|
|
RowCount := FPopupList.RowCount;
|
|
FPopupWidth := FPopupList.Width;
|
|
FListVisible := False;
|
|
ResetFindStr;
|
|
if FKeyField = nil then
|
|
FCurKeyValue := Null
|
|
else
|
|
FCurKeyValue := FKeyField.Value;
|
|
|
|
inherited;
|
|
|
|
FPopupList.ListSource := nil;
|
|
FPopupList.Parent := nil;
|
|
end;
|
|
|
|
procedure TdxBarLookupCombo.DoEnter;
|
|
begin
|
|
ResetFindStr;
|
|
inherited;
|
|
end;
|
|
|
|
procedure TdxBarLookupCombo.DropDown(X, Y: Integer);
|
|
var
|
|
ControlWidth : Integer;
|
|
r : TRect;
|
|
W: Integer;
|
|
begin
|
|
FSetValue := False;
|
|
|
|
with FPopupList do
|
|
begin
|
|
IsPopup := True;
|
|
Parent := CurItemLink.Control.Parent;
|
|
GetWindowRect(TCustomdxBarComboControl(CurItemLink.Control).Handle, r);
|
|
ComboTop := r.Top + (r.Bottom - r.Top) div 2;
|
|
Font.Handle := CloneFont(CurItemLink.BarControl.EditFontHandle);
|
|
Color := FColor;
|
|
if Self.ListField <> '' then
|
|
ListField := Self.ListField
|
|
else
|
|
ListField := Self.KeyField;
|
|
ListFieldIndex := Self.ListFieldIndex;
|
|
RowCount := Self.RowCount;
|
|
ListSource := Self.ListSource;
|
|
if FListLink.Active then
|
|
FRecordCount := FListLink.RecordCount;
|
|
if not FInFindSelection and not VarIsNull(FCurKeyValue) and FListLink.Active then
|
|
FListLink.DataSet.Locate(FKeyFieldName, FCurKeyValue, []);
|
|
end;
|
|
|
|
with CurItemLink.ItemRect do
|
|
begin
|
|
W := Right - Left - TdxBarLookupComboControl(CurItemLink.Control).CaptionWidth;
|
|
if W > FPopupWidth then
|
|
ControlWidth := W
|
|
else
|
|
ControlWidth := FPopupWidth;
|
|
end;
|
|
|
|
SetWindowPos(FPopupList.Handle, 0, 0, 0, ControlWidth, FPopupList.Height,
|
|
SWP_NOZORDER or SWP_NOMOVE or SWP_NOACTIVATE);
|
|
FListVisible := True;
|
|
|
|
inherited;
|
|
end;
|
|
|
|
procedure TdxBarLookupCombo.DoClick;
|
|
var
|
|
W, H, D, I, J: Integer;
|
|
begin
|
|
inherited;
|
|
if Assigned(OnClick) or ReadOnly then Exit;
|
|
|
|
FForm := TForm.Create(nil);
|
|
with FForm do
|
|
begin
|
|
if FAllowResizing then
|
|
BorderIcons := []
|
|
else
|
|
BorderStyle := bsDialog;
|
|
Caption := cxGetResourceString(@dxSBAR_LOOKUPDIALOGCAPTION);
|
|
Font := BarManager.Font;
|
|
Position := poScreenCenter;
|
|
|
|
FLocateEdit := TEdit.Create(FForm);
|
|
with FLocateEdit do
|
|
begin
|
|
Parent := FForm;
|
|
OnKeyPress := DoKeyPress;
|
|
OnKeyDown := DoKeyDown;
|
|
end;
|
|
FLocateList := TdxBarPopupLookupControl.Create(FForm);
|
|
with FLocateList do
|
|
begin
|
|
FCombo := Self;
|
|
IsPopup := False;
|
|
Parent := FForm;
|
|
Color := FColor;
|
|
if Self.ListField <> '' then
|
|
ListField := Self.ListField
|
|
else
|
|
ListField := Self.KeyField;
|
|
ListFieldIndex := Self.ListFieldIndex;
|
|
ListSource := Self.ListSource;
|
|
|
|
Height := 2 * 2 + Self.RowCount * GetTextHeight;
|
|
if Self.FPopupWidth = 0 then
|
|
Width := FLocateEdit.Width
|
|
else
|
|
Width := Self.FPopupWidth;
|
|
end;
|
|
ButtonOk := TButton.Create(FForm);
|
|
with ButtonOk do
|
|
begin
|
|
Caption := cxGetResourceString(@dxSBAR_LOOKUPDIALOGOK);
|
|
Default := True;
|
|
ModalResult := mrOk;
|
|
Parent := FForm;
|
|
end;
|
|
ButtonCancel := TButton.Create(FForm);
|
|
with ButtonCancel do
|
|
begin
|
|
Caption := cxGetResourceString(@dxSBAR_LOOKUPDIALOGCANCEL);
|
|
Cancel := True;
|
|
ModalResult := mrCancel;
|
|
Parent := FForm;
|
|
end;
|
|
|
|
H := MulDiv(FLocateEdit.Height, 43, 42);
|
|
W := MulDiv(H, 13, 4);
|
|
D := FLocateEdit.Height div 4;
|
|
|
|
FLocateEdit.SetBounds(D, D, FLocateList.Width, FLocateEdit.Height);
|
|
with FLocateList do
|
|
begin
|
|
Left := D;
|
|
Top := FLocateEdit.BoundsRect.Bottom + D;
|
|
end;
|
|
ButtonOk.SetBounds(FLocateList.BoundsRect.Right + D, D, W, H);
|
|
ButtonCancel.SetBounds(ButtonOk.Left, ButtonOk.BoundsRect.Bottom + D, W, H);
|
|
I := D + FLocateList.Width + D + W + D;
|
|
J := D + FLocateEdit.Height + D + FLocateList.Height + D;
|
|
if J < 3 * D + 2 * H then J := 3 * D + 2 * H;
|
|
while (ClientWidth <> I) or (ClientHeight <> J) do
|
|
begin
|
|
ClientWidth := I;
|
|
ClientHeight := J;
|
|
end;
|
|
|
|
OnResize := FormSize;
|
|
FLocateEdit.Text := Text;
|
|
LocateKey;
|
|
FListVisible := True;
|
|
if (ShowModal = mrOk) and FListActive then
|
|
begin
|
|
if FKeyField <> nil then FKeyValue := FKeyField.Value;
|
|
KeyValueChanged;
|
|
end;
|
|
RowCount := FLocateList.RowCount;
|
|
FPopupWidth := FLocateList.Width;
|
|
ResetFindStr;
|
|
FListVisible := False;
|
|
Free;
|
|
FLocateEdit := nil;
|
|
end;
|
|
end;
|
|
|
|
function TdxBarLookupCombo.GetEditHandle: Integer;
|
|
begin
|
|
if FLocateEdit = nil then
|
|
Result := TCustomdxBarComboControl(CurItemLink.Control).Handle
|
|
else
|
|
Result := FLocateEdit.Handle;
|
|
end;
|
|
|
|
function TdxBarLookupCombo.GetEditText: string;
|
|
begin
|
|
if FLocateEdit = nil then
|
|
Result := CurText
|
|
else
|
|
Result := FLocateEdit.Text;
|
|
end;
|
|
|
|
procedure TdxBarLookupCombo.SetEditText(AText: string);
|
|
begin
|
|
if FLocateEdit = nil then
|
|
CurText := AText
|
|
else
|
|
FLocateEdit.Text := AText;
|
|
end;
|
|
|
|
function TdxBarLookupCombo.GetDropDownWindow: HWND;
|
|
begin
|
|
Result := inherited GetDropDownWindow;
|
|
if Result = 0 then Result := FPopupList.Handle;
|
|
end;
|
|
|
|
procedure TdxBarLookupCombo.DoKeyPress(Sender: TObject; var Key: Char);
|
|
begin
|
|
KeyPress(Key);
|
|
end;
|
|
|
|
procedure TdxBarLookupCombo.DoKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
|
|
begin
|
|
if CheckKeyForDropDownWindow(Key, Shift) then
|
|
begin
|
|
FLocateList.KeyDown(Key, Shift);
|
|
Key := 0;
|
|
end;
|
|
end;
|
|
|
|
procedure TdxBarLookupCombo.FormSize(Sender: TObject);
|
|
var
|
|
H, W, D: Integer;
|
|
begin
|
|
H := MulDiv(FLocateEdit.Height, 43, 42);
|
|
W := MulDiv(H, 13, 4);
|
|
D := FLocateEdit.Height div 4;
|
|
|
|
FLocateEdit.SetBounds(D, D, FForm.ClientWidth - (D + D + W + D), FLocateEdit.Height);
|
|
with FLocateList do
|
|
begin
|
|
Left := D;
|
|
Top := FLocateEdit.Top + FLocateEdit.Height + D;
|
|
Width := FLocateEdit.Width;
|
|
Height := FForm.ClientHeight - D - Top;
|
|
end;
|
|
ButtonOk.SetBounds(FForm.ClientWidth - D - W, D, W, H);
|
|
ButtonCancel.SetBounds(ButtonOk.Left, ButtonOk.Top + ButtonOk.Height + D, W, H);
|
|
end;
|
|
|
|
function TdxBarLookupCombo.CheckKeyForDropDownWindow(Key: Word; Shift: TShiftState): Boolean;
|
|
begin
|
|
// if {(FCombo <> nil) and }(Key = VK_RETURN) then
|
|
if Key in [VK_RETURN, VK_TAB] then
|
|
FSetValue := True;
|
|
Result := Key in [VK_UP, VK_LEFT, VK_DOWN, VK_RIGHT, VK_PRIOR, VK_NEXT, VK_HOME, VK_END];
|
|
end;
|
|
|
|
procedure TdxBarLookupCombo.KeyDown(var Key: Word; Shift: TShiftState);
|
|
begin
|
|
if Key = VK_ESCAPE then
|
|
ResetFindStr;
|
|
inherited KeyDown(Key, Shift);
|
|
end;
|
|
|
|
procedure TdxBarLookupCombo.KeyPress(var Key: Char);
|
|
var
|
|
lFind, ASelectedAll: Boolean;
|
|
AStartPos, AEndPos: Integer;
|
|
begin
|
|
if FListField <> nil then
|
|
try
|
|
case Key of
|
|
#8: // BkSpace
|
|
begin
|
|
SendMessage(GetEditHandle, EM_GETSEL, Longint(@AStartPos), Longint(@AEndPos));
|
|
ASelectedAll := (AEndPos - AStartPos) = Length(EditText);
|
|
if ASelectedAll then
|
|
begin
|
|
ResetFindStr;
|
|
EditText := '';
|
|
end
|
|
else
|
|
if FFindSelection then
|
|
begin
|
|
FFindStr := Copy(FFindStr, 0, Length(FFindStr)-1);
|
|
SendMessage(GetEditHandle, EM_SETSEL, Length(FFindStr), Length(EditText));
|
|
end;
|
|
end;
|
|
#32..#255:
|
|
begin
|
|
FInFindSelection := True;
|
|
try
|
|
if FFindSelection then begin
|
|
FFindStr := FFindStr + Key;
|
|
end else begin
|
|
FFindSelection := true;
|
|
FFindStr := Key;
|
|
end;
|
|
lFind := False;
|
|
try
|
|
lFind := FListLink.DataSet.Locate(FListField.FieldName, FFindStr, [loCaseInsensitive, loPartialKey])
|
|
except end;
|
|
if lFind then
|
|
begin
|
|
EditText := FListField.DisplayText;
|
|
SendMessage(GetEditHandle, EM_SETSEL, Length(FFindStr), Length(EditText));
|
|
// FSetValue := True;
|
|
end
|
|
else
|
|
begin
|
|
if FFindSelection and (Length(FFindStr) > 1) then
|
|
begin
|
|
FFindStr := Copy(FFindStr, 1, Length(FFindStr)-1);
|
|
if not FListVisible then DroppedDown := True;
|
|
end
|
|
else
|
|
begin
|
|
ResetFindStr;
|
|
EditText := '';
|
|
end;
|
|
if not FListVisible then DroppedDown := True;
|
|
end;
|
|
if FImmediateDropDown and not FListVisible then
|
|
begin
|
|
DroppedDown := True;
|
|
end;
|
|
finally
|
|
FInFindSelection := False;
|
|
end;
|
|
end;
|
|
end;
|
|
finally
|
|
Key := #0;
|
|
inherited KeyPress(Key);
|
|
end;
|
|
end;
|
|
|
|
procedure TdxBarLookupCombo.UpdateListFields;
|
|
var
|
|
DataSet: TDataSet;
|
|
begin
|
|
FKeyField := nil;
|
|
FListField := nil;
|
|
FListFields.Clear;
|
|
FListActive := False;
|
|
if FListLink.Active {and (FKeyFieldName <> '') }then
|
|
begin
|
|
DataSet := FListLink.DataSet;
|
|
FKeyField := DataSet.FindField(FKeyFieldName);
|
|
try
|
|
DataSet.GetFieldList(FListFields, FListFieldName);
|
|
except
|
|
raise;
|
|
end;
|
|
if (FListFields.Count = 0) and (FKeyField <> nil) then
|
|
FListFields.Add(FKeyField);
|
|
if FListFields.Count <> 0 then
|
|
if (0 <= FListFieldIndex) and (FListFieldIndex < FListFields.Count) then
|
|
FListField := FListFields[FListFieldIndex]
|
|
else
|
|
FListField := FListFields[0];
|
|
FListActive := FListField <> nil;
|
|
end;
|
|
if FKeyField = nil then FKeyValue := Null;
|
|
end;
|
|
|
|
procedure TdxBarLookupCombo.ListLinkDataChanged;
|
|
begin
|
|
if FListActive then
|
|
begin
|
|
if not VarIsNull(FKeyValue) and VarEquals(FKeyValue, FKeyField.Value) then
|
|
Text := FListField.DisplayText;
|
|
end;
|
|
end;
|
|
|
|
procedure TdxBarLookupCombo.KeyValueChanged;
|
|
begin
|
|
if FListActive and not LocateKey then
|
|
ListLink.DataSet.First;
|
|
if (FListField <> nil) {and not VarIsNULL(FKeyValue) }then
|
|
CurText := FListField.DisplayText
|
|
else
|
|
CurText := '';
|
|
if Assigned(FOnKeyValueChange) then FOnKeyValueChange(Self);
|
|
Text := CurText;
|
|
end;
|
|
|
|
function TdxBarLookupCombo.LocateKey: Boolean;
|
|
var
|
|
KeySave: Variant;
|
|
begin
|
|
if FKeyField = nil then
|
|
Result := True
|
|
else
|
|
begin
|
|
Result := False;
|
|
try
|
|
KeySave := FKeyValue;
|
|
if not VarIsNull(FKeyValue) and FListLink.Active and
|
|
FListLink.DataSet.Locate(FKeyFieldName, FKeyValue, []) then
|
|
begin
|
|
Result := True;
|
|
FKeyValue := KeySave;
|
|
end;
|
|
except
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure TdxBarLookupCombo.ResetFindStr;
|
|
begin
|
|
FFindStr := '';
|
|
FFindSelection := False;
|
|
// FSetValue := False;
|
|
end;
|
|
|
|
function TdxBarLookupCombo.GetListSource: TDataSource;
|
|
begin
|
|
Result := FListLink.DataSource;
|
|
end;
|
|
|
|
procedure TdxBarLookupCombo.SetKeyFieldName(const Value: string);
|
|
begin
|
|
if FKeyFieldName <> Value then
|
|
begin
|
|
FKeyFieldName := Value;
|
|
UpdateListFields;
|
|
end;
|
|
end;
|
|
|
|
procedure TdxBarLookupCombo.SetKeyValue(const Value: Variant);
|
|
begin
|
|
if not VarEquals(FKeyValue, Value) then
|
|
begin
|
|
FKeyValue := Value;
|
|
KeyValueChanged;
|
|
end;
|
|
end;
|
|
|
|
procedure TdxBarLookupCombo.SetListFieldIndex(Value: Integer);
|
|
begin
|
|
if Value < 0 then Exit;
|
|
FListFieldIndex := Value;
|
|
end;
|
|
|
|
procedure TdxBarLookupCombo.SetListFieldName(const Value: string);
|
|
begin
|
|
if FListFieldName <> Value then
|
|
begin
|
|
FListFieldName := Value;
|
|
UpdateListFields;
|
|
end;
|
|
end;
|
|
|
|
procedure TdxBarLookupCombo.SetListSource(Value: TDataSource);
|
|
begin
|
|
FListLink.DataSource := Value;
|
|
if Value <> nil then Value.FreeNotification(Self);
|
|
end;
|
|
|
|
procedure TdxBarLookupCombo.SetRowCount(Value: Integer);
|
|
begin
|
|
if Value < 1 then Exit;
|
|
FRowCount := Value;
|
|
end;
|
|
|
|
{ TdxBarLookupComboControl }
|
|
|
|
procedure TdxBarLookupComboControl.SetFocused(Value: Boolean);
|
|
var
|
|
FCombo: TdxBarLookupCombo;
|
|
begin
|
|
if Focused <> Value then
|
|
begin
|
|
inherited SetFocused(Value);
|
|
FCombo := TdxBarLookupCombo(Item);
|
|
if Value then
|
|
FCombo.FCurKeyValue := FCombo.FKeyValue;
|
|
if FCombo.FListActive and FCombo.FSetValue then
|
|
if Value then
|
|
FCombo.LocateKey
|
|
else
|
|
if (Text <> '') and (FCombo.FKeyField <> nil) then
|
|
FCombo.KeyValue := FCombo.FKeyField.Value
|
|
else
|
|
FCombo.KeyValue := Null;
|
|
end;
|
|
end;
|
|
|
|
procedure TdxBarLookupComboControl.WndProc(var Message: TMessage);
|
|
begin
|
|
with Message do
|
|
if (Msg = WM_KEYDOWN) and ((wParam = VK_RETURN) or (wParam = VK_TAB)) then
|
|
with TdxBarLookupCombo(Item) do
|
|
begin
|
|
if FKeyField <> nil then FKeyValue := FKeyField.Value;
|
|
KeyValueChanged;
|
|
end;
|
|
inherited WndProc(Message);
|
|
end;
|
|
|
|
{ TdxBarPopupLookupLink }
|
|
|
|
procedure TdxBarPopupLookupLink.ActiveChanged;
|
|
begin
|
|
if FBarPopupLookup <> nil then FBarPopupLookup.UpdateListFields;
|
|
end;
|
|
|
|
procedure TdxBarPopupLookupLink.DataSetChanged;
|
|
begin
|
|
if FBarPopupLookup <> nil then FBarPopupLookup.ListLinkDataChanged;
|
|
end;
|
|
|
|
procedure TdxBarPopupLookupLink.LayoutChanged;
|
|
begin
|
|
if FBarPopupLookup <> nil then FBarPopupLookup.UpdateListFields;
|
|
end;
|
|
|
|
procedure TdxBarPopupLookupLink.DataSetScrolled(Distance: Integer);
|
|
begin
|
|
if FBarPopupLookup <> nil then FBarPopupLookup.ListLinkDataChanged;
|
|
end;
|
|
|
|
{ TdxBarPopupLookupControl }
|
|
|
|
constructor TdxBarPopupLookupControl.Create(AOwner: TComponent);
|
|
begin
|
|
inherited Create(AOwner);
|
|
|
|
ControlStyle := ControlStyle - [csCaptureMouse];
|
|
|
|
FListLink := TdxBarPopupLookupLink.Create;
|
|
FListLink.FBarPopupLookup := Self;
|
|
FListFields := TList.Create;
|
|
FRowCount := 7;
|
|
end;
|
|
|
|
destructor TdxBarPopupLookupControl.Destroy;
|
|
begin
|
|
FListFields.Free;
|
|
FListLink.FBarPopupLookup := nil;
|
|
FListLink.Free;
|
|
|
|
inherited Destroy;
|
|
end;
|
|
|
|
procedure TdxBarPopupLookupControl.WMCancelMode(var Message: TMessage);
|
|
begin
|
|
StopTracking;
|
|
inherited;
|
|
end;
|
|
|
|
procedure TdxBarPopupLookupControl.WMCaptureChanged(var Message: TMessage);
|
|
begin
|
|
inherited;
|
|
if FCloseButtonIsTracking then
|
|
begin
|
|
FCloseButtonIsTracking := False;
|
|
FMouseAboveCloseButton := False;
|
|
SendMessage(Handle, WM_NCPAINT, 0, 0);
|
|
end;
|
|
StopTracking;
|
|
end;
|
|
|
|
procedure TdxBarPopupLookupControl.WMEraseBkgnd(var Message: TWmEraseBkgnd);
|
|
begin
|
|
Message.Result := 1;
|
|
end;
|
|
|
|
procedure TdxBarPopupLookupControl.WMGetDlgCode(var Message: TMessage);
|
|
begin
|
|
Message.Result := DLGC_WANTARROWS or DLGC_WANTCHARS;
|
|
end;
|
|
|
|
procedure TdxBarPopupLookupControl.WMGetMinMaxInfo(var Message: TWMGetMinMaxInfo);
|
|
begin
|
|
inherited;
|
|
Message.MinMaxInfo^.ptMinTrackSize := Point(100, 100);
|
|
end;
|
|
|
|
procedure TdxBarPopupLookupControl.WMLButtonUp(var Message: TWMLButtonUp);
|
|
begin
|
|
inherited;
|
|
if FCloseButtonIsTracking then
|
|
begin
|
|
FCloseButtonIsTracking := False;
|
|
ReleaseCapture;
|
|
if FMouseAboveCloseButton then
|
|
FCombo.BarManager.HideAll
|
|
else
|
|
SendMessage(Handle, WM_NCPAINT, 0, 0);
|
|
end;
|
|
end;
|
|
|
|
procedure TdxBarPopupLookupControl.WMNCCalcSize(var Message: TWMNCCalcSize);
|
|
begin
|
|
inherited;
|
|
if IsPopup then
|
|
FCombo.PainterClass.SysPanelCalcSize(Handle, Message.CalcSize_Params^.rgrc[0],
|
|
FCorner, FCombo, FCombo.AllowResizing);
|
|
end;
|
|
|
|
procedure TdxBarPopupLookupControl.WMNCHitTest(var Message : TWMNCHITTEST);
|
|
var
|
|
PrevMouseAboveCloseButton: Boolean;
|
|
begin
|
|
inherited;
|
|
with Message do
|
|
if PtInRect(FGripRect, SmallPointToPoint(Pos)) then
|
|
Result := GetHitTestByCorner(FCorner)
|
|
else
|
|
begin
|
|
PrevMouseAboveCloseButton := FMouseAboveCloseButton;
|
|
FMouseAboveCloseButton := (GetTopWindow(0) = Handle) and
|
|
((GetCapture = 0) or FCloseButtonIsTracking) and
|
|
PtInRect(FCloseButtonRect, SmallPointToPoint(Pos));
|
|
if FMouseAboveCloseButton then Result := HTBORDER;
|
|
if PrevMouseAboveCloseButton <> FMouseAboveCloseButton then
|
|
SendMessage(Handle, WM_NCPAINT, 0, 0);
|
|
end;
|
|
end;
|
|
|
|
procedure TdxBarPopupLookupControl.WMNCLButtonDown(var Message: TWMNCLButtonDown);
|
|
begin
|
|
inherited;
|
|
if FMouseAboveCloseButton then
|
|
begin
|
|
FCloseButtonIsTracking := True;
|
|
SetCapture(Handle);
|
|
SendMessage(Handle, WM_NCPAINT, 0, 0);
|
|
end;
|
|
end;
|
|
|
|
procedure TdxBarPopupLookupControl.WMNCPaint(var Message: TWMNCPaint);
|
|
begin
|
|
inherited;
|
|
if IsPopup then
|
|
FCombo.PainterClass.SysPanelDraw(Handle, FCombo.AllowResizing,
|
|
FMouseAboveCloseButton, FCloseButtonIsTracking, FCloseButtonRect, FGripRect, FCorner);
|
|
end;
|
|
|
|
procedure TdxBarPopupLookupControl.WMSize(var Message: TWMSize);
|
|
var
|
|
TextHeight, Rows: Integer;
|
|
begin
|
|
inherited;
|
|
TextHeight := GetTextHeight;
|
|
Rows := Message.Height div TextHeight;
|
|
if Rows < 1 then Rows := 1;
|
|
FRowCount := Rows;
|
|
if ListLink.BufferCount <> Rows then
|
|
begin
|
|
ListLink.BufferCount := Rows;
|
|
ListLinkDataChanged;
|
|
end;
|
|
end;
|
|
|
|
procedure TdxBarPopupLookupControl.WMTimer(var Message: TMessage);
|
|
begin
|
|
TimerScroll;
|
|
end;
|
|
|
|
procedure TdxBarPopupLookupControl.WMVScroll(var Message: TWMVScroll);
|
|
var
|
|
SI: TScrollInfo;
|
|
begin
|
|
with Message, ListLink.DataSet do
|
|
case ScrollCode of
|
|
SB_LINEUP: MoveBy(-FRecordIndex - 1);
|
|
SB_LINEDOWN: MoveBy(FRecordCount - FRecordIndex);
|
|
SB_PAGEUP: MoveBy(-FRecordIndex - FRecordCount + 1);
|
|
SB_PAGEDOWN: MoveBy(FRecordCount - FRecordIndex + FRecordCount - 2);
|
|
SB_THUMBPOSITION:
|
|
if IsSequenced then
|
|
begin
|
|
SI.cbSize := sizeof(SI);
|
|
SI.fMask := SIF_ALL;
|
|
GetScrollInfo(Self.Handle, SB_VERT, SI);
|
|
if SI.nTrackPos <= 1 then First
|
|
else if SI.nTrackPos >= RecordCount then Last
|
|
else RecNo := SI.nTrackPos;
|
|
end
|
|
else
|
|
case Pos of
|
|
0: First;
|
|
1: MoveBy(-FRecordIndex - FRecordCount + 1);
|
|
2: Exit;
|
|
3: MoveBy(FRecordCount - FRecordIndex + FRecordCount - 2);
|
|
4: Last;
|
|
end;
|
|
SB_BOTTOM: Last;
|
|
SB_TOP: First;
|
|
end;
|
|
end;
|
|
|
|
procedure TdxBarPopupLookupControl.WMWindowPosChanging(var Message : TWMWINDOWPOSCHANGING);
|
|
var
|
|
BorderSize, TextHeight, Rows, AHeight: Integer;
|
|
begin
|
|
if IsPopup then
|
|
begin
|
|
BorderSize := 2 + Byte(FCombo.AllowResizing) * dxDropDownNCHeight;
|
|
TextHeight := GetTextHeight;
|
|
with Message.WindowPos^ do
|
|
AHeight := cy;
|
|
Rows := (AHeight - BorderSize) div TextHeight;
|
|
if Rows < 1 then Rows := 1;
|
|
with Message.WindowPos^ do
|
|
if ComboTop < y + cy then
|
|
cy := Rows * TextHeight + BorderSize
|
|
else
|
|
if (AHeight <> 0) then begin
|
|
cy := Rows * TextHeight + BorderSize;
|
|
y := y + AHeight - cy;
|
|
end;
|
|
end;
|
|
inherited;
|
|
end;
|
|
|
|
procedure TdxBarPopupLookupControl.CMMouseLeave(var Message: TMessage);
|
|
begin
|
|
inherited;
|
|
if FMouseAboveCloseButton then
|
|
begin
|
|
FMouseAboveCloseButton := False;
|
|
if HandleAllocated then SendMessage(Handle, WM_NCPAINT, 0, 0);
|
|
end;
|
|
end;
|
|
|
|
procedure TdxBarPopupLookupControl.CreateParams(var Params: TCreateParams);
|
|
begin
|
|
inherited CreateParams(Params);
|
|
with Params do
|
|
if IsPopup then
|
|
ExStyle := WS_EX_TOOLWINDOW or WS_EX_TOPMOST
|
|
else
|
|
ExStyle := ExStyle or WS_EX_CLIENTEDGE;
|
|
end;
|
|
|
|
procedure TdxBarPopupLookupControl.CreateWnd;
|
|
begin
|
|
inherited CreateWnd;
|
|
if IsPopup then
|
|
begin
|
|
Windows.SetParent(Handle, 0);
|
|
CallWindowProc(DefWndProc, Handle, WM_SETFOCUS, 0, 0);
|
|
FHScrollWidth := GetSystemMetrics(SM_CYHSCROLL);
|
|
FVScrollWidth := GetSystemMetrics(SM_CXVSCROLL);
|
|
FCloseBtnDown := False;
|
|
FCloseBtnPaint := False;
|
|
end;
|
|
UpdateScrollBar;
|
|
end;
|
|
|
|
procedure TdxBarPopupLookupControl.DblClick;
|
|
begin
|
|
inherited;
|
|
if not IsPopup then
|
|
FCombo.FForm.ModalResult := mrOk;
|
|
end;
|
|
|
|
procedure TdxBarPopupLookupControl.Notification(AComponent: TComponent; Operation: TOperation);
|
|
begin
|
|
inherited Notification(AComponent, Operation);
|
|
if Operation = opRemove then
|
|
if (FListLink <> nil) and (AComponent = ListSource) then ListSource := nil;
|
|
end;
|
|
|
|
procedure TdxBarPopupLookupControl.KeyDown(var Key: Word; Shift: TShiftState);
|
|
var
|
|
Delta: Integer;
|
|
begin
|
|
inherited KeyDown(Key, Shift);
|
|
if not FListActive then Exit;
|
|
Delta := 0;
|
|
case Key of
|
|
VK_UP, VK_LEFT: Delta := -1;
|
|
VK_DOWN, VK_RIGHT: Delta := 1;
|
|
VK_PRIOR: Delta := 1 - FRowCount;
|
|
VK_NEXT: Delta := FRowCount - 1;
|
|
VK_HOME: Delta := -Maxint;
|
|
VK_END: Delta := Maxint;
|
|
end;
|
|
if Delta <> 0 then
|
|
begin
|
|
if Delta = -Maxint then
|
|
ListLink.DataSet.First
|
|
else
|
|
if Delta = Maxint then
|
|
ListLink.DataSet.Last
|
|
else
|
|
ListLink.DataSet.MoveBy(Delta);
|
|
SelectCurrent;
|
|
end;
|
|
end;
|
|
|
|
procedure TdxBarPopupLookupControl.ListLinkDataChanged;
|
|
begin
|
|
if FListActive then
|
|
begin
|
|
FRecordIndex := ListLink.ActiveRecord;
|
|
FRecordCount := ListLink.RecordCount;
|
|
end else
|
|
begin
|
|
FRecordIndex := 0;
|
|
FRecordCount := 0;
|
|
end;
|
|
if HandleAllocated then
|
|
begin
|
|
UpdateScrollBar;
|
|
Invalidate;
|
|
end;
|
|
end;
|
|
|
|
procedure TdxBarPopupLookupControl.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
|
|
begin
|
|
if (Button = mbLeft) and
|
|
Assigned(ListLink.DataSet) {and ListLink.DataSet.CanModify} then
|
|
if ssDouble in Shift then
|
|
if FRecordIndex = Y div GetTextHeight then
|
|
DblClick
|
|
else
|
|
else
|
|
begin
|
|
MouseCapture := True;
|
|
FTracking := True;
|
|
SelectItemAt(X, Y);
|
|
end;
|
|
inherited MouseDown(Button, Shift, X, Y);
|
|
end;
|
|
|
|
procedure TdxBarPopupLookupControl.MouseMove(Shift: TShiftState; X, Y: Integer);
|
|
begin
|
|
if FTracking then
|
|
begin
|
|
SelectItemAt(X, Y);
|
|
FMousePos := Y;
|
|
TimerScroll;
|
|
end;
|
|
inherited MouseMove(Shift, X, Y);
|
|
end;
|
|
|
|
procedure TdxBarPopupLookupControl.MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
|
|
begin
|
|
if FTracking then
|
|
begin
|
|
StopTracking;
|
|
SelectItemAt(X, Y);
|
|
if (FCombo <> nil) and ListLink.Active and IsPopup then
|
|
begin
|
|
if Y < 0 then Y := 0;
|
|
if Y >= ClientHeight then Y := ClientHeight - 1;
|
|
Y := Y div GetTextHeight;
|
|
if Y >= ListLink.RecordCount then Exit;
|
|
with FCombo do
|
|
try
|
|
if FKeyField <> nil then FKeyValue := FKeyField.Value;
|
|
KeyValueChanged;
|
|
finally
|
|
if (CurItemLink <> nil) and (CurItemLink.RealItemLink <> nil) then
|
|
CurItemLink.RealItemLink.BringToTopInRecentList(True);
|
|
try
|
|
BarManager.HideAll;
|
|
except
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
inherited MouseUp(Button, Shift, X, Y);
|
|
end;
|
|
|
|
procedure TdxBarPopupLookupControl.Paint;
|
|
var
|
|
I, J, W, X, TextWidth, TextHeight, LastFieldIndex, SelectedRecord: Integer;
|
|
Selected : Boolean;
|
|
S: string;
|
|
R: TRect;
|
|
Field: TField;
|
|
AAlignment: TAlignment;
|
|
begin
|
|
if not FListActive then
|
|
begin
|
|
Canvas.FillRect(ClientRect);
|
|
Exit;
|
|
end;
|
|
|
|
Canvas.Font := Font;
|
|
TextWidth := Canvas.TextWidth('0');
|
|
TextHeight := Canvas.TextHeight('0');
|
|
LastFieldIndex := ListFields.Count - 1;
|
|
if ColorToRGB(Color) <> ColorToRGB(clBtnFace) then
|
|
Canvas.Pen.Color := clBtnFace else
|
|
Canvas.Pen.Color := clBtnShadow;
|
|
SelectedRecord := ListLink.ActiveRecord;
|
|
for I := 0 to FRowCount - 1 do
|
|
begin
|
|
Canvas.Font.Color := Font.Color;
|
|
Canvas.Brush.Color := Color;
|
|
R.Top := I * TextHeight;
|
|
R.Bottom := R.Top + TextHeight;
|
|
Selected := False;
|
|
if I < FRecordCount then
|
|
begin
|
|
ListLink.ActiveRecord := I;
|
|
if (SelectedRecord = I) then
|
|
begin
|
|
Canvas.Font.Color := clHighlightText;
|
|
Canvas.Brush.Color := clHighlight;
|
|
Selected := True;
|
|
end;
|
|
R.Right := 0;
|
|
for J := 0 to LastFieldIndex do
|
|
begin
|
|
Field := ListFields[J];
|
|
if J < LastFieldIndex then
|
|
W := Field.DisplayWidth * TextWidth + 4 else
|
|
W := ClientWidth - R.Right;
|
|
S := Field.DisplayText;
|
|
X := 2;
|
|
AAlignment := Field.Alignment;
|
|
case AAlignment of
|
|
taRightJustify: X := W - Canvas.TextWidth(S) - 3;
|
|
taCenter: X := (W - Canvas.TextWidth(S)) div 2;
|
|
end;
|
|
R.Left := R.Right;
|
|
R.Right := R.Right + W;
|
|
Canvas.TextRect(R, R.Left + X, R.Top, S);
|
|
if J < LastFieldIndex then
|
|
begin
|
|
Canvas.MoveTo(R.Right, R.Top);
|
|
Canvas.LineTo(R.Right, R.Bottom);
|
|
Inc(R.Right);
|
|
if R.Right >= ClientWidth then Break;
|
|
end;
|
|
end;
|
|
end;
|
|
R.Left := 0;
|
|
R.Right := ClientWidth;
|
|
if I >= FRecordCount then Canvas.FillRect(R);
|
|
if Selected then
|
|
Canvas.DrawFocusRect(R);
|
|
end;
|
|
R.Top := R.Bottom;
|
|
R.Bottom := ClientHeight;
|
|
Canvas.Brush.Color := Color;
|
|
Canvas.FillRect(R);
|
|
if FRecordCount <> 0 then ListLink.ActiveRecord := FRecordIndex;
|
|
end;
|
|
|
|
function TdxBarPopupLookupControl.GetTextHeight: Integer;
|
|
var
|
|
DC: HDC;
|
|
SaveFont: HFont;
|
|
Metrics: TTextMetric;
|
|
begin
|
|
DC := GetDC(0);
|
|
SaveFont := SelectObject(DC, Font.Handle);
|
|
GetTextMetrics(DC, Metrics);
|
|
SelectObject(DC, SaveFont);
|
|
ReleaseDC(0, DC);
|
|
Result := Metrics.tmHeight;
|
|
end;
|
|
|
|
procedure TdxBarPopupLookupControl.UpdateListFields;
|
|
var
|
|
DataSet: TDataSet;
|
|
begin
|
|
FListField := nil;
|
|
FListFields.Clear;
|
|
FListActive := False;
|
|
if FListLink.Active then
|
|
begin
|
|
DataSet := FListLink.DataSet;
|
|
try
|
|
DataSet.GetFieldList(FListFields, FListFieldName);
|
|
except
|
|
raise;
|
|
end;
|
|
if (FListFieldIndex >= 0) and (FListFieldIndex < FListFields.Count) then
|
|
FListField := FListFields[FListFieldIndex]
|
|
else
|
|
if (FListFields.Count > 0) then
|
|
FListField := FListFields[0];
|
|
FListActive := FListField <> nil;
|
|
end;
|
|
end;
|
|
|
|
function TdxBarPopupLookupControl.GetListSource: TDataSource;
|
|
begin
|
|
Result := FListLink.DataSource;
|
|
end;
|
|
|
|
procedure TdxBarPopupLookupControl.SetListFieldName(const Value: string);
|
|
begin
|
|
if FListFieldName <> Value then
|
|
begin
|
|
FListFieldName := Value;
|
|
UpdateListFields;
|
|
end;
|
|
end;
|
|
|
|
procedure TdxBarPopupLookupControl.SetListSource(Value: TDataSource);
|
|
begin
|
|
FListLink.DataSource := Value;
|
|
if Value <> nil then Value.FreeNotification(Self);
|
|
end;
|
|
|
|
procedure TdxBarPopupLookupControl.SelectCurrent;
|
|
begin
|
|
if FCombo <> nil then
|
|
begin
|
|
FCombo.EditText := FListField.DisplayText;
|
|
FCombo.ResetFindStr;
|
|
SendMessage(FCombo.GetEditHandle, EM_SETSEL, 0, Length(FCombo.EditText));
|
|
end;
|
|
end;
|
|
|
|
procedure TdxBarPopupLookupControl.SelectItemAt(X, Y: Integer);
|
|
var
|
|
Delta: Integer;
|
|
begin
|
|
if not FCombo.FListActive then Exit;
|
|
if Y < 0 then Y := 0;
|
|
if Y >= ClientHeight then Y := ClientHeight - 1;
|
|
Delta := Y div GetTextHeight - FRecordIndex;
|
|
ListLink.DataSet.MoveBy(Delta);
|
|
SelectCurrent;
|
|
end;
|
|
|
|
procedure TdxBarPopupLookupControl.SetRowCount(Value: Integer);
|
|
begin
|
|
if Value < 1 then Value := 1;
|
|
if Value > 100 then Value := 100;
|
|
Height := Value * GetTextHeight + 2 +
|
|
Byte(IsPopup and FCombo.AllowResizing) * dxDropDownNCHeight;
|
|
end;
|
|
|
|
procedure TdxBarPopupLookupControl.StopTimer;
|
|
begin
|
|
if FTimerActive then
|
|
begin
|
|
KillTimer(Handle, 1);
|
|
FTimerActive := False;
|
|
end;
|
|
end;
|
|
|
|
procedure TdxBarPopupLookupControl.StopTracking;
|
|
begin
|
|
if FTracking then
|
|
begin
|
|
StopTimer;
|
|
FTracking := False;
|
|
MouseCapture := False;
|
|
end;
|
|
end;
|
|
|
|
procedure TdxBarPopupLookupControl.TimerScroll;
|
|
var
|
|
Delta, Distance, Interval: Integer;
|
|
begin
|
|
Delta := 0;
|
|
Distance := 0;
|
|
if FMousePos < 0 then
|
|
begin
|
|
Delta := -1;
|
|
Distance := -FMousePos;
|
|
end;
|
|
if FMousePos >= ClientHeight then
|
|
begin
|
|
Delta := 1;
|
|
Distance := FMousePos - ClientHeight + 1;
|
|
end;
|
|
if Delta = 0 then StopTimer else
|
|
begin
|
|
if ListLink.DataSet.MoveBy(Delta) <> 0 then SelectCurrent;
|
|
Interval := 200 - Distance * 15;
|
|
if Interval < 0 then Interval := 0;
|
|
SetTimer(Handle, 1, Interval, nil);
|
|
FTimerActive := True;
|
|
end;
|
|
end;
|
|
|
|
procedure TdxBarPopupLookupControl.UpdateScrollBar;
|
|
var
|
|
SIOld, SINew: TScrollInfo;
|
|
begin
|
|
if FListLink.Active and HandleAllocated then
|
|
with ListLink.DataSet do
|
|
begin
|
|
SIOld.cbSize := sizeof(SIOld);
|
|
SIOld.fMask := SIF_ALL;
|
|
GetScrollInfo(Self.Handle, SB_VERT, SIOld);
|
|
SINew := SIOld;
|
|
if IsSequenced then
|
|
begin
|
|
SINew.nMin := 1;
|
|
SINew.nPage := FRowCount;
|
|
SINew.nMax := Integer(DWORD(RecordCount) + SINew.nPage - 1);
|
|
if State in [dsInactive, dsBrowse, dsEdit] then
|
|
SINew.nPos := RecNo;
|
|
end
|
|
else
|
|
begin
|
|
SINew.nMin := 0;
|
|
SINew.nPage := 0;
|
|
SINew.nMax := 4;
|
|
if BOF then SINew.nPos := 0
|
|
else if EOF then SINew.nPos := 4
|
|
else SINew.nPos := 2;
|
|
end;
|
|
if (SINew.nMin <> SIOld.nMin) or (SINew.nMax <> SIOld.nMax) or
|
|
(SINew.nPage <> SIOld.nPage) or (SINew.nPos <> SIOld.nPos) then
|
|
SetScrollInfo(Self.Handle, SB_VERT, SINew, True);
|
|
end;
|
|
end;
|
|
|
|
initialization
|
|
dxBarRegisterItem(TdxBarLookupCombo, TdxBarLookupComboControl, True);
|
|
|
|
finalization
|
|
dxBarUnregisterItem(TdxBarLookupCombo);
|
|
|
|
end.
|