程式學

星期一, 10月 29, 2007

複製程序(procedure)或函式(function)的程式碼後，在private能自動產生的方法

在程序名或函式名上(不用圈選)按右鍵，選擇complete class at cursor即可。

例外處理

Object Pascal定義了許多例外類別，在Delphi中，類別幾乎都以T開頭，但例外類別卻大部分是E開頭，例如：EDateTimeError, EConvertError,EDivByZero,ERangeError等，所有例外皆繼承自Exception 類別。

要在Delphi中在設計階段能使用 Exception的功能，須先設定下列步驟：

主選單 ==> Tools ==> Debugging Options...
==> Language Exceptions標籤頁中的 Stop on Delphi Exceptions 的勾勾取消即可。

try ... except ... 的範例：


try
  保護的指令
except
  有例外發生時，要如何處理
end;

為何要 try ... except ... ，其目的在於"保護的指令"該區段若有任何的錯誤，不希望造成系統的停止運作，而是將運作的流程直接跳到 except區段，由該區段來執行錯誤排除的工作。

範例一


procedure TForm1.Button1Click(Sender: TObject);
var
  d: Tdatetime;
  i,j: integer;
begin
  try
    d:= strtodatetime(edit1.Text);
    i:= strtoint(edit2.text);
    j:= strtoint(edit3.text);
    i:= i div j;
    edit2.Text:= inttostr(i);
  except
    on EDivByZero do showmessage('除以零的錯誤');
     //可以自訂錯誤訊息
    on Econverterror do showmessage('型態轉換錯誤');
    on e:Exception do   //超過一行的指令需用begin...end; //任何變數名稱都可以，不一定要e，在此為臨時的變數名稱。 Exception為所有例外處理的老祖宗
      showmessage('系統訊息： ' + e.Message);
  end;
end;

自製的 raise Exception型態，程式設計者可以自訂錯誤訊息，並將例外的情形集中處理


interface
type
   EMyException=class(Exception); //自訂的錯誤型態

begin
  try
    i:= strtoint(edit1.Text);
    j:= strtoint(edit2.Text);
    if i < 10 then
      raise EMyException.Create('edit1 值小於 10')
    else if i > 100 then
      raise EMyException.Create('edit1 值大於 100');
    edit2.Text:= inttostr(i div j);
  except
    on e:EMyException do showmessage(e.Message);
           //自訂的exception會自動移除，不須自己寫指令清除 e.destroy
    on ee:Exception do showmessage('系統錯誤訊息:' + ee.Message);
  end;
end;

Try ... Finally ... end;
目的為了保護系統的資源以便在完成工作後釋放原先所取得的資源，在Delphi中以下的資源通常需要下指令去取得，也需要下指令去釋放 Files，Memory，Windows resources (VCL only)，Objects等。

格式如下


{ 取得資源的指令}
try
  { 利用該資源的相關指令}
finally
  { 最後須釋放相關資源}
end;

範例：
以下範例取得之記憶體的資源將無法正常的釋放，造成你在寫成程式，記憶體愈來愈少。


procedure TForm1.Button1Click(Sender: TComponent);
var
  APointer: Pointer;
  AnInteger, ADividend: Integer;
begin
  ADividend := 0;
  GetMem(APointer, 1024); // 要求 1K 的記憶體容量
  AnInteger := 10 div ADividend; //若在此發生錯誤，則下列的釋放資源的工作將無法做到
  FreeMem(APointer, 1024);
end;
}
//修改成下列方式，其意義就是不管 div的指令有無錯誤，皆須執行 finally內之指令，即釋放記憶體freemem。

procedure TForm1.Button1Click(Sender: TComponent);
var
  APointer: Pointer;
  AnInteger, ADividend: Integer;
begin
  ADividend := 0;
  GetMem(APointer, 1024); { allocate 1K of memory }
  try
    AnInteger := 10 div ADividend; { this generates an error }
  finally
    FreeMem(APointer, 1024); { execution resumes here, despite the error }
  end;
end;

except 與 finally 合併使用
語法如下：


try
  try
    statement1;
    statement2;
    ...
  except
    on E:except do ...//進行例外處理
  end;
finally
  statement_n;  //釋放系統資源
end;

範例：


procedure TForm1.Button1Click(Sender: TObject);
var
  i,j: integer;
begin
  try
    try
      i:=strtoint(edit1.text);
      j:=strtoint(edit2.text);
      i:= i div j;
      edit1.text:= inttostr(i);
    except
      on E:Exception do
        showmessage(E.message);
    end;
  finally
    showmessage('finally 這一段一定會做(釋放系統資源)');
  end;
end;

Global exception handeling(一般不建議，因為太多的exception，會更亂)
如果希望將所有的 Exception 統一在副程式中處理，可以利用 Application.onException的屬性，將應用程式中所有的例外狀況，交由同一段指令來處理。

使用步驟如下：


//1. 宣告處理Exception的程序名稱，例如MyExceptionHandler
{ Public declarations }
procedure MyExceptionHandler(Sender : TObject; E : Exception );

//2. 定義 Exception Handler於 implementation區，例如：
procedure TForm1.MyExceptionHandler(Sender : TObject; E : Exception );
var
  wRetVal : Word;
begin
  wRetVal := MessageDlg('錯誤訊息: ' + E.Message, mtError, mbAbortRetryIgnore,0);
  case wRetVal of
    mrAbort:
    begin
      { handle "Abort" here... }
    end;
    mrRetry:
    begin
      { handle "Retry" here... }
    end;
    mrIgnore:
    begin
      { handle "Ignore" here... }
    end;
    else
    begin
      { handle "other" action here...}
    end;
  end;
end;

//3. 指定應用程式的Exception將集中至 MyExceptionHandler管理
procedure TForm1.FormCreate(Sender: TObject);
begin
  { begin new code }
  Application.OnException:=MyExceptionHandler;
  { end new code }
end;

巢狀式(分層次)的例外處理


try //第一層的保護區塊起點
  statement...;

  try //第二層的保護區塊起點
    statement...;
  except //第二層的例外處理程式
    statement...;
  end;
    ...
except //第一層的例外處理
  on e:Exception do ...
end;

物件 : 多型(三)

『多型性』基本上就是一種樣式多種呈現的方式，或者說同一件事情有兩種以上的解釋。

例如在C++中 I = J + K 其中的 "+" 可能會因 J 及 K 的形態不同而有許多種不同的意義。
例如生物的覓食 Eat() 具有多種不同的定義。
例如每個人對賺錢 make_money() 皆有不同的方法。
Polymorphism可以做到軟體元件的Plug and Play 。

現代的OOP compiler(如C++，Java，object pascal) 皆支援 virtual function以完成 polymorphism 的機制。

polymorphism 的方式可以用 overloading 或 overriding 來解釋。

所謂 overloading上一章已經提過，主要就是同一個副程式的名稱，呼叫是依據輸入引數的型態或輸入引數的數量來決定，執行哪一個副程式。

而 overriding則是與繼承性有關，任何父類別中的副程式，若宣告為 virtual或 dynamic則可以被子類別的副程式所覆蓋 (指用override的指令)。如果父類別的副程式不想實現真正的程式碼，則須在加上宣告 abstract。

overriding只對 virtual 或 dynamic的副程式有效，所以任何要做 overriding皆須在宣告的後面加上 virtual 或 dynamic，不加的話是屬於 static 的副程式(一般 function 或 procedure 預設為 static)，無法 overriding。

