InputBox ComboBox輸入視窗

//ComboBox輸入視窗
//Ex: InputBox('Caption', '血型', 'A;B;O;AB','A型;B型;O型;AB型', Result)

function fn_InputBox(const ACaption, APrompt: WideString; AListValue, AListDesc:WideString; var AResult:String): Boolean; overload; //ComboBox輸入視窗
var
  Form: TForm;
  Prompt:TLabel;
  Combobox: TCombobox;
  DialogUnits: TPoint;
  ButtonTop, ButtonWidth, ButtonHeight: Integer;
  j, iTop, iHeight:Integer;
  DescList, ValueList:TStringList;
  function GetAveCharSize(Canvas: TCanvas): TPoint;
  var
    I: Integer;
    Buffer: array[0..51] of Char;
  begin
    for I := 0 to 25 do Buffer[I] := Chr(I + Ord('A'));
    for I := 0 to 25 do Buffer[I + 26] := Chr(I + Ord('a'));
    GetTextExtentPoint(Canvas.Handle, Buffer, 52, TSize(Result));
    Result.X := Result.X div 52;
  end;
begin
  Result := False;
  ValueList := TStringList.Create;
  DescList := TStringList.Create;
  Form := TForm.Create(Application);
  with Form do
  begin
    try
      Font.Name := 'Arial';
      Font.Size := 12;
      Font.Style := [fsBold];
      Canvas.Font := Font;
      DialogUnits := GetAveCharSize(Canvas);
      BorderStyle := bsDialog;
      Caption := ACaption;
      ClientWidth := MulDiv(180, DialogUnits.X, 4);
      Position := poScreenCenter;

      Prompt := TLabel.Create(Form);
      with Prompt do
      begin
        Parent := Form;
        Caption := APrompt;
        Left := MulDiv(8, DialogUnits.X, 4);
        Top := MulDiv(8, DialogUnits.Y, 8);
        Constraints.MaxWidth := MulDiv(164, DialogUnits.X, 4);
        WordWrap := True;
      end;

      Combobox := TCombobox.Create(Form);
      with Combobox do
      begin
        Parent := Form;
        CharCase := ecUpperCase;
        Left := Prompt.Left;
        Top := Prompt.Top + Prompt.Height + 5;
        Width := MulDiv(164, DialogUnits.X, 4);

        ValueList.Assign(fn_SplitStr(';', AListValue));
        DescList.Assign(fn_SplitStr(';', AListDesc));
        Items.Clear;
        for j := 0 to DescList.Count-1 do
        begin
          if j >= ValueList.Count then
            Break;
          if (ValueList[j]+DescList[j])<>'' then
            Items.Add(ValueList[j]+ ' - ' +DescList[j]);
        end;
        ItemIndex := ValueList.IndexOf(AResult);

        iTop := Top;
        iHeight := Height;
      end;

      ButtonTop := iTop + iHeight + 15;
      ButtonWidth := MulDiv(50, DialogUnits.X, 4);
      ButtonHeight := MulDiv(14, DialogUnits.Y, 8);
      with TButton.Create(Form) do
      begin
        Parent := Form;
        Caption := '確定';
        ModalResult := mrOk;
        Default := True;
        SetBounds(MulDiv(38, DialogUnits.X, 4), ButtonTop, ButtonWidth,
          ButtonHeight);
      end;

      with TButton.Create(Form) do
      begin
        Parent := Form;
        Caption := '取消';
        ModalResult := mrCancel;
        Cancel := True;
        SetBounds(MulDiv(92, DialogUnits.X, 4), ButtonTop, ButtonWidth,
          ButtonHeight);
        Form.ClientHeight := Top + Height + 13;
      end;
      if ShowModal = mrOk then
      begin
        AResult := '';
        if Combobox.ItemIndex<>-1 then
          AResult := ValueList[Combobox.ItemIndex];
        Result := True;
      end;
    finally
      FreeAndNil(ValueList);
      FreeAndNil(DescList);
      Form.Free;
    end;
  end;
end;