顯示具有 Delphi基礎 標籤的文章。 顯示所有文章
顯示具有 Delphi基礎 標籤的文章。 顯示所有文章

星期三, 8月 31, 2011

MemoryStream To String

The code you have is unnecessarily complex, even for older Delphi versions. Why should fetching the string version of a stream force the stream's memory to be reallocated, after all?
function MemoryStreamToString(M: TMemoryStream): string;

begin
SetString(Result, M.Memory, M.Size div SizeOf(Char));
end;

That works in all Delphi versions, not just Delphi 2009. It works when the stream is empty without any special case. SetString is an under-appreciated function.

If the contents of your stream aren't changing to Unicode with your switch to Delphi 2009, then you should use this function instead:
function MemoryStreamToString(M: TMemoryStream): AnsiString;

begin
SetString(Result, M.Memory, M.Size);
end;

That's equivalent to your original code, but skips the special cases.

星期四, 11月 11, 2010

開啟檔案,若失敗就跳出選擇關聯程式清單


if OpenDialog1.execute then
begin
if ShellExecute(handle, 'Open', PChar(OpenDialog1.FileName), nil, nil, SW_NORMAL) = SE_ERR_NOASSOC then
ShellExecute(GetDesktopWindow, nil, 'RUNDLL32.EXE',
PChar('shell32.dll, OpenAs_RunDLL ' + OpenDialog1.FileName),
PChar(ExtractFilePath(ParamStr(0))), SW_NORMAL);
end;

星期五, 3月 27, 2009

建立classname,然後可以幫助判斷該classname是否關閉

註冊classname

public
procedure createparams(var params:tcreateparams);override;

const
TSFPatch729ClassName = 'abcde';

procedure TForm1.CreateParams(var Params: TCreateParams);
begin
inherited;
StrCopy(Params.WinClassName, _TSFPatch729ClassName);
end;

判斷classname

const
TSFPatch729ClassName = 'abcde';

begin
while isWindow(FindWindow(_TSFPatch729ClassName,nil)) do
begin
sleep(300);
end;
end;

星期二, 4月 08, 2008

開始寫Delphi程式要注意的事

Project -> options > Compiler -> Code generation -> 取消勾選Optimization
Tool -> Environment Options -> Delphi Direct -> 取消勾選Automatically poll network

Form 屬性scaled設成false 屬性設字型大小建議用Height

星期一, 12月 03, 2007

幫執行檔(exe)加上一些資訊

Project->Options->Version Info
勾選 Include version information in project
然後看要加什麼在執行檔的資訊:

檔案版本 Module version number
說明 FileDescription
著作權 LegalCopyright

內部名稱 InternalName
公司名稱 Company Name
合法商標 LegalTrademarks
原始檔名 OriginalFilename
產品名稱 ProductName
產品版本 ProductVersion
語系 Language
說明 Comments

星期三, 11月 07, 2007

指標的使用


procedure TForm1.Button1Click(Sender: TObject);
var
P: ^Integer; //P為一個指標,指標內存變數為Integer
X: Integer;
begin
P := @X; //用@ 符號把另一個相同類型變數的地址賦給它
// 改變此位址的值有兩種方法
X := 10;
P^ := 20;
end;

procedure TForm1.Button2Click(Sender: TObject);
var
P: ^Integer;
begin
// initialization
New (P); //動態分配內存
// operations
P^ := 20;
ShowMessage (IntToStr (P^));
// termination
Dispose (P); //記得在此釋放喔
end;

procedure TForm1.Button3Click(Sender: TObject);
var
P: ^Integer;
begin
P := nil; //空指標如果還要顯示,那要加nil,否則會出現"一般保護錯"(GPF)的錯誤
ShowMessage (IntToStr (P^));
end;

procedure TForm1.Button4Click(Sender: TObject);
var
P: ^Integer;
X: Integer;
begin
P := @X;
X := 100;
if P <> nil then //所以結論用此來顯示,會比較安全
ShowMessage (IntToStr (P^));
end;

星期二, 11月 06, 2007

Parent ,Owner ,Sender ,Self ,is ,as 的用法

甚麼是Parent?
Parent 就是直接包含物件本身的 container (容器)。
例如:在 form1上加上一個 button1,則 button1的 parent就是 form1,若在 form1上加上一個 panel1,然後在 panel1上再加上一個 button2,則 panel1的 parent就是 form1,而 button2 的 parent 就是 panel1。

