皆さんこんにちは、風の鳩サブレーです。

ComboBoxの各項目に対応コードをもてるようにしたものです。

新設プロパティ
ConvCsv : TstringList    項目と対応するコードを記述した
 　　　　　　　　　　　　カンマ区切り文字列リスト
Code    : string         設定コード
HojoCode : string        補助コード
CodeOrd  : integer       コードがカンマ区切りの並びの何番目（０から）
HojoCodeOrd : integer    補助コードが 〃
ValueOrd    : integer    項目が       〃
CompNumber  : Boolean    コードを数値として比較(True)
                                 文字列として比較(false)
MoveByRet    : Boolean   リターンキーでフォーカス移動する(true)
                                                     しない(false)

簡単なつかいかた

まずConvCsv に対応表を設定します。
例）
CodeComboBox1.ConvCsv.Clear;
CodeComboBox1.ConvCsv.add('0,いいえ,NO');
CodeComboBox1.ConvCsv.add('1,はい,YES');
CodeComboBox1.ConvCsv.add('2,その他,OTHER');

CodeOrd,HojoCodeOrd,ValueOrdを指定します
上の場合１つ目をコード、２つ目を項目、３つ目を補助コードとして
CodeComboBox1.CodeOrd := 0;
CodeComboBox1.HojoCodeOrd := 2;
CodeComboBox1.ValueOrd := 1;

Codeを指定します。
CodeComboBox1.Code := 1;

でcomboboxには はい が表示され,HojoCode には YES が入ります。

逆にプルダウンから その他 を選ぶと
Code プロパティには 2 が HojoCodeプロパティには OTHER が入ります。

unit CodeComboBox;

interface

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

type
  TCodeComboBox = class(TComboBox)
  private
    { Private 宣言 }
    FMoveByRet : boolean;
    FConvlist  : Tstringlist;
    FConvCode  : Tstringlist;
    FHojoList  : Tstringlist;
    FCode,FHojoCode : String;
    FNumber    : Boolean;
    FCodeOrd , FValueOrd , FHojoCodeord : integer;
    FOnCodeChange: TNotifyEvent;
    function GetConvCsv: TStringlist;
    procedure SetConvCsv(Value: TStringlist);
    function GetCode: String;
    procedure SetCode(Value: String);
    procedure prepare(Sender: TObject);
    procedure SetCodeOrd(Value :integer);
    procedure SetHojoCodeOrd(Value :integer);
    procedure SetValueOrd(Value :integer);
  protected
    { Protected 宣言 }
  public
    { Public 宣言 }
    constructor Create(AOwner : TComponent); override;
    destructor Destroy; override;
    procedure Change; override;
    procedure Clear2 ; virtual;
    procedure Keypress(var key:char); override;
  published
    { Published 宣言 }
    Property Code : String read GetCode write SetCode;
    Property HojoCode : String read FHojoCode write FHojoCode;
    Property CompNumber : Boolean read FNumber write FNumber;
    Property ConvCsv : Tstringlist read GetConvCsv write SetConvCsv;
    Property CodeOrd : integer read FCodeOrd write SetCodeOrd default
0;
    Property HojoCodeOrd : integer read FHojoCodeOrd write
SetHojoCodeOrd
default 0;
    Property ValueOrd : integer read FValueOrd write SetValueOrd
default 1;
    property MoveByRet : boolean read Fmovebyret write Fmovebyret
default
True;
    property OnCodeChange: TNotifyEvent read FOnCodeChange write
FOnCodeChange;
  end;

procedure Register;

implementation

constructor TCodeComboBox.Create (AOwner : TComponent);
begin
  inherited Create(AOwner);
  FConvList := Tstringlist.create;
  FConvCode := Tstringlist.create;
  FHojoList := Tstringlist.create;
  FConvlist.onChange := Prepare;
  FCodeOrd := 0;
  FHojoCodeOrd := 0;
  FValueOrd := 1;
  FMoveByRet := true;
end;

destructor TCodeComboBox.Destroy;
begin
  FConvList.free;
  FConvCode.free;
  FHojoList.Free;
  inherited Destroy;
end;

