adbimctr.pas

来自「delphi编程控件」· PAS 代码 · 共 572 行

unit adbimctr;
(*
 COPYRIGHT (c) RSD Software 1997 - 98
 All Rights Reserved.
*)

interface
uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, DB, DBTables, DBCtrls, aimctrls;

type

TAutoDBImageListBox = class(TAutoCustomImageListBox)
private
  FDataLink: TFieldDataLink;
  FUseValues : Boolean;

  procedure DataChange(Sender: TObject);
  procedure UpdateData(Sender: TObject);
  function GetDataField: string;
  function GetDataSource: TDataSource;
  function GetField: TField;
  function GetReadOnly: Boolean;
  procedure SetDataField(const Value: string);
  procedure SetDataSource(Value: TDataSource);
  procedure SetReadOnly(Value: Boolean);
  procedure SetItems(Value: TStrings);
  procedure SetUseValues(Value: Boolean);
  procedure WMLButtonDown(var Message: TWMLButtonDown); message WM_LBUTTONDOWN;
  procedure CMExit(var Message: TCMExit); message CM_EXIT;
protected
  procedure Click; override;
  procedure KeyDown(var Key: Word; Shift: TShiftState); override;
  procedure KeyPress(var Key: Char); override;
  procedure Notification(AComponent: TComponent;
    Operation: TOperation); override;
public
  constructor Create(AOwner: TComponent); override;
  destructor Destroy; override;
  property Field: TField read GetField;
published
  property DataField: string read GetDataField write SetDataField;
  property DataSource: TDataSource read GetDataSource write SetDataSource;
  property Items write SetItems;
  property ReadOnly: Boolean read GetReadOnly write SetReadOnly default False;
  property UseValues : Boolean read FUseValues write SetUseValues;
end;

TAutoDBImageComboBox = class(TAutoImageComboBox)
private
  FDataLink: TFieldDataLink;
  FUseValues : Boolean;

  procedure DataChange(Sender: TObject);
  procedure UpdateData(Sender: TObject);
  function GetDataField: string;
  function GetDataSource: TDataSource;
  function GetField: TField;
  function GetReadOnly: Boolean;
  procedure SetDataField(const Value: string);
  procedure SetDataSource(Value: TDataSource);
  procedure SetReadOnly(Value: Boolean);
  procedure SetItems(Value: TStrings);
  procedure SetUseValues(Value: Boolean);
  procedure WMLButtonDown(var Message: TWMLButtonDown); message WM_LBUTTONDOWN;
  procedure CMExit(var Message: TCMExit); message CM_EXIT;
protected
  procedure Click; override;
  procedure KeyDown(var Key: Word; Shift: TShiftState); override;
  procedure KeyPress(var Key: Char); override;
  procedure Notification(AComponent: TComponent;
    Operation: TOperation); override;
public
  constructor Create(AOwner: TComponent); override;
  destructor Destroy; override;
  property Field: TField read GetField;
published
  property DataField: string read GetDataField write SetDataField;
  property DataSource: TDataSource read GetDataSource write SetDataSource;
  property Items write SetItems;
  property ReadOnly: Boolean read GetReadOnly write SetReadOnly default False;
  property UseValues : Boolean read FUseValues write SetUseValues;
end;

TAutoDBSpinImage = class(TAutoCustomSpinImage)
private
  FDataLink: TFieldDataLink;
  UpdateDataFlag : Boolean;

  procedure DataChange(Sender: TObject);
  procedure UpdateData(Sender: TObject);
  function GetDataField: string;
  function GetDataSource: TDataSource;
  function GetField: TField;
  procedure SetDataField(const Value: string);
  procedure SetDataSource(Value: TDataSource);
  procedure CMExit(var Message: TCMExit); message CM_EXIT;
protected
  procedure Notification(AComponent: TComponent;
    Operation: TOperation); override;
  function CanChange : Boolean; override;
  procedure Change; override;
  procedure UpdateItems; override; 
public
  constructor Create(AOwner: TComponent); override;
  destructor Destroy; override;
  property Field: TField read GetField;