甚麼是 Owner ?
Owner 表示物件的擁有者,owner主要負責兩件事,一是owner的記憶體空間被移除時,其所擁有的物件亦將同時被移除。二是 owner須負責載入及儲存 被擁有者的published屬性。
通常一個表單 form擁有在其上的所有元件,所以表單被移除時,其上面的元件之記憶體空間亦將被移除。
一個應用程式則擁有所有的表單,所以應用程式結束時,所有元件擁有的記憶體亦將移除。

甚麼是 sender ?
Sender就是觸發這個事件的物件。
例如:
在 form1上加上四個 button (button1, button2, button3, button4) 及一個 edit1。
button1的 onclick事件加上指令如下:

procedure TForm1.Button1Click(Sender: TObject);
begin
if sender is Tbutton then
showmessage(Tbutton(sender).Caption)
else if sender = nil then
showmessage('no sender')
else if sender = edit1 then
showmessage('from edit1');
end;

button2 的 onclick事件,點選 Button1click。
button3 的 onclick 事件,寫上下列指令

procedure TForm1.Button3Click(Sender: TObject);
begin
button1Click(nil);
end;

button4 的 onclick 事件,寫上下列指令

procedure TForm1.Button4Click(Sender: TObject);
begin
button1click(edit1);
end;

edit1 的 onclick 事件,點選 Button1Click。
F9執行後,分別點選button1, button2, button3, button4, edit1,觀察其結果。

甚麼是 is ?
is 是一個運算子,用來判斷一個物件是否屬於某一種類別或其繼承者。
語法: object is class
例如: if sender is Tedit then ...
if sender is Tobject then .... //只要是物件,則永遠成立,因所有物件皆繼承 Tobject。

甚麼是 as ?
as 是一個運算子,可以將一個物件指定成某一種類別,若型態錯誤,將傳回 EInvalidCast之例外。
例如:showmessage((sender as Tbutton).caption); // 如果 sender 在執行階段為 Tbutton 則可顯示caption屬性。

甚麼是 self?
Self是指目前程式碼所屬的物件。
例如:
procedure TForm1.Button1Click(Sender: TObject);
begin
self.color:=clred; // self 表示 form1
end;

星期一, 10月 29, 2007

例外處理

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

星期一, 10月 22, 2007

視窗繪圖基本概念

處理畫面經常使用到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月 18, 2007

很無聊時學寫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;

星期一, 10月 15, 2007

參數傳遞


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.

星期四, 10月 04, 2007

如何加入Res資源檔(讓你可以將bmp、txt、dll、jpg檔...跟exe檔包在一起)

首先要有資源檔製作工具,裡面包括有:
_BuildRes.bat
Build.ini
Build.rc
ZPack.exe
及你要包的檔案(在此我是加入Wording0.txt及Wording1.txt多國語言版)

然後先編輯Build.ini,其內容如下:

[System]
Extention=.Tmp

;程式所要使用到的檔案列表,這些檔案會被ZPack包成.Tmp檔。
[Files]
0=Wording0.txt
1=Wording1.txt


然後執行
_BuildRes.bat
就會產生Build.RES及BUILD.Tmp。

這時將Build.RES複製到你主程式的目錄內。

在主程式{$R *.dfm}的後面加上下面這一行:

{$R build.res}


並加入UZPack.pas及URandomString到你的專案內:
其程式碼如下:

unit UZPack;

interface

uses
Windows, Classes, SysUtils, {FileCtrl,} ZLib, Forms, URandomString;

function ExtractDLL(APath, ASrcFilename: String; ARenameFile: Boolean): String;
//function ExtractDLL2(APath, ASrcFilename: String; ARenameFile: Boolean): String;

implementation

//uses ULogFileOut ;

//==========================================================================
function MyUpcase(S:string):string;
var L,D:Integer;
P,Q:PChar;
C:char;
begin
L:=Length(S); P:=@S[1];
while L>0 do begin
Q:=CharNext(P); D:=Q-P;
if D=1 then begin
C:=P^;
if (C>='a') and (C<='z') then P^:=char(byte(C) and $DF);
end;
dec(L,D); P:=Q;
end;
Result:=S;
end;

//==========================================================================
function FindName(F:string; G:TStream):string;
var Sz:DWord;
L:byte;
Fn:array[0..255] of char;
begin
Result:='';
F:=MyUpCase(F);
while G.Position < G.Size do begin // Search file name
G.Read(L,Sizeof(L)); G.Read(Fn,L); Result:=StrPas(Fn);
if (F=StrPas(Fn)) or (F='') then break; // Find
G.Seek(4,1); // Skip
G.Read(Sz,Sizeof(Sz)); G.Seek(Sz,1);
Result:='';
end;
end;

