【delphi开源代码栏目提醒】:以下是网学会员为您推荐的delphi开源代码-DBCCBOX.PAS,希望本篇文章对您学习有所帮助。
unit dbCCBox;
interface
uses Windows, SysUtils, Messages, Classes, Controls, Forms,
Graphics, Menus, StdCtrls, ExtCtrls, Mask, Dialogs, Buttons, ComCtrls, Db, DBCtrls, DBTables;
type
{ TDBCodeComboBox }
TDBCodeComboBox = class(TCustomComboBox)
private
FDataLink: TFieldDataLink;
FPaintControl: TPaintControl;
FQuery : TQuery;
FCodeField: string;
FDisplayField: string;
FSQL : string;
FDisplayDatasource: TDataSource;
procedure SetCodeField(const Value: string);
procedure SetDisplayField(const Value: string);
procedure SetDisplayDatasource(const Value: TDataSource);
function GetCodeValue(const sText : string) : string;
function GetDisplayValue(const sText : string) : string;
procedure UpdateData(Sender: TObject);
procedure SetupQueryProperties;
procedure ConstructSQL;
procedure FillComboBoxItems;
procedure DataChange(Sender: TObject);
procedure EditingChange(Sender: TObject);
function GetComboText: string;
function GetDataField: string;
function GetDataSource: TDataSource;
function GetField: TField;
function GetReadOnly: Boolean;
procedure SetComboText(const Value: string);
procedure SetDataField(const Value: string);
procedure SetDataSource(Value: TDataSource);
procedure SetEditReadOnly;
procedure SetItems(Value: TStrings);
procedure SetReadOnly(Value: Boolean);
procedure CMEnter(var Message: TCMEnter); message CM_ENTER;
procedure CMExit(var Message: TCMExit); message CM_EXIT;
procedure CMGetDataLink(var Message: TMessage); message CM_GETDATALINK;
procedure WMPaint(var Message: TWMPaint); message WM_PAINT;
protected
procedure Change; override;
procedure Click; override;
procedure ComboWndProc(var Message: TMessage; ComboWnd: HWnd;
ComboProc: Pointer); override;
procedure CreateWnd; override;
procedure DropDown; override;
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;
procedure WndProc(var Message: TMessage); override;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
function ExecuteAction(Action: TBasicAction): Boolean; override;
function UpdateAction(Action: TBasicAction): Boolean; override;
function UseRightToLeftAlignment: Boolean; override;
property Field: TField read GetField;
property Text;
published
property Style; {Must be published before Items}
property Anchors;
property BiDiMode;
property Color;
property Constraints;
property Ctl3D;
property DataField: string read GetDataField write SetDataField;
property DataSource: TDataSource read GetDataSource write SetDataSource;
property DragCursor;
property DragKind;
property DragMode;
property DropDownCount;
property Enabled;
property Font;
property ImeMode;
property ImeName;
property ItemHeight;
property Items write SetItems;
property ParentBiDiMode;
property ParentColor;
property ParentCtl3D;
property ParentFont;
property ParentShowHint;
property PopupMenu;
property ReadOnly: Boolean read GetReadOnly write SetReadOnly default False;
property ShowHint;
property Sorted;
property TabOrder;
property TabStop;
property Visible;
property OnChange;
property OnClick;
property OnDblClick;
property OnDragDrop;
property OnDragOver;
property OnDrawItem;
property OnDropDown;
property OnEndDock;
property OnEndDrag;
property OnEnter;
property OnExit;
property OnKeyDown;
property OnKeyPress;
property OnKeyUp;
property OnMeasureItem;
property OnStartDock;
property OnStartDrag;
property CodeField : string read FCodeField write SetCodeField;
property DisplayField : string read FDisplayField write SetDisplayField;
property DisplayDatasource : TDataSource read FDisplayDatasource write SetDisplayDatasource;
end;
implementation
{ TDBCodeComboBox }
constructor TDBCodeComboBox.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, 'CODECOMBOBOX');
FQuery := TQuery.Create(Self);
end;
destructor TDBCodeComboBox.Destroy;
begin
FPaintControl.Free;
FDataLink.Free;
FDataLink := nil;
FQuery.Close;
FQuery.Free;
inherited Destroy;
end;
procedure TDBCodeComboBox.Loaded;
begin
inherited Loaded;
if (csDesigning in ComponentState) then DataChange(Self);
end;
procedure TDBCodeComboBox.Notification(AComponent: TComponent;
Operation: TOperation);
begin
inherited Notification(AComponent, Operation);
if (Operation = opRemove) and (FDataLink <> nil) and
(AComponent = DataSource) then DataSource := nil;
end;
procedure TDBCodeComboBox.CreateWnd;
begin
inherited CreateWnd;
SetEditReadOnly;
end;
procedure TDBCodeComboBox.DataChange(Sender: TObject);
begin
if not (Style = csSimple) and DroppedDown then
Exit;
if FDataLink.Field <> nil then
SetComboText(FDataLink.Field.Text)
else
if csDesigning in ComponentState then
SetComboText(Name)
else
SetComboText('');
end;
procedure TDBCodeComboBox.UpdateData(Sender: TObject);
begin
FDataLink.Field.Text := GetComboText;
end;
procedure TDBCodeComboBox.SetComboText(const Value: string);
var
I: Integer;
Redraw: Boolean;
begin
if Value <> GetComboText 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 I := Items.IndexOf(Value);
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 := GetDisplayValue(Value);
end;
end;
function TDBCodeComboBox.GetComboText: string;
var
I: Integer;
begin
try
if Style in [csDropDown, csSimple] then
Result := GetCodeValue(Text)
else
begin
I := ItemIndex;
if I < 0 then
Result := ''
else
Result := GetCodeValue(Items[I]);
end;
except
on Exception do;
end;
end;
procedure TDBCodeComboBox.Change;
begin
FDataLink.Edit;
inherited Change;
FDataLink.Modified;
end;
procedure TDBCodeComboBox.Click;
begin
FDataLink.Edit;
inherited Click;
FDataLink.Modified;
end;
procedure TDBCodeComboBox.DropDown;
begin
inherited DropDown;
end;
function TDBCodeComboBox.GetDataSource: TDataSource;
begin
Result := FDataLink.DataSource;
end;
procedure TDBCodeComboBox.SetDataSource(Value: TDataSource);
begi
上一篇:
dbBacupRestore.pas
下一篇:
中小企业财务战略选择的探讨