其中 virtual method可以有較快的執行速度，而 dynamic method可以有較小的程式碼，一般來說 virtual method將較為有效率。

polymorphism 更重要的是父類別的功能可以由子類別來取代，如此在執行階段，將會非常有彈性地，我們由下列程式範例來說明。

5個class類別TFigure、TCircle、TPolygon、TSquare及TTriangle。
TCircle及TPolygon繼承Tfigure。TSquare及TTriangle繼承TPolygon。


unit Unit1;
interface
uses
   Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
   Dialogs, StdCtrls;
type
   TForm1 = class(TForm)
   Button1: TButton;
   procedure Button1Click(Sender: TObject);
   private
   { Private declarations }
   public
   { Public declarations }
end;
type
   TFigure = class
   public
    procedure draw;virtual;abstract; //若要做overridding則用virtual;否則用abstract
       // 宣告 abstract所以不須實作TFigure.draw之程式碼
       // virtual亦可使用 dynamic，一般來說virtual要較大的記憶體空間，但效率較好，dynamic則較小的記憶體空間，但效率較差
end;
type
   TCircle = class(TFigure)
   public
    procedure draw;override;

end;
type
   TPolygon = class(TFigure)
   public
    procedure draw;override;
    procedure static_draw;
end;
type
   TSquare = class(TPolygon)
   public
    procedure draw;override;
end;
type
   TTriangle = class(TPolygon)
   public
    procedure draw;override;
    procedure static_draw;

end;
var
   Form1: TForm1;
implementation
{$R *.dfm}
procedure TCircle.draw;
begin
   showmessage('TCircle');
end;
procedure TPolygon.draw;
begin
   showmessage('TPolygon');
end;
procedure TSquare.draw;
begin
   showmessage('TSquare');
end;
procedure TTriangle.draw;
begin
   showmessage('TTriangle');
end;


procedure TPolygon.static_draw;

begin
   showmessage('static function -- polygon draw');

end;
procedure TTriangle.static_draw;

begin
   showmessage('static function -- triangle draw');

end;
procedure TForm1.Button1Click(Sender: TObject);
   var F: array[0..3] of TFigure;
   i: integer;
   p1: Tpolygon;

begin
   F[0]:=TCircle.Create;
   F[1]:=TPolygon.Create;
   F[2]:=TSquare.Create;
   F[3]:=TTriangle.Create;
   for i:=0 to 3 do
     F[i].draw;      // 所謂的一種樣式多種表現形式
   for i:=0 to 3 do  // 釋放物件之記憶體，或可用 F[i].destroy;
     F[i].Free;      // 但 Free會先判斷是否有有被建立物件
  
//測試static function 與 virtual function 或 dynamic function之差異
   p1:= TTriangle.create;
   
   p1.static_draw; // 雖然p1由TTriangle所建立，仍靜態連結到Tpolygon
   Ttriangle(p1).static_draw;  //須強制轉態方能執行Ttriangle中的static_draw函數
   p1.draw;  // 這個會執行Ttriangle的draw，由此可了解virtual(dynamic)與static之差異

             // 多型的功能須藉由virtual或dynamic function方能達到
   p1.free;
end;
end.


type
  TFirstComponent = class(TCustomControl)
    procedure Move; { static method}
    //procedure Move; abstract; {不想定義實做寫}
    procedure Flash; virtual; { virtual method}
    procedure Beep; dynamic;  {dynamic virtual method}
  end;

  TSecondComponet = class(TFirstComponent)
    procedure Move; //可重新定義，但不用寫overrides
    procedure Flash; override;  {overrides inherited method}
    procedure Beep; override;  {overrides inherited method}
  end;

物件 : 繼承性(二)

1. unit1有Tc1及Tc2類別，Tc2類別是繼承Tc1，因屬同一個unit底下，所以所有的屬性(public、private及protected)皆可以被呼叫。

2. unit2若單純uses unit1的話，Tc1類別的public，Tc2類別的public，及Tc類別所繼承父的public。

3. unit2有Tc3類別，其為繼承Tc2，則只能呼叫public及protected，但是不能呼叫private。在此須注意uses要放在interface裡，不能放在implementation裡。

uint1.pas


unit Unit1;
interface
uses
   Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
   Dialogs, StdCtrls;
type
   TForm1 = class(TForm)
   procedure FormCreate(Sender: TObject);
   private
   { Private declarations }
   public
   { Public declarations }
end;
type
   Tc1 = class
   public
     public_c1: string;
   private
     private_c1: string;
   protected
     protected_c1: string;
end;
type
   Tc2 = class(Tc1)
   public
     public_c2: string;
   private
     private_c2: string;
   protected
     protected_c2: string;
end;
var
   Form1: TForm1;
   c2: Tc2;
   c1: Tc1;
implementation
uses Unit2;
{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);
begin
   c2 := Tc2.Create;
   c2.public_c2:='a';
   c2.private_c2:='b';
   c2.protected_c2:='c';
   c2.public_c1:='d';  //都可以存取，主要是繼承Tc1
   c2.private_c1:='e';
   c2.protected_c1:='f';
   c1 := Tc1.Create;
   c1.public_c1:='aa';
   c1.private_c1:='bb';
   c1.protected_c1:='cc';
 // 各位要觀察的是 c2或c1物件按下.的時候可以下拉哪些 function
end;

end.

uint2.pas


unit Unit2;
interface
uses
   Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
   Dialogs, StdCtrls, unit1;

//因為要繼承 Tc2，所以引用的 unit1 單元須寫在 class type的宣告之前，所以須
//寫在 interface 區
type
   TForm2 = class(TForm)
     Button1: TButton;
     Button2: TButton;
     procedure Button1Click(Sender: TObject);
     procedure Button2Click(Sender: TObject);
   private
     { Private declarations }
   public
     { Public declarations }
end;
type
   Tc3= class(Tc2)  //因為在interface 就需要Tc2，所以unit1要寫在interface上面喔
   public
     public_c3: string;
   private
     private_c3: string;
   protected
     protected_c3: string;
end;
var
   Form2: TForm2;
implementation
//uses Unit1;   //不能寫implemetation後面
{$R *.dfm}
procedure TForm2.Button1Click(Sender: TObject);
begin
 // 只有 public 區的資料可以被讀取
   c1.public_c1:='a';
   c2.public_c1 :='b';
   c2.public_c2 := 'c';
end;
procedure TForm2.Button2Click(Sender: TObject);
 var c3: Tc3;
begin
   c3:= Tc3.Create;
   c3.public_c3 := 'a';
   c3.private_c3:= 'a';
   c3.protected_c3:= 'a';

   c3.public_c2:= 'a';
   c3.protected_c2:= 'a';

   c3.public_c1 := 'a';
   c3.protected_c1:= 'a';
// 有沒有發現Tc2及Tc1內的private變數無法經由繼承的方式來讀取，
// 但是protected 的資料卻可存取
// 記得如果是Tc2與Tc3在同一個 unit，則 private 變數仍可存取

end;
end.

有繼承的類別，若有與父類別相同的程序(屬性)則將會覆蓋掉父類別的程序(屬性)


unit Unit1;
interface
uses
   Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
   Dialogs, StdCtrls;
type
   TForm1 = class(TForm)
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
   private
   { Private declarations }
   public
   { Public declarations }
end;
type
   Tc1 = class
   public
     public_c1: string;
     procedure public_p1;
   private
     private_c1: string;
   protected
     protected_c1: string;
