Delphi 身分證產生器(練習題目用)

為了能慢慢熟悉Delphi語言
之前寫過猜數字以後
這次寫一個身分證產生器當作另一個題目練習
身分證驗證規則如圖

表單格式如上圖
程式碼 : 

unit bodycode;

interface

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

type
  TForm1 = class(TForm)
    bodyCode: TEdit;
    Button1: TButton;
    ComboBox1: TComboBox;
    RadioButton1: TRadioButton;
    RadioButton2: TRadioButton;
    procedure Button1Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);
var
 fir,sel,fin,sec : String;
 i,las,pos,len,s1,s2,sum,s1a,s1b : Integer;
 s : array[0..6] of Integer;
begin
 pos := combobox1.ItemIndex;  //user選擇的選項位置
 sel := combobox1.Items.Strings[pos];  //把所選的字串抓出
 len := Length(sel);            //字串長度算出
 fir := copy(sel,len,1);           //抓出最後面的數字
 s1 := StrToInt(copy(sel,1,2))+9;      //將編號+9
 if Radiobutton1.Checked = true then
  sec := '1'                         //選男生就等於1
 else if Radiobutton2.Checked = true then
  sec := '2'                         //女生等於2
 else
  begin
   showMessage('Please Choose gender!');
   exit;
  end;
 sum := 0;
 for i := 0 to 6 do
  begin
   Randomize;
   s[i] := trunc(Random(10));  //隨機產生中間7碼
   sum := sum + s[i]*(7-i);   //產生後乘上數字累加上去
   fin := fin + IntToStr(s[i]);   //同時將中間字串產生
  end;
 s2 := StrToInt(sec)*8;
 s1a := (s1 div 10)*1;
 s1b := (s1 mod 10)*9;
 sum := sum+s1a+s1b+s2;   //產生驗證數字總合
 if (sum mod 10) = 0 then
  las := 0
 else
  las := 10-(sum mod 10);        //產生最後一碼
 fin := fir + sec + fin + IntToStr(las);       //身分證字號產出
 bodyCode.Text := fin;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  combobox1.ItemIndex := 0;  //強制設定一開始就選到第一個選項
end;

end.

Delphi 資料庫連接SQL Server 2008 R2 (新增,修改,刪除,查詢)

雖然Delphi在DB Control裡有工具可以直接拉出對資料庫作新增修改刪除的動作
但介面上要比較好看且功能較強大的話還是要自己寫出IUDS的動作
所以寫了小小的程式當作練習
我是使用ADO做資料庫連線
先設定ADOQuery的ConnectionString,連線成功
再設定一個DataSource使其可以連上資料庫
這邊我是用一個DBGrid呈現資料表中的資料

表單配置如下圖

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, Grids, DBGrids, DB, ADODB, StdCtrls, Mask, DBCtrls;