published
  property Align;
  property Color;
  property Ctl3D;
  property DataField: string read GetDataField write SetDataField;
  property DataSource: TDataSource read GetDataSource write SetDataSource;
  property DragCursor;
  property DragMode;
  property Enabled;
  property Font;
  property ParentColor default False;
  property ParentCtl3D;
  property ParentFont;
  property ParentShowHint;
  property PopupMenu;
  property ShowHint;
  property TabOrder;
  property TabStop default True;
  property Visible;
  property OnClick;
  property OnDblClick;
  property OnDragDrop;
  property OnDragOver;
  property OnEndDrag;
  property OnEnter;
  property OnExit;
  property OnKeyDown;
  property OnKeyPress;
  property OnKeyUp;
  property OnMouseDown;
  property OnMouseMove;
  property OnMouseUp;
  property OnStartDrag;
end;


implementation

{ TAutoDBImageListBox }

constructor TAutoDBImageListBox.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FDataLink := TFieldDataLink.Create;
  FDataLink.Control := Self;
  FDataLink.OnDataChange := DataChange;
  FDataLink.OnUpdateData := UpdateData;
end;

destructor TAutoDBImageListBox.Destroy;
begin
  FDataLink.Free;
  FDataLink := nil;
  inherited Destroy;
end;

procedure TAutoDBImageListBox.Notification(AComponent: TComponent;
  Operation: TOperation);
begin
  inherited Notification(AComponent, Operation);
  if (Operation = opRemove) and (FDataLink <> nil) and
    (AComponent = DataSource) then DataSource := nil;
end;

procedure TAutoDBImageListBox.DataChange(Sender: TObject);
begin
  if FDataLink.Field <> nil then begin
    if Not FUseValues then
      ItemIndex := Items.IndexOf(FDataLink.Field.Text)
    else ItemIndex := ValuesIndexOf(FDataLink.Field.Text);
  end else ItemIndex := -1;

end;

procedure TAutoDBImageListBox.UpdateData(Sender: TObject);
begin
  if ItemIndex >= 0 then begin
    if Not FUseValues then
      FDataLink.Field.Text := Items[ItemIndex]
    else FDataLink.Field.Text := Values[ItemIndex];
  end else FDataLink.Field.Text := '';
end;

procedure TAutoDBImageListBox.Click;
begin
  if FDataLink.Edit then
  begin
    inherited Click;
    FDataLink.Modified;
  end;
end;

function TAutoDBImageListBox.GetDataSource: TDataSource;
begin
  Result := FDataLink.DataSource;
end;

procedure TAutoDBImageListBox.SetDataSource(Value: TDataSource);
begin
  FDataLink.DataSource := Value;
  if Value <> nil then Value.FreeNotification(Self);
end;

function TAutoDBImageListBox.GetDataField: string;
begin
  Result := FDataLink.FieldName;
end;

procedure TAutoDBImageListBox.SetDataField(const Value: string);
begin
  FDataLink.FieldName := Value;
end;

function TAutoDBImageListBox.GetReadOnly: Boolean;
begin
  Result := FDataLink.ReadOnly;
end;

procedure TAutoDBImageListBox.SetReadOnly(Value: Boolean);
begin
  FDataLink.ReadOnly := Value;
end;

function TAutoDBImageListBox.GetField: TField;
begin
  Result := FDataLink.Field;
end;

procedure TAutoDBImageListBox.KeyDown(var Key: Word; Shift: TShiftState);
begin
  inherited KeyDown(Key, Shift);
  if Key in [VK_PRIOR, VK_NEXT, VK_END, VK_HOME, VK_LEFT, VK_UP,
    VK_RIGHT, VK_DOWN] then
    if not FDataLink.Edit then Key := 0;
end;

procedure TAutoDBImageListBox.KeyPress(var Key: Char);
begin
  inherited KeyPress(Key);
  case Key of
    #32..#255:
      if not FDataLink.Edit then Key := #0;
    #27:
      FDataLink.Reset;
  end;
end;

procedure TAutoDBImageListBox.WMLButtonDown(var Message: TWMLButtonDown);
begin
  if FDataLink.Edit then inherited
  else
  begin
    SetFocus;
    with Message do
      MouseDown(mbLeft, KeysToShiftState(Keys), XPos, YPos);
  end;