end;
type
   Tc2 = class(Tc1)
   public
     public_c2: string;
     procedure public_p1;
     procedure public_p2;
   private
     private_c2: string;
   protected
     protected_c2: string;
end;
var
   Form1: TForm1;
   c2: Tc2;
   c1: Tc1;
implementation
uses Unit2;
{$R *.dfm}
procedure Tc1.public_p1;
begin
  showmessage('Tc1.p1');
end;

procedure Tc2.public_p1;
begin
  showmessage('Tc2.p1');
end;

procedure Tc2.public_p2;
begin
  showmessage('Tc2.p2');
end;

procedure TForm1.Button1Click(Sender: TObject);
var c1:Tc1;
    c2:Tc2;
begin
  c1:=Tc1.create;
  c2:=Tc2.Create;
  c1.public_p1; //Tc1.p1
  c2.public_p1; //Tc2.p1   有相同的子類別會覆蓋掉父類別的程序(屬性)
  c2.public_p2; //Tc2.p2
end;

end.

物件 : 設計與封裝性(一)


type  TMyClass = class(被繼承的類別) //若class後面不寫，則是繼承TObject(class的老祖宗)
   Button1: TButton;   // 不寫，置放VCL 物件，此為published 區
   Edit1: TEdit;
   procedure Button1Click(Sender: TObject);
   private
     ... { private declarations here}
   protected
     ... { protected declarations here }
   public
     ... { public declarations here }
   published
     ... { published declarations here }
end;

public --- 不管同一單元或不同單元皆可存取，只要有引用皆可存取。
private --- 僅限於同一單元的可以存取，此點與 C++不同，在 C++ 中 private 的存取須同一個 class。
protected --- 僅限於繼承父類別的子子孫孫，方可以存取，不限制是否在同一個單元。
published --- 除了具有 Run-time Type Information (RTTI)的功能外，與 public 的功能完全相同。
RTTI 為了增加整個程式的生產力的東西，就像是設計階段已把元件屬性改掉，但執行階段想把剛設定的屬性值，靠RTTI幫你載入剛設定屬性的檔案。


unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

type
   Tmyclass = class (Tobject)  // 或 Tmyclass = class 自動繼承了Tobject
   private
     a: integer;
     b: string;
   public
     c: integer;
     procedure showData();
     property pa: integer write a; //權限管理 pa虛擬變數可以寫入a
     property pb: string read b; //權限管理 pb虛擬變數可以讀取b
     property pc: string read b write b; //權限管理 pc虛擬變數可以讀取b寫入b
  end;
var
  Form1: TForm1;
  myObj: Tmyclass; //定義在此，別的unit也可以讀得到，但若建立在implementation別的unit就讀不到囉
implementation

{$R *.dfm}
procedure Tmyclass.showData();
begin
  showmessage(b);   
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  myObj := Tmyclass.create; //非視覺化的物件，記得要自己把它建立物件實體
  myObj.pa := 12;                  // OK
  //myObj.pb := 'ab';                // 不行，因為 readonly
  showmessage( myObj.pb );         // OK因為可讀
  myObj.pc:='12';                    // OK，因可讀可寫
  showmessage(myObj.pc); // OK

  //myObj.a:=12;   　　//private變數，在相同的unit下可讀取，

  //myObj.b:='abc';　　//不同的unit下不可讀取,可透過public 區的property變數pc來讀取

end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  myObj.Free; //若物件有被建立則移除掉，若沒有，則不做動作，用此方式比較好
  myObj.Destroy; //暴力移除掉物件，可能會有問題
end;
end.

第一步：設計類別 ( 例子中沒有視覺化物件 )
類別內的成員有三種：(1) Field (2) Method (Function或 Procedure) (3) Property
Field: 就是定義在 class 內的變數
Method: 定義在 class 內的 procedure 或 function
Property: 針對現有 Field 增加存取的屬性

第二步：建立物件,依據類別所建立的實體

成員的存取
類別內 private 區的資料在同一個 unit 內的函數皆可存取，但在不同的 unit 內則不能存取。
(就像 implementation區內的資料)
類別內 pubilc 區的資料在同一個或不同的 unit 內的函數，只要有uses該單元皆可存取。
(像 interface 區內的資料)
記得物件本身的存取仍受到位於 interface 區或 implemenation 區的規範。

建構子 constructor 及解構子 destructor //像是unit的initialization
建構子宣告方式 constructor create; //像是unit的finalization
解構子宣告方式 destructor destroy;
以下為完整的範例，先建立一個Form使用兩個Buttons


unit Unit1;
interface
uses
   Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
   Dialogs, StdCtrls;
type
   TForm1 = class(TForm)
   Button1: TButton;
   Button2: TButton;
   procedure Button1Click(Sender: TObject);
   procedure Button2Click(Sender: TObject);
   private
   { Private declarations }
   public
   { Public declarations }
end;
type Tc=class
   public
   a: integer;
   constructor create;
   destructor destroy;
   private
end;
var
   Form1: TForm1;
   obj: Tc; 
   s: string;
implementation
{$R *.dfm}
constructor Tc.create; //當物件被create就會執行
begin
   s:='object created';
end; 
destructor Tc.destroy;
begin
   s:='object destroyed';
end; 
procedure TForm1.Button1Click(Sender: TObject);
begin
   obj:= Tc.create;
   showmessage(s);end;
procedure TForm1.Button2Click(Sender: TObject);
begin
   obj.destroy;
   showmessage(s);
end;

end.

變數存取空間

1. 副程式內的變數，僅對函數內的存取有效，即可視空間為整個副程式。
如：


procedure p1; //procedure及function皆為副程式
var i:interger;//i僅對函數內的存取有效
begin
 ...
end;

2. unit 內的變數 (不管在 interface 或 implementation區) ，其可視空間為整個 unit，如果變數或副程式定義於interface 區，則其他 unit 亦可存取(但須用uses去引用)，若定義於 implementation 區則可視空間僅在該 unit 內。
如：


unit Unit1;
interface
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs;
type
  TForm1 = class(TForm)
  private
    { Private declarations }
  public
    { Public declarations }
  end;
var
  Form1: TForm1;
  j:integer; //屬於interface，其他 unit 亦可存取(但須用uses去引用)
implementation
{$R *.dfm}
var i:integer; //屬於implementation，其他unit不可存取。並記得在此的變數要定義在最前(副程式前)，如此副程式才能讀到此變數
end.

3. 同一個變數名稱不能在 interface 區宣告，但又在 implementation 區宣告。

4. 同一個副程式名稱，如果要其他程式單元可以引用，則須在 interface 有所宣告，否則只須在 implemention區宣告並定義實體的副程式內容。
如：


unit Unit1;
interface
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs;
type
  TForm1 = class(TForm)
  private
    { Private declarations }
  public
    { Public declarations }
  end;
procedure p1; //宣告
var
  Form1: TForm1;
implementation
{$R *.dfm}
procedure p1; //在implemetation定義的副程式要給別的unit使用，則要宣告在interface裡
begin
 ...
end;
end.

5. 變數的引用，以距離最近為存取原則，若相同的變數，函數內有定義，則存取函數內之值，若無，存取 class內所定義之值，若 class內無此變數，則存取該 unit 內之變數，若該 unit 內無此變數，則可存取所引用的其他單元之變數值，如果引用的許多的單元中，皆有定義此變數，則以先引用的單元為主。
如：


unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
  private
    i : integer; //第二優先讀取Form(class)
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
  i : integer; //第三優先讀取interface(因與implementation宣告的變數不能相同)
implementation