//==========================================================================
function LoadZip(Tag,Zip:TStream):DWord;
var Z:TDecompressionStream;
L:DWord;
begin
Tag.Size:=0;
Zip.Read(L,Sizeof(L));
Zip.Read(Result,Sizeof(Result));
Z:=TDecompressionStream.Create(Zip);
Tag.CopyFrom(Z,L);
Tag.Seek(0,0);
Z.Free;
end;

//==========================================================================
function Unpack(P,FileName:string; ChangeName:Boolean):TStringList;
var T:TStream;
s,
G,N:string;
X:TStream;
begin
Result:=TStringList.Create;
try
P:=MyUpCase(P); ForceDirectories(P);
T:=TResourceStream.Create(HInstance,'ZIPDATA','FINEART');
if Assigned(T) then begin
repeat
N:=FindName(FileName,T);
if N<>'' then begin
if ChangeName then
begin
s := RandomAlphabetString(0, 8, True);
G:=Format('%s%s%s',[P,s,ExtractFileExt(N)]);
end
else
G:=P+N;
X:=TFileStream.Create(G,fmCreate);
if Assigned(X) then begin
LoadZip(X,T);
Result.AddObject(Format('%s=%s',[N,G]),TObject(X.Size));
X.Free;
end;
end;
until N='';
T.Free;
end;
except
end;
end;

{==============================================================================}
{ 函式敘述: }
{ 將以ZPack包在程式Resource中的檔案解出來到特定目錄。 }
{ 參數: }
{ APAth: }
{ 要解到哪個目錄。 }
{ ASrcFilename: }
{ 要解出哪個檔案。 }
{ ARenameFile: }
{ 解出來的檔案是否要換成隨機的檔名。 }
{ 傳回值: }
{ 若成功解出,會傳回該檔案的完整路徑檔名。否則傳回空字串。 }
{==============================================================================}
function ExtractDLL(APath, ASrcFilename: String; ARenameFile: Boolean): String;
var
L: TStringList;
begin
Result := ExtractFilePath(Application.ExeName) + ASrcFilename;
L := Unpack(APath, ASrcFilename, ARenameFile);
if L.Count > 0 then
begin
Result := L[0];
Result := Copy(Result, AnsiPos('=', Result) + 1, Length(Result));
end;
L.Free;
if not FileExists(Result) then
Result := '';
end;

{
function ExtractDLL2(APath, ASrcFilename: String; ARenameFile: Boolean): String;
var
L: TStringList;
begin
Result := APath + ASrcFilename;
L := Unpack(APath, ASrcFilename, ARenameFile);
DDLOG('Unpack pathname :' + Result ) ;
if L.Count > 0 then
begin
Result := L[0];
Result := Copy(Result, AnsiPos('=', Result) + 1, Length(Result));
DDLOG('L.Count>0: ' + Result ) ;
end;
L.Free;
if not FileExists(Result) then
Result := '';
end;
}
end.



unit URandomString;

interface

function RandomAlphabetChar(Caps: Byte=0): Char;
function RandomAlphabetString(Caps: Byte=0; ALength: Integer=0;
WantNum: Boolean=false): String;

implementation

(*======================================================
隨機取一個英文字母
Parameter:
Caps: 是否限制大小寫
0 : 不限
1 : 大寫字母
2 : 小寫字母
Return:
傳回亂數取得的英文字母
*)
function RandomAlphabetChar(Caps: Byte=0): Char;
begin
Result:=Chr($61+Random(26));
Case Caps of
0:
begin
// 隨機決定大小寫
if Random(2)=1 then
Result:=UpCase(Result);
end;
1:
Result:=UpCase(Result);
end;
end;

(*======================================================
隨機產生一個字串
Parameter:
Caps: 是否限制大小寫
0 : 不限
1 : 大寫字母
2 : 小寫字母
Length: 字串長度,若為0則長度為1~10的不定長度值
WantNum:是否要夾雜有數字
true : 要夾雜數字
false: 不要有數字
Return:
傳回隨機產生的字串
*)
function RandomAlphabetString(Caps: Byte=0; ALength: Integer=0;
WantNum: Boolean=false): String;
var
i: Integer;
iLen: Integer;
begin
// 要產生的字串長度
if ALength=0 then
iLen:=Random(10)+1
else
iLen:=ALength;