end;

procedure TAutoDBImageListBox.CMExit(var Message: TCMExit);
begin
  try
    FDataLink.UpdateRecord;
  except
    SetFocus;
    raise;
  end;
  inherited;
end;

procedure TAutoDBImageListBox.SetItems(Value: TStrings);
begin
  Items.Assign(Value);
  DataChange(Self);
end;

procedure TAutoDBImageListBox.SetUseValues(Value: Boolean);
begin
  if(FUseValues <> Value)then begin
    FUseValues := Value;
    DataChange(Self);
  end;
end;

{ TAutoDBImageComboBox }

constructor TAutoDBImageComboBox.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FDataLink := TFieldDataLink.Create;
  FDataLink.Control := Self;
  FDataLink.OnDataChange := DataChange;
  FDataLink.OnUpdateData := UpdateData;
end;

destructor TAutoDBImageComboBox.Destroy;
begin
  FDataLink.Free;
  FDataLink := nil;
  inherited Destroy;
end;

procedure TAutoDBImageComboBox.Notification(AComponent: TComponent;
  Operation: TOperation);
begin
  inherited Notification(AComponent, Operation);
  if (Operation = opRemove) and (FDataLink <> nil) and
    (AComponent = DataSource) then DataSource := nil;
end;

procedure TAutoDBImageComboBox.DataChange(Sender: TObject);
begin
  if FDataLink.Field <> nil then begin
    if Not FUseValues then
      ItemIndex := Items.IndexOf(FDataLink.Field.Text)
    else ItemIndex := ValuesIndexOf(FDataLink.Field.Text);
  end else ItemIndex := -1;

end;

procedure TAutoDBImageComboBox.UpdateData(Sender: TObject);
begin
  if ItemIndex >= 0 then begin
    if Not FUseValues then
      FDataLink.Field.Text := Items[ItemIndex]
    else FDataLink.Field.Text := Values[ItemIndex];
  end else FDataLink.Field.Text := '';
end;

procedure TAutoDBImageComboBox.Click;
begin
  if FDataLink.Edit then
  begin
    inherited Click;
    FDataLink.Modified;
  end;
end;

function TAutoDBImageComboBox.GetDataSource: TDataSource;
begin
  Result := FDataLink.DataSource;
end;

procedure TAutoDBImageComboBox.SetDataSource(Value: TDataSource);
begin
  FDataLink.DataSource := Value;
  if Value <> nil then Value.FreeNotification(Self);
end;

function TAutoDBImageComboBox.GetDataField: string;
begin
  Result := FDataLink.FieldName;
end;

procedure TAutoDBImageComboBox.SetDataField(const Value: string);
begin
  FDataLink.FieldName := Value;
end;

function TAutoDBImageComboBox.GetReadOnly: Boolean;
begin
  Result := FDataLink.ReadOnly;
end;

procedure TAutoDBImageComboBox.SetReadOnly(Value: Boolean);
begin
  FDataLink.ReadOnly := Value;
end;

function TAutoDBImageComboBox.GetField: TField;
begin
  Result := FDataLink.Field;
end;

procedure TAutoDBImageComboBox.KeyDown(var Key: Word; Shift: TShiftState);
begin
  inherited KeyDown(Key, Shift);
  if Key in [VK_PRIOR, VK_NEXT, VK_END, VK_HOME, VK_LEFT, VK_UP,
    VK_RIGHT, VK_DOWN] then
    if not FDataLink.Edit then Key := 0;
end;

procedure TAutoDBImageComboBox.KeyPress(var Key: Char);
begin
  inherited KeyPress(Key);
  case Key of
    #32..#255:
      if not FDataLink.Edit then Key := #0;
    #27:
      FDataLink.Reset;
  end;
end;

procedure TAutoDBImageComboBox.WMLButtonDown(var Message: TWMLButtonDown);
begin
  if FDataLink.Edit then inherited
  else
  begin
    SetFocus;
    with Message do
      MouseDown(mbLeft, KeysToShiftState(Keys), XPos, YPos);
  end;
end;

