listcombobox.pas

电力行业前台收费程序,需要有后台SQL数据库,和电费管理系统配合应用.

unit ListComboBox;
{
这是一个功能非常简单的控件，是从TComboBox继承下来的。
可以给它指定一个DataSet（ListDataSet）的特定字段(ListFieldName)，再调用Refresh方法,
它可以将表中此字段所有的内容加到items中，并根据类型不同做数据类型转换。可用在登录
界面上选取用户名。
杨国强 1999.5.14
}
interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls,Dsgnintf,DB;

type
  TListComboBox = class(TComboBox)
  private
    FListFieldName:String;
    FListKeyName:String;
    FKeyValue:array[0..255] of Integer;
    FListDataSet:TDataSet;
    FListNow:Boolean;
    FOldOnChange:TNotifyEvent;
    FNewOnChange:TNotifyEvent;
    procedure SetDataSet(Value:TDataSet);
    procedure SetListNow(Value:Boolean);
    procedure SetListName(Value:String);
    procedure SetKeyName(Value:String);
    function GetKeyVal:Integer;
  protected
    procedure MyOnChange(Sender:TObject);
  public
    constructor Create(AOwner: TComponent); override;
    procedure Refresh(MaxList:Integer);
    property KeyVal:Integer read GetKeyVal;
  published
    property ListFieldName:String read FListFieldName write SetListName;
    property ListKeyName:String read FListKeyName write SetKeyName;
    property ListDataSet:TDataSet read FListDataSet write SetDataSet;
    property NowList:Boolean read FListNow write SetListNow default False;
  end;

  TFieldListComb = class(TStringProperty)
  private
    procedure GetNameList(var FieldsName:TStringList);
  public
    function GetDataSet:TDataSet;
    function GetAttributes: TPropertyAttributes; override;
    procedure GetValues(CallProc: TGetStrProc); override;
  end;

procedure Register;

implementation

function TFieldListComb.GetAttributes: TPropertyAttributes;
begin
  Result := [paValueList, paSortList];
end;

procedure TFieldListComb.GetValues(CallProc: TGetStrProc);
var
  I: Integer;
  Values: TStringList;
begin
  Values := TStringList.Create;
  try
    GetNameList(Values);
    for I := 0 to Values.Count - 1 do CallProc(Values[I]);
  finally
    Values.Free;
  end;
end;

function TFieldListComb.GetDataSet:TDataSet;
begin
  if (GetComponent(0) is TListComboBox) then
    Result := TListComboBox(GetComponent(0)).ListDataSet
  else
    Result := nil;
end;

procedure TFieldListComb.GetNameList(var FieldsName:TStringList);
var
  I:Integer;
  SelDataSet:TDataSet;
  SetState:Boolean;
begin
  SelDataSet:=GetDataSet;
  if SelDataSet=nil then
    exit
  else
    with SelDataSet do begin
      try
        SetState:=Active;
        if not Active then
          Active:=True;
        for I:=0 to FieldCount-1 do
          FieldsName.Add(Fields[I].DisplayName);
        if not SetState then
          Active:=False;
      except
        raise;
      end;
    end;
end;

constructor TListComboBox.Create(AOwner: TComponent);
begin
  Inherited Create(AOwner);
  FListFieldName:='';
  FListKeyName:='';
  FNewOnChange:=MyOnChange;
end;

procedure TListComboBox.SetDataSet(Value:TDataSet);
begin
  if (FListDataSet<>nil)and(FListDataSet<>Value)then begin
    Self.Items.Clear;
    FListFieldName:='';
    FListKeyName:='';
  end;
  FListDataSet:=Value;
end;

procedure TListComboBox.Refresh(MaxList:Integer);
var
  I:Integer;
  SetState:Boolean;
  CurPosMark:TBookmark;
  DispStr:String;
begin
  if (FListFieldName='')or(FListDataSet=nil) then
    exit;
  Items.Clear;
  if Assigned(OnChange) then begin
    if @OnChange<>@FNewOnChange then begin
      FOldOnChange:=OnChange;
      OnChange:=MyOnChange;
    end;
  end
  else begin
    OnChange:=MyOnChange;
    FOldOnChange:=nil;
  end;
  with FListDataSet do begin
    if not Active then
      Open;
    if FindField(FListKeyName)<>nil then
      try
        FieldByName(FListKeyName).AsInteger;
      except
        ShowMessage('[ListKeyName]必须是整型');
        Exit;
      end;
    SetState:=Active;
    if not Active then
      Active:=True;
    DisableControls;
    CurPosMark:=GetBookmark;
    First;
    I:=1;
    while not Eof do begin
      Case FieldByName(FListFieldName).DataType of
        ftString:
          DispStr:=FieldByName(FListFieldName).AsString;
        ftSmallint, ftInteger, ftWord:
          DispStr:=IntToStr(FieldByName(FListFieldName).AsInteger);
        ftFloat, ftCurrency:
           DispStr:=FloatToStr(FieldByName(FListFieldName).AsFloat);
        ftDate,ftTime,ftDateTime:
           DispStr:=DateTimeToStr(FieldByName(FListFieldName).AsDateTime);
        else begin
           DispStr:='不支持的数据类型';
           break;
        end;
      end;
      if FindField(FListKeyName)<>nil then
        FKeyValue[Items.Count]:=FieldByName(FListKeyName).AsInteger;
      Items.Add(FieldByName(FListFieldName).AsString);
      if(I>=MaxList)and(MaxList<>-1) then break;
      try
        next;  //可参照Eof为True的四个条件
      except
        break;
      end;
      Inc(I);
    end;
    GotoBookmark(CurPosMark);
    FreeBookmark(CurPosMark);
    EnableControls;
    if not SetState then begin
      Active:=False;
    end;
  end;
end;

procedure TListComboBox.SetListNow(Value:Boolean);
begin
  Items.Clear;
  try
    refresh(-1);
    FListNow:=Value;
  except
    raise;
  end;
end;

procedure TListComboBox.SetListName(Value:String);
begin
  if Value<>FListFieldName then begin
    FListFieldName:=Value;
    if FListNow then begin
      refresh(-1);
    end;
  end;
end;

procedure TListComboBox.SetKeyName(Value:String);
begin
  if Value<>FListKeyName then begin
    FListKeyName:=Value;
    if FListNow then begin
      refresh(-1);
    end;
  end;
end;

function TListComboBox.GetKeyVal:Integer;
begin
  Result:=FKeyValue[Self.ItemIndex];
end;

procedure TListComboBox.MyOnChange(Sender:TObject);
begin
  with FListDataSet do begin
    if FindField(FListKeyName)<>nil then
      Locate(FListKeyName,KeyVal,[]);
    if Assigned(FOldOnChange) then
      FOldOnChange(Sender);
  end;
end;

procedure Register;
begin
  RegisterComponents('Samples', [TListComboBox]);
  RegisterPropertyEditor(TypeInfo(string),TListComboBox,
                         'ListFieldName',
                         TFieldListComb);
  RegisterPropertyEditor(TypeInfo(string),TListComboBox,
                         'ListKeyName',
                         TFieldListComb);
end;

end.