david
78ab77cd4c
git-svn-id: https://192.168.0.254/svn/Componentes.Terceros.jvcl@19 7f62d464-2af8-f54e-996c-e91b33f51cbe
1019 lines
29 KiB
ObjectPascal
1019 lines
29 KiB
ObjectPascal
{-----------------------------------------------------------------------------
|
|
The contents of this file are subject to the Mozilla Public License
|
|
Version 1.1 (the "License"); you may not use this file except in compliance
|
|
with the License. You may obtain a copy of the License at
|
|
http://www.mozilla.org/MPL/MPL-1.1.html
|
|
|
|
Software distributed under the License is distributed on an "AS IS" basis,
|
|
WITHOUT WARRANTY OF ANY KIND, either expressed or implied. See the License for
|
|
the specific language governing rights and limitations under the License.
|
|
|
|
The Original Code is: JvDBComb.PAS, released on 2002-07-04.
|
|
|
|
The Initial Developers of the Original Code are: Fedor Koshevnikov, Igor Pavluk and Serge Korolev
|
|
Copyright (c) 1997, 1998 Fedor Koshevnikov, Igor Pavluk and Serge Korolev
|
|
Copyright (c) 2001,2002 SGB Software
|
|
All Rights Reserved.
|
|
|
|
Contributor(s):
|
|
Polaris Software
|
|
|
|
You may retrieve the latest version of this file at the Project JEDI's JVCL home page,
|
|
located at http://jvcl.delphi-jedi.org
|
|
|
|
Known Issues:
|
|
-----------------------------------------------------------------------------}
|
|
// $Id: JvDBCombobox.pas 12588 2009-10-30 15:11:55Z ahuser $
|
|
|
|
unit JvDBCombobox;
|
|
|
|
{$I jvcl.inc}
|
|
|
|
interface
|
|
|
|
uses
|
|
{$IFDEF UNITVERSIONING}
|
|
JclUnitVersioning,
|
|
{$ENDIF UNITVERSIONING}
|
|
Windows, Messages,
|
|
Variants, Classes, Graphics, Controls, StdCtrls, DB, DBCtrls,
|
|
JvExStdCtrls, JvDBUtils, JvCombobox;
|
|
|
|
type
|
|
TJvCustomDBComboBox = class;
|
|
TJvDBComboBox = class;
|
|
|
|
TJvComboBoxFilterEvent = procedure(Sender: TObject; DataSet: TDataSet; var Accept: Boolean) of object;
|
|
|
|
TJvDBComboBoxListDataLink = class(TDataLink)
|
|
private
|
|
FOnReload: TNotifyEvent;
|
|
protected
|
|
procedure DataEvent(Event: TDataEvent; Info: Integer); override;
|
|
public
|
|
property OnReload: TNotifyEvent read FOnReload write FOnReload;
|
|
end;
|
|
|
|
TJvDBComboBoxListSettings = class(TPersistent)
|
|
private
|
|
FListDataLink: TJvDBComboBoxListDataLink;
|
|
FFilter: string;
|
|
FKeyField: string;
|
|
FDisplayField: string;
|
|
FOnFilter: TJvComboBoxFilterEvent;
|
|
FShowOutfilteredValue: Boolean;
|
|
FOutfilteredValueFont: TFont;
|
|
FComboBox: TJvCustomDBComboBox;
|
|
procedure SetDataSource(const Value: TDataSource);
|
|
procedure SetFilter(const Value: string);
|
|
function GetDataSource: TDataSource;
|
|
procedure SetDisplayField(const Value: string);
|
|
procedure SetKeyField(const Value: string);
|
|
procedure SetShowOutfilteredValue(const Value: Boolean);
|
|
procedure SetOutfilteredValueFont(const Value: TFont);
|
|
protected
|
|
procedure ListDataChange(Sender: TObject);
|
|
procedure FontChange(Sender: TObject);
|
|
procedure Notification(AComponent: TComponent; Operation: TOperation);
|
|
|
|
property ComboBox: TJvCustomDBComboBox read FComboBox;
|
|
public
|
|
constructor Create(AComboBox: TJvCustomDBComboBox);
|
|
destructor Destroy; override;
|
|
procedure Assign(Source: TPersistent); override;
|
|
|
|
function IsValid: Boolean;
|
|
published
|
|
{ ShowOutfilteredValue: Shows the value/item if the field value is not in the
|
|
filtered dataset but in the unfiltered dataset. }
|
|
property ShowOutfilteredValue: Boolean read FShowOutfilteredValue write SetShowOutfilteredValue default False;
|
|
{ OutfilteredValueFont: The font that is used to paint the out-filtered value/item. }
|
|
property OutfilteredValueFont: TFont read FOutfilteredValueFont write SetOutfilteredValueFont;
|
|
|
|
{ Filter: Is used to filter the dataset. It is compatible to the TClientDataSet.Filter }
|
|
property Filter: string read FFilter write SetFilter;
|
|
{ KeyField: The field that is used for the ComboBox.Values list. }
|
|
property KeyField: string read FKeyField write SetKeyField;
|
|
{ DisplayField: The field that is used for the ComboBox.Items list. }
|
|
property DisplayField: string read FDisplayField write SetDisplayField;
|
|
{ DataSource: The records of the data source are filtered and added to the
|
|
ComboBox.Values/Items list. }
|
|
property DataSource: TDataSource read GetDataSource write SetDataSource;
|
|
|
|
{ OnFilter is triggered for every record before the Filter property is applied. }
|
|
property OnFilter: TJvComboBoxFilterEvent read FOnFilter write FOnFilter;
|
|
end;
|
|
|
|
TJvCustomDBComboBox = class(TJvCustomComboBox, IJvDataControl)
|
|
private
|
|
FDataLink: TFieldDataLink;
|
|
FPaintControl: TPaintControl;
|
|
FBeepOnError: Boolean;
|
|
FResetValue: Boolean;
|
|
FUpdateFieldImmediatelly: Boolean;
|
|
FListSettings: TJvDBComboBoxListSettings;
|
|
FValues: TStringList;
|
|
FEnableValues: Boolean;
|
|
procedure SetEnableValues(Value: Boolean);
|
|
function GetValues: TStrings;
|
|
procedure SetValues(Value: TStrings);
|
|
procedure ValuesChanged(Sender: TObject);
|
|
procedure DataChange(Sender: TObject);
|
|
procedure EditingChange(Sender: TObject);
|
|
function GetDataField: string;
|
|
function GetDataSource: TDataSource;
|
|
function GetField: TField;
|
|
function GetReadOnly: Boolean;
|
|
procedure SetDataField(const Value: string);
|
|
procedure SetDataSource(Value: TDataSource);
|
|
procedure SetEditReadOnly;
|
|
procedure SetReadOnly(Value: Boolean);
|
|
procedure UpdateData(Sender: TObject);
|
|
function GetComboText: string;
|
|
procedure SetComboText(const Value: string);
|
|
procedure CMGetDataLink(var Msg: TMessage); message CM_GETDATALINK;
|
|
procedure WMPaint(var Msg: TWMPaint); message WM_PAINT;
|
|
procedure SetListSettings(const Value: TJvDBComboBoxListSettings);
|
|
protected
|
|
function GetDataLink: TDataLink;
|
|
|
|
procedure DoExit; override;
|
|
procedure Change; override;
|
|
procedure Click; override;
|
|
procedure Reset;
|
|
|
|
// This may cause trouble with BCB because it uses a HWND parameter
|
|
// but as it is defined in the VCL itself, we can't do much.
|
|
procedure ComboWndProc(var Msg: TMessage; ComboWnd: HWND; ComboProc: Pointer); override;
|
|
|
|
procedure CreateWnd; override;
|
|
function GetPaintText: string; virtual;
|
|
procedure KeyDown(var Key: Word; Shift: TShiftState); override;
|
|
procedure KeyPress(var Key: Char); override;
|
|
procedure Loaded; override;
|
|
procedure Notification(AComponent: TComponent; Operation: TOperation); override;
|
|
procedure SetStyle(Value: TComboBoxStyle); override;
|
|
function FilterAccepted: Boolean; virtual;
|
|
|
|
procedure SetItems(const Value: TStrings); override;
|
|
procedure WndProc(var Msg: TMessage); override;
|
|
property BeepOnError: Boolean read FBeepOnError write FBeepOnError default False;
|
|
property ComboText: string read GetComboText write SetComboText;
|
|
property DataField: string read GetDataField write SetDataField;
|
|
property DataSource: TDataSource read GetDataSource write SetDataSource;
|
|
property ReadOnly: Boolean read GetReadOnly write SetReadOnly default False;
|
|
property ListSettings: TJvDBComboBoxListSettings read FListSettings write SetListSettings;
|
|
property Values: TStrings read GetValues write SetValues;
|
|
property EnableValues: Boolean read FEnableValues write SetEnableValues default True;
|
|
public
|
|
constructor Create(AOwner: TComponent); override;
|
|
destructor Destroy; override;
|
|
|
|
procedure UpdateDropDownItems; virtual;
|
|
function ExecuteAction(Action: TBasicAction): Boolean; override;
|
|
function UpdateAction(Action: TBasicAction): Boolean; override;
|
|
function UseRightToLeftAlignment: Boolean; override;
|
|
|
|
property Field: TField read GetField;
|
|
property Items write SetItems;
|
|
property Text;
|
|
property UpdateFieldImmediatelly: Boolean read FUpdateFieldImmediatelly write FUpdateFieldImmediatelly default False;
|
|
end;
|
|
|
|
TJvDBComboBox = class(TJvCustomDBComboBox)
|
|
published
|
|
property Align;
|
|
property AutoSize;
|
|
property Style default csDropDownList; { must be published before Items }
|
|
property BeepOnError;
|
|
property BevelEdges;
|
|
property BevelInner;
|
|
property BevelKind default bkNone;
|
|
property BevelOuter;
|
|
property Color;
|
|
property DataField;
|
|
property DataSource;
|
|
property DragMode;
|
|
property DragCursor;
|
|
property DropDownCount;
|
|
property DropDownWidth;
|
|
property Enabled;
|
|
property EnableValues;
|
|
property Font;
|
|
property Anchors;
|
|
property BiDiMode;
|
|
property Constraints;
|
|
property DragKind;
|
|
property ParentBiDiMode;
|
|
property ImeMode;
|
|
property ImeName;
|
|
property ItemHeight;
|
|
property Items;
|
|
property ParentColor;
|
|
property ParentFont;
|
|
property ParentShowHint;
|
|
property PopupMenu;
|
|
property ReadOnly;
|
|
property ShowHint;
|
|
property Sorted;
|
|
property TabOrder;
|
|
property TabStop;
|
|
property UpdateFieldImmediatelly;
|
|
property Values;
|
|
property Visible;
|
|
property ListSettings; { should be published after Items and Values }
|
|
property OnChange;
|
|
property OnClick;
|
|
property OnDblClick;
|
|
property OnDragDrop;
|
|
property OnDragOver;
|
|
property OnDrawItem;
|
|
property OnDropDown;
|
|
property OnEndDrag;
|
|
property OnEnter;
|
|
property OnExit;
|
|
property OnKeyDown;
|
|
property OnKeyPress;
|
|
property OnKeyUp;
|
|
property OnMeasureItem;
|
|
property OnStartDrag;
|
|
property OnContextPopup;
|
|
property OnEndDock;
|
|
property OnStartDock;
|
|
end;
|
|
|
|
{$IFDEF UNITVERSIONING}
|
|
const
|
|
UnitVersioning: TUnitVersionInfo = (
|
|
RCSfile: '$URL: https://jvcl.svn.sourceforge.net/svnroot/jvcl/tags/JVCL3_39/run/JvDBCombobox.pas $';
|
|
Revision: '$Revision: 12588 $';
|
|
Date: '$Date: 2009-10-30 16:11:55 +0100 (ven., 30 oct. 2009) $';
|
|
LogPath: 'JVCL\run'
|
|
);
|
|
{$ENDIF UNITVERSIONING}
|
|
|
|
implementation
|
|
|
|
uses
|
|
VDBConsts,
|
|
{$IFNDEF COMPILER12_UP}
|
|
JvJCLUtils,
|
|
{$ENDIF ~COMPILER12_UP}
|
|
SysUtils,
|
|
JvDBFilterExpr,
|
|
JvConsts;
|
|
|
|
type
|
|
TDataSetAccess = class(TDataSet);
|
|
|
|
//=== { TJvCustomDBComboBox } ================================================
|
|
|
|
constructor TJvCustomDBComboBox.Create(AOwner: TComponent);
|
|
begin
|
|
inherited Create(AOwner);
|
|
ControlStyle := ControlStyle + [csReplicatable];
|
|
FDataLink := TFieldDataLink.Create;
|
|
FDataLink.Control := Self;
|
|
FDataLink.OnDataChange := DataChange;
|
|
FDataLink.OnUpdateData := UpdateData;
|
|
FDataLink.OnEditingChange := EditingChange;
|
|
FPaintControl := TPaintControl.Create(Self, 'COMBOBOX');
|
|
FBeepOnError := False;
|
|
|
|
FListSettings := TJvDBComboBoxListSettings.Create(Self);
|
|
FValues := TStringList.Create;
|
|
FValues.OnChange := ValuesChanged;
|
|
FEnableValues := True;
|
|
Style := csDropDownList;
|
|
end;
|
|
|
|
destructor TJvCustomDBComboBox.Destroy;
|
|
begin
|
|
FPaintControl.Free;
|
|
FDataLink.OnDataChange := nil;
|
|
FDataLink.OnUpdateData := nil;
|
|
FDataLink.Free;
|
|
FDataLink := nil;
|
|
FreeAndNil(FListSettings);
|
|
FValues.OnChange := nil;
|
|
FValues.Free;
|
|
inherited Destroy;
|
|
end;
|
|
|
|
procedure TJvCustomDBComboBox.Loaded;
|
|
begin
|
|
inherited Loaded;
|
|
if csDesigning in ComponentState then
|
|
DataChange(Self);
|
|
UpdateDropDownItems;
|
|
end;
|
|
|
|
procedure TJvCustomDBComboBox.Notification(AComponent: TComponent;
|
|
Operation: TOperation);
|
|
begin
|
|
inherited Notification(AComponent, Operation);
|
|
if (Operation = opRemove) and (FDataLink <> nil) and (AComponent = DataSource) then
|
|
DataSource := nil;
|
|
|
|
if FListSettings <> nil then
|
|
FListSettings.Notification(AComponent, Operation);
|
|
end;
|
|
|
|
procedure TJvCustomDBComboBox.CreateWnd;
|
|
begin
|
|
inherited CreateWnd;
|
|
SetEditReadOnly;
|
|
DataChange(Self);
|
|
end;
|
|
|
|
procedure TJvCustomDBComboBox.DataChange(Sender: TObject);
|
|
begin
|
|
if not HandleAllocated or (DroppedDown and not FResetValue) then
|
|
Exit;
|
|
if FDataLink.Field <> nil then
|
|
SetComboText(FDataLink.Field.AsString)
|
|
else
|
|
if csDesigning in ComponentState then
|
|
ComboText := Name
|
|
else
|
|
if FDataLink <> nil then
|
|
FDataLink.UpdateRecord
|
|
else
|
|
ComboText := '';
|
|
end;
|
|
|
|
procedure TJvCustomDBComboBox.UpdateData(Sender: TObject);
|
|
begin
|
|
FDataLink.Field.AsString := ComboText;
|
|
end;
|
|
|
|
procedure TJvCustomDBComboBox.SetComboText(const Value: string);
|
|
var
|
|
I: Integer;
|
|
Redraw: Boolean;
|
|
begin
|
|
if Value <> ComboText then
|
|
begin
|
|
if Style <> csDropDown then
|
|
begin
|
|
Redraw := (Style <> csSimple) and HandleAllocated;
|
|
if Redraw then
|
|
SendMessage(Handle, WM_SETREDRAW, 0, 0);
|
|
try
|
|
if Value = '' then
|
|
I := -1
|
|
else
|
|
begin
|
|
I := Items.IndexOf(Value);
|
|
if (I = -1) and FEnableValues then
|
|
I := Values.IndexOf(Value);
|
|
end;
|
|
if I >= Items.Count then
|
|
I := -1;
|
|
ItemIndex := I;
|
|
finally
|
|
if Redraw then
|
|
begin
|
|
SendMessage(Handle, WM_SETREDRAW, 1, 0);
|
|
Invalidate;
|
|
end;
|
|
end;
|
|
if I >= 0 then
|
|
Exit;
|
|
end;
|
|
if Style in [csDropDown, csSimple] then
|
|
Text := Value;
|
|
end;
|
|
end;
|
|
|
|
function TJvCustomDBComboBox.GetComboText: string;
|
|
var
|
|
I: Integer;
|
|
begin
|
|
if (Style in [csDropDown, csSimple]) and not FEnableValues then
|
|
Result := Text
|
|
else
|
|
begin
|
|
I := ItemIndex;
|
|
if (I < 0) or (FEnableValues and (FValues.Count < I + 1)) then
|
|
Result := ''
|
|
else
|
|
if FEnableValues then
|
|
Result := FValues[I]
|
|
else
|
|
Result := Items[I];
|
|
end;
|
|
end;
|
|
|
|
procedure TJvCustomDBComboBox.Change;
|
|
begin
|
|
FDataLink.Edit;
|
|
if UpdateFieldImmediatelly then
|
|
FDataLink.UpdateRecord;
|
|
inherited Change;
|
|
FDataLink.Modified;
|
|
end;
|
|
|
|
procedure TJvCustomDBComboBox.Click;
|
|
begin
|
|
FDataLink.Edit;
|
|
if UpdateFieldImmediatelly then
|
|
FDataLink.UpdateRecord;
|
|
inherited Click;
|
|
FDataLink.Modified;
|
|
end;
|
|
|
|
function TJvCustomDBComboBox.GetDataSource: TDataSource;
|
|
begin
|
|
Result := FDataLink.DataSource;
|
|
end;
|
|
|
|
procedure TJvCustomDBComboBox.SetDataSource(Value: TDataSource);
|
|
begin
|
|
if not (FDataLink.DataSourceFixed and (csLoading in ComponentState)) then
|
|
begin
|
|
if FDataLink.DataSource <> nil then
|
|
FDataLink.DataSource.RemoveFreeNotification(Self);
|
|
FDataLink.DataSource := Value;
|
|
end;
|
|
if Value <> nil then
|
|
Value.FreeNotification(Self);
|
|
end;
|
|
|
|
function TJvCustomDBComboBox.GetDataField: string;
|
|
begin
|
|
Result := FDataLink.FieldName;
|
|
end;
|
|
|
|
procedure TJvCustomDBComboBox.SetDataField(const Value: string);
|
|
begin
|
|
FDataLink.FieldName := Value;
|
|
end;
|
|
|
|
function TJvCustomDBComboBox.GetReadOnly: Boolean;
|
|
begin
|
|
Result := FDataLink.ReadOnly;
|
|
end;
|
|
|
|
procedure TJvCustomDBComboBox.SetReadOnly(Value: Boolean);
|
|
begin
|
|
FDataLink.ReadOnly := Value;
|
|
end;
|
|
|
|
function TJvCustomDBComboBox.GetField: TField;
|
|
begin
|
|
Result := FDataLink.Field;
|
|
end;
|
|
|
|
procedure TJvCustomDBComboBox.KeyDown(var Key: Word; Shift: TShiftState);
|
|
begin
|
|
inherited KeyDown(Key, Shift);
|
|
if Key in [VK_BACK, VK_DELETE, VK_UP, VK_DOWN, 32..255] then
|
|
if not FDataLink.Edit and (Key in [VK_UP, VK_DOWN]) then
|
|
Key := 0;
|
|
end;
|
|
|
|
procedure TJvCustomDBComboBox.KeyPress(var Key: Char);
|
|
begin
|
|
inherited KeyPress(Key);
|
|
if CharInSet(Key, [#32..#255]) and (FDataLink.Field <> nil) and
|
|
not FDataLink.Field.IsValidChar(Key) then
|
|
begin
|
|
if BeepOnError then
|
|
SysUtils.Beep;
|
|
Key := #0;
|
|
end;
|
|
case Key of
|
|
CtrlH, CtrlV, CtrlX, #32..#255:
|
|
FDataLink.Edit;
|
|
Esc:
|
|
begin
|
|
FDataLink.Reset;
|
|
if UpdateFieldImmediatelly and (FDataLink.Field <> nil) then
|
|
FDataLink.Field.Value := FDataLink.Field.OldValue;
|
|
SelectAll;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure TJvCustomDBComboBox.EditingChange(Sender: TObject);
|
|
begin
|
|
SetEditReadOnly;
|
|
end;
|
|
|
|
procedure TJvCustomDBComboBox.SetEditReadOnly;
|
|
begin
|
|
if (Style in [csDropDown, csSimple]) and HandleAllocated then
|
|
SendMessage(EditHandle, EM_SETREADONLY, Ord(not FDataLink.Editing), 0);
|
|
end;
|
|
|
|
procedure TJvCustomDBComboBox.Reset;
|
|
begin
|
|
FResetValue := True;
|
|
try
|
|
DataChange(Self); {Restore text}
|
|
finally
|
|
FResetValue := False;
|
|
end;
|
|
end;
|
|
|
|
procedure TJvCustomDBComboBox.WndProc(var Msg: TMessage);
|
|
begin
|
|
if not (csDesigning in ComponentState) then
|
|
case Msg.Msg of
|
|
WM_COMMAND:
|
|
if TWMCommand(Msg).NotifyCode = CBN_SELCHANGE then
|
|
begin
|
|
try
|
|
if not FDataLink.Edit then
|
|
begin
|
|
if Style <> csSimple then
|
|
PostMessage(Handle, CB_SHOWDROPDOWN, 0, 0);
|
|
Exit;
|
|
end;
|
|
except
|
|
Reset;
|
|
raise;
|
|
end;
|
|
end;
|
|
CB_SHOWDROPDOWN:
|
|
if Msg.WParam <> 0 then
|
|
begin
|
|
try
|
|
FDataLink.Edit;
|
|
except
|
|
Reset;
|
|
raise;
|
|
end;
|
|
end
|
|
else
|
|
if not FDataLink.Editing then
|
|
Reset;
|
|
WM_CREATE, WM_WINDOWPOSCHANGED, CM_FONTCHANGED:
|
|
FPaintControl.DestroyHandle;
|
|
end;
|
|
inherited WndProc(Msg);
|
|
end;
|
|
|
|
procedure TJvCustomDBComboBox.ComboWndProc(var Msg: TMessage; ComboWnd: HWND; ComboProc: Pointer);
|
|
begin
|
|
if not (csDesigning in ComponentState) then
|
|
case Msg.Msg of
|
|
WM_LBUTTONDOWN:
|
|
if (Style = csSimple) and (ComboWnd <> EditHandle) then
|
|
if not FDataLink.Edit then
|
|
Exit;
|
|
end;
|
|
inherited ComboWndProc(Msg, ComboWnd, ComboProc);
|
|
end;
|
|
|
|
procedure TJvCustomDBComboBox.DoExit;
|
|
begin
|
|
try
|
|
FDataLink.UpdateRecord;
|
|
except
|
|
SelectAll;
|
|
if CanFocus then
|
|
SetFocus;
|
|
raise;
|
|
end;
|
|
inherited DoExit;
|
|
if ListSettings.IsValid and ListSettings.ShowOutfilteredValue and (ItemIndex = -1) then
|
|
Invalidate;
|
|
end;
|
|
|
|
procedure TJvCustomDBComboBox.CMGetDataLink(var Msg: TMessage);
|
|
begin
|
|
Msg.Result := Longint(FDataLink);
|
|
end;
|
|
|
|
function TJvCustomDBComboBox.GetDataLink: TDataLink;
|
|
begin
|
|
Result := FDataLink;
|
|
end;
|
|
|
|
procedure TJvCustomDBComboBox.WMPaint(var Msg: TWMPaint);
|
|
|
|
procedure DefaultPaint;
|
|
var
|
|
S: string;
|
|
R: TRect;
|
|
P: TPoint;
|
|
Child: HWND;
|
|
begin
|
|
if csPaintCopy in ControlState then
|
|
begin
|
|
S := GetPaintText;
|
|
if Style = csDropDown then
|
|
begin
|
|
SendMessage(FPaintControl.Handle, WM_SETTEXT, 0, LPARAM(PChar(S)));
|
|
SendMessage(FPaintControl.Handle, WM_PAINT, Msg.DC, 0);
|
|
Child := GetWindow(FPaintControl.Handle, GW_CHILD);
|
|
if Child <> 0 then
|
|
begin
|
|
Windows.GetClientRect(Child, R);
|
|
Windows.MapWindowPoints(Child, FPaintControl.Handle, R.TopLeft, 2);
|
|
GetWindowOrgEx(Msg.DC, P);
|
|
SetWindowOrgEx(Msg.DC, P.X - R.Left, P.Y - R.Top, nil);
|
|
IntersectClipRect(Msg.DC, 0, 0, R.Right - R.Left, R.Bottom - R.Top);
|
|
SendMessage(Child, WM_PAINT, Msg.DC, 0);
|
|
end;
|
|
end
|
|
else
|
|
begin
|
|
SendMessage(FPaintControl.Handle, CB_RESETCONTENT, 0, 0);
|
|
if Items.IndexOf(S) <> -1 then
|
|
begin
|
|
SendMessage(FPaintControl.Handle, CB_ADDSTRING, 0, LPARAM(PChar(S)));
|
|
SendMessage(FPaintControl.Handle, CB_SETCURSEL, 0, 0);
|
|
end;
|
|
SendMessage(FPaintControl.Handle, WM_PAINT, Msg.DC, 0);
|
|
end;
|
|
end
|
|
else
|
|
inherited;
|
|
end;
|
|
|
|
var
|
|
S: string;
|
|
R: TRect;
|
|
PaintStruct: TPaintStruct;
|
|
DC: HDC;
|
|
OldFont: HFONT;
|
|
begin
|
|
{ If the field value is not part of the DataSource }
|
|
if (Style in [csDropDownList, csOwnerDrawFixed, csOwnerDrawVariable]) and
|
|
ListSettings.ShowOutfilteredValue and (ItemIndex = -1) and
|
|
FDataLink.Active and (FDataLink.Field <> nil) and not FDataLink.Field.IsNull and
|
|
ListSettings.IsValid then
|
|
begin
|
|
if ListSettings.DisplayField <> '' then
|
|
S := VarToStr(ListSettings.DataSource.DataSet.Lookup(ListSettings.KeyField, FDataLink.Field.AsVariant, ListSettings.DisplayField))
|
|
else
|
|
S := FDataLink.Field.Text;
|
|
|
|
if Trim(S) = '' then
|
|
begin
|
|
DefaultPaint;
|
|
Exit;
|
|
end;
|
|
|
|
DC := Msg.DC;
|
|
if DC = 0 then
|
|
DC := BeginPaint(Handle, PaintStruct);
|
|
try
|
|
Msg.DC := DC;
|
|
DefaultPaint;
|
|
|
|
R := ClientRect;
|
|
InflateRect(R, -1, -1);
|
|
Inc(R.Left, 3);
|
|
SetTextColor(DC, ColorToRGB(ListSettings.OutfilteredValueFont.Color));
|
|
SetBkMode(DC, TRANSPARENT);
|
|
OldFont := SelectObject(DC, ListSettings.OutfilteredValueFont.Handle);
|
|
if Style = csDropDownList then
|
|
DrawText(DC, PChar(S), Length(S), R, DT_VCENTER or DT_END_ELLIPSIS or DT_SINGLELINE or DT_NOPREFIX)
|
|
else
|
|
begin
|
|
Inc(R.Left);
|
|
R.Top := 3;
|
|
DrawText(DC, PChar(S), Length(S), R, DT_END_ELLIPSIS or DT_SINGLELINE or DT_NOPREFIX)
|
|
end;
|
|
SelectObject(DC, OldFont);
|
|
finally
|
|
if PaintStruct.hdc <> 0 then
|
|
EndPaint(Handle, PaintStruct);
|
|
end;
|
|
end
|
|
else
|
|
DefaultPaint;
|
|
end;
|
|
|
|
function TJvCustomDBComboBox.GetPaintText: string;
|
|
var
|
|
I: Integer;
|
|
begin
|
|
Result := '';
|
|
if FDataLink.Field <> nil then
|
|
begin
|
|
if FEnableValues then
|
|
begin
|
|
I := Values.IndexOf(FDataLink.Field.AsString);
|
|
if I >= 0 then
|
|
Result := Items.Strings[I];
|
|
end
|
|
else
|
|
Result := FDataLink.Field.Text;
|
|
end;
|
|
end;
|
|
|
|
procedure TJvCustomDBComboBox.SetItems(const Value: TStrings);
|
|
begin
|
|
inherited SetItems(Value);
|
|
DataChange(Self);
|
|
end;
|
|
|
|
procedure TJvCustomDBComboBox.SetStyle(Value: TComboBoxStyle);
|
|
begin
|
|
if (Value in [csSimple, csDropDown]) and FEnableValues then
|
|
FEnableValues := False;
|
|
|
|
if (Value = csSimple) and Assigned(FDataLink) and FDataLink.DataSourceFixed then
|
|
_DBError(SNotReplicatable);
|
|
inherited SetStyle(Value);
|
|
end;
|
|
|
|
function TJvCustomDBComboBox.UseRightToLeftAlignment: Boolean;
|
|
begin
|
|
Result := DBUseRightToLeftAlignment(Self, Field);
|
|
end;
|
|
|
|
function TJvCustomDBComboBox.ExecuteAction(Action: TBasicAction): Boolean;
|
|
begin
|
|
Result := inherited ExecuteAction(Action) or (FDataLink <> nil) and
|
|
FDataLink.ExecuteAction(Action);
|
|
end;
|
|
|
|
function TJvCustomDBComboBox.UpdateAction(Action: TBasicAction): Boolean;
|
|
begin
|
|
Result := inherited UpdateAction(Action) or (FDataLink <> nil) and
|
|
FDataLink.UpdateAction(Action);
|
|
end;
|
|
|
|
procedure TJvCustomDBComboBox.ValuesChanged(Sender: TObject);
|
|
begin
|
|
if FEnableValues then
|
|
DataChange(Self);
|
|
end;
|
|
|
|
procedure TJvCustomDBComboBox.SetEnableValues(Value: Boolean);
|
|
begin
|
|
if FEnableValues <> Value then
|
|
begin
|
|
if Value and (Style in [csDropDown, csSimple]) then
|
|
Style := csDropDownList;
|
|
FEnableValues := Value;
|
|
DataChange(Self);
|
|
end;
|
|
end;
|
|
|
|
procedure TJvCustomDBComboBox.SetListSettings(const Value: TJvDBComboBoxListSettings);
|
|
begin
|
|
if Value <> FListSettings then
|
|
FListSettings.Assign(Value);
|
|
end;
|
|
|
|
function TJvCustomDBComboBox.GetValues: TStrings;
|
|
begin
|
|
Result := FValues;
|
|
end;
|
|
|
|
procedure TJvCustomDBComboBox.SetValues(Value: TStrings);
|
|
begin
|
|
FValues.Assign(Value);
|
|
end;
|
|
|
|
function TJvCustomDBComboBox.FilterAccepted: Boolean;
|
|
begin
|
|
Result := True;
|
|
with ListSettings do
|
|
if Assigned(FOnFilter) and (DataSource <> nil) and (DataSource.DataSet <> nil) then
|
|
FOnFilter(Self, DataSource.DataSet, Result);
|
|
end;
|
|
|
|
procedure TJvCustomDBComboBox.UpdateDropDownItems;
|
|
var
|
|
Bookmark: TBookmark;
|
|
FilterExpr: TJvDBFilterExpression;
|
|
LKeyField, LDisplayField: TField;
|
|
DataSet: TDataSet;
|
|
begin
|
|
if ([csDesigning, csLoading, csDestroying] * ComponentState = []) and
|
|
(ListSettings.DataSource <> nil) and (ListSettings.DataSource.DataSet <> nil) and
|
|
(ListSettings.DataSource.State = dsBrowse) then
|
|
begin
|
|
{ Component is in the ListDataSet mode }
|
|
Items.BeginUpdate;
|
|
Values.BeginUpdate;
|
|
try
|
|
Items.Clear;
|
|
Values.Clear;
|
|
if ListSettings.IsValid and ListSettings.DataSource.DataSet.Active and (ListSettings.KeyField <> '') then
|
|
begin
|
|
DataSet := ListSettings.DataSource.DataSet;
|
|
LKeyField := DataSet.FieldByName(ListSettings.KeyField);
|
|
if ListSettings.DisplayField = '' then
|
|
LDisplayField := LKeyField
|
|
else
|
|
LDisplayField := DataSet.FieldByName(ListSettings.DisplayField);
|
|
|
|
DataSet.DisableControls;
|
|
try
|
|
Bookmark := DataSet.GetBookmark;
|
|
try
|
|
FilterExpr := nil;
|
|
if ListSettings.Filter <> '' then
|
|
FilterExpr := TJvDBFilterExpression.Create(DataSet, ListSettings.Filter, []);
|
|
try
|
|
DataSet.First;
|
|
while not DataSet.Eof do
|
|
begin
|
|
if FilterAccepted
|
|
and ((FilterExpr = nil) or FilterExpr.Evaluate)
|
|
then
|
|
begin
|
|
Items.Add(LDisplayField.AsString);
|
|
Values.Add(LKeyField.AsString);
|
|
end;
|
|
DataSet.Next;
|
|
end;
|
|
finally
|
|
FilterExpr.Free;
|
|
end;
|
|
finally
|
|
if Bookmark <> nil then
|
|
begin
|
|
DataSet.GotoBookmark(Bookmark);
|
|
DataSet.FreeBookmark(Bookmark);
|
|
end;
|
|
end;
|
|
finally
|
|
//DataSet.EnableControls;
|
|
TDataSetAccess(DataSet).RestoreState(DataSet.State); // do not trigger a refresh
|
|
end;
|
|
end;
|
|
finally
|
|
Items.EndUpdate;
|
|
Values.EndUpdate;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
{ TJvDBComboBoxListDataLink }
|
|
|
|
procedure TJvDBComboBoxListDataLink.DataEvent(Event: TDataEvent; Info: Integer);
|
|
begin
|
|
inherited DataEvent(Event, Info);
|
|
if Assigned(FOnReload) then
|
|
begin
|
|
case Event of
|
|
deFieldListChange,
|
|
deDataSetChange:
|
|
FOnReload(Self);
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
{ TJvDBComboBoxListSettings }
|
|
|
|
constructor TJvDBComboBoxListSettings.Create(AComboBox: TJvCustomDBComboBox);
|
|
begin
|
|
inherited Create;
|
|
FComboBox := AComboBox;
|
|
FListDataLink := TJvDBComboBoxListDataLink.Create;
|
|
FListDataLink.OnReload := ListDataChange;
|
|
FShowOutfilteredValue := False;
|
|
FOutfilteredValueFont := TFont.Create;
|
|
FOutfilteredValueFont.Color := clRed;
|
|
FOutfilteredValueFont.OnChange := FontChange;
|
|
end;
|
|
|
|
destructor TJvDBComboBoxListSettings.Destroy;
|
|
begin
|
|
SetDataSource(nil);
|
|
FOutfilteredValueFont.Free;
|
|
FListDataLink.OnReload := nil;
|
|
FListDataLink.Free;
|
|
FListDataLink := nil;
|
|
inherited Destroy;
|
|
end;
|
|
|
|
procedure TJvDBComboBoxListSettings.FontChange(Sender: TObject);
|
|
begin
|
|
ComboBox.Invalidate;
|
|
end;
|
|
|
|
procedure TJvDBComboBoxListSettings.Assign(Source: TPersistent);
|
|
var
|
|
Src: TJvDBComboBoxListSettings;
|
|
begin
|
|
if Source is TJvDBComboBoxListSettings then
|
|
begin
|
|
Src := TJvDBComboBoxListSettings(Source);
|
|
FShowOutfilteredValue := Src.FShowOutfilteredValue;
|
|
FOutfilteredValueFont.Assign(Src.FOutfilteredValueFont);
|
|
FFilter := Src.FFilter;
|
|
FKeyField := Src.FKeyField;
|
|
FDisplayField := Src.FDisplayField;
|
|
SetDataSource(Src.DataSource);
|
|
FOnFilter := Src.FOnFilter;
|
|
|
|
ComboBox.UpdateDropDownItems;
|
|
ComboBox.Invalidate;
|
|
end
|
|
else
|
|
inherited Assign(Source);
|
|
end;
|
|
|
|
procedure TJvDBComboBoxListSettings.Notification(AComponent: TComponent; Operation: TOperation);
|
|
begin
|
|
if Operation = opRemove then
|
|
if AComponent = DataSource then
|
|
SetDataSource(nil);
|
|
end;
|
|
|
|
procedure TJvDBComboBoxListSettings.SetDataSource(const Value: TDataSource);
|
|
begin
|
|
if Value <> DataSource then
|
|
begin
|
|
if DataSource <> nil then
|
|
begin
|
|
DataSource.RemoveFreeNotification(ComboBox);
|
|
FListDataLink.DataSource := nil;
|
|
end;
|
|
FListDataLink.DataSource := Value;
|
|
if DataSource <> nil then
|
|
DataSource.FreeNotification(ComboBox);
|
|
ComboBox.UpdateDropDownItems;
|
|
end;
|
|
end;
|
|
|
|
procedure TJvDBComboBoxListSettings.SetDisplayField(const Value: string);
|
|
begin
|
|
if Value <> FDisplayField then
|
|
begin
|
|
FDisplayField := Value;
|
|
ComboBox.UpdateDropDownItems;
|
|
end;
|
|
end;
|
|
|
|
procedure TJvDBComboBoxListSettings.SetFilter(const Value: string);
|
|
begin
|
|
if Value <> FFilter then
|
|
begin
|
|
FFilter := Trim(Value);
|
|
ComboBox.UpdateDropDownItems;
|
|
ComboBox.DataChange(Self);
|
|
end;
|
|
end;
|
|
|
|
procedure TJvDBComboBoxListSettings.SetKeyField(const Value: string);
|
|
begin
|
|
if Value <> FKeyField then
|
|
begin
|
|
FKeyField := Value;
|
|
ComboBox.UpdateDropDownItems;
|
|
end;
|
|
end;
|
|
|
|
procedure TJvDBComboBoxListSettings.SetOutfilteredValueFont(const Value: TFont);
|
|
begin
|
|
if Value <> FOutfilteredValueFont then
|
|
begin
|
|
FOutfilteredValueFont.Assign(Value);
|
|
ComboBox.Invalidate;
|
|
end;
|
|
end;
|
|
|
|
procedure TJvDBComboBoxListSettings.SetShowOutfilteredValue(const Value: Boolean);
|
|
begin
|
|
if Value <> FShowOutfilteredValue then
|
|
begin
|
|
FShowOutfilteredValue := Value;
|
|
ComboBox.Invalidate;
|
|
end;
|
|
end;
|
|
|
|
function TJvDBComboBoxListSettings.GetDataSource: TDataSource;
|
|
begin
|
|
if FListDataLink <> nil then
|
|
Result := FListDataLink.DataSource
|
|
else
|
|
Result := nil;
|
|
end;
|
|
|
|
function TJvDBComboBoxListSettings.IsValid: Boolean;
|
|
begin
|
|
Result := (DataSource <> nil) and (DataSource.DataSet <> nil) and DataSource.DataSet.Active and
|
|
(KeyField <> '');
|
|
end;
|
|
|
|
procedure TJvDBComboBoxListSettings.ListDataChange(Sender: TObject);
|
|
begin
|
|
if FListDataLink.Active and (DataSource.State = dsBrowse) then
|
|
begin
|
|
ComboBox.UpdateDropDownItems;
|
|
ComboBox.DataChange(Self);
|
|
end;
|
|
end;
|
|
|
|
{$IFDEF UNITVERSIONING}
|
|
initialization
|
|
RegisterUnitVersion(HInstance, UnitVersioning);
|
|
|
|
finalization
|
|
UnregisterUnitVersion(HInstance);
|
|
{$ENDIF UNITVERSIONING}
|
|
|
|
end.
|