居民身份证升位计算器

关于居民身份证从15位升到18位,其实是有一个国家标准的,所以就依此做了个计算器。。。

效果:

////工程文件

program Project1;

uses
  Forms,
  Unit1 in 'Unit1.pas' {frmMain};

{$R *.res}

begin
  Application.Initialize;
  Application.CreateForm(TfrmMain, frmMain);
  Application.Run;
end.

//单元文件
unit Unit1;

interface

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

type
  TfrmMain = class(TForm)
    Edit1: TEdit;
    Edit2: TEdit;
    Button1: TButton;
    Panel1: TPanel;
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    procedure Button1Click(Sender: TObject);
    procedure Edit1KeyPress(Sender: TObject; var Key: Char);
  private
    { Private declarations }
    function  ExpandIdNum(ID: string):string;
  public
    { Public declarations }
  end;

var
  frmMain: TfrmMain;

implementation

{$R *.dfm}

procedure TfrmMain.Button1Click(Sender: TObject);
begin
  if Length(Trim(Edit1.Text)) <> 15 then
  begin
    ShowMessage('请检查输入是否有误!');
    Exit;
  end;
  Edit2.ReadOnly := False;
  Edit2.Text := ExpandIdNum(Edit1.Text);
  Edit2.ReadOnly := True;
end;

procedure TfrmMain.Edit1KeyPress(Sender: TObject; var Key: Char);
begin
  //限制非数字输入
  if not (Key in ['0'..'9',#8]) then Key := #0;
end;

function TfrmMain.ExpandIdNum(ID: string):string;
const
W:array [1..18] of integer = (7,9,10,5,8,4,2,1,6,3,7,9,10,5,8,4,2,1); 
A:array [0..10] of char = ('1','0','x','9','8','7','6','5','4','3','2'); 
var 
i, j, S: integer; 
NewID: string; 
begin
  if Length(ID) <> 15 then
    result:= ''
  else
  begin
    NewID:= ID;
    Insert('19', NewID, 7);
    S:= 0;
    try
      for i:=1 to 17 do
      begin
      j:= StrToInt(NewID[i]) * W[i];
      S:= S + j;
      end;
    except
      result:= '有误';
      exit;
    end;
    S:= S mod 11;
    Result:= NewID + A[S];
  end;
end; 


end.

//窗体代码
object frmMain: TfrmMain
  Left = 406
  Top = 154
  BorderIcons = [biSystemMenu, biMinimize]
  Caption = #36523#20221#35777#25193#23637#21319#20301
  ClientHeight = 192
  ClientWidth = 379
  Color = clBtnFace
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -11
  Font.Name = 'Tahoma'
  Font.Style = []
  OldCreateOrder = False
  Position = poScreenCenter
  PixelsPerInch = 96
  TextHeight = 13
  object Label1: TLabel
    Left = 14
    Top = 72
    Width = 128
    Height = 13
    Caption = #36755#20837#21407#36523#20221#35777#21495'(15'#20301')'#65306
  end
  object Label2: TLabel
    Left = 16
    Top = 133
    Width = 140
    Height = 13
    Caption = #21319#20301#21518#30340#36523#20221#35777#21495'(18'#20301')'#65306
  end
  object Label3: TLabel
    Left = 254
    Top = 152
    Width = 110
    Height = 36
    AutoSize = False
    Caption = 'copyright by blacksnake and cc'
    Font.Charset = DEFAULT_CHARSET
    Font.Color = clRed
    Font.Height = -13
    Font.Name = 'Tahoma'
    Font.Style = []
    ParentFont = False
    WordWrap = True
  end
  object Edit1: TEdit
    Left = 16
    Top = 93
    Width = 223
    Height = 31
    Font.Charset = DEFAULT_CHARSET
    Font.Color = clWindowText
    Font.Height = -19
    Font.Name = 'Tahoma'
    Font.Style = []
    ParentFont = False
    TabOrder = 0
    OnKeyPress = Edit1KeyPress
  end
  object Edit2: TEdit
    Left = 17
    Top = 151
    Width = 227
    Height = 31
    Font.Charset = DEFAULT_CHARSET
    Font.Color = clFuchsia
    Font.Height = -19
    Font.Name = 'Tahoma'
    Font.Style = [fsBold]
    ParentFont = False
    ReadOnly = True
    TabOrder = 1
  end
  object Button1: TButton
    Left = 251
    Top = 54
    Width = 122
    Height = 88
    Caption = #35745'  '#31639
    Font.Charset = DEFAULT_CHARSET
    Font.Color = clMenuHighlight
    Font.Height = -21
    Font.Name = 'Tahoma'
    Font.Style = [fsBold]
    ParentFont = False
    TabOrder = 2
    OnClick = Button1Click
  end
  object Panel1: TPanel
    Left = 0
    Top = 0
    Width = 379
    Height = 41
    Align = alTop
    Caption = #36523#20221#35777#21319#20301#35745#31639#22120
    Font.Charset = DEFAULT_CHARSET
    Font.Color = clInactiveCaptionText
    Font.Height = -37
    Font.Name = #26999#20307'_GB2312'
    Font.Style = [fsBold, fsUnderline]
    ParentFont = False
    TabOrder = 3
  end
end

posted @ 2011-06-06 20:38  客栈老人  阅读(6233)  评论(0编辑  收藏  举报