{$R *.dfm}
var i : integer; //第三優先讀取unit(因與imterface宣告的變數不能相同)

procedure TForm1.Button1Click(Sender: TObject);
var i : integer; //第一優先讀取副程式
begin
  ...
end;

6. 定義於 class 內的變數及副程式，除了受到位於 interface 區或 implemenatation 區的影響外，仍須受到 class 封裝特性 public，private，protected，published 的規範。
public --- 不管同一單元或不同單元皆可存取，只要有引用皆可存取。
private --- 僅限於同一單元的可以存取，此點與 C++不同，在 C++ 中 private 的存取須同一個 class。
protected --- 僅限於繼承父類別的子子孫孫，方可以存取，不限制是否在同一個單元。
published --- 除了具有 Runtime Type Information (RTTI)的功能外，與 public 的功能完全相同。
如：


type
  TForm1 = class(TForm)
  private
    i : integer;
    { Private declarations }
  public
    j : integer;  //別的unit，有use到就可以讀到
    { Public declarations }
  end;

星期五, 10月 26, 2007

集合

集合型態的宣告

type Tmyset = set of 基本型態;

其中基本型態，指的是序數型態(ordinal)，且個數不得大於256 (0 到 255)。

範例：


type
  T1=1..10;
  T2= (Red, Yellow, Green);
  T3='A'..'F';
  Tset1 = set of T1;
  Tset2 = set of T2;
  Tset3 = set of T3;

var
  a: Tset1;
  b: Tset2;
  c: Tset3;

或簡化為


var 
  a: set of 1..10;
  b: set of (Red, Yellow, Green);
  c: set of 'A'..'F';

下列範例超過256將有錯誤產生


var
  d: set of integer;
  e: set of real;
  f: set of string;
  g: set of char;

集合的設定


a:= [1,2,3];
b:=[Red, Green];
c:[A,D];

集合的運算

+, - , * , <=, >= , = , <>, in

數獨

新增一個TButton並點兩下加入事件
在Form的OnCreate, OnPaint點兩下加入事件
接著就加入程式碼囉~


unit Unit1;

interface

uses
  Windows, Graphics, Forms, Classes, Controls, StdCtrls, Dialogs, Grids;
  