Result:='';
for i:=0 to iLen-1 do
begin
if WantNum then
if Random(2)=1 then
begin
Result:=Result+Chr(Random(10)+$30);
continue;
end;
Result:=Result+RandomAlphabetChar(Caps);
end;
end;

end.


皆接在讀取文字檔的ULang.pas內,先按ALT+F11加入uses UZPack。
並判斷如果目錄下沒有多國語言文字檔的話,則讀取資源檔,程式碼如下:

//初始化字串檔(解檔及取得檔名) by v
function InitStringFile():boolean;
var
sStringFileName:string;
begin
//result:=false;
g_cLang := GetLanguage;// 取得系統語系
//g_cLang := '1';//
if not (g_cLang in ['0','1','2','3']) then
g_cLang := '2' ;// 目前只提供四種語言,內訂英文

sStringFileName:='wording' + g_cLang + '.txt' ;
g_sStrFile:=g_sWorkPath +sStringFileName;
//showmessage(g_sStrFile);

//檢查目前執行環境同目錄下,若無字串檔,則解檔案至 temp 路徑下
if not FileExists(g_sStrFile) then
begin
g_sStrFile:=g_sTempPath+sStringFileName;
if( StrIComp(PChar(ExtractDLL(g_sTempPath, sStringFileName, false)),PChar(g_sStrFile)) <> 0 ) then // 解壓縮文字檔
begin
result:=False;
//showmessage('Extract wording file failed !');
exit;
end ;
end;

result:=true;
end;



另外想解壓縮mdb放到temp目錄下,又不想刪除,可用下列的方式
新增UCommon.pas

unit UCommon;

interface

uses Windows, SysUtils;

procedure InitGlobalVariable;
function GetWorkDirectory:String;
function GetTmpDirectory(): string ;
function ExtractZpackFile(filename:String):String;

var
g_sTempPath : string; // (TempPath)
g_sWorkPath : string; // (WorkingPath)

implementation

uses UZPack;

procedure InitGlobalVariable;
begin
g_sWorkPath:=GetWorkDirectory();
g_sTempPath:=GetTmpDirectory();
createdir(g_sTempPath+'QooFunds'); //在%temp%\下建立QooFunds資料夾
g_sTempPath:=g_sTempPath + 'QooFunds\';
end;

function GetWorkDirectory;
var
aBuf: array[0..260] of Char;
begin
GetModuleFileName(HINSTANCE, @aBuf[0], SizeOf(aBuf));
Result := IncludeTrailingBackslash(ExtractFilePath(StrPas(aBuf)));
end;

function GetTmpDirectory(): string ;
var
dwBuffSize : DWORD ;
cBuffer : array[0..MAX_PATH] of char ;
begin
dwBuffSize := MAX_PATH ;
GetTempPath( dwBuffSize, cBuffer) ;
Result := cBuffer ;
end ;

function ExtractZpackFile(filename:String):String;
var
sPathName : string ;
begin
sPathName := g_sTempPath + filename ;
if not FileExists(sPathName) then
if( StrIComp(PChar(ExtractDLL(g_sTempPath, filename, false)),PChar(sPathName)) <>0 ) then
begin
// ErrMsgBox('Extract report templete failed') ;
Halt ;
end ;
Result:= sPathName;
end;

end.

project1

program Project1;

uses
ExceptionLog,
Forms,
Unit1 in 'Unit1.pas' {Form1},
UZPack in 'UZPack.pas',
URandomString in 'URandomString.pas',
UCommon in 'UCommon.pas';

{$R *.res}
{$R build.res}

begin
InitGlobalVariable;

Application.Initialize;
Application.CreateForm(TForm1, Form1);
Application.Run;
end.


主視窗開始加入

uses UZPack, UCommon;

procedure TForm1.FormCreate(Sender: TObject);
begin
sTemplateFile:=ExtractZpackFile('我的基金.mdb');

ADOConnection1.ConnectionString := 'Provider=Microsoft.Jet.OLEDB.4.0;User ID=Admin;Data Source='+sTemplateFile+';Mode=Share Deny None;Persist Security Info=False;Jet OLEDB:Engine Type=5';
try
ADOConnection1.Connected := True;
except
Showmessage('連線失敗!');
end;
end;

星期二, 10月 02, 2007

一維、二維的固定、動態大小陣列宣告及使用