procedure TAutoDBImageComboBox.CMExit(var Message: TCMExit);
begin
  try
    FDataLink.UpdateRecord;
  except
    SetFocus;
    raise;
  end;
  inherited;
end;

procedure TAutoDBImageComboBox.SetItems(Value: TStrings);
begin
  Items.Assign(Value);
  DataChange(Self);
end;

procedure TAutoDBImageComboBox.SetUseValues(Value: Boolean);
begin
  if(FUseValues <> Value)then begin
    FUseValues := Value;
    DataChange(Self);
  end;
end;

{ TAutoDBSpinImage}

constructor TAutoDBSpinImage.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);

  UpdateDataFlag := False;
  FDataLink := TFieldDataLink.Create;
  FDataLink.Control := Self;
  FDataLink.OnDataChange := DataChange;
  FDataLink.OnUpdateData := UpdateData;
  DefaultImages := False;
end;

destructor TAutoDBSpinImage.Destroy;
begin
  FDataLink.Free;
  FDataLink := nil;
  inherited Destroy;
end;

procedure TAutoDBSpinImage.Notification(AComponent: TComponent;
  Operation: TOperation);
begin
  inherited Notification(AComponent, Operation);
  if (Operation = opRemove) and (FDataLink <> nil) and
    (AComponent = DataSource) then DataSource := nil;
end;

procedure TAutoDBSpinImage.DataChange(Sender: TObject);

  function IsNumeric(St : String) : Boolean;
  Var
    i : Integer;
  begin
    Result := False;
    for i := 1 to Length(St) do
      if Not (((St[i] >= '0') And (St[i] <= '9'))
      Or ((St[i] = '-') And (i = 1))) then
        exit;
    Result := True;
  end;

begin
  if(UpdateDataFlag) then exit;
  UpdateDataFlag := True;
  if FDataLink.Field <> nil then begin
    if DefaultImages then begin
      if IsNumeric(FDataLink.Field.Text) then
        try
         ItemIndex := FDataLink.Field.AsInteger;
        except
          raise;
        end
        else ItemIndex := -1;
    end
    else ItemIndex := Items.IndexOf(FDataLink.Field.Text);
  end else ItemIndex := -1;
  UpdateDataFlag := False;
end;

procedure TAutoDBSpinImage.UpdateData(Sender: TObject);
begin
  if(UpdateDataFlag) then exit;
  UpdateDataFlag := True;
  if ItemIndex >= 0 then begin
    if DefaultImages then
      FDataLink.Field.Text := IntToStr(ItemIndex)
    else FDataLink.Field.Text := Items[ItemIndex].Value;
  end else begin
    if Not DefaultImages then
       FDataLink.Field.Text := '-1'
    else FDataLink.Field.Text := '';
  end;
  UpdateDataFlag := False;
end;

function TAutoDBSpinImage.GetDataSource: TDataSource;
begin
  Result := FDataLink.DataSource;
end;

procedure TAutoDBSpinImage.SetDataSource(Value: TDataSource);
begin
  FDataLink.DataSource := Value;
  if Value <> nil then Value.FreeNotification(Self);
end;

function TAutoDBSpinImage.GetDataField: string;
begin
  Result := FDataLink.FieldName;
end;

procedure TAutoDBSpinImage.SetDataField(const Value: string);
begin
  FDataLink.FieldName := Value;
end;

function TAutoDBSpinImage.CanChange: Boolean;
begin
  if Not (csLoading in ComponentState) then
    Result := Not FDataLink.ReadOnly And Not ReadOnly And FDataLink.Edit
  else Result := inherited CanChange;  
end;

function TAutoDBSpinImage.GetField: TField;
begin
  Result := FDataLink.Field;
end;

procedure TAutoDBSpinImage.CMExit(var Message: TCMExit);
begin
  try
    FDataLink.UpdateRecord;
  except
    SetFocus;
    raise;
  end;
  inherited;
end;

procedure TAutoDBSpinImage.UpdateItems;
begin
  if Not (csLoading in ComponentState) then
    DataChange(Self);
end;

procedure TAutoDBSpinImage.Change;
begin
  if Not (csLoading in ComponentState) then
    UpdateData(self);
  inherited Change;
end;

end.