procedure TCodeComboBox.Clear2;
begin
  clear;
  Code := '';
  ConvCsv.Clear;
end;

function TCodeComboBox.GetConvCsv: TStringlist;
begin
  Result := FConvList;
end;

procedure TCodeComboBox.SetConvCsv(Value: TStringlist);
begin
  FConvList.Assign(Value);
  prepare(nil);
end;

procedure TCodeComboBox.prepare(Sender:TObject);
var i,p,cc : integer;
    s,it : string;
    cf,vf,hf : boolean;
begin
  FConvCode.Clear;
  FHojoList.Clear;
  items.Clear;
  for i := 1 to FConvList.count do
  begin
    s := FConvList[i-1];
    if copy(s,1,2) = '//' then
      continue;
    cf := false;
    vf := false;
    hf := false;
    cc := 0;
    while (not cf) or (not hf) or (not vf) do
    begin
      p := ansipos(',',s);
      if p = 0 then
        it := s
      else
        it := copy(s,1,p-1);
      if cc = FCodeOrd then
      begin
        FConvCode.add(it);
        cf := true;
      end;
      if cc = FHojoCodeOrd then
      begin
        FHojoList.add(it);
        hf := true;
      end;
      if cc = FValueOrd then
      begin
        items.add(it);
        vf := true;
      end;
      if p = 0 then
        break;
      delete(s,1,p);
      inc(cc);
    end;
  end;
  setcode(FCode);
end;


function TCodeComboBox.GetCode: String;
begin
  Result := FCode;
end;

procedure TCodeComboBox.SetCode(Value: String);
var i,v : integer;
    c : string;
begin
  if FCode = Value then
    exit;
  FCode := Value;
  hint := 'Code:' + Value;
  if Trim(Value) = '' then
    exit;
  c := '';
  if FNumber then
    v := strtoint(Value);
  for i := 1 to FConvCode.count do
  begin
    if not FNumber then
    begin
      if Value = FConvCode[i-1] then
      begin
        c := items[i-1];
        HojoCode := FHojoList[i-1];
        break;
      end;
    end
    else
    begin
      if v = strtoint(FConvCode[i-1]) then
      begin
        c := items[i-1];
        HojoCode := FHojoList[i-1];
        break;
      end;
    end;
  end;
  text := c;
  if Assigned(FOnCodeChange) then FOnCodeChange(Self);
end;


procedure TCodeComboBox.Change;
var i : integer;
    c,v1 : string;
begin
  v1 := text;
  if Trim(v1) <> '' then
  begin
    c := '';
    for i := 1 to items.count do
    begin
      if v1 = items[i-1] then
      begin
        c := FConvCode[i-1];
        HojoCode := FHojoList[i-1];
        break;
      end;
    end;
    code := c;
  end;
  inherited;
end;

procedure TCodeComboBox.SetCodeOrd(Value : integer);
begin
  FCodeOrd := Value;
  prepare(nil);
end;

procedure TCodeComboBox.SetHojoCodeOrd(Value : integer);
begin
  FHojoCodeOrd := Value;
  prepare(nil);
end;

procedure TCodeComboBox.SetValueOrd(Value : integer);
begin
  FValueOrd := Value;
  prepare(nil);
end;

procedure TCodeComboBox.Keypress(var key : char);
begin
  inherited;
  if (key = #13) and (FMoveByRet) then
    sendmessage(TForm(self.owner).handle,WM_NEXTDLGCTL,0,0);
end;

procedure Register;
begin
  RegisterComponents('Samples', [TCodeComboBox]);
end;

end.

風の鳩サブレー(JBG03220)

Original document by 風の鳩サブレー  氏 ID:(JBG03220)

ここにあるドキュメントは NIFTY SERVEの Delphi Users' Forum の16番会議室「玉石混淆みんなで作るSample蔵」に投稿されたサンプルです。これらのサンプルはボーランド株式会社がサポートする公式のものではありません。また、必ずしも動作が検証されているものではありません。これらのサンプルを使用したことに起因するいかなる損害も投稿者、およびフォーラムスタッフはその責めを負いません。使用者のリスクの範疇でご使用下さい。