procedure TForm1.Button1Click(Sender: TObject);
var
//固定一維、二維陣列
A1 : array[1..10] of Integer; //設定範圍
A2 : array[1..10,1..10] of Integer;

//動態一維、二維陣列
B1, D : Array of Integer;
B2 :array of array of Integer;
const
//常數一維、二維陣列
C1: array[0..6] of String = ('日', '一', '二', '三', '四', '五', '六');
C2: array[0..6,0..1] of String = (('日','7'), ('一','1'), ('二','2'), ('三','3'), ('四','4'), ('五','5'), ('六','6'));
//也可用
//C2: array[0..6] of array[0..1] of String = (('日','7'), ('一','1'), ('二','2'), ('三','3'), ('四','4'), ('五','5'), ('六','6'));
begin
SetLength(B1,10); //代表給定 B1[0..9]
SetLength(B2,10,10); //代表給定 B2[0..9][0..9]

B1[1]:=5;
A1[2]:=4;
B2[1][1]:=2;

A1[1] := 1; // 不能用A1[0]

showmessage(inttostr(B1[1])); //顯示5
showmessage(inttostr(B2[1][1]));

// Low及High的使用 (目前使用只能取回有一維的起始值)
showmessage(inttostr(Low(B1))); //顯示0
showmessage(inttostr(High(B1))); //顯示9

// Copy的使用
D := Copy(B1); //用Copy 不加參數則會將 B1 陣列全部Copy 到D陣列去 ps:動態宣告可用而已

// 如何釋放
SetLength(B1,0);//這裡申請將B1釋放
B1:=nil;//釋放B1
end;

星期五, 9月 14, 2007

資料結構範例


unit Unit1;

interface

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

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

type
TDateRec = record
Year: integer;
Month: (Jan,Feb,Mar,Apr,May,Jun,Jul,Aug,Sep,Oct,Nov,Dec); //Month為1月到12月的英文字
Day: 1..31; //day為1~31的數值
end;

type
Name = record
FirstName: string;
LastName: string;
end;

type
Employee = record
EmName: Name; //Name為上面定義的結構包括FirstNmae及LastName
Addr: string;
Phone: string;
Salary: integer;
end;

var
Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);
var
test: Employee; //這兩個結構之後用到,可以得知Name的結構並不須要宣告
Dnow: TdateRec;
begin
test.EmName.FirstName:='123';
test.Addr :='456';
test.Phone:='333';
Dnow.year:=2006;
Dnow.Month:=Jun;
Dnow.Day :=30;
end;
end.

星期三, 9月 12, 2007

Delphi 中的顏色

clBlack黑色Black
clMaroon栗色Maroon
clGreen綠色Green
clOlive橄欖綠Olive green
clNavy深藍色Navy blue
clPurple紫色Purple
clTeal深青色Teal
clGray灰色Gray
clSilver銀色Silver
clRed紅色Red
clLine淺綠色Lime green
clBlue藍色Blue
clFuchsia紫紅色Fuchsia
clAqua淺綠色Aqua
clWhite白色White
clBackground當前的系統桌面的背景顏色
clActiveCaption當前的被激活窗口的標題欄的顏色
clInactiveCaption當前的沒有被激活的窗口的標題欄的顏色
clMenu當前的菜單背景的顏色
clWindow當前的窗口背景的顏色
clWindowFrame當前的窗口框架的顏色
clMenuText當前的菜單上的文本的顏色
clCaptionText當前的被激活窗口的標題欄的文本的顏色
clActiveBorder當前的被激活窗口的邊界顏色
clInactiveBorder當前的沒有被激活窗口的邊界顏色
clAppWorkSpace當前的應用程序工作區的顏色
clHighlight當前的被選擇文本的背景顏色
clHighlightText當前的被選擇文本的顏色
clBtnFace當前的按鈕表面的顏色
clBtnShadow當前的按鈕投影的陰影顏色
clGrayText當前的無效文本的顏色
clBtnText當前的按鈕上文本的顏色
clInactiveCaptionText當前的被激活窗口標題欄的文本顏色
clBtnHighlight當前的按鈕上高亮度的顏色
cl3DDkShadow只有對Windows95或NT4.0系統:三維顯示元素陰影的顏色
cl3DLight只有對Windows95或NT4.0系統:對於三維顯示元素的亮面(朝向光源的面)
clInfoText只有對Windows95或NT4.0系統:ToolTip(工具提示)的文本顏色
clInfoBk只有對Windows95或NT4.0系統:ToolTip(工具提示)的背景顏色