david
47aaf11578
git-svn-id: https://192.168.0.254/svn/Componentes.Terceros.DevExpressVCL@38 05c56307-c608-d34a-929d-697000501d7a
1179 lines
32 KiB
ObjectPascal
1179 lines
32 KiB
ObjectPascal
|
|
{*******************************************************************}
|
|
{ }
|
|
{ Developer Express Visual Component Library }
|
|
{ Express data-aware inplace editors }
|
|
{ }
|
|
{ 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 }
|
|
{ }
|
|
{ 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 dxDBEdtr;
|
|
|
|
interface
|
|
|
|
{$I dxEdVer.inc}
|
|
|
|
uses
|
|
SysUtils, Messages, Windows, Classes, Graphics, Menus, Controls, Forms, StdCtrls,
|
|
dxCntner, dxEditor, dxExEdtr, DB{$IFNDEF DELPHI3}, DBTables {$ENDIF}, DBCtrls,
|
|
dxUtils{$IFDEF DELPHI6}, Variants{$ENDIF};
|
|
|
|
type
|
|
{ TdxInplaceLookupEdit }
|
|
|
|
TdxInplaceLookupEdit = class;
|
|
TPopupDBLookupListBox = class;
|
|
|
|
TdxPickColumnCloseUp = procedure(Sender: TObject; var Value: Variant;
|
|
var Accept: Boolean) of object;
|
|
|
|
TdxListSourceLink = class(TDataLink)
|
|
private
|
|
FLookupEdit: TdxInplaceLookupEdit;
|
|
protected
|
|
procedure ActiveChanged; override;
|
|
procedure DataSetChanged; override;
|
|
procedure LayoutChanged; override;
|
|
public
|
|
constructor Create;
|
|
end;
|
|
|
|
TdxInplaceLookupEdit = class(TdxInplaceDropDownEdit)
|
|
private
|
|
FCanDeleteText: Boolean;
|
|
FClearKey: TShortCut;
|
|
FDataList: TPopupDBLookupListBox;
|
|
FField: TField;
|
|
FFindSelection: Boolean;
|
|
FFindStr: string;
|
|
FKeyFieldName: string;
|
|
FListFieldName: string;
|
|
FListLink: TdxListSourceLink;
|
|
FLookupDisplayAssigned: Boolean; // non LookupMode
|
|
FLookupDisplayText: string; // non LookupMode
|
|
FLookupKeyValue: Variant;
|
|
FLookupMode: Boolean;
|
|
FLookupSource: TDatasource;
|
|
FRevertable: Boolean;
|
|
FUnboundMode: Boolean;
|
|
FOnCloseUp: TdxPickColumnCloseUp;
|
|
procedure CheckNotCircular;
|
|
procedure CheckNotLookup;
|
|
function GetDisplayText(AIsLookupResult: Boolean): string;
|
|
function GetField: TField;
|
|
function GetKeyFieldName: string;
|
|
function GetListSource: TDataSource;
|
|
function GetLookupAlignment: TAlignment;
|
|
function GetLookupDisplayText(const ALookupKeyValue: Variant): string;
|
|
function GetLookupListField: TField;
|
|
function GetLookupMode: Boolean;
|
|
function GetMasterField: TField;
|
|
procedure PrepareListBox;
|
|
procedure ResetFindStr;
|
|
procedure SetKeyFieldName(const Value: string);
|
|
procedure SetField(Value: TField);
|
|
procedure SetListFieldName(const Value: string);
|
|
procedure SetListSource(Value: TDataSource);
|
|
procedure SetLookupKeyValue(const Value: Variant);
|
|
protected
|
|
procedure KeyDown(var Key: Word; Shift: TShiftState); override;
|
|
procedure KeyPress(var Key: Char); override;
|
|
procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
|
|
procedure Notification(AComponent: TComponent; Operation: TOperation); override;
|
|
procedure AssignEditProperties; override;
|
|
procedure AssignEditValue(const Value: Variant); override;
|
|
procedure AssignLookupKeyValue(const Value: Variant);
|
|
procedure ClearField; virtual;
|
|
procedure CloseUp(Accept: Boolean); override;
|
|
function DataLink: TDataLink; virtual;
|
|
procedure DoCloseUp(var Value: Variant; var Accept: Boolean); {$IFDEF DELPHI4} reintroduce {$ELSE} virtual {$ENDIF};
|
|
procedure DoIncremental(Distance: Integer; Circle: Boolean); override;
|
|
procedure DropDown; override;
|
|
procedure FindListValue(const Value: string); override;
|
|
function IsCircular: Boolean;
|
|
procedure ListLinkDataChanged; virtual;
|
|
procedure LoadDisplayValue(var Data: Variant; IsPaintCopy: Boolean); override;
|
|
procedure SetActive(Value: Boolean); override;
|
|
procedure SetEditReadOnly(Value: Boolean); override;
|
|
function SetKeyValue(const AValue: Variant): Boolean; virtual;
|
|
procedure SetLookupMode(Value: Boolean);
|
|
procedure UpdateListFields; virtual;
|
|
property ClearKey: TShortCut read FClearKey write FClearKey default 0;
|
|
property Field: TField read GetField write SetField;
|
|
property ListFieldName: string read FListFieldName write SetListFieldName;
|
|
property ListLink: TdxListSourceLink read FListLink;
|
|
property MasterField: TField read GetMasterField;
|
|
property CanDeleteText: Boolean read FCanDeleteText write FCanDeleteText default False;
|
|
property Revertable: Boolean read FRevertable write FRevertable default False;
|
|
property OnCloseUp: TdxPickColumnCloseUp read FOnCloseUp write FOnCloseUp;
|
|
property LookupKeyValue: Variant read FLookupKeyValue write SetLookupKeyValue;
|
|
property UnboundMode: Boolean read FUnboundMode write FUnboundMode default False;
|
|
// TODO: new
|
|
property KeyFieldName: string read GetKeyFieldName write SetKeyFieldName;
|
|
property ListSource: TDataSource read GetListSource write SetListSource;
|
|
property LookupAlignment: TAlignment read GetLookupAlignment;
|
|
property LookupListField: TField read GetLookupListField;
|
|
property LookupMode: Boolean read GetLookupMode;
|
|
public
|
|
constructor Create(AOwner: TComponent); override;
|
|
destructor Destroy; override;
|
|
function CanModify: Boolean; override;
|
|
function DefaultReadOnly: Boolean; override;
|
|
function IsEditable: Boolean;
|
|
end;
|
|
|
|
{ TPopupDBLookupListBox }
|
|
|
|
TPopupDBLookupListBox = class(TPopupDataList)
|
|
private
|
|
FBorderStyle: TdxPopupBorderStyle;
|
|
FShadow: Boolean;
|
|
FShadowSize: Integer;
|
|
procedure SetBorderStyle(Value: TdxPopupBorderStyle);
|
|
procedure SetShadow(Value: Boolean);
|
|
procedure SetShadowSize(Value: Integer);
|
|
procedure WMNCCalcSize(var Message: TWMNCCalcSize); message WM_NCCALCSIZE;
|
|
procedure WMNCPaint(var Message: TWMNCPaint); message WM_NCPAINT;
|
|
procedure WMSize(var Message: TWMSize); message WM_SIZE;
|
|
protected
|
|
procedure CreateParams(var Params: TCreateParams); override;
|
|
{$IFDEF DELPHI4}
|
|
function GetBorderSize: Integer; override;
|
|
{$ENDIF}
|
|
public
|
|
constructor Create(AOwner: TComponent); override;
|
|
property BorderStyle: TdxPopupBorderStyle read FBorderStyle write SetBorderStyle default pbSingle;
|
|
property Shadow: Boolean read FShadow write SetShadow default False;
|
|
property ShadowSize: Integer read FShadowSize write SetShadowSize default dxEditShadowSize;
|
|
end;
|
|
|
|
function CalcBlobEditKind(ABlobKind: TdxBlobKind; AField: TField): TdxBlobEditKind;
|
|
function GetBlobEditKind(Field: TField): TdxBlobEditKind;
|
|
function GetBlobIcon(Field: TField): TdxBlobIcon; // obsolete
|
|
procedure SaveGraphicToBlobField(AGraphic: TGraphic; AField: TField);
|
|
procedure SaveGraphicToField(AGraphic: TGraphic; AField: TField);
|
|
procedure SaveBlobValueToField(const AValue: Variant; AField: TField);
|
|
function CanLookupFieldModify(AField: TField): Boolean;
|
|
|
|
implementation
|
|
|
|
uses
|
|
Consts, Clipbrd, dxEdStr, ExtDlgs, DBConsts{$IFDEF DELPHI6}, VDBConsts{$ENDIF};
|
|
|
|
function CalcBlobEditKind(ABlobKind: TdxBlobKind; AField: TField): TdxBlobEditKind;
|
|
const
|
|
BlobEditKinds: array [bkBlob..bkOle] of TdxBlobEditKind = (bekBlob, bekMemo, bekPict, bekOle);
|
|
begin
|
|
if ABlobKind = bkAuto then
|
|
Result := GetBlobEditKind(AField)
|
|
else Result := BlobEditKinds[ABlobKind];
|
|
end;
|
|
|
|
function GetBlobEditKind(Field: TField): TdxBlobEditKind;
|
|
begin
|
|
Result := bekBlob;
|
|
if Assigned(Field) then
|
|
begin
|
|
case Field.DataType of
|
|
ftMemo, ftFmtMemo: Result := bekMemo;
|
|
ftGraphic: Result := bekPict;
|
|
ftParadoxOle, ftDBaseOle: Result := bekOle;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
function GetBlobIcon(Field: TField): TdxBlobIcon;
|
|
begin
|
|
Result := biBlob;
|
|
if (Field <> nil) then
|
|
begin
|
|
case Field.DataType of
|
|
ftMemo, ftFmtMemo: Result := biMemo;
|
|
ftGraphic: Result := biPict;
|
|
ftParadoxOle, ftDBaseOle: Result := biOle;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure SaveGraphicToBlobField(AGraphic: TGraphic; AField: TField);
|
|
var
|
|
BlobStream: TStream;
|
|
begin
|
|
if AField is TBlobField then
|
|
with AField as TBlobField do
|
|
begin
|
|
{$IFNDEF DELPHI3}
|
|
BlobStream := TBlobStream.Create(AField as TBlobField, bmWrite);
|
|
{$ELSE}
|
|
BlobStream := DataSet.CreateBlobStream(AField, bmWrite);
|
|
{$ENDIF}
|
|
try
|
|
AGraphic.SaveToStream(BlobStream);
|
|
finally
|
|
BlobStream.Free;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure SaveGraphicToField(AGraphic: TGraphic; AField: TField);
|
|
begin
|
|
if Assigned(AField) then
|
|
if Assigned(AGraphic) then
|
|
begin
|
|
if AGraphic is TBitmap then
|
|
AField.Assign(AGraphic)
|
|
else SaveGraphicToBlobField(AGraphic, AField);
|
|
end
|
|
else
|
|
AField.Clear;
|
|
end;
|
|
|
|
procedure SaveBlobValueToField(const AValue: Variant; AField: TField);
|
|
begin
|
|
if Assigned(AField) then
|
|
begin
|
|
if VarType(AValue) = varNull then
|
|
AField.Clear
|
|
else
|
|
if VarType(AValue) = varString then
|
|
AField.Value := AValue
|
|
else
|
|
SaveGraphicToField(TGraphic(Integer(AValue)), AField);
|
|
end;
|
|
end;
|
|
|
|
function VarEquals(const V1, V2: Variant): Boolean;
|
|
begin
|
|
Result := False;
|
|
try
|
|
Result := V1 = V2;
|
|
except
|
|
end;
|
|
end;
|
|
|
|
function CanLookupFieldModify(AField: TField): Boolean;
|
|
var
|
|
AMasterFields: TList;
|
|
I: Integer;
|
|
begin
|
|
Result := False;
|
|
if Assigned(AField.DataSet) then
|
|
begin
|
|
AMasterFields := TList.Create;
|
|
try
|
|
AField.DataSet.GetFieldList(AMasterFields, AField.KeyFields);
|
|
Result := AMasterFields.Count > 0;
|
|
for I := 0 to AMasterFields.Count - 1 do
|
|
Result := Result and TField(AMasterFields[I]).CanModify;
|
|
finally
|
|
AMasterFields.Free;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
{ TdxListSourceLink }
|
|
|
|
constructor TdxListSourceLink.Create;
|
|
begin
|
|
inherited Create;
|
|
{$IFDEF DELPHI5}
|
|
VisualControl := True;
|
|
{$ENDIF}
|
|
end;
|
|
|
|
procedure TdxListSourceLink.ActiveChanged;
|
|
begin
|
|
if Assigned(FLookupEdit) then
|
|
FLookupEdit.UpdateListFields;
|
|
end;
|
|
|
|
procedure TdxListSourceLink.DataSetChanged;
|
|
begin
|
|
if Assigned(FLookupEdit) then
|
|
FLookupEdit.ListLinkDataChanged;
|
|
end;
|
|
|
|
procedure TdxListSourceLink.LayoutChanged;
|
|
begin
|
|
if Assigned(FLookupEdit) then
|
|
FLookupEdit.UpdateListFields;
|
|
end;
|
|
|
|
{ TdxInplaceLookupEdit }
|
|
|
|
constructor TdxInplaceLookupEdit.Create(AOwner: TComponent);
|
|
begin
|
|
inherited Create(AOwner);
|
|
FLookupSource := TDataSource.Create(nil);
|
|
FDataList := TPopupDBLookupListBox.Create(nil); {override TPopupDataList}
|
|
FDataList.Visible := False;
|
|
FDataList.OnMouseUp := ListMouseUp;
|
|
FActiveList := FDataList;
|
|
FSearchStyle := True;
|
|
FListLink := TdxListSourceLink.Create;
|
|
FListLink.FLookupEdit := Self;
|
|
FLookupKeyValue := Null;
|
|
FLookupMode := True;
|
|
end;
|
|
|
|
destructor TdxInplaceLookupEdit.Destroy;
|
|
begin
|
|
FListLink.FLookupEdit := nil;
|
|
FListLink.Free;
|
|
FListLink := nil;
|
|
FLookupSource.Free;
|
|
FLookupSource := nil;
|
|
FDataList.Free;
|
|
FDataList := nil;
|
|
inherited Destroy;
|
|
end;
|
|
|
|
function TdxInplaceLookupEdit.CanModify: Boolean;
|
|
begin
|
|
Result := False;
|
|
// if HandleAllocated then
|
|
// if CanDeleteText and (SelLength = GetTextLenEx) then
|
|
// Result := True;
|
|
end;
|
|
|
|
function TdxInplaceLookupEdit.DefaultReadOnly: Boolean;
|
|
begin
|
|
Result := not UnboundMode;
|
|
if Assigned(MasterField) and MasterField.CanModify then
|
|
Result := False;
|
|
end;
|
|
|
|
function TdxInplaceLookupEdit.IsEditable: Boolean;
|
|
begin
|
|
Result := not ReadOnly and (UnboundMode or
|
|
Assigned(Field) and ((Field.FieldKind = fkLookup) or not LookupMode));
|
|
end;
|
|
|
|
procedure TdxInplaceLookupEdit.KeyDown(var Key: Word; Shift: TShiftState);
|
|
|
|
procedure MoveTo(Distance: Integer);
|
|
begin
|
|
DoIncremental(Distance, False);
|
|
Key := 0;
|
|
end;
|
|
|
|
begin
|
|
case Key of
|
|
VK_ESCAPE:
|
|
ResetFindStr;
|
|
VK_DELETE:
|
|
if (SelLength = GetTextLen) and CanDeleteText then
|
|
ClearField;
|
|
end;
|
|
if not IsInplace then
|
|
case Key of
|
|
VK_UP: MoveTo(-1);
|
|
VK_DOWN: MoveTo(1);
|
|
VK_PRIOR: MoveTo(- (DropDownRows - 1));
|
|
VK_NEXT: MoveTo((DropDownRows - 1));
|
|
end;
|
|
if (ShortCut(Key, Shift) <> 0) and (ClearKey = ShortCut(Key, Shift)) then
|
|
ClearField;
|
|
inherited KeyDown(Key, Shift);
|
|
end;
|
|
|
|
procedure TdxInplaceLookupEdit.KeyPress(var Key: Char);
|
|
var
|
|
AListField: TField;
|
|
ADataSet: TDataSet;
|
|
AKeyFieldName, AListFieldName: string;
|
|
Found: Boolean;
|
|
|
|
procedure FillFromList;
|
|
var
|
|
AIsLookupResult: Boolean;
|
|
begin
|
|
Text := FFindStr;
|
|
Found := False;
|
|
try
|
|
Found := ADataSet.Locate(AListFieldName, Text, [loCaseInsensitive, loPartialKey])
|
|
except
|
|
end;
|
|
if Found then
|
|
begin
|
|
FDisableRefresh := True;
|
|
try
|
|
AIsLookupResult := SetKeyValue(ADataSet.FieldByName(AKeyFieldName).Value);
|
|
finally
|
|
FDisableRefresh := False;
|
|
end;
|
|
Text := GetDisplayText(AIsLookupResult{TODO: True}{IsLookupResult});
|
|
SetSelEx(Length(FFindStr), Length(Text), True);
|
|
end
|
|
else
|
|
begin
|
|
if FFindSelection and (Length(FFindStr) > 1) then
|
|
begin
|
|
Key := Copy(FFindStr, Length(FFindStr) - 1, 1)[1];
|
|
FFindStr := Copy(FFindStr, 1, Length(FFindStr) - 2);
|
|
Text := GetDisplayText(False);
|
|
KeyPress(Key);
|
|
Exit;
|
|
end
|
|
else
|
|
begin
|
|
ResetFindStr;
|
|
Text := GetDisplayText(False);
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
begin
|
|
if ReadOnly then
|
|
begin
|
|
Key := #0;
|
|
inherited KeyPress(Key);
|
|
Exit;
|
|
end;
|
|
if (Field <> nil) or UnboundMode then
|
|
begin
|
|
try
|
|
if LookupMode then
|
|
with Field do
|
|
begin
|
|
ADataSet := LookupDataSet;
|
|
AListFieldName := LookupResultField;
|
|
if ADataSet <> nil then
|
|
AListField := ADataSet.FindField(LookupResultField)
|
|
else AListField := nil;
|
|
AKeyFieldName := LookupKeyFields;
|
|
end
|
|
else
|
|
begin
|
|
if ListSource <> nil then
|
|
ADataSet := ListSource.DataSet
|
|
else
|
|
ADataSet := nil;
|
|
AListField := GetLookupListField;
|
|
if AListField <> nil then
|
|
AListFieldName := AListField.FieldName
|
|
else
|
|
AListFieldName := '';
|
|
AKeyFieldName := KeyFieldName;
|
|
end;
|
|
case Key of
|
|
#8: // BkSpace
|
|
begin
|
|
if (SelLength = GetTextLen) and CanDeleteText then
|
|
ClearField
|
|
else
|
|
if not FFindSelection and (SelStart <> 0) then
|
|
begin
|
|
FFindSelection := True;
|
|
FFindStr := Text;
|
|
end;
|
|
if FFindSelection then
|
|
begin
|
|
FFindStr := Copy(FFindStr, 1, Length(FFindStr) - 1);
|
|
if (FFindStr = '') and CanDeleteText then
|
|
ClearField
|
|
else
|
|
begin
|
|
SetSelEx(Length(FFindStr), Length(Text), True);
|
|
FillFromList;
|
|
end;
|
|
end;
|
|
end;
|
|
#32..#255:
|
|
begin
|
|
if (ADataSet = nil) or (AListField = nil) then Exit;
|
|
if FFindSelection then
|
|
FFindStr := FFindStr + Key
|
|
else
|
|
begin
|
|
FFindSelection := True;
|
|
FFindStr := Key;
|
|
end;
|
|
FillFromList;
|
|
if ImmediateDropDown and not FListVisible then
|
|
begin
|
|
DropDown;
|
|
FindListValue(Text);
|
|
end;
|
|
end;
|
|
end;
|
|
finally
|
|
Key := #0;
|
|
inherited KeyPress(Key);
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure TdxInplaceLookupEdit.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
|
|
begin
|
|
if (Button = mbLeft) and (ssDouble in Shift) and Revertable then
|
|
begin
|
|
DoIncremental(1, True);
|
|
FindListValue(Text);
|
|
end;
|
|
inherited MouseDown(Button, Shift, X, Y);
|
|
end;
|
|
|
|
procedure TdxInplaceLookupEdit.Notification(AComponent: TComponent; Operation: TOperation);
|
|
begin
|
|
inherited Notification(AComponent, Operation);
|
|
if (Operation = opRemove) and (AComponent = FField) then
|
|
Field := nil;
|
|
end;
|
|
|
|
procedure TdxInplaceLookupEdit.AssignEditProperties;
|
|
begin
|
|
inherited AssignEditProperties;
|
|
if not IsInplace then
|
|
SetLookupMode((Field <> nil) and (Field.FieldKind = fkLookup));
|
|
end;
|
|
|
|
procedure TdxInplaceLookupEdit.AssignEditValue(const Value: Variant);
|
|
begin
|
|
if FDisableRefresh then Exit;
|
|
inherited AssignEditValue(Value);
|
|
if not LookupMode then
|
|
LookupKeyValue := Value;
|
|
ResetFindStr;
|
|
end;
|
|
|
|
procedure TdxInplaceLookupEdit.AssignLookupKeyValue(const Value: Variant);
|
|
begin
|
|
AssigningText := True;
|
|
try
|
|
FLookupDisplayAssigned := False;
|
|
FLookupKeyValue := Value;
|
|
Text := GetDisplayText(False);
|
|
finally
|
|
AssigningText := False;
|
|
end;
|
|
end;
|
|
|
|
procedure TdxInplaceLookupEdit.ClearField;
|
|
begin
|
|
if Assigned(Field) or UnboundMode then
|
|
begin
|
|
SetKeyValue(Null);
|
|
Text := GetDisplayText(False);
|
|
ResetFindStr;
|
|
SelectAll;
|
|
end;
|
|
end;
|
|
|
|
procedure TdxInplaceLookupEdit.CloseUp(Accept: Boolean);
|
|
var
|
|
ListValue: Variant;
|
|
S: string;
|
|
begin
|
|
if FListVisible then
|
|
begin
|
|
ResetFindStr;
|
|
if GetCapture <> 0 then SendMessage(GetCapture, WM_CANCELMODE, 0, 0);
|
|
FocusNeeded;
|
|
SetWindowPos(FActiveList.Handle, 0, 0, 0, 0, 0, SWP_NOZORDER or
|
|
SWP_NOMOVE or SWP_NOSIZE or SWP_NOACTIVATE or SWP_HIDEWINDOW);
|
|
FListVisible := False;
|
|
if Assigned(FDataList) then
|
|
begin
|
|
ListValue := FDataList.KeyValue;
|
|
FDataList.ListSource := nil;
|
|
end;
|
|
FLookupSource.Dataset := nil;
|
|
Invalidate;
|
|
DoCloseUp(ListValue, Accept);
|
|
if Accept then
|
|
if Assigned(FDataList) then
|
|
begin
|
|
SetKeyValue(ListValue);
|
|
if Assigned(Field) then
|
|
begin
|
|
S := GetDisplayText(False);
|
|
if Self.Text <> S then
|
|
Self.Text := S;
|
|
end;
|
|
SelectAll;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
function TdxInplaceLookupEdit.DataLink: TDataLink;
|
|
begin
|
|
Result := nil;
|
|
end;
|
|
|
|
procedure TdxInplaceLookupEdit.DoCloseUp(var Value: Variant; var Accept: Boolean);
|
|
begin
|
|
if Assigned(FOnCloseUp) then FOnCloseUp(Self, Value, Accept);
|
|
end;
|
|
|
|
procedure TdxInplaceLookupEdit.DoIncremental(Distance: Integer; Circle: Boolean);
|
|
var
|
|
ADataSet: TDataSet;
|
|
AKeyField: string;
|
|
AMasterField: TField;
|
|
AValue, ANewValue: Variant;
|
|
begin
|
|
if IsEditable then
|
|
begin
|
|
ResetFindStr;
|
|
if LookupMode then
|
|
begin
|
|
ADataSet := Field.LookupDataSet;
|
|
AKeyField := Field.LookupKeyFields;
|
|
end
|
|
else
|
|
begin
|
|
if ListSource <> nil then
|
|
ADataSet := ListSource.DataSet
|
|
else
|
|
ADataSet := nil;
|
|
AKeyField := KeyFieldName;
|
|
end;
|
|
if (ADataSet <> nil) and (AKeyField <> '') then
|
|
with ADataSet do
|
|
begin
|
|
AMasterField := ADataSet.FindField(AKeyField);
|
|
if UnboundMode then
|
|
AValue := FLookupKeyValue
|
|
else
|
|
if Assigned(MasterField) then
|
|
AValue := MasterField.Value
|
|
else
|
|
AValue := AMasterField.Value;
|
|
if Locate(AKeyField, AValue, []) then
|
|
begin
|
|
MoveBy(Distance);
|
|
if EOF and Circle then
|
|
First;
|
|
end
|
|
else
|
|
First;
|
|
ANewValue := AMasterField.Value;
|
|
if not VarEquals(AValue, ANewValue) then
|
|
SetKeyValue(ANewValue);
|
|
SelectAll;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure TdxInplaceLookupEdit.DropDown;
|
|
begin
|
|
if IsEditable then
|
|
begin
|
|
Windows.SetFocus(Handle);
|
|
if GetFocus <> Handle then Exit;
|
|
EditButtonClick;
|
|
PrepareListBox;
|
|
CalcPosition(FDataList, False);
|
|
with FActiveList do
|
|
SetWindowPos(Handle, HWND_TOP, Left, Top, 0, 0,
|
|
SWP_NOSIZE or SWP_NOACTIVATE or SWP_SHOWWINDOW);
|
|
FListVisible := True;
|
|
Invalidate;
|
|
end;
|
|
end;
|
|
|
|
procedure TdxInplaceLookupEdit.FindListValue(const Value: string);
|
|
var
|
|
AMasterField: TField;
|
|
AValue: Variant;
|
|
begin
|
|
if UnboundMode then
|
|
AValue := FLookupKeyValue
|
|
else
|
|
begin
|
|
AMasterField := MasterField;
|
|
if Assigned(AMasterField) then
|
|
AValue := AMasterField.Value
|
|
else
|
|
AValue := Null;
|
|
end;
|
|
FDataList.KeyValue := AValue;
|
|
end;
|
|
|
|
function TdxInplaceLookupEdit.IsCircular: Boolean;
|
|
begin
|
|
Result := FListLink.Active and (DataLink <> nil) and
|
|
FListLink.DataSet.IsLinkedTo(DataLink.DataSource);
|
|
end;
|
|
|
|
procedure TdxInplaceLookupEdit.ListLinkDataChanged;
|
|
begin
|
|
end;
|
|
|
|
procedure TdxInplaceLookupEdit.LoadDisplayValue(var Data: Variant; IsPaintCopy: Boolean);
|
|
begin
|
|
if Assigned(DataDefinition) and not LookupMode then
|
|
Data := GetLookupDisplayText(DataDefinition.EditValue)
|
|
else
|
|
inherited LoadDisplayValue(Data, IsPaintCopy);
|
|
end;
|
|
|
|
procedure TdxInplaceLookupEdit.SetActive(Value: Boolean);
|
|
begin
|
|
inherited SetActive(Value);
|
|
ResetFindStr;
|
|
end;
|
|
|
|
procedure TdxInplaceLookupEdit.SetEditReadOnly(Value: Boolean);
|
|
begin
|
|
inherited SetEditReadOnly(Value);
|
|
if HandleAllocated then
|
|
SendMessage(Handle, EM_SETREADONLY, Ord(True), 0);
|
|
end;
|
|
|
|
function TdxInplaceLookupEdit.SetKeyValue(const AValue: Variant): Boolean;
|
|
|
|
procedure LookupChanged;
|
|
begin
|
|
Modified := True;
|
|
Change;
|
|
end;
|
|
|
|
var
|
|
AMasterField: TField;
|
|
begin
|
|
Result := False;
|
|
if UnboundMode then
|
|
begin
|
|
AssignLookupKeyValue(AValue);
|
|
LookupChanged; // TODO: !!!
|
|
Result := True;
|
|
end
|
|
else
|
|
if Assigned(Field) then
|
|
with Field do
|
|
begin
|
|
AMasterField := MasterField;
|
|
if AMasterField.CanModify and EditCanModify then
|
|
begin
|
|
if VarIsNull(AValue) then
|
|
AMasterField.Clear
|
|
else
|
|
AMasterField.Value := AValue;
|
|
AssignLookupKeyValue(AValue); // TODO: needed Text reassign ?
|
|
LookupChanged; // TODO: !!!
|
|
Result := True;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure TdxInplaceLookupEdit.UpdateListFields;
|
|
begin
|
|
if not LookupMode then
|
|
begin
|
|
CheckNotCircular;
|
|
FLookupDisplayAssigned := False;
|
|
Text := GetLookupDisplayText(FLookupKeyValue);
|
|
ResetFindStr;
|
|
end;
|
|
end;
|
|
|
|
procedure TdxInplaceLookupEdit.CheckNotCircular;
|
|
begin
|
|
if IsCircular then
|
|
DatabaseError(SCircularDataLink);
|
|
end;
|
|
|
|
procedure TdxInplaceLookupEdit.CheckNotLookup;
|
|
begin
|
|
if LookupMode then
|
|
DatabaseError(SPropDefByLookup);
|
|
if (DataLink <> nil) and DataLink.DataSourceFixed then
|
|
DatabaseError(SDataSourceFixed);
|
|
end;
|
|
|
|
function TdxInplaceLookupEdit.GetDisplayText(AIsLookupResult: Boolean): string;
|
|
var
|
|
AField, AMasterField: TField;
|
|
AKeyField: string;
|
|
ALookupDataSet: TDataSet;
|
|
begin
|
|
Result := '';
|
|
if not LookupMode then
|
|
Result := GetLookupDisplayText(FLookupKeyValue)
|
|
else
|
|
if Assigned(Field) then
|
|
with Field do
|
|
begin
|
|
ALookupDataSet := LookupDataSet;
|
|
AKeyField := LookupKeyFields;
|
|
if UnboundMode then
|
|
begin
|
|
if Assigned(ALookupDataSet) and (AKeyField <> '') then
|
|
with ALookupDataSet do
|
|
begin
|
|
AMasterField := FindField(AKeyField);
|
|
if Assigned(AMasterField) and Locate(AKeyField, FLookupKeyValue, []) then
|
|
begin
|
|
AField := FindField(LookupResultField);
|
|
if Assigned(AField) then
|
|
Result := AField.DisplayText;
|
|
end;
|
|
end;
|
|
end
|
|
else
|
|
begin
|
|
if AIsLookupResult and Assigned(ALookupDataSet) then
|
|
AField := LookupDataSet.FindField(LookupResultField)
|
|
else
|
|
AField := nil;
|
|
if Assigned(AField) then
|
|
Result := AField.DisplayText
|
|
else
|
|
Result := Field.DisplayText;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
function TdxInplaceLookupEdit.GetField: TField;
|
|
begin
|
|
if Assigned(DataDefinition) then
|
|
Result := DataDefinition.LinkObject as TField
|
|
else
|
|
Result := FField;
|
|
end;
|
|
|
|
function TdxInplaceLookupEdit.GetKeyFieldName: string;
|
|
begin
|
|
if LookupMode then
|
|
Result := ''
|
|
else
|
|
Result := FKeyFieldName;
|
|
end;
|
|
|
|
function TdxInplaceLookupEdit.GetMasterField: TField;
|
|
begin
|
|
if Assigned(Field) then
|
|
if LookupMode then
|
|
with Field do
|
|
Result := DataSet.FindField(KeyFields)
|
|
else
|
|
Result := Field
|
|
else
|
|
Result := nil;
|
|
end;
|
|
|
|
function TdxInplaceLookupEdit.GetListSource: TDataSource;
|
|
begin
|
|
if LookupMode then
|
|
Result := nil
|
|
else
|
|
Result := FListLink.DataSource;
|
|
end;
|
|
|
|
function TdxInplaceLookupEdit.GetLookupAlignment: TAlignment;
|
|
begin
|
|
Result := taLeftJustify;
|
|
if LookupMode then
|
|
begin
|
|
if Assigned(Field) then
|
|
Result := Field.Alignment;
|
|
end
|
|
else
|
|
if (FListLink <> nil) and (LookupListField <> nil) then
|
|
Result := LookupListField.Alignment;
|
|
end;
|
|
|
|
function TdxInplaceLookupEdit.GetLookupDisplayText(const ALookupKeyValue: Variant): string;
|
|
var
|
|
S: string;
|
|
Pos: Integer;
|
|
begin
|
|
if (ListSource <> nil) and (ListSource.DataSet <> nil) and
|
|
ListSource.DataSet.Active and (KeyFieldName <> '') then
|
|
begin
|
|
if FLookupDisplayAssigned then
|
|
Result := FLookupDisplayText
|
|
else
|
|
begin
|
|
S := ListFieldName;
|
|
if S = '' then S := KeyFieldName;
|
|
if S <> '' then
|
|
begin
|
|
Pos := 1;
|
|
S := ExtractFieldName(S, Pos);
|
|
if not IsCircular and
|
|
(VarEquals(ListSource.DataSet.FieldByName(KeyFieldName).Value, ALookupKeyValue) or
|
|
ListSource.DataSet.Locate(KeyFieldName, ALookupKeyValue, [])) then
|
|
FLookupDisplayText := ListSource.DataSet.FieldByName(S).DisplayText
|
|
else
|
|
FLookupDisplayText := '';
|
|
end;
|
|
FLookupDisplayAssigned := True;
|
|
end;
|
|
end
|
|
else
|
|
begin
|
|
FLookupDisplayAssigned := False;
|
|
FLookupDisplayText := '';
|
|
end;
|
|
Result := FLookupDisplayText;
|
|
end;
|
|
|
|
function TdxInplaceLookupEdit.GetLookupListField: TField;
|
|
var
|
|
S: string;
|
|
Pos: Integer;
|
|
begin
|
|
Result := nil;
|
|
if (ListSource <> nil) and (ListSource.DataSet <> nil) then
|
|
begin
|
|
S := ListFieldName;
|
|
if S = '' then S := KeyFieldName;
|
|
if S <> '' then
|
|
begin
|
|
Pos := 1;
|
|
S := ExtractFieldName(S, Pos);
|
|
Result := ListSource.DataSet.FindField(S);
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
function TdxInplaceLookupEdit.GetLookupMode: Boolean;
|
|
begin
|
|
Result := FLookupMode and Assigned(Field);
|
|
end;
|
|
|
|
procedure TdxInplaceLookupEdit.PrepareListBox;
|
|
var
|
|
ARecordCount: Integer;
|
|
begin
|
|
with FDataList do
|
|
begin
|
|
// style
|
|
Parent := Self;
|
|
BorderStyle := Self.PopupBorderStyle;
|
|
Color := Self.Color;
|
|
Font := Self.Font;
|
|
Shadow := Style.Shadow;
|
|
if DropDownWidth <> 0 then
|
|
Width := DropDownWidth
|
|
else Width := Self.Width;
|
|
RowCount := DropDownRows;
|
|
ListSource := nil;
|
|
if LookupMode then
|
|
with Self.Field do
|
|
begin
|
|
FLookupSource.DataSet := LookupDataSet;
|
|
KeyField := LookupKeyFields;
|
|
ListField := LookupResultField;
|
|
if ListFieldName <> '' then
|
|
begin
|
|
ListField := ListFieldName;
|
|
// ListFieldIndex := Self.ListFieldIndex;
|
|
end;
|
|
try
|
|
ListSource := FLookupSource;
|
|
except
|
|
ListSource := nil;
|
|
raise;
|
|
end;
|
|
KeyValue := DataSet.FieldByName(KeyFields).Value;
|
|
end
|
|
else
|
|
begin
|
|
KeyField := KeyFieldName;
|
|
KeyValue := FLookupKeyValue;
|
|
if ListFieldName <> '' then
|
|
ListField := ListFieldName
|
|
else
|
|
ListField := KeyFieldName;
|
|
try
|
|
ListSource := Self.ListSource;
|
|
except
|
|
ListSource := nil;
|
|
raise;
|
|
end;
|
|
end;
|
|
if (ListSource <> nil) and (ListSource.DataSet <> nil) then
|
|
begin
|
|
ARecordCount := ListSource.DataSet.RecordCount;
|
|
if (ARecordCount > 0) and (RowCount > ARecordCount) then
|
|
RowCount := ARecordCount;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure TdxInplaceLookupEdit.ResetFindStr;
|
|
begin
|
|
FFindSelection := False;
|
|
FFindStr := '';
|
|
end;
|
|
|
|
procedure TdxInplaceLookupEdit.SetKeyFieldName(const Value: string);
|
|
begin
|
|
CheckNotLookup;
|
|
if FKeyFieldName <> Value then
|
|
begin
|
|
FKeyFieldName := Value;
|
|
UpdateListFields;
|
|
end;
|
|
end;
|
|
|
|
procedure TdxInplaceLookupEdit.SetField(Value: TField);
|
|
begin
|
|
if FField <> Value then
|
|
begin
|
|
FField := Value;
|
|
if Assigned(Value) then
|
|
Value.FreeNotification(Self);
|
|
end;
|
|
end;
|
|
|
|
procedure TdxInplaceLookupEdit.SetListFieldName(const Value: string);
|
|
begin
|
|
if FListFieldName <> Value then
|
|
begin
|
|
FListFieldName := Value;
|
|
UpdateListFields;
|
|
end;
|
|
end;
|
|
|
|
procedure TdxInplaceLookupEdit.SetListSource(Value: TDataSource);
|
|
begin
|
|
CheckNotLookup;
|
|
FListLink.DataSource := Value;
|
|
if Value <> nil then
|
|
Value.FreeNotification(Self);
|
|
end;
|
|
|
|
procedure TdxInplaceLookupEdit.SetLookupKeyValue(const Value: Variant);
|
|
begin
|
|
AssignLookupKeyValue(Value);
|
|
ResetFindStr;
|
|
end;
|
|
|
|
procedure TdxInplaceLookupEdit.SetLookupMode(Value: Boolean);
|
|
begin
|
|
if FLookupMode <> Value then
|
|
begin
|
|
if Value then
|
|
begin
|
|
FListLink.DataSource := nil;
|
|
FKeyFieldName := '';
|
|
FLookupSource.DataSet := nil;
|
|
end;
|
|
FLookupMode := Value;
|
|
end;
|
|
end;
|
|
|
|
{ TPopupDBLookupListBox }
|
|
|
|
constructor TPopupDBLookupListBox.Create(AOwner: TComponent);
|
|
begin
|
|
inherited Create(AOwner);
|
|
FShadowSize := dxEditShadowSize;
|
|
end;
|
|
|
|
procedure TPopupDBLookupListBox.CreateParams(var Params: TCreateParams);
|
|
begin
|
|
inherited CreateParams(Params);
|
|
with Params do
|
|
begin
|
|
ExStyle := WS_EX_TOOLWINDOW{ or WS_EX_TOPMOST};
|
|
Style := Style and not WS_BORDER;
|
|
WindowClass.Style := CS_SAVEBITS;
|
|
end;
|
|
end;
|
|
|
|
{$IFDEF DELPHI4}
|
|
function TPopupDBLookupListBox.GetBorderSize: Integer;
|
|
begin
|
|
case BorderStyle of
|
|
pbSingle:
|
|
Result := 2;
|
|
pbFlat:
|
|
Result := 4;
|
|
pbFrame3D:
|
|
Result := 8;
|
|
else
|
|
Result := inherited GetBorderSize;
|
|
end;
|
|
if Shadow then Inc(Result, ShadowSize);
|
|
end;
|
|
{$ENDIF}
|
|
|
|
procedure TPopupDBLookupListBox.SetBorderStyle(Value: TdxPopupBorderStyle);
|
|
begin
|
|
if FBorderStyle <> Value then
|
|
begin
|
|
FBorderStyle := Value;
|
|
RecreateWnd;
|
|
end;
|
|
end;
|
|
|
|
procedure TPopupDBLookupListBox.SetShadow(Value: Boolean);
|
|
begin
|
|
if FShadow <> Value then
|
|
begin
|
|
FShadow := Value;
|
|
RecreateWnd;
|
|
end;
|
|
end;
|
|
|
|
procedure TPopupDBLookupListBox.SetShadowSize(Value: Integer);
|
|
begin
|
|
if Value < 1 then Value := 1;
|
|
if FShadowSize <> Value then
|
|
begin
|
|
FShadowSize := Value;
|
|
RecreateWnd;
|
|
end;
|
|
end;
|
|
|
|
procedure TPopupDBLookupListBox.WMNCCalcSize(var Message: TWMNCCalcSize);
|
|
begin
|
|
inherited;
|
|
case BorderStyle of
|
|
pbSingle:
|
|
InflateRect(Message.CalcSize_Params^.rgrc[0], -1, -1);
|
|
pbFlat:
|
|
InflateRect(Message.CalcSize_Params^.rgrc[0], -2, -2);
|
|
pbFrame3D:
|
|
InflateRect(Message.CalcSize_Params^.rgrc[0], -4, -4);
|
|
end;
|
|
if Shadow then
|
|
with Message.CalcSize_Params^.rgrc[0] do
|
|
begin
|
|
Dec(Right, ShadowSize);
|
|
Dec(Bottom, ShadowSize);
|
|
end;
|
|
end;
|
|
|
|
procedure TPopupDBLookupListBox.WMNCPaint(var Message: TWMNCPaint);
|
|
begin
|
|
inherited;
|
|
DrawWindowPopupBorder(Handle, BorderStyle,
|
|
(GetWindowLong(Handle, GWL_STYLE) and (WS_HSCROLL or WS_VSCROLL)) = (WS_HSCROLL or WS_VSCROLL),
|
|
Shadow, ShadowSize);
|
|
end;
|
|
|
|
procedure TPopupDBLookupListBox.WMSize(var Message: TWMSize);
|
|
begin
|
|
inherited;
|
|
UpdateShadow(Handle, Shadow, ShadowSize);
|
|
end;
|
|
|
|
end.
|