type
  TForm1 = class(TForm)
    ADOQuery1: TADOQuery;
    DataSource1: TDataSource;
    DBGrid1: TDBGrid;
    btnAZ: TButton;
    btnZA: TButton;
    Label1: TLabel;
    ediID: TEdit;
    btnSea: TButton;
    Label2: TLabel;
    DBID: TDBEdit;
    DBPW: TDBEdit;
    Label3: TLabel;
    Label4: TLabel;
    btnUpdate: TButton;
    btnDelect: TButton;
    btnUp: TButton;
    btnDown: TButton;
    btnFirst: TButton;
    btnLast: TButton;
    Label5: TLabel;
    ID: TEdit;
    PW: TEdit;
    Label6: TLabel;
    Label7: TLabel;
    btnIsert: TButton;
    btnClose: TButton;
    Label8: TLabel;
    procedure btnAZClick(Sender: TObject);
    procedure btnZAClick(Sender: TObject);
    procedure btnSeaClick(Sender: TObject);
    procedure btnUpdateClick(Sender: TObject);
    procedure btnDelectClick(Sender: TObject);
    procedure btnUpClick(Sender: TObject);
    procedure btnDownClick(Sender: TObject);
    procedure btnFirstClick(Sender: TObject);
    procedure btnLastClick(Sender: TObject);
    procedure btnIsertClick(Sender: TObject);
    procedure btnCloseClick(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.btnAZClick(Sender: TObject);
begin
 ADOQuery1.Sort := 'ID ASC'    //升冪排序
end;

procedure TForm1.btnZAClick(Sender: TObject);
begin
 ADOQuery1.Sort := 'ID DESC'   //降冪排序
end;
procedure TForm1.btnSeaClick(Sender: TObject);
 var
  F : Boolean;
 begin
   F := ADOQuery1.Locate('ID',ediID.Text,[loPartialKey]); //搜尋特定字串
  if F = False then
   begin
    showMessage('No Data Exist!');   //沒有相符資料
   end;
 end;

procedure TForm1.btnUpdateClick(Sender: TObject);  //修改
 var
  i : Integer;
 begin
   i := Application.MessageBox('確定要修改這筆資料?','修改確認',MB_OKCANCEL);
  if i = 1 then
  begin
   ADOQuery1.Edit;
   ADOQuery1['ID'] := DBID.Text;
   ADOQuery1['PW'] := DBPW.Text;
   ADOQuery1.Post;
  end
  else
   exit;
 end;

procedure TForm1.btnDelectClick(Sender: TObject);   //刪除
 var
  i : Integer;
 begin
   i := Application.MessageBox('確定要刪除這筆資料?','刪除確認',MB_OKCANCEL);
  if i = 1 then
    ADOQuery1.Delete
  else
    exit;
 end;

procedure TForm1.btnUpClick(Sender: TObject);  //上一筆功能
 begin
  if ADOQuery1.Bof then
    ADOQuery1.First
  else
    ADOQuery1.Prior;
 end;

procedure TForm1.btnDownClick(Sender: TObject);   //下一筆功能
 begin
  if ADOQuery1.Eof then
   ADOQuery1.Last
  else
   ADOQuery1.Next;
 end;

procedure TForm1.btnFirstClick(Sender: TObject);    //第一筆
 begin
  ADOQuery1.First();
 end;

procedure TForm1.btnLastClick(Sender: TObject);     //最後一筆
 begin
  ADOQuery1.Last();
 end;

procedure TForm1.btnIsertClick(Sender: TObject);   //新增
 begin
  if ID.Text = '' then
   begin
     showMessage('請輸入資料');
     exit;
   end;
  if Length(ID.Text) > 5 then
   begin
     showMessage('輸入字串長度要小於5');
     ID.Clear;
     exit;
   end;
  ADOQuery1.Insert;
  ADOQuery1['ID'] := ID.Text;
  ADOQuery1['PW'] := PW.Text;
  ADOQuery1.Post;
  ID.Clear;
  PW.Clear;
 end;
 
procedure TForm1.btnCloseClick(Sender: TObject);
begin
 Close();
end;

end.

Delphi DBGrid的設定

放入DBGrid後
點擊DBGrid兩下就會出現小視窗
裡面會出現所有欄位的選項
可針對每個欄位去修改

Delphi 一些Delphi的學習網站

中文網站 : 

http://www.cynet.com.tw/Learning/Delphi/Delphi_Basic/index.html

http://www.cyut.edu.tw/~rcchen/courses/delphi/html/delphi.htm

英文網站 : 

http://www.delphibasics.co.uk/index.html

Blogger 程式碼貼上美化

1. 新增程式碼美化工具

Blogger資訊主頁  >  版面配置  >  新增小工具(任一都可)  >  HTML/JAVASCRIPT
進入後標題自訂
內容放入 :

<script src="https://google-code-prettify.googlecode.com/svn/loader/run_prettify.js"></script>

2. 如何使用

class="language-所使用的程式語言" EX : JAVA

<pre class="prettyprint"><code class="language-java">//程式碼</code></pre>

Delphi 猜數字遊戲(電腦猜)

設定數字給電腦猜(難度較高)

unit GauessNumAI;

interface

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

type
  TForm1 = class(TForm)
    ediAns: TEdit;
    Label1: TLabel;
    btnStart: TButton;
    btnReset: TButton;
    btnClose: TButton;
    FinalLabel: TLabel;
    ansList: TMemo;
    procedure btnCloseClick(Sender: TObject);
    procedure btnResetClick(Sender: TObject);
    procedure btnStartClick(Sender: TObject);

  private
    { Private declarations }
    function AddZero(const Num : SmallInt):ShortString;//加0
    function DubCheck(const Num : ShortString):Boolean;//是否有重複
    function ABCheck(const Num,AnsNum : ShortString):ShortString;//算幾a幾b
    procedure FindAns(const Num : ShortString); //尋找可能答案
    procedure Start(); //開始動作
    procedure Reset(); //重置
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
  PossibleArray :array[0..5040] of ShortString;   //解集合
  NowCount : Integer = 0;   //陣列長度
  TempCount : Integer = 0;  //暫時紀錄陣列長度
  Ans : ShortString = '0123'; //答案

implementation

{$R *.dfm}

function TForm1.AddZero(const Num : SmallInt):ShortString; //如果三位數前面就加0,小於三位數就回傳'0000'
 begin
   Result := IntToStr(Num);
    if Num <= 999 then
      Result := '0' + Result;
    if Num <= 99 then
      Result := '0000';
 end;

function TForm1.DubCheck(const Num : ShortString):Boolean; //如果四位數中有重複就不算(有就回傳true)
 var
  i,j : SmallInt;
 begin
  Result := False;
    for i := 1 to 3 do
     for j := i+1 to 4 do
       if Num[i] = Num[j] then //數字重複就繼續
         begin
           Result := True;
           break;
         end;
 end;

function TForm1.ABCheck(const Num,AnsNum : ShortString):ShortString; //算出AB數
 var
  A,B,i,j : SmallInt;
 begin
   A := 0;
   B := 0;
  for i := 1 to 4 do //猜測的數字位置
   for j := 1 to 4 do  //答案的數字位置
    if Num[i] = AnsNum[j] then  //數字相同繼續
      if i = j then
        Inc(A)        //位置相同加A
      else
        Inc(B);       //位置不同加B
  Result := IntToStr(A) + IntToStr(B);
 end;

procedure TForm1.FindAns(const Num : ShortString);
 var
  i : Integer;
 begin
  TempCount :=  NowCount;  //暫時紀錄原本陣列長度
  NowCount := 0;   //重計
  for i := 0 to TempCount do
   begin
     if ABCheck(Num,Ans) = ABCheck(Num,PossibleArray[i]) then //將有可能的解都重放入陣列中
       begin
         PossibleArray[NowCount] := PossibleArray[i];
         Inc(NowCount);
       end;
   end;
 end;

procedure TForm1.Start;
 var
  r,i,t : Integer;
  AB : ShortString;
 begin
  t := 0;
  while AB <> '40' do
   begin
    Randomize;
    r := Trunc(Random(NowCount)); //取亂數(陣列長度內)
    AB := ABCheck(PossibleArray[r],Ans); //取出比較AB
    ansList.Lines.Add(IntToStr(t+1) + '. ' + PossibleArray[r] + '　' + AB[1] + 'A' + AB[2] + 'B'); //印出
    FindAns(PossibleArray[r]); //呼叫程式開始尋找可能解
    Inc(t);
    if AB = '40' then
    begin
      FinalLabel.Caption := 'Total Guess Times : ' + IntToStr(t); //答案找出就印出總次數
      break;
    end;
   end;
 end;

procedure TForm1.ReSet;  //產生(重置)所有解集合
 var
  i : Integer;
  N : ShortString;
 begin
   NowCount := 0;
  for i := 0 to 9876 do
  begin
    N := AddZero(i);
    if Not(DubCheck(N)) then
    begin
      PossibleArray[NowCount] := N;
      Inc(NowCount);
    end;
  end;
 end;

procedure TForm1.btnCloseClick(Sender: TObject);
begin
 Close();
end;

procedure TForm1.btnResetClick(Sender: TObject);
begin
 ediAns.Text := '';
 ansList.Lines.Clear;
end;

procedure TForm1.btnStartClick(Sender: TObject);   //Start按鈕按下去後開始動作
 begin
  if (ediAns.Text <> '') and (not(DubCheck(ediAns.Text))) and (AddZero(StrToInt(ediAns.Text)) <> '0000') then
  begin
    ansList.Lines.Clear;
    ReSet();
    Ans := AddZero(StrToInt(ediAns.Text));
    Start();
  end
  else
    Showmessage('Please Enter Number ! ');
 end;

end.

Delphi 猜數字遊戲(猜電腦)

猜電腦給的數字(難度較低的題目)

unit GuessAI;

interface

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

type
  TForm1 = class(TForm)
    ediIN: TEdit;
    btnStart: TButton;
    btnClose: TButton;
    Tit: TLabel;
    Ans: TListBox;
    ed: TLabel;
    procedure btnStartClick(Sender: TObject);
    procedure btnCloseClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);

  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
  a : array[0..9] of integer;//0~9的數字陣列