type
  TByteSet = set of Byte;
  TBytes = array of Byte;

  TForm1 = class(TForm)
    Button1: TButton;
    procedure FormCreate(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure FormPaint(Sender: TObject);
  private
    Done: Boolean;
    ResultTable: array[0..8, 0..8] of Byte;    //最後產出之結果
  public
    function SetToBytes(ASet: TByteSet; Range: Integer): TBytes;
    function ColSet(Index: Integer): TByteSet;
    function RowSet(Index: Integer): TByteSet;
  end;

var
  Form1: TForm1;

implementation

uses SysUtils;

{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);
begin
  Randomize;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  Sudos: TBytes;
  I, K, L, C, R: Byte;
  S: array[0..2] of TByteSet;
  AreaSet: array[0..8] of TByteSet;//作為比對
begin
  Sudos := nil;
  repeat
    Done := True;
    for I := 0 to 8 do AreaSet[I] := [];   //九個區域
    FillChar(ResultTable, SizeOf(ResultTable), $FF);
    for I := 0 to 80 do   //81個號碼
    begin
      C := I mod 9;    //C=除以9取黍數  Cols
      R := I div 9;    //R=除以9        Rows
      K := (R div 3) * 3 + (C div 3);  //K=列除3*3+行除3
      S[0] := [0..8] - ColSet(C);     //Column Available SudoSet
      S[1] := [0..8] - RowSet(R);     //Row Available SudoSet
      S[2] := [0..8] - AreaSet[K];   //Area Available SudoSet
      S[0] := S[0] * S[1] * S[2];     //Intersection: The Available SudoSet
      if S[0] = [] then   //空集合時就不做了
        Done := False
      else
      begin
        Sudos := SetToBytes(S[0], 9);     //Random Selection
        L := Sudos[Random(Length(Sudos))];
        AreaSet[K] := AreaSet[K] + [L]; 
        ResultTable[C, R] := L;
      end;
    end;
  until Done;

  Repaint;//繪出數讀表

end;

function TForm1.SetToBytes(ASet: TByteSet; Range: Integer): TBytes;
var
  I, J: Byte;
begin
  SetLength(Result, Range);
  J := 0;
  for I := 0 to Range-1 do
  begin
    if I in ASet then
    begin
      Result[J] := I;
      ASet := ASet - [I];
      Inc(J);
    end;
    if ASet = [] then Break;
  end;
  SetLength(Result, J);
end;

function TForm1.ColSet(Index: Integer): TByteSet;
var
  i: Integer;
begin
  Result := [];
  for i := 0 to 8 do
    if ResultTable[Index, i] <> $FF then
      Result := Result + [ResultTable[Index, i]];
end;

function TForm1.RowSet(Index: Integer): TByteSet;
var
  i: Integer;
begin
  Result := [];
  for i := 0 to 8 do
    if ResultTable[i, Index] <> $FF then
      Result := Result + [ResultTable[i, Index]];
end;

procedure TForm1.FormPaint(Sender: TObject);
const
  CW = 40;
  RH = 40;

  procedure SetPen(Color: TColor; Width: Integer; Style: TPenStyle; Mode: TPenMode);
  begin
    Canvas.Pen.Color := Color;
    Canvas.Pen.Width := Width;
    Canvas.Pen.Style := Style;
    Canvas.Pen.Mode := Mode;
  end;

  procedure SetBrush(Color: TColor; Style: TBrushStyle);
  begin
    Canvas.Brush.Color := Color;
    Canvas.Brush.Style := Style;
  end;

  procedure SetFont(Name: string; Height: Integer; Color: TColor; Style: TFontStyles);
  begin
    Canvas.Font.Name := Name;
    Canvas.Font.Height := Height;
    Canvas.Font.Color := Color;
    Canvas.Font.Style := Style;
  end;

  procedure Clear;
  var
    rt: TRect;
  begin
    SetPen(clGray, 1, psSolid, pmCopy); //設定邊寬
    SetBrush(clSilver, bsSolid); //設定背景
    rt := Rect(0, 0, CW*9-8, RH*9-8); //設定常數   //352 //352
    OffsetRect(rt, 10, 10);
    Canvas.Rectangle(rt); //畫被景圖
  end;

  procedure DrawColsRows;
  var
    i: Integer;
    rt: TRect;
  begin
    SetPen(clSilver, 1, psSolid, pmCopy); //銀色，固，1
    SetBrush(clGray, bsSolid); //灰，固
    rt := Rect(0, 0, CW, RH*9-8); //0,0,40,352

    OffsetRect(rt, 10, 10); //位於圖的初使位置
    for i := 0 to 7 do
    begin
      Canvas.FrameRect(rt);
      OffsetRect(rt, CW-1, 0); //偏移位置少一，才不會兩行寬
    end;

    rt := Rect(0, 0, CW*9-8, RH); //0,0,352,40
    OffsetRect(rt, 10, 10); //位於圖的初使位置
    for I := 0 to 8 do
    begin
      Canvas.FrameRect(rt);
      OffsetRect(rt, 0, RH-1);
    end;
  end;

  procedure DrawColsRows2;
  var
    i: Integer;
    rt: TRect;
  begin
    SetPen(clSilver, 1, psSolid, pmCopy);
    SetBrush(clRed, bsSolid);
    rt := Rect(0, 0, CW*9-8, RH*3-2);  //0, 0, 352, 118
    OffsetRect(rt, 10, 10);
    for i := 0 to 2 do
    begin
      Canvas.FrameRect(rt);     //畫直的矩形
      OffsetRect(rt, 0, (RH-1)*3);
    end;

    rt := Rect(0, 0, CW*3-2, RH*9-8);
    OffsetRect(rt, 10, 10);
    for i := 0 to 2 do
    begin
      Canvas.FrameRect(rt);     //畫橫的矩形
      OffsetRect(rt, (CW-1)*3, 0);
    end;
  end;

  procedure DrawContents;
  var
    i, j: Integer;
    rt: TRect;
    S: string;
  begin
    SetBrush(clGray, bsSolid);
    SetFont('ARIAL',36,clWhite,[fsBold]); //設定字型
    for i := 0 to 8 do
      for j := 0 to 8 do
      begin
        rt := Rect((CW-1)*i, (RH-1)*j, (CW-1)*(i+1), (RH-1)*(j+1)); //39*i, 39*j, 39*(i+1), 39*(j+1)
        OffsetRect(rt, 10, 10);
        InflateRect(rt, -2, -2);
        Inc(rt.Right);
        Inc(rt.Bottom);
        S := IntToStr(ResultTable[i, j]+1); //結果表加1，然後存到S字串
        Canvas.TextRect(Rt, Rt.Left+10, Rt.Top+2, S);
      end;
  end;

begin
  Clear;
  DrawColsRows;
  DrawColsRows2;

  if Done then  //如果做完就畫內容囉
    DrawContents;
end;

end.

好玩的MSN遊戲機器人設計

先是截此視窗的圖，然後做辨視，接著依演算法去點選。
截圖
只截取此視窗，並不可亂移動，參數一開始即確定
辨視
依圖形顏色，位置，形狀去判斷，不能判斷再重抓圖一次
演算法
先橫的由下而上，再直的由左而右
至少三點，所以要一個來記錄前兩點，
若前兩點為相同則記錄flag，
flag=y然後再第三點就去找相對位置，y就break，n就記錄(記錄此點值，並判斷與前一點是否相同，設定flag)後跳到下一點
flag=n目前點去找前二點的相對位置(依序找，相同的點才進入判斷相對位置，否則跳到下一點)看有沒有同樣的，y就break，用程式去點擊相對位置(兩個)，n就記錄(記錄此點值，並判斷與前一點是否相同，設定flag)後跳到下一點

星期三, 10月 24, 2007

cxSplitter 物件使用

假如版面上到下分別為cxGrid cxSplitter ElTree
cxGrid屬性Align = alTop
cxSplitter屬性AlignSplitter = salTop
ElTree屬性Align = alClient

cxSplitter
屬性Control = cxGrid1
屬性HotZone = MediaPlayer9

如此cxSplitter點下去，cxGrid就會不見，ElTree則往上擴展開來。

星期一, 10月 22, 2007

地圖上直接顯示股價資訊(網頁上)

累似STOCKQ，但是是顯示在全世界的地圖上，有顯示的國家用不同顏色。
所要用到的技術：
php讀取網頁http://twpug.net/modules/xfsnippet/detail.php?type=snippet&snippet_id=10
php自動更新，但只更新文字，不更新圖片。
全世界地圖製作。
原物料小圖示製作(股市不用，用地圖)。

基本上只顯示股市及原物料
將一步可再使用MSCI指數，可以較大範圍來看(如：MSCI台灣:1235)

視窗繪圖基本概念

處理畫面經常使用到Canvas物件，此物件定義於Graphics單元裡，其屬性有
Brush，其同時屬於TCanvas及TForm物件裡，在TShape物件中，Brush是用來決定填充的背景顏色或樣式，而當Brush用於Controls時，只能用於繪製背景，且此時Brush是唯讀且Run-time的屬性。

　　GDI是Graphics Device Interface 的縮寫，是作業系統在螢幕以及印表機上繪製圖形的次性統，同時也提供給應用程式透過GDI函式庫與資料結構，處理顯示與列印等相關工作，不同於之前練習的簡單空白視窗，讓我們將利用GDI處理一些有趣的東西 !!

　　基本上，視窗作業系統是採取將硬體與應用程式隔離開的策略，應用程式被禁止直接存取硬體的資源，所有跟硬體相關的工作都是由作業系統代為完成，也包括繪圖與文字顯示(文字是由許多點繪製而成)的部分，往往理所當然的簡單工作，在手工打造的過程下卻往往呈現繁複而細緻的樣貌，而GDI正是視窗應用程式用於圖形處理的主要構件，要駕馭龐雜又功能強大的GDI，往往也是對程式設計工作的一大考驗。

　　由於作業系統不允許應用程式直接存取硬體資源(顯示卡、印表機..等裝置)，但視窗應用程式又極需仰賴複雜的圖形，用來顯示與使用者互動的訊息，因此作業系統必須提供繪圖介面供應用程式使用，否則視窗將無法完成繪製圖形以及顯示文字的工作，這也就意味著在視覺的呈現上將會犧牲對使用者的吸引力。

　　由於GDI刻意對應用程式隱藏硬體裝置的細節，這也就表示，應用程式的繪圖與顯示文字的需求就必須交由GDI代為與硬體裝置溝通，這種做法可以避免視窗應用程式過度依賴特定裝置的能力，儘管GDI可以代理與裝置溝通的工作，基於使用上的目的， GDI主要是用於處理靜態的圖形輸出，因此僅具有簡單的動畫顯示能力，如果需要產生大量的動畫效果如GAME這類的應用程式，你應該更進一步的尋求DirectX或是 OpenGL這類的函式庫來解決問題。

　　不管微軟在GDI的函式庫是如何處理與硬體裝置溝通的細節，你可以簡單的將GDI視為虛擬的繪圖裝置(印表的過程也可以視為是繪圖，只是他的輸出是在印表紙上),透過GDI所提供的函式庫完成工作，這種做法，至少可以滿足二個主要的問題-簡化工作與統一管理。
簡化工作
　　在現今的PC上，裝置是由許多的廠商各自所生產的，如果應用程式都需要直接控制硬體，就必須針對各個不同廠牌以及型號單獨撰寫程式碼，而這幾乎是不可能的任務，更糟糕的情況是，以目前硬體進步的速度，可能很多軟體還沒測試出廠，就被淘汰了，對程式設計師而言這將是一場噩夢，因此由作業系統提供一個虛擬裝置的介面，實際控制的部分就由裝置的驅動程式與作業系統溝通，應用程式不需要關心實際硬體的細節，所有低階控制的部分都交由介面負責，這樣相較之下就顯得比較簡化而合理。

統一管理
　　由於視窗作業環境在同一時間往往有許多應用程式執行，而這些應用程式的視窗也必須同時輸出在螢幕上(多工作業下的正常狀況)，如果每個應用程式都想要掌握硬體的控制權，這時問題就大了，A視窗的作業可能在最大化之後遮蓋整個桌面，而擋住B視窗的資料，或是B視窗的工作會輸出在A視窗之上，這先看似理所當然的工作其實牽涉到許多麻煩的狀況，在不同視窗間的輸出區域可能會增加也可能會減少，甚至使用者移動視窗後，顯示區域也會互相重疊，甚至被破壞，因此必須有一個隨時將顯示區域恢復正常的機制，否則使用者將無法獲得正確的輸出甚至為讓視窗應用程式無法運作，由於GDI是由作業系統提供，在運用GDI函式的同時，也要求應用程式必須相對提出視窗相關資料，因此可以由作業系統判斷何者該更新或是該如何更新。

何謂全域式運算(ROP:raster operation)？當視窗系統用色筆來畫線時，它實際是在色筆的像素與顯示器表面的像素之間執行位元的布林運算。
何謂二元全域式運算(ROP2:binary raster operation)？因為畫線只牽涉兩種像素的圖案，所以布林運算亦稱為如此。

GDI圖形裝置介面 - 視窗系統內的圖形由此來操作的，控制圖形輸出設備的顯示，並在這些驅動檔案中去呼叫常式，如GDI建立可知道顯示器螢幕的.Drv將處理什麼；不處理時則自己將計算畫圖，如畫橢圓。目前都只有普通功能，若要更好的功能，則要借助DirectX及OpenGL。
圖形輸出設備區分為 1.全域式設備(raster)，如顯示器介面卡，印表機及2.向量式設備(vector)，如繪圖機。
當要在圖形輸出設備上要畫東西，你就要先取得設備環境代碼，即DC，其如當畫文字時，有文字背景、色彩及字元間隔，而GDI函數的參數只須起始點、文字、文字長度。當釋放DC時即不再有效。
取得特別一個視窗的設備環境1. hdc = BeginPaint (hwnd, &ps); //ps變數是PAINTSTRUCT型態的結構，此結構含有一個叫rcPaint的RECT(矩形)結構，該結構定義一塊能圍住視窗本文工作區無效區域的矩形，利用此傳回的環境代碼，你只能在此區域內畫圖。EndPaint(hwnd, &ps);2. hdc = GetDC(hwnd); //傳回本文工作區的視窗代碼3. hdc = GetWindowDc(hwnd); //而非只是本文工作區，此功能少用。假如你想用，必零去誘捕WM_NCPAINT(非本文北作區著畫)訊息以防止視窗系統在非本文工作區上著畫。ReleaseDC(hwnd, hdc); //釋放DC
取得整個顯示器的設備環境hdc = CreateDC(lpszDriver, lpszDevice, lpszOutput, lpData);// 如hdc = CreateDC('DISPLAY', null, null, null); // 取得一個允許我們在視窗本文工作區之外著畫的設備環境代碼;// 如hdcPrinter = CreateDC('IBMGRX', 'IBM Graphics', 'LPT1:', null); //取得印表機設備環境的代碼Delete(DC);
若只是想取得有關設備環境的資訊，並非想著畫可用hdcInfo = CreateIC(lpszDriver, lpszDevice, lpszOutput, lpData);DeleteDC(hdcInfo);// 如取得記憶體設備環境來操控某些點陣圖hdcMem = CreateCompatibleDC(hdc);DeleteDC(hdcMem);
中介檔案(metafiles)，其為寫成二進位形式之GDI呼叫的一些集合，你可用取得中介檔案設備環境來建立中介檔案：hdcMeta = CreateMetaFile(lpszFilename);hmf = CloseMetaFile(hdcMeta);在中介檔案設備環境有效期間，任何你以hdcMeta呼叫的GDI函數都變成中介檔案的一部分。當你呼叫CloseMetafile時，設備環境代碼即為無效。而函數傳回此中介檔案的代碼(hmf)。
取得設備環境資訊如顯示器大小和其色彩的相容性，可呼叫：nValue = GetDeviceCaps(hdc, nIndex);nIndex參數是定義在Windows.H中28個識別字的其中一個。例如， nIndex為HORZRES能使GetDeviceCaps傳回以像素為單位的設備寬度；而VERTRES參數傳回以像素為單位的設備高度。假如hdc是螢幕設備環境的代碼時，你所得到的資訊與從GetSystemMetrics取得的是一樣。假如hdc是印表機的設備環境代碼，則GetDeviceCaps取得以像素為單位的印表機顯示區域之高度和寬度。你可用GetDeviceCaps取得設備處理各類圖形的能力。這點對影像顯示器不重要，但如果是對印表機就很重要。例如，多數的繪圖機無法畫出點陣圖影像-這點就是由GetDeviceCaps告訴你的。
因為GDI問題在於彩色的點陣圖無法以不同的色彩組織來被儲存，和使用在圖形輸出設備上，固有個新的點陣圖被定義為獨立於設備的點陣圖稱之為DIB，因為其本身的色彩對照表便可指出像素位元如何對應到RGB色彩。

圖形區塊轉移函數有
PatBlt、BitBlt、MaskBlt、PlgBlt、TransparentBlt和StretchBlt等

PatBlt(hdc, xDest, yDest, xWidth, yHeight, dwROP);會用目前選進設備環境中的畫筆

名稱 ROP碼(16進制) 新像素點算法(P來源像素, D目的像素)
BLACKNESS 000042 全部為0
0500A9 ~(P D)
0A0329 ~P & D
0F0001 ~P
500325 ~P & -D
DSTINVERT 550009 ~D
PATINVERT 5A0049 P ^ D
5F00E9 ~(P & D)
A000C9 P & D
A50065 ~(P ^ D)
AA0029 D
AF0229 ~P D
PATCOPY F00021 P
F50225 P ~D
FA0089 P D
WHITENESS FF0062 全部為1

範例如：
procedure TForm1.Button1Click(Sender: TObject);
var
Bitmap: TBitmap;
begin
Bitmap := TBitmap.Create;
try
Bitmap.LoadFromFile('test.Bmp');
Form1.Canvas.Brush.Bitmap := Bitmap;
Form1.Canvas.FillRect(Rect(0,0,100,100));
finally
Form1.Canvas.Brush.Bitmap := nil;
Bitmap.Free;
end;
end;

procedure TForm1.Button2Click(Sender: TObject);
var
Bitmap: TBitmap;
begin
Bitmap := TBitmap.Create;
try
Bitmap.LoadFromFile('test.Bmp');
Form1.Canvas.Brush.Bitmap := Bitmap;
PatBlt(Form1.Canvas.Handle, 0, 0, 100, 100, PATCOPY); //用PATCOPY就等於FillRect
finally
Form1.Canvas.Brush.Bitmap := nil;
Bitmap.Free;
end;
end;

用BitBlt來轉換位元
BitBlt(hdcDest, xDest, yDest, xWidth, yHeight, hdcSrc, xSrc, ySrc, swROP);
名稱 ROP碼(16進制) 新像素點算法(P來源像素, D目的像素)
BLACKNESS 000042 全部為0
NOTSRCERASE 1100A6 ~(S D)
NOTSRCCOPY 330008 ~S
SRCERASE 440328 S & ~D
DSTINVERT 550009 ~D
PATINVERT 5A0049 P ^ D
SRCINVERT 660046 S ^ D
SRCAND 8800C6 S & D
MERGEPAINT BB0226 ~S D
MERGECOPY C000CA P & S
SRCCOPY CC0020 S
SRCPAINT EE0086 S D
PATCOPY F00021 P
PATPAINT FB0A09 P ~S D
WHITENESS FF0062 全部為1

用StretchBlt來擴張Bitmaps
StretchBlt(hdcDest, xDest, yDest, xDestWidth, yDestHeight, hdcSrc, xSrc, ySrc, xSrcWidth, ySrcHeight, dwROP);
當xSrcWidth和xDestWidth值之正負號不相同時，則StretchBlt會建立一個鏡子影像。

當壓縮點陣圖時，StretchBlt必須把數行或數列的像素結合成一行或一列。它根據設備環境中的延伸模式屬性可有三種方法來完成。你還可用SetStretchBltMode函數更改延伸模式：
SetStretchBltMode(hdc, nMode);
nMode之值可為下列之任一個：
BLACKONWHITE(預設值)：假如有兩個或更多個像素零被結合成一個像素時，StretchBlt對這些像素執行邏輯AND運算。結果的像素只有在所有原始像素都是白色時才會是白色，這實際意指黑色像素比白色像素更有優勢。
WHITEONBLACK：假如有兩個或更多個像素零被結合成一個像素時，StretchBlt對這些像素執行邏輯OR運算。結果的像素只有在所有原始像素都是黑色時才會是黑色，這實際意指白色像素比黑色像素更有優勢。
COLORONCOLOR：StretchBlt僅把行或列像素除走而不做任何的邏輯運算。對彩色點陣圖而言，因為其他兩種模式會使色彩遭到扭曲，所以通常這是最好的方法。

星期五, 10月 19, 2007

大數運算

先去http://www.submanifold.be/網站下載FGInt.zip回來用就可以囉~


uses FGInt;

procedure TForm1.Button1Click(Sender: TObject);
var
    a,b,c:TFGInt;
    s:string;
begin
    FGInt.Base10StringToFGInt('987654321',a); //a = 987654321
    FGInt.Base10StringToFGInt('123456789',b); //b = 123456789

    FGInt.FGIntAdd(a,b,c); // c = a + b
    FGint.FGIntToBase10String(c,s);
    showmessage(s);

    FGInt.FGIntSub(a,b,c); // c = a - b
    FGint.FGIntToBase10String(c,s);
    showmessage(s);

    FGInt.FGIntMul(a,b,c); // c = a * b
    FGint.FGIntToBase10String(c,s);
    showmessage(s);

    FGInt.FGIntDiv(a,b,c); // c = a / b
    FGint.FGIntToBase10String(c,s);
    showmessage(s);
end;

星期四, 10月 18, 2007

矩陣操作

新增9個TButton、3個TMemo、1個TLabel


unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    Memo1: TMemo;
    Button1: TButton;
    Button2: TButton;
    Button3: TButton;
    Button4: TButton;
    Button5: TButton;
    Memo2: TMemo;
    Button6: TButton;
    Button7: TButton;
    Memo3: TMemo;
    Label1: TLabel;
    Button9: TButton;
    Button8: TButton;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure Button9Click(Sender: TObject);
    procedure Button6Click(Sender: TObject);
    procedure Button7Click(Sender: TObject);
    procedure Button4Click(Sender: TObject);
    procedure Button5Click(Sender: TObject);
    procedure Button8Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
  n : array[1..100] of integer;
  a : array [1..4, 1..4] of integer;
  m : array[1..100] of integer;
  b : array [1..4, 1..4] of integer;
implementation

{$R *.dfm}
procedure swap(var a,b:integer);
var
  t : integer;
begin
  t := a;
  a := b;
  b := t;
end;

// 讀入陣列A
procedure TForm1.Button1Click(Sender: TObject);
var
  i : integer;
  F : textfile;
begin
  Memo1.clear;
  i := 0;
  AssignFile(F,'number.txt');
  reset(F);
  while not(EOF(F)) do begin
    i := i+1;
    readln(F,n[i]);
    Memo1.lines.add(inttostr(n[i]));
  end;
  closeFile(F);
end;

// 排序
procedure TForm1.Button2Click(Sender: TObject);
var
  i, j : integer;
begin
  Memo1.clear;
  for i:=1 to 15 do begin
    for j:=i+1 to 16 do
      if n[i]>n[j] then
        swap(n[i], n[j]);
    Memo1.lines.add(inttostr(n[i]));
  end;
  Memo1.lines.add(inttostr(n[16]));
end;

// 轉成矩陣(橫轉)
procedure TForm1.Button3Click(Sender: TObject);
var
  i,j : integer;
  s : string;
begin
  memo1.Clear;
  for i :=1 to 4 do begin
    s :='';
    for j :=1 to 4 do begin
      a[i,j] :=n[4*(i-1)+j];
      s := s+ inttostr(a[i,j])+' ';
    end;
    memo1.Lines.Add(s);
  end;
end;

// 轉成矩陣(直轉)
procedure TForm1.Button9Click(Sender: TObject);
var
  i,j : integer;
  s : string;
begin
  memo1.Clear;
  for i :=1 to 4 do begin
    s :='';
    for j :=1 to 4 do begin
      a[i,j] :=n[i+4*(j-1)];
      s := s+ inttostr(a[i,j])+' ';
    end;
    memo1.Lines.Add(s);
  end;
end;

// 亂數產生B矩陣
procedure TForm1.Button6Click(Sender: TObject);
var
  i, j:integer;
  s : string;
begin
  memo2.Clear;
  for i:=1 to 16 do
    m[i]:=random(100);

  for i :=1 to 4 do begin
    s :='';
    for j :=1 to 4 do begin
      b[i,j] :=m[j+4*(i-1)];
      s := s+ inttostr(b[i,j])+' ';
    end;
    memo2.Lines.Add(s);
  end;
end;

// B矩陣排序
procedure TForm1.Button7Click(Sender: TObject);
var
  i, j : integer;
  s : string;
begin
  Memo2.clear;
  for i:=1 to 15 do begin
    for j:=i+1 to 16 do
      if m[i]>m[j] then
        swap(m[i], m[j]);
  end;

  for i :=1 to 4 do begin
    s :='';
    for j :=1 to 4 do begin
      b[i,j] :=m[4*(i-1)+j];
      s := s+ inttostr(b[i,j])+' ';
    end;
    memo2.Lines.Add(s);
  end;
end;

// +
procedure TForm1.Button4Click(Sender: TObject);
var
  i, j : integer;
  s : string;
begin
  Memo3.Clear;
  for i := 1 to 4 do begin
    s := '';
    for j := 1 to 4 do begin
      s := s + inttostr(a[i,j] + b[i,j]) + ' ';
    end;
  Memo3.Lines.Add(s);
  end;
end;

// -
procedure TForm1.Button5Click(Sender: TObject);
var
  i, j : integer;
  s : string;
begin
  Memo3.Clear;
  for i := 1 to 4 do begin
    s := '';
    for j := 1 to 4 do begin
      s := s + inttostr(a[i,j] - b[i,j]) + ' ';
    end;
  Memo3.Lines.Add(s);
  end;
end;

procedure TForm1.Button8Click(Sender: TObject);
var
  i, j, k, max, min : integer;
begin
  Memo3.clear;
  for j := 1 to 4 do begin     //列
    min := 1;
    for i := 2 to 4 do
      if a[j,i]        min := i;

    max := j;
    for k := 1 to 4 do
      if (a[k,min]>a[j,min]) and (k<>j) then  //k不能=j
        max := k;

    if max=j then
      Memo3.lines.add('鞍點在：'+inttostr(j)+', '+inttostr(min))
    else
      Memo3.lines.add('沒有鞍點');
  end;
end;

end.

很無聊時學寫Power函數


function power(base, n : integer) : int64;
var
  i : integer;
  t : int64;
begin
  t := 1;
  for i := 1 to n do
    t := t * base;
  power := t;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  showmessage(inttostr(power(4, 3)));
end;

字串及陣列寫入及讀取檔案

新增4個TButton、1個TMemo、2個TEdit


unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    Button1: TButton;
    Button2: TButton;
    Button3: TButton;
    Button4: TButton;
    Memo1: TMemo;
    Edit1: TEdit;
    Edit2: TEdit;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure Button4Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);
