zoukankan      html  css  js  c++  java
  • Delphi 2009 泛型容器单元(Generics.Collections)[4]: TDictionary<T>

    TDictionary 类似哈希表.

    本例效果图:



    代码文件:
    unit Unit1;
    
    interface
    
    uses
      Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
      Dialogs, StdCtrls;
    
    type
      TForm1 = class(TForm)
        Memo1: TMemo;
        Edit1: TEdit;
        Edit2: TEdit;
        Button1: TButton;
        Button2: TButton;
        Button3: TButton;
        Button4: TButton;
        procedure FormCreate(Sender: TObject);
        procedure FormDestroy(Sender: TObject);
        procedure Button1Click(Sender: TObject);
        procedure Button2Click(Sender: TObject);
        procedure Button3Click(Sender: TObject);
        procedure Button4Click(Sender: TObject);
      end;
    
    var
      Form1: TForm1;
    
    implementation
    
    {$R *.dfm}
    
    uses Generics.Collections; {Delphi 2009 新增的泛型容器单元}
    
    var
      Dictionary: TDictionary<Cardinal,string>;  
      {定义一个泛型 TDictionary 类, 指定有 Cardinal、string 构成}
    
    {建立}
    procedure TForm1.FormCreate(Sender: TObject);
    begin
      Dictionary := TDictionary<Cardinal,string>.Create;
    
      Memo1.Clear;
      Button1.Caption := Button1.Caption + ' 添加';
      Button2.Caption := Button2.Caption + ' 删除';
      Button3.Caption := Button3.Caption + ' 尝试取值';
      Button4.Caption := Button4.Caption + ' 清空';
    
      Edit1.Clear;
      Edit2.Clear;
      Edit1.NumbersOnly := True;
    end;
    
    {释放}
    procedure TForm1.FormDestroy(Sender: TObject);
    begin
      Dictionary.Free;
    end;
    
    {添加}
    procedure TForm1.Button1Click(Sender: TObject);
    var
      key: Cardinal;
      value: string;
      str: string;
      k,v: Boolean;
    begin
      key := StrToIntDef(Edit1.Text, 0);
      value := Edit2.Text;
      if value = '' then value := 'Null';
    
      k := Dictionary.ContainsKey(key);     {Key 是否存在}
      v := Dictionary.ContainsValue(value); {Value 是否存在}
      
      if not k then
      begin
        Dictionary.Add(key, value);
        Memo1.Lines.Add(Format('%d=%s', [key, value])); {同步显示}
      end;
    
      if k and not v then
      begin
        str := Format('key 已存在: %d=%s; 是否修改其值?', [key, Dictionary[key]]);
        if MessageBox(0, PChar(str), '提示', MB_OKCANCEL or MB_ICONQUESTION) = mrOk then
        begin
          //Dictionary[key] := value; {Dictionary[key] = Dictionary.Item[key]}
          Dictionary.AddOrSetValue(key, value);       {也可使用上一句}
          Memo1.Lines.Values[IntToStr(key)] := value; {同步显示}
        end;
      end;
    
      if k and v then
      begin
        str := Format('%d=%s 已存在, 不能重复添加', [key, value]);
        MessageBox(0, PChar(str), '错误', MB_OK + MB_ICONHAND);
      end;
    
      Text := IntToStr(Dictionary.Count);
    end;
    
    {删除: Remove}
    procedure TForm1.Button2Click(Sender: TObject);
    var
      key: Integer;
      i: Integer;
    begin
      key := StrToIntDef(Edit1.Text, 0);
    
      if not Dictionary.ContainsKey(key) then  
      begin
        ShowMessageFmt('key: %d 不存在', [key]);
        Exit;
      end;
        
      Dictionary.Remove(key);
      Text := IntToStr(Dictionary.Count);
      
      {同步显示}
      i := Memo1.Lines.IndexOfName(IntToStr(key));
      if i > -1 then Memo1.Lines.Delete(i);
    end;
    
    {尝试取值: TryGetValue}
    procedure TForm1.Button3Click(Sender: TObject);
    var
      key: Integer;
      value: string;
    begin
      key := StrToIntDef(Edit1.Text, 0);
      if Dictionary.TryGetValue(key, value) then
        ShowMessageFmt('key: %d 已存在, 其值是: %s', [key, value])
      else
        ShowMessageFmt('key: %d 不存在', [key])
    end;
    
    {清空: Clear}
    procedure TForm1.Button4Click(Sender: TObject);
    begin
      Dictionary.Clear;
      Text := IntToStr(Dictionary.Count);
      Memo1.Clear; {同步显示}
    end;
    
    end.
    
    窗体文件:
    object Form1: TForm1
      Left = 0
      Top = 0
      Caption = 'Form1'
      ClientHeight = 165
      ClientWidth = 275
      Color = clBtnFace
      Font.Charset = DEFAULT_CHARSET
      Font.Color = clWindowText
      Font.Height = -11
      Font.Name = 'Tahoma'
      Font.Style = []
      OldCreateOrder = False
      Position = poDesktopCenter
      OnCreate = FormCreate
      OnDestroy = FormDestroy
      PixelsPerInch = 96
      TextHeight = 13
      object Memo1: TMemo
        Left = 0
        Top = 0
        Width = 133
        Height = 165
        Align = alLeft
        Font.Charset = DEFAULT_CHARSET
        Font.Color = clWindowText
        Font.Height = -13
        Font.Name = 'Courier New'
        Font.Style = []
        Lines.Strings = (
          'Memo1')
        ParentFont = False
        ScrollBars = ssBoth
        TabOrder = 0
        ExplicitHeight = 176
      end
      object Button1: TButton
        Left = 139
        Top = 40
        Width = 128
        Height = 25
        Caption = 'Button1'
        TabOrder = 1
        OnClick = Button1Click
      end
      object Button2: TButton
        Left = 139
        Top = 71
        Width = 128
        Height = 25
        Caption = 'Button2'
        TabOrder = 2
        OnClick = Button2Click
      end
      object Button3: TButton
        Left = 139
        Top = 102
        Width = 128
        Height = 25
        Caption = 'Button3'
        TabOrder = 3
        OnClick = Button3Click
      end
      object Edit1: TEdit
        Left = 139
        Top = 8
        Width = 40
        Height = 21
        TabOrder = 4
        Text = 'Edit1'
      end
      object Edit2: TEdit
        Left = 185
        Top = 8
        Width = 81
        Height = 21
        TabOrder = 5
        Text = 'Edit2'
      end
      object Button4: TButton
        Left = 139
        Top = 133
        Width = 128
        Height = 25
        Caption = 'Button4'
        TabOrder = 6
        OnClick = Button4Click
      end
    end
    
  • 相关阅读:
    vue前台 (三)优化三级分类请求次数(发送ajax次数)
    vue前台(三)采用申明式导航去点击连接到其他组件(采用事件委派方式)
    浅谈Vue中的路由配置项meta
    vue前台(三)函数防抖和节流,lodash
    vuex的mapState 辅助函数
    Vue使用NProgress
    axios拦截器
    编程式路由跳转到当前路由, 控制台抛出NavigationDuplicated的错误
    window 右键菜单添加 vscode
    对《Python核心编程》中“第一个Python程序”的改进
  • 原文地址:https://www.cnblogs.com/del/p/1269024.html
Copyright © 2011-2022 走看看