implementation

{$R *.dfm}



procedure TForm1.FormCreate(Sender: TObject);
var
 i,j,k : integer;
begin
  Randomize;
  for i := 0 to 9 do
   a[i] := i;
  for i := 0 to 9 do //將a陣列的順序打亂產生亂數
    begin
     k := random(10);
     j := a[i];
     a[i] := a[k];
     a[k] := j;
     end;
    Tit.Caption := IntToStr(a[0])+ IntToStr(a[1])+ IntToStr(a[2])+ IntToStr(a[3])
end;

var q : integer = 1;
procedure TForm1.btnStartClick(Sender: TObject);

var

Nu,str : string;
i,j : integer;
b : array[0..3] of integer;
an,bn : integer;

begin

  for i := 0 to 3 do
   begin
    Nu := ediIN.Text;
    b[i] := StrToInt(Copy(Nu,i+1,1));
   end;
  an := 0;
  bn := 0;
  for i := 0 to 3 do
   begin
    for j := 0 to 3 do
    begin
     if a[i] = b[j] then //如果數字相同bn++
        bn := bn+1;
    end;
     if a[i] = b[i] then //如果數字位置相同an++
        an := an+1;
   end;
  bn := bn-an;

  str := ' 第 ' + IntToStr(q) + ' 次 '+ ' : '  + Nu + '        ' + IntToStr(an) + 'A' + IntToStr(bn) + 'B';
  Ans.Items.Add(str);
   q := q+1;
   if an = 4 then //如an=4則跳出
   begin
    ed.Caption := '共猜' + IntToStr(q-1) + '次';
    showMessage('猜中了');
   end;
end;

procedure TForm1.btnCloseClick(Sender: TObject);
begin
Close();
end;


end.