var
  F : textfile;
begin
  AssignFile(F,'data.txt');
  ReWrite(F);

  //寫入數據
  WriteLn(F, Edit1.Text);
  WriteLn(F, Edit2.Text);
  CloseFile(F);
  Showmessage('寫入成功');
end;

procedure TForm1.Button2Click(Sender: TObject);
var
  F : textfile;
  s1,s2 : string;

begin
  AssignFile(F,'data.txt');
  Reset(F);
  //讀取數據
  ReadLn(F, s1); //不能直接寫Edit1.Text
  ReadLn(F, s2); //不能直接寫Edit2.Text
  Edit1.Text := s1;
  Edit2.Text := s2;
  CloseFile(F);
  Showmessage('讀取成功');
end;

procedure TForm1.Button3Click(Sender: TObject);
var
  n : array[1..100] of integer;
  i : integer;
  F : textfile;
begin
  AssignFile(F,'number.txt');
  Rewrite(F);
  for i := 1 to 100 do
  begin
    n[i] := i;
    Writeln(F,n[i]);
  end;
  CloseFile(F);
  Showmessage('寫入成功');
end;

procedure TForm1.Button4Click(Sender: TObject);
var
  n : array[1..100] of integer;
  i : integer;
  F : textfile;
begin
  AssignFile(F,'number.txt');
  Reset(F);
  i := 0;
  while not(EOF(F)) do begin
    i := i+1;
    Readln(F, n[i]);
    Memo1.Lines.add(inttostr(n[i]));
  end;
  closeFile(F);
  Showmessage('讀取成功');
end;

end.

星期二, 10月 16, 2007

開啟資料夾並搜尋檔案及得知其檔案大小

此可以做為新增MP3歌曲的功能，只要加入某個最上層目錄，就可以自動加入所有子目錄及其音樂。

新增2個TButton、1個TEdit、1個TMemo(ScrollBars屬性ssBoth)
兩個按鈕皆點兩下加入事件


unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    Memo1: TMemo;
    Edit1: TEdit;
    Button1: TButton;
    Button2: TButton;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
  private
    procedure GetFileSize(sPath : string);
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1 : TForm1;
  Path : string;

implementation

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);
var
  Dir: String;
begin
  Dir := '';
  if SelectDirectory('選擇文件夾', '', Dir) then
  begin
    if Copy(Dir,Length(Dir),1) <> '\' then
      Dir := Dir + '\';
    Edit1.text := Dir;  //Edit1顯示路徑
    Path := Dir;  //Path全域變數記錄Dir
  end;
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
  GetFileSize(Edit1.text);
end;

procedure TForm1.GetFileSize(sPath : string);
var
  hFind     : THandle;
  filename, fPath  : string;
  nSize     : Int64;
  fd        : WIN32_FIND_DATA;
begin
  hFind:=Windows.FindFirstFile(PChar(sPath + '*.*'), fd); //所有檔案都找
  if(hFind <> INVALID_HANDLE_VALUE) then
  begin
    repeat
      filename:=fd.cFileName;
      fPath := sPath + filename;
      if((filename = '.') or (filename = '..')) then //不是上層 或 上上層
        Continue;
      if(fd.dwFileAttributes and FILE_ATTRIBUTE_DIRECTORY) > 0 then //是否為目錄
      begin
        GetFileSize(fPath + '\'); //遞迴呼叫 跑子目錄
      end else begin
        nSize:=fd.nFileSizeHigh;
        nSize:=nSize shl 32;
        nSize:=nSize or fd.nFileSizeLow;
        Memo1.lines.add(fPath+'       Size='+inttostr(nSize)=' bytes');
      end;
    until (not Windows.FindNextFile(hFind, fd));
    Windows.FindClose(hFind);
  end;
end;

end.

星期一, 10月 15, 2007

防止軟體程式重複被執行兩次


program Project1;

uses
  ExceptionLog,
  Forms,
  windows,
  Unit1 in 'Unit1.pas' {Form1};

{$R *.res}
var
  Mutex : THandle;

begin
  Mutex := CreateMutex(nil, false, pchar(application.title));
  if (Mutex = 0) OR (GetLastError = ERROR_ALREADY_EXISTS) then
  begin
    Application.MessageBox('不能重覆執行程式','一次只能執行一個程式',mb_ok);
    // code to searh for, and activate
    // the previous (first) instance
    //Application.terminate;
  end else begin
    Application.Initialize;
    Application.CreateForm(TForm1, Form1);
    Application.Run;
    if Mutex <> 0 then
      CloseHandle(Mutex);
  end;
end.

參數傳遞


unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

type
  TString20 = String[20];

type
  TDigits = array[1..10] of integer;

type
  TDigits1 = array of integer; //開放式宣告方式

var
  Form1: TForm1;

implementation

{$R *.dfm}
//參數傳值
function DoubleByValue(X : Integer) : Integer;
begin
  X := X *2 ;
  Result := X ;
end;

//變數參數
function DoubleByRef(var X : Integer) : Integer; //變數傳入可再改變X變數，並不會有備份變數產生
begin
  X := X * 2 ;
  Result := X ;
end;

//常數參數
function DoubleByCns(Const X : integer) : Integer;//編譯程式可以對於結構型別或字串型別的參數，產生最佳化的機器碼。也可以提供一層安全防護，避免不小心把參數以變數參數的方式，
begin
  Result := 8;
  if X = 4 then
    Result := 4;
end;

//輸出參數
procedure GetInfo(out Info : string);
begin
  Info := 'ShowInfo';
end;

//字串參數傳入
procedure Check(S : TString20); //因為不能傳入 procdure Check(S : String[20]); //語法錯誤 所以要自定型別
begin
  showmessage(S);
end;

//陣列參數傳入
procedure Sort(A : TDigits);  //因procdure Sort(A ： array[1..10] of integer)； // 語法錯誤
begin

end;

//陣列參數傳入
function Find(A : array of Char):Integer; //宣告了一個叫做Find的函式，這個函式可以接受一個任意大小的字元陣列當參數，並且傳回一個整數值
begin
  Result:=0;
end;

//預設參數值
procedure FillArray(A : Integer; B : Integer = 0); //不可以前有後沒有procedure FillArray(A : Integer = 0; B : Integer);不可以寫在一起procedure FillArray(A, B : Integer = 0);
begin

end;

procedure TForm1.Button1Click(Sender: TObject);
var  
  test: array of DifBlk;
  I, J, V, W, N, M : integer;
  MyRecord : string;
begin
  I := 4;
  V := 4;
  N := 4;
  J := DoubleByValue(I); // J= 8 ； I = 4
  W := DoubleByRef(V); // W = 8 ； V = 8
  M := DoubleByCns(N); // N = 8 ； V = 8

  GetInfo(MyRecord); //MyRecord只是一個放資料的容器，GetInfo可以把產生的資料放在裡頭 。呼叫GetInfo時候，在程式的控制權轉移到GetInfo之前，MyRecord所佔用的記憶體就會自動解除。
  showmessage(MyRecord);

  Check('CC');

  //FillArray(MyI);即等於  FillArray(MyI, 0);
end;

end.

將錯誤的Log/.及LPM/*.LPM檔案刪除

主程式修改：花費我二、三天的時間來認識anderson的程式

訂閱：文章 (Atom)

程式學

關於我自己

Archives

Subscribe

Powered By