Delphi Function 中文說明函式及簡要範例

Delphi Function 中文說明函式及簡要範例

▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼

======================================================================

數學函數 (Arithmetic Routines)

Unit: System

======================================================================

Abs        傳回參數的絕對值。        function Abs(X);

ArcTan    傳回正切函數的反函數值。    function ArcTan(X: Real): Real;

Cos        傳回餘弦函數值        function Cos(X: Real): Real;

        (X 以弧度為單位)。       

Exp        傳回自然指數值。        function Cos(X: Real): Real;

Frac    傳回參數的小數部份。        function Frac(X: Real): Real;

Int        傳回參數的整數部份。        function Int(X: Real): Real;

Ln        傳回自然對數值。        function Ln(X: Real): Real;

Pi        傳回圓周率π的值。        function Pi: Real;

Sin        傳回正弦函數值。        function Sin(X: Real): Real;

Sqr        傳回參數的平方。        function Sqr(X: Real): (Real);

Sqrt    傳回參數的平方根。        function Sqrt(X: Real): Real;

===========================================================================

控制台函數 (Console Routines)

===========================================================================

Unit: WinCrt

函數名稱        函數說明        函數語法

===========================================================================

AssignCrt 將文字檔連結到一個控制台視窗。    procedure AssignCrt(var f: Text);

ClrEol    清附游標位置到該行最後的所有字元。procedure ClrEol;

ClrScr    清附螢幕並重置游標至左上角。    procedure ClrScr;

CursorTo 移動游標至給定座標。        procedure CursorTo(X, Y:Integer);

DoneWinCrt 結束控制台視窗。        procedure DoneWinCrt;

GotoXY    移動游標至給定座標。        procedure GotoXY(X, Y: Byte);

InitWinCrt 建立控制台視窗。        procedure InitWinCrt;

KeyPressed 判斷是否有一按鍵。        function KeyPressed:Boolean;

ReadBuf    從控制台視窗讀入一行。       

function ReadBuf(Buffer: Pchar;Count: Word):

ReadKey 讀取按鍵字元。        function ReadKey: Char;

ScrollTo 捲動控制台視窗至顯示位置。    procedure ScrollTo(X, Y: Integer);

TrackCursor 捲動控制台視窗宜到游標可見。procedure TrackCursor;

WhereX 傳回游標的X 座標。        function WhereX: Byte;

WhereY 傳回游標的Y 標標。        function WhereY: Byte;

WriteBuf 寫入一區塊字元到控制台視窗。 procedure WriteBuf

WriteChar 寫一個字元到控制台視窗。    procedure WriteChar(CH: Char);

=================================================

日期與時間函數 (Date and Time Routines)

Unit: SysUtils

========================================

Date 傳回今天日期。function Date: TDateTime;

DateTimeToStr 將時間格式轉為字串。function DateTimeToStr(DateTime: TDateTime):String;

DateTimeToString 將時間格式轉為字串。

procedure DateTimeToString(var Result: string;const Format: string;DateTime: TDateTime);

DateToStr 將日期格式轉為字串。function DateToStr(Date: TDateTime): String;

DayOfWeek 傳回今天星期幾。function DayOfWeek(Date: TDateTime): Integer;

DecodeDate 分解所指定的日期為年、月、日。

procedure DecodeDate(Date: TDateTime;var Year, Month, Day:Word);

DecodeTime 分解所指定的日期為時、分、秒。

procedure DecodeTime(Time: TDateTime;var Hour, Min, Sec,MSec: Word);

EncodeDate 傳回將年、月、日所組合的日期格式。

function EncodeDate(Year, Month, Day: Word):TDateTime;

EncodeTime 傳回將時、分、秒所組合的時間格式。

function EncodeTime(Hour, Min, Sec, MSec:Word): TDateTime;

FormatDateTime 以指定的格式傳回日期時間。

function FormatDateTime(const Format: string;DateTime: TDateTime):String;

Now 傳回現在的日期時間。function Now: TDateTime;

StrToDate 將字串轉為日期格式。function StrToDate(const S:string): TDateTime;

StrToDateTime 將字串轉為日期時間格式

function StrToDateTime(const S: string): TDateTime;

StrToTime 將字串轉為時間格式。function StrToTime(const S:string): TDateTime;

Time 傳回現在時間。function Time: TDateTime;

TimeToStr 將時格式轉為字串。function TimeToStr(Time:TDateTime): String;

========================================

動態配置函數(Dynamic Allocation Routines)

Unit: System

========================================

Dispose 釋回一個動態變數。procedure Dispose(var P: Pointer);

Free 釋放一個物件複本。procedure Free;

FreeMem 釋回一給定大小的動態變數。

procedure FreeMem(var P:Pointer; Size: Word);

GetMem 建立一個指定大小的動態變數，並由Pointer 參數傳回位址。

procedure GetMem(var P:Pointer; Size: Word);

New 建立一個新的動態變數，並將Pointer 參數指向它。

procedure New(var P: Pointer);

function New():Pointer;

MaxAvail 傳回連續最大的可配置空間。function MaxAvail: Longint;

MemAvail 傳回所有的可配置空間。function MemAvail: Longint;

========================================

檔案管理函數

Unit: SysUtils

========================================

ChangeFileExt 變更檔案的延伸檔名。

function ChangeFileExt(const FileName,Extension: string):string;

DateTimeToFileDate 將Delphi 的日期格式轉換為DOS的日期格式。

functionDateTimeToFileDate(DateTime:TDateTime): Longint;

DeleteFile 刪除一個檔案。

function DeleteFile(const FileName: string):Boolean;

DiskFree 傳回磁碟的可用空間。function DiskFree(Drive: Byte): Longint;

DiskSize 傳回指定磁碟的容量大小。function DiskSize(Drive: Byte): Longint;

ExpandFileName 傳回一個完整的路徑及檔名字串。

function expandFileName(const FileName: string):string;

ExtractFileExt 傳回檔案的延伸檔名。

function ExtractFileExt(const FileName string):string;

ExtractFileName 傳回檔案的檔名。

function ExtractFileName(const FileName: string):string;

ExtractFilePath 傳回檔案的路徑。

function ExtractFilePath(const FileName: string):string;

FileAge 傳回檔案的年紀function FileAge(const FileName: string):Longint;

FileCreate 以指定檔名建立一個檔案。

function FileCreate(const FileName: string):Integer;

FileClose 關閉指定的檔案。procedureFileClose(Handle: Integer);

FileDateToDateTime 將DOS 的日期格式轉為Delphi 的日期格式。

function FileDateToDateTime(FileDate: Longint):TDateTime;

FileExists 判別檔案是否存在。function FileExists(const FileName: string):Boolean;

FileGetAttr 傳回檔案屬性。function FileGetAttr(const FileName: string):Integer;

FileGetDate 傳回檔案的日期及時間。function FileGetDate(Handle: Integer): Longint;

FileRead 從指定的檔案讀入資料。

function FileRead(Handle:Integer; var Buffer;Count:Longint):Longint;

FileSearch 在目錄列中搜尋指定的檔案。

function FileSearch(constName, DirList: string):string;

FileSeek 改變檔案游標的位置。

function FileSeek(Handle: Integer;Offset: Longint;Origin: Integer):Longint;

FileSetAttr 設定檔案屬性。

function FileSetAttr(const FileName: string;Attr:Integer): Integer;

FileSetDate 設定檔案的日期及時間。

procedure FileSetDate(Handle: Integer; Age:Longint);

FileOpen 開啟檔案。

function FileOpen(const FileName: string; Mode:Word): Integer;

FileWrite 寫資料到檔案。

function FileWrite(Handle:Integer;const Buffer; Count:Longint): Longint;

FindClose 終止找尋第一個／下一個的動作。

procedure FindClose(var SearchRec: TSearchRec);

FindFirst 尋找第一個符合的檔案並設定其屬性。

function FindFirst(const Path: string;Attr: Word; var F:TSearchRec): Integer;

FindNext 傳回下一個符合的檔案。function FindNext(var F:TSearchRec): Integer;

RenameFile 變更檔名。function RenameFile(const OldName,NewName: string):Boolean;

========================================

浮點數轉換函數 (Floating-point Conversion Routines)

Unit: SysUtils

========================================

FloatToDecimal 將浮點數值分成小數及整數部份的數字傳回。

procedure FloatToDecimal(var Result: TFloatRec;Value:Extended;Precision, Decimals:Integer);

FloatToStrF 依照指定格式將浮點數轉成字串描述。

function FloatToStrF(Value: Extended; Format:TFloatFormat;Precision,Digits: Integer): string;

FloatToStr 將浮點數轉成字串描述。function FloatToStr(Value: Extended): string;

FloatToText 將所給的浮點數值，分成小數及整數部份的數字依照格式傳回。

function FloatToText(Buffer: Pchar; Value:Extended;Format:TFloatFormat;Precision,Digits: Integer): Integer;

FloatToTextFmt 將浮點數依照格式轉成字串傳回。

function FloatToTextFmt(Buffer: PChar; Value:Extended;Format: PChar) :Integer;

FormatFloat 將浮點數值依照Format 格式傳回。

function FormatFloat(constFormat: string;Value:Extended):string;

StrToFloat 將所給字串轉成一個浮點數值。

function StrToFloat(const S: string): Extended;

TextToFloat 將一個null 結尾字串轉成浮點數值

function TextToFloat(Buffer: PChar;var Value:Extended): Boolean;

========================================

流程控制函數 (Flow-control Routines)

Unit: System

========================================

Break 終止迴圈。如for, while 及repeat 迴圈。

procedure Break;

Continue 繼續迴圈。如for, while 及repeat 迴圈。

procedure Continue;

Exit 離開目前的區塊。procedure Exit;

Halt 停止程式的執行並回到作業系統。

procedure Halt[ ( Exitcode: Word ) ];

RunError 停止程式執行。procedure RunError[ ( Errorcode: Byte ) ];

========================================

輸出入函數 (I/O Routines)

Unit: System

========================================

AssignFile 指定一個檔案到檔案變數。procedure AssignFile(var f, String);

CloseFile 關閉檔案。procedure CloseFile(var F);

Eof 判斷是否已到檔案結尾。

Typed or untyped files:

functionEof(var F): BooleanText files:function Eof [ (var F: Text) ]:Boolean;

Erase 清除檔案內容。procedure Erase(var F);

FilePos 傳回目前檔案游標位置。function FilePos(var F): Longint;

FileSize 傳回檔案的大小function FileSize(var F):Longint;

GetDir 傳回指定磁碟的工作目錄。procedure GetDir(D: Byte; var S: String);

IOResult 傳回最後I/O 執行的狀態。function IOResult: Integer;

MkDir 建立一子目錄。procedure MkDir(S: String);

Rename 變更外部檔案的檔名。procedure Rename(var F; Newname);

Reset 開啟一個已存在的檔案。procedure Reset(var F [: File; Recsize: Word ] );

Rewrite 建立並開啟一個新檔。procedure Rewrite(var F: File [; Recsize: Word ] );

RmDir 刪除一個空目錄。procedure RmDir(S: String);

Seek 移動檔案游標。procedure Seek(var F; N: Longint);

Truncate 刪截目前位置以後的檔案內容。procedure Truncate(var F);

========================================

記憶體管理函數 Memory-management Routines)

Unit: SysUtils

========================================

AllocMem 配置一個記憶體區塊給堆積heap 。

function AllocMem(Size: Cardinal): Pointer;

ReAllocMem 從堆積釋回一區塊。

function ReAllocMem(P: Pointer;CurSize, NewSize:Cardinal): Pointer;

========================================

雜項函數 (Miscellaneous Routines)

Unit: System, SysUtils

========================================

AddExitProc 加入一個程序到執行時期程式庫的出口程序列中。

procedure AddExitProc(Proc: TProcedure);

Exclude 從一個集合除去一個元素。procedure Exclude(var S: set of T;I:T);

FillChar 以一個字元填入指定個數到一個變數上。

procedure FillChar(var X; Count: Word; value);

Hi 傳回參數的高位元組。function Hi(X): Byte;

Include 將元素包含到集合內。procedure Include(var S: set of T; I:T);

Lo 傳回參數的低位元組。function Lo(X): Byte;

Move 從Source 複製Count 個數的位元組到Dest 。

procedure Move(varSource,Dest; Count: Word);

ParamCount 傳回命令列參數的個數。function ParamCount: Word;

ParamStr 傳回一個指定的命令列參數。function ParamStr(Index): String;

Random 傳回一個隨機亂數。function Random[ ( Range: Word) ];

Randomize 初值化亂數產生器。procedure Randomize;

SizeOf 傳回參數所佔位元組數。function SizeOf(X): Word;

Swap 將參數的高位元組和低位元組交換。function Swap(X);

TypeOf 傳回指向物件型態的虛擬方法表的指標。function TypeOf(X) : Pointer

UpCase 將字元轉為大寫。function UpCase(Ch: Char):Char;

========================================

次序函數 (Ordinal Routines)

Unit: System

========================================

Dec 遞減一個變數。procedure Dec(var X[ ; N:Longint]);

Inc 遞增一個變數procedure Inc(var X[ ; N:Longint ] );

Odd 判別式否為奇數。function Odd(X: Longint):Boolean;

Pred 傳回參數的前任者。function Pred(X);

Succ 傳回參數的後繼者。function Succ(X);

========================================

指標和位址函數 (Pointer and Address Routines)

Unit: System

========================================

addr 傳回指定物件的位址。function Addr(X): pointer;

Assigned 判斷是否一個函數或程序是nil

function Assigned(var P):Boolean;

CSeg 傳回CS 程式段暫存器的內容。function CSeg: Word;

DSeg 傳回DS 資料段暫存器的內容。function DSegt: Word;

Ofs 傳回參數的偏移位址。function Ofs(X): Word;

Ptr 將所指定的節段及偏移位址組合到一個指標。function Ptr(Seg, Ofs: Word):Pointer;

Seg 傳回參數的節段位址。function Seg(X): Word;

SPtr 傳回SP 堆疊存器的內容。function SPtr: Word;

SSeg 傳回SS 堆疊段暫存器的內容。function SSeg: Word;

========================================

字串格式函數 (String-formatting Routines)

Unit: SysUtils

========================================

FmtStr 將所列參數依照Format 的格式組合到Result 字串傳回。

procedure FmtStr(var Resut: string; const Format:string;const Args: array of const);

Format 將所列參數依照Format 的格式組合到Pascal 格式字串傳回。

fonction Format(const Format: string;const Args:array of const): string;

FormatBuf 格式化所列的參數。

function FormatBuf(var Buffer; BufLen: Word;const Format;

FmtLen:Word;Const Args: array of const):Word;

StrFmt 格式化所列的參數。function StrFmt(Buffer,

Format: PChar;const Args: array of const):PChar;

StrLFmt 格式化所列參數，並將結果指向Buffer 指標。

function StrLFmt(Buffer: PChar; MxLen: Word;Format:

PChar;const Args: array of const):PChar;

========================================

字串處理函數(String-handling Routines :Pascal-style)

Unit: SystUtils

========================================

AnsiCompareStr 比較兩個字串。function AnsiCompareStr(const S1, S2: string):Integer;

AnsiCompareText 比較兩個字串且無大小寫區別。

function AnsiCompareText(const S1, S2: string):Integer;

AnsiLowerCase 將字串內容轉為小寫。function AnsiLowerCase(const S: string): string;

AnsiUpperCase 將字串內容轉為大寫。function AnsiUpperCase(const S: string): string;

AppendStr 將所給字串連接到Dest 字串後面。

procedure AppendStr(var Dest: string; const S:string);

AssignStr 配置記憶體空間給字串。

procedure AppendStr(var P: PString; const S:String);

CompareStr 比較兩個字串。

function CompareStr(const S1,S2: string):Integer;

CompareText 比較兩個字串且無大小寫區別。

function CompareText(const S1, S2: String):Integer;

Concat 連結所列字串。function Concat(s1 [, s2,… , sn]: String):String;

Copy 傳回字串的部份字串內容。function Copy(S: String; Index, Count:Integer): String;

Delete 刪除所給字串內的子字串。procedure Delete(var S: String; Index,Count:Integer);

DisposeStr 釋回字串佔用的空間。procedure DisposeStr(P: PString);

FmtLoadStr 從程式的資源字串表中載入一個字串。

function FmtLoadStr(Ident: Word;const Args: array of const): string;

Insert 在一個字串內插入一個子字串

procedure Insert(Source: String; var S: String;Index: Integer);

IntToHex 將一個整數轉為十六進位。

function IntToHex(Value: Longint; Digits:Integer): string;

IntToStr 將數字轉成字中格式。function IntToStr(Value: Longint): string;

IsValidIdent 判別字串內容是否為正確的識別字。

function IsValidIdent(const Ident: string):Boolean;

Length 傳回字串的長度。function Length(S: String): Integer;

LoadStr 從應用程式的可執行檔中載入一個字串資源。

function LoadStr(Ident: Word): string;

LowerCase 將字串轉成小寫。function LowerCase(const S: string): string;

NewStr 從堆積配置一個字串空間。function NewStr(const S: string): PString;

Pos 傳回子字串在字串中的位置。function Pos(Substr: String; S: String):

Str 將數值轉為字串。procedure Str(X [: Width [: Decimals ]];var S);

StrToInt 將字串轉為整數值。function StrToInt(const S: string): Longint;

StrToIntDef 將字串轉整數值或預設值。

function StrToIntDef(const S: string; Default:Longint): Longint;

Uppercase 將字串轉成大寫。function UpperCase(const S: string): string;

val 將字串內容轉為數值描述。procedure Val(S; var V; var Code: Integer);

========================================

字串處理函數 (String-handling Routines : Null-terminated)

Unit: SysUtils

========================================

StrAlloc 配置一個最大長度為Size-1 的緩衝區給null 結尾字串

function StrAlloc(Size: Word): PChar;

StrBufSize 傳回由StrAlloc 配置的字串緩衝區內可以儲存的最大字元數。

function StrBufSize(Str: PChar): Wrd;StrCat 連結兩個字串並傳回該字串。

function StrCat(Dest, Source: PCar): PChar;

StrComp 比照兩個字串。function StrComp(Str1, Str2 : Pchar): Integer;

StrCopy 拷貝Source 字串到Dest 上。function StrCopy(Dest, Source: PChar): PChar

StrDispose 釋回一個字串空間。function StrDispose(Str:PChar);

StrCopy 拷貝Source 字串到Dest 上並傳回指向該字串結尾的指標。

function StrECopy(Dest, Surce: Pchar): Pchar;

StrEnd 傳回一指標指向字串的結尾function StrEnd(Str: Pchar): Pchar;

StrLCat 將Source 字串連結到Dest 字串後，並傳回連結的字串。

function StrLCat(Dest, Source:PCar; MaxLen: Word): PChar;

StrIComp 比較兩個字串具無大小寫區別

function StrIComp(Str1, Str2:Pchar): Integer;

StrLComp 比較兩個字串到所指定的最大長度

function StrLComp(Str1, Str2:Pchar; MaxLen: Word): Integer;

StrLCopy 從一字串拷貝指定字元數到另一字串

Function StrLCopy(Dest,Source:PChar;MaxLen: Cardinal): PChar;

StrLen 傳回字串的長度。function StrLen(Str: PChar):Cardinal;

StrLIComp 比較兩個字串到所指定的最大長度具無大小寫區別。

function StrLIComp(Str1, Str2:PChar; MaxLen: Word):Integer;

StrLower 將字串轉成小寫。

function StrLower(Str: PChar):PChar;

StrMove 拷貝Count 字元數，從Source 到Dest字串。

function StrMove(Dest, Source:PChar; Count: Cardinal): PChar

StrNew 從堆積配置一個字串。function StrNew(Str: PChar):PChar;

StrPas 將null 結尾字中轉成一個Pascal 格式字串。

function StrPas(Str: Pchar):String;

StrPCopy 拷貝一個Pascal 格式字串到一個null結尾字串。

Function StrPCopy(Dest:PChar;Source: String): PChar;

StrPLCopy 拷貝MaxLen 所指字元數，從Pascal格式字串到null 結尾字串。

Function StrPLCopy(Dest:Pchar;cost Source: string;MaxLen: Word): PChar;

StrPos 傳回一指標指向在Str1 內最先出現 Str2 字串的位置。

function StrPos(Str1, Str2: Pchar): Pchar;

StrScan 傳回一指標指向在Str 字串中第一個出現chr 字元的位置。

function StrScan(Str: PChar; Chr: Char): PChar;

StrRScan 傳回一指標指向在Str 子串中最後出現chr 字元的位置。

function StrRScan(Str: Pchar; Chr: Char): PChar;

StrUpper 將字串轉成大寫。function StrUpper(Str: PChar):PChar;

========================================

文字檔案函數 (Text-file Routines)

Unit: System

========================================

Append 開啟一個存在的檔案供增加。procedure Append(var f: Text);

Eoln 判別一文字檔是否在行尾。function Eoln [(var F: Text) ]:Boolean;

Flush 清除文字輸出檔的緩衝區。procedure Flush(var F: Text);

Read 從檔案讀入資料到所列變數。Typed files:

Procedure Read(F , V1[, V2,… ,Vn ] );Text files:

procedure Read( [ var F: Text; ] V1 [,V2,… ,Vn]);

Readln 從檔案讀入資料到所列變數並跳至下一行。

procedure Readln( [ var F:Text; ]V1 [, V2,… ,Vn ]);

SeekEof 判別是否已到檔尾。function SeekEof [ ( var F:Text) ]: Boolean;

SeekEoln 判別一檔案是否在行尾。function SeekEoln [(var F: Text) ]: Boolean;

SetTextBuf 指定一個I/O 緩衝區給一文字檔。

procedure SetTextBuf(var F: Text; var Buf [ ; Size:Word ] );

Write 將變數內的資料寫到檔案。Text files:

procedure Write( [ var F:Text; ] P1 [,P2,… ,Pn ] );

Typed files:

procedure Write(F, V1[V2,… Vn]);

writeln 執行Write 程序並輸出一個跳行到檔案。

procedure Writeln([ var F: Text; ] P1 [, P2,… ,Pn ] );

========================================

轉換函數(Transfer Routines)

Unit: System

========================================

Chr 傳回ASCII 碼所對應的字元。function Chr(X: Byte): Char;

Delphi 源碼任務 ( http://home.kimo.com.tw/bruce0211/ ) 打字整理15

High 傳回參數在範圍內的最高值。function High(X);

Low 傳回參數在範圍內的最低值。function Low(X);

Ord 傳回一個有序型態所對應的順序值。function Ord(X): Longint;

Round 將一個實數值四捨五入而傳回整數值。function Round(X: Real):Longint;

Trunc 將一個實數值去尾而傳回整數值。function Trunc(X: Real):Longint;

========================================

未定型態檔案函數(Untyped-file Routines)

Unit: System

========================================

BlockRead 從檔案讀入一個或數個記錄到Buf 變數。

procedure BlockRead(var F: File; var Buf;Count: Word [; var Result:Word]);

BlockWrite 從一變數寫入一個或數個記錄。

procedure BlockWrite(var f: File; var Buf;Count: Word [; var Result:Word]);

▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼

delphi關於時間的加減

如何時間相減後得出相差的時分秒
procedure TForm1.Button1Click(Sender: TObject);
var
    h,m,s,ms:word;
    str1,str2:string;
begin
    str1:='09:00:00';
    str2:=FormatDateTime('hh:nn:ss',StrToDateTime(str1) + EncodeTime(0, 15, 0, 0));//往後15分鐘
    DecodeTime(StrToDateTime(str2) - StrToDateTime(str1), h, m, s, ms);
    ShowMessage(format('%d 小时; ',[h])+format('%d分钟; ',[m])+format('%d 秒; ',[s])+format('%d 微秒 ',[ms]));
end;

關於時間的加減                    
d1, d2: TDateTime;
d1 := d2 + EncodeDate(1, 0, 0); // d2 的時間加一年
d1 := d2 + EncodeDate(0, 1, 0); // d2 的時間加一個月
d1 := d2 + EncodeDate(0, 0, 1); // d2 的時間加一天
d1 := d2 + EncodeTime(1, 0, 0, 0); // d2 的時間加一小時，最大到23小時
d1 := d2 + EncodeTime(0, 1, 0, 0); // d2 的時間加一分鐘
d1 := d2 + EncodeTime(0, 0, 1, 0); // d2 的時間加一秒
d1 := d2 + EncodeTime(0, 0, 0, 1); // d2 的時間加一毫秒，加1000次才等於一秒

Delphi 7 的函式，給您參考
IncYear
IncMonth
IncDay
IncHour
IncMinute
IncSecond
IncMilliSecond

[Delphi] 使用TStringList讀取UTF-8編碼的文件

一開始我是用AssignFile方式讀取一份文字檔，在ANSI編碼的時候還算順利，如下:
procedure MyClass.ReadAnsiFile;
var
  f : TextFile;
  line : String;
begin
  AssignFile(f, 'C:\temp\myFile.txt');
  Reset(f);
  line := '';
 
  While not Eof(f) do
  begin
    ReadLn(f, line);
  end;
  CloseFile(f);
end;

每行印出來都很正常，但是當我將這個檔案換成UTF-8編碼時(不管有沒有BOM)，他只要遇到中文字就變成亂碼了，所以我必須換個寫法
(假設我已經知道要讀取的文件是UTF-8格式)

procedure MyClass.ReadUtf8File;
var
  strList : TStringList;
  I : Integer;
  line := '';
begin
  strList := TStringList.Create;
  stringList.LoadFromFile('C:\temp\myFile2.txt', TEncoding.UTF8);
  for I := 0 to strList.Count - 1 do
  begin
    line := strList[I];
  end;
end;

關鍵就在strList.LoadFromeFile(path, TEncoding.UTF8)
有API可以呼叫當然就使用它，這樣會省事多了

JSON資料交換，利用 superobject，重新封裝ClientDataSet<－>JSON

轉自What's X
先下載superobject，Server端的資料寫入，請參考
重新封裝的類別uJSONDB

unit uJSONDB;

interface

  uses

     SysUtils, Classes, Variants, DB, DBClient, SuperObject, Dialogs;

  type

    TJSONDB = class

    private

      class function getJsonFieldNames(res: ISuperObject):TStringList ;

      class function getJsonFieldValues(res: ISuperObject):TStringList ;

    public

      class procedure JsonToClientDataSet(jsonArr: TSuperArray; dstCDS: TClientDataSet);

      class function ClientDataSetToJSON(srcCDS: TClientDataSet):UTF8String;

  end;

implementation

function GetToken(var astring: string;const fmt:array of char): string;

var

   i,j:integer;

   Found:Boolean;

begin

    found:=false;

    result:='';

    aString := TrimLeft(aString);

    if length(astring)=0 then exit;

    I:=1;

    while I<=length(Astring) do

          begin

          found:=false;

          if aString[i]<=#128 then

             begin

             for j:=Low(Fmt) to High(Fmt) do

                 begin

                 if (astring[i]<>Fmt[j])  then continue;

                 found:=true;

                 break;

                 end;

             if Not found then I:=I+1;

             end

          else I:=I+2;

          if found then break;

          end;

    if found then

    begin

      result:=copy(astring,1,i-1);

      delete(astring,1,i);

    end

    else

    begin

      result:=astring;

      astring:='';

    end;

end;

function GetFieldParams(PropName, Source:string): string;

var

   S1, S2: string;

   TmpParam: string;

   AChar: string;

   aValue, aPropName, aSource: string;

begin

   Result:='';

   if Source='' then Exit;

   aSource := Source;

   while aSource <> '' do

   begin

     aValue := GetToken(aSource,[',']);

     aPropName := GetToken(aValue,[':']);

     if CompareText(PropName,aPropName) <> 0 then continue;

     Result := aValue;

     break;

   end;

end;

//從json取得欄位名稱

class function TJSONDB.getJsonFieldNames(res: ISuperObject):TStringList ;

var

  i: Integer;

  fieldList : TStringList;

  fieldNames :String;

begin

  try

    fieldList := TStringList.Create;

    fieldNames := res.AsObject.getNames.AsString;

    fieldNames := StringReplace(fieldNames, '[', '', [rfReplaceAll, rfIgnoreCase]);

    fieldNames := StringReplace(fieldNames, ']', '', [rfReplaceAll, rfIgnoreCase]);

    fieldNames := StringReplace(fieldNames, '"', '', [rfReplaceAll, rfIgnoreCase]);

    fieldList.Delimiter := ',';

    fieldList.DelimitedText := fieldNames;

    Result:= fieldList;

  finally

    //fieldList.Free;

  end;

end;

//從json取得欄位值

class function TJSONDB.getJsonFieldValues(res: ISuperObject):TStringList ;

var

  i: Integer;

  fieldList : TStringList;

  fieldValues :String;

begin

  try

    fieldList := TStringList.Create;

    fieldValues := res.AsObject.getValues.AsString;

    fieldValues := StringReplace(fieldValues, '[', '', [rfReplaceAll, rfIgnoreCase]);

    fieldValues := StringReplace(fieldValues, ']', '', [rfReplaceAll, rfIgnoreCase]);

    fieldValues := StringReplace(fieldValues, '"', '', [rfReplaceAll, rfIgnoreCase]);

    fieldList.Delimiter := ',';

    fieldList.DelimitedText := fieldValues;

    Result:= fieldList;

  finally

    //fieldList.Free;

  end;

end;

//json轉CDS

class procedure TJSONDB.JsonToClientDataSet(jsonArr: TSuperArray; dstCDS: TClientDataSet);

var

  fieldList: TStringList;

  valuesList: TStringList;

  jsonSrc: string;

  i, j: Integer;

begin

  fieldList:= getJsonFieldNames(SO[jsonArr[0].AsJson(False,False)]);

  if (dstCDS.FieldCount = 0) then

  begin

    for i := 0 to fieldList.Count -1 do

    begin

      dstCDS.FieldDefs.Add(fieldList[i],ftString,100, False);

    end;

    dstCDS.CreateDataSet;

    dstCDS.Close;

    dstCDS.Open;

  end;

  try

    dstCDS.DisableControls;

    for i := 0 to jsonArr.Length -1 do

    begin

      jsonSrc:= SO[jsonArr[i].AsJson(False,False)].AsString;

      jsonSrc := StringReplace(jsonSrc, '[', '', [rfReplaceAll, rfIgnoreCase]);

      jsonSrc := StringReplace(jsonSrc, ']', '', [rfReplaceAll, rfIgnoreCase]);

      jsonSrc := StringReplace(jsonSrc, '"', '', [rfReplaceAll, rfIgnoreCase]);

      jsonSrc := StringReplace(jsonSrc, '{', '', [rfReplaceAll, rfIgnoreCase]);

      jsonSrc := StringReplace(jsonSrc, '}', '', [rfReplaceAll, rfIgnoreCase]);

      dstCDS.Append;

      for j:= 0 to fieldList.Count -1 do

      begin

        dstCDS.FieldByName(fieldList[j]).AsString:= GetFieldParams(fieldList[j], jsonSrc);

      end;

      dstCDS.Post;

    end;

  finally

    dstCDS.EnableControls;

  end;

end;

//ClientDataSet轉JSON

class function TJSONDB.ClientDataSetToJSON(srcCDS: TClientDataSet): UTF8String;

var

  i, j: Integer;

  keyValue:String;

  jsonList:TStringList;

  jsonResult:String;

begin

  if not srcCDS.Active then srcCDS.Open;

  try

    jsonList := TStringList.Create;

    srcCDS.DisableControls;

    srcCDS.First;

    while not srcCDS.Eof do

    begin

      keyValue:= '';

      for i := 0 to srcCDS.FieldDefs.Count -1 do

      begin

        keyValue:= keyValue + Format('"%s":"%s",',[srcCDS.Fields[i].FieldName, srcCDS.Fields[i].AsString]);

      end;

      jsonList.Add(Format('{%s}',[Copy(keyValue, 0, Length(keyValue)-1)]));

      srcCDS.Next;

    end;

    for i := 0 to jsonList.Count -1 do

    begin

      jsonResult := jsonResult + jsonList[i] + ',';

    end;

    Result:= Utf8Encode(Format('[%s]', [Copy(jsonResult, 0, Length(jsonResult)-1)]));

  finally

    srcCDS.EnableControls;

    jsonList.Free;

  end;

end;

end.

使用範例

//取得資料

procedure TForm1.btnRefreshClick(Sender: TObject);

var

  getString:string;

  json: ISuperObject;

  ja: TSuperArray;

begin

  try

    getString := idhtp1.Get('http://localhost/xuan/wsLine.php');

    json :=SO(getString);

    ja := json.AsArray;

    TJSONDB.JsonToClientDataSet(ja, cdsMain);

  finally

  end;

end;

//寫入資料

procedure TForm1.btnSubmitClick(Sender: TObject);

var

  jsonString:string;

  jsonStream:TStringStream;

begin

  if cdsNew.State in [dsEdit] then cdsNew.Post;

  try

    jsonString:= TJSONDB.ClientDataSetToJSON(cdsNew);

    jsonStream := TStringStream.Create(jsonString);

    idhtp1.HandleRedirects := True;

    idhtp1.ReadTimeout := 5000;

    idhtp1.Request.ContentType := 'application/json';

    idhtp1.Post('http://localhost/xuan/wsLine.php?action=insert',jsonStream);

  finally

    jsonStream.Free;

  end;

end;

畫面



JSON格式參考


[{"id":"0987336122","name":"\u738b\u5c0f\u660e","content":"","misc_type":"Jpeg","misc":null,"msg_date":"2012-10-09 11:18:38"},
{"id":"0987336122","name":"\u674e\u5c0f\u83ef","content":"","misc_type":"Jpeg","misc":null,"msg_date":"2012-10-09 11:18:45"}]

FindComponent函數

var i:Byte;
  aTitle : String;
  lb:TQRLabel;
begin
 for i:= 0 to 6 do
  begin
    lb := FindComponent('QRLblA'+IntToStr(i)) as TQRLabel;
    if lb <> nil then
    begin
      lb.Caption := ' ';
    end;
  end;
end;

DELPHI XE

快快樂樂學習 delphi XE5 for Android app...agenda
http://jamesjuantw.pixnet.net/blog/post/161355278

官網xe6
http://docwiki.embarcadero.com/RADStudio/XE6/en/Tutorials

Mobile Tutorial: Using LiveBindings to Populate a ListView
http://docwiki.embarcadero.com/RADStudio/XE6/en/Mobile_Tutorial:_Using_LiveBindings_to_Populate_a_ListView_(iOS_and_Android)

ANDROID的歷代版本(Android 2.3 ~4.4)及Android L的差異
http://tu0925399900.pixnet.net/blog/post/167317143-android%E7%9A%84%E6%AD%B7%E4%BB%A3%E7%89%88%E6%9C%AC(android-2.3-~4.4)%E5%8F%8Aandroid-l%E7%9A%84%E5%B7%AE

Mobile Tutorial: Using Tab Components to Display Pages
http://docwiki.embarcadero.com/RADStudio/XE6/en/Mobile_Tutorial:_Using_Tab_Components_to_Display_Pages_(iOS_and_Android)

Mobile Tutorial: Using a Button Component with Different Styles
http://docwiki.embarcadero.com/RADStudio/XE6/en/Mobile_Tutorial:_Using_a_Button_Component_with_Different_Styles_(iOS_and_Android)

手機無法用showmodal的問題，以下有解，使用匿名函數：
http://docwiki.embarcadero.com/RADStudio/XE5/en/ShowModal_Dialogs_in_FireMonkey_Mobile_Apps

對listview所binding的欄位做customformat
http://docwiki.embarcadero.com/RADStudio/XE6/en/Using_Custom_Format_and_Parse_Expressions_in_LiveBindings#Binding_Expressions

內建的Medthod (Default LiveBindings Methods)
http://docwiki.embarcadero.com/RADStudio/XE6/en/Default_LiveBindings_Methods

範例
http://docwiki.embarcadero.com/Libraries/XE6/en/System.SysUtils.Format

XE6控件
http://docwiki.embarcadero.com/RADStudio/XE6/en/Working_with_Native_and_Custom_FireMonkey_Styles

要使用android模擬器的裝置最低需求
http://docwiki.embarcadero.com/RADStudio/XE6/en/Creating_an_Android_Emulator

ListBox
http://docwiki.embarcadero.com/RADStudio/XE5/en/Mobile_Tutorial:_Using_ListBox_Components_to_Display_a_Table_View_(iOS_and_Android)

Android SDK | 教學講義集
http://www.sdk.tw/2013/05/android-sdk.html

DataSnap的傳遞封包大小是32k，可以參考以下網址：(做上傳的，參考看看)
http://www.myexception.cn/program/618866.html

同樣的處理方式：另一篇sample Code
http://blog.csdn.net/ddqqyy/article/details/6185835

CnPack 组件包
http://www.cnpack.org/downbuilds.php?lang=zh-cn

DELPHI常用環境設定

顏色設定：
Comment => Olive
Reserved word => Red
Sring => Green
Number =>Fuchsia

剪貼簿(Clipboard)和動態數據交換

轉貼自剪貼簿和動態數據交換

應用程式間的數據交換是象Windows 這樣的多工環境的重要特性。作為一種基於Windows的開發工具，Delphi支援如下四種數據交換方式：剪貼簿、動態數據交換 ( DDE)、物件聯接與嵌入(OLE)以及動態聯接庫(DLLs)。這中間前三種方式最為常用，OLE功能最為強大，DDE次之。而剪貼簿使用最為方便。在本章，我們只討論剪貼簿和動態數據交換。利用OLE實現數據交換見下一章，利用動態聯接庫(DLLs)進行數據交換將在第十章中介紹。　　

7.1 剪貼簿及其應用　

本質上，剪貼簿只是一個全局記憶體塊。當一個應用程式將數據轉送給剪貼簿後，通過修改記憶體塊分配標誌，把相關記憶體塊的所有權從應用程式移交給Windows自身。其它應用程式可以通過一個句柄找到這個記憶體塊，從而能夠從記憶體塊中讀取數據。這樣就實現了數據在不同應用程式間的傳輸。　　

剪貼簿雖然功能較為簡單，且不能實現即時傳輸，但卻是更為複雜的DDE和OLE的基礎。對於一些只是偶爾需要使用其它應用程式數據的程式來說，使用剪貼簿不失為一種方便、快捷的方式。

Delphi把剪貼簿的大部分功能封裝到一個TClipboard類中，同時把使用頻度最高的文本傳輸功能(包括DBImage的圖像傳輸功能)置入相應部件作為部件的方法，從而使用戶可以十分方便地使用剪貼簿進行程式設計。　

7.1.1 使用剪貼簿傳輸文本　

剪貼簿傳輸文本主要是應用如下的三個方法:CopyToClipboard、CutToClipboard 和PasteFromClipboard。包含這些方法的部件如下表所示。　

　　 表7.1 包含剪貼簿方法的部件

───────────────────────────

方 法 部 件

??????????????????????????????????????????????????????

TDBEdit TDBMemo

TDBImage

CopyToClipboard TEdit TMemo TMaskEdit

TOLEContainer

TDDEServerItem

??????????????????????????????????????????????????????

TDBEdit TDBMemo

CutToClipboard TDBImage

TEdit TMemo TMaskEdit

??????????????????????????????????????????????????????

TDBEdit TDBMemo

PasteFromClipboard TDBImage

TEdit TMemo TMaskEdit

───────────────────────────　

除TDBImage外，其餘全是有關文本的控件。

在把文本傳輸到剪貼簿之前，文本必須被選中。

若選TMaskEdit的AutoSelect屬性為True，則當MaskEdit獲得輸入焦點時文本自動被選中；若選TEdit、TMemo的HideSelection屬性為True，則失去焦點時，文本選中狀態自動隱藏，重新獲得焦點時再顯示。

下面的語句把MaskEdit中選中的文本剪下來到剪貼簿：　

MaskEdit .CutToClipboard;　

下面的語句把剪貼簿中的文本貼上去到Memo的目前遊標處：　

Memo.PasteFromClipboard；　

利用剪貼簿類也可以實現文本的傳輸，見(7.1.2)中的介紹。　

7.1.2 剪貼簿類　

為方便剪貼簿的操作，Delphi在Clipbrd庫單元中定義了一個TClipboard類，並且預定義了一個變數Clipboard作為類TClipboard的實例，從而使用戶在絕大多數場合不必自己去定義一個TClipboard的實例。

利用剪貼簿類可以進行文本、圖像和部件的傳輸，剪貼簿類為實現這些方法提供了相應的屬性和方法。表7.2、表7.3列出了TClipboard屬性和方法的意義。　　

表 7.2 TClipboard的屬性

───────────────────────────

屬 性 意 義

———————————————————————————

AsText 存檔剪貼簿的文本，只有執行時才可設定

FormatCount 可用剪貼簿格式的數目

Formats 可用剪貼簿格式鍊

───────────────────────────　

　　 表 7.3 TClipboard的方法

─────────────────────────────────────

方 法 參 數 意 義

—————————————————————————————————————

Clear 無 清除剪貼簿的內容

Assign Source:TPersistent 把Source參數指定的物件拷貝到剪貼簿，常

用於圖形、圖像物件

Open 無打開剪貼簿，阻止其它應用程式改變它的內容

Close 無 關閉打開的剪貼簿

SetComponent Source:TPersistent 把部件拷貝到剪貼簿

GetComponent Owner 從剪貼簿取回一個部件並放置

Parent :TPersistent

SetAsHandle Format:Word 把指定格式數據的句柄交給剪貼簿

返回型式：THandle

GetAsHandle Format:Word 返回剪貼簿指定格式數據的句柄

返回型式：THandle

HasFormat Format:Word 判斷剪貼簿是否擁有給定的格式

返回型式：Boolean

SetTextBuf Buffer:PChar 設定剪貼簿的文本內容

─────────────────────────────────────　

　　剪貼簿中可能的數據格式如下表。　

表 7.4　剪貼簿數據格式及其意義

──────────────────────────────

數據格式 意 義

——————————————————————————————

CF_TEXT 文本。每行以CF_LF結束，nil標誌文本結束

CF_BITMAP Windows點陣圖

CF_METAFILE Windows元文件

CF_PICTURE TPicture型式的物件

CF_OBJECT 任何TPersistent型式的物件

───────────────────────────────　

利用TClipboard實現文本的傳輸使用AsText屬性和SetTextBuf方法。

AsText屬性為非控件部件的剪貼簿操作提供了方便。如：　

Clipboard. AsText := Form1.Caption ;　

把Form1的標題拷貝到剪貼簿。　

Label1.Caption := Clipboard.AsText;　

把剪貼簿中的文本寫入Label1。

SetTextBuf用於把超過255個字元的字元串拷入剪貼簿。　

7.1.3 利用剪貼簿傳輸圖像　

7.1.3.1 拷貝　

Image部件上的內容和窗體上的圖形可以直接拷貝到剪貼簿。圖像拷貝利用Clipboard的Assign方法。

例如：　

Clipboard.Assign(Image1.Picture);　

把Image1上的圖像拷貝到剪貼簿。　

7.1.3.2 剪下來　

圖像的剪下來是首先把圖像拷貝到剪貼簿，而後在原位置用空白圖像進行覆蓋。

下面一段程式表示了圖像的剪下來。　　

procedure TForm1.Cut1Click(Sender: TObject);

var

ARect: TRect;

begin

Clipboard.Assign(Image1.Picture);

with Image.Canvas do

begin

CopyMode := cmWhiteness;

ARect := Rect(0, 0, Image.Width, Image.Height);

CopyRect(ARect, Image.Canvas, ARect);

CopyMode := cmSrcCopy;

end;

end;

7.1.3.3 貼上去　

從剪貼簿上貼上去圖像，首先偵測剪貼簿上的數據格式。如果格式為CF_BITMAP，則呼叫目標點陣圖的Assign 方法貼上去圖像。

程式清單如下。

procedure TForm1.PasteButtonClick(Sender: TObject);

var

Bitmap: TBitmap;

begin

if Clipboard.HasFormat(CF_BITMAP) then

begin

Bitmap := TBitmap.Create;

try

Bitmap.Assign(Clipboard);

Image.Canvas.Draw(0, 0, Bitmap);

finally

Bitmap.Free;

end;

end;

end;　

try...finally為資源保護塊，參第十二章。

7.1.4 建立自己的剪貼簿觀察程式　

在這一節中我們要建立一個自己的剪貼簿觀察程式，用來存檔截獲到剪貼簿中的點陣圖。

Windows允許用戶建立自己的剪貼簿觀察程式，並把該程式加入到一個剪貼簿觀察器鍊中。在鍊中，位置靠前的程式有義務把有關剪貼簿的訊息傳遞到緊隨其後的觀察程式。而處於鍊首的程式由Windows的訊息回圈機制直接把剪貼簿訊息發送過來。

建立一個剪貼簿觀察程式，首先該程式必須能響應相應的Windows訊息。對於那些熟悉Microsoft公司Visual Basic的讀者來說，這是令他們頭疼而束手無策的地方。但Delphi在這方面卻有良好的表現：利用關鍵字message，用戶可以將一個過程定義為響應特定的Windows訊息。如：　

procedure WMDrawClipboard(var Msg:TWMDrawClipboard);

message WM_DRAWCLIPBOARD;　

可以響應WM_DRAWCLIPBOARD訊息。類TWMDrawClipboard是訊息類Message 的子類。Delphi把所有的訊息都重新進行了定義，使用戶在使用時可以直接引用其便於記憶的數據成員，而不必再自己動手去分解訊息。雖然這並不能算作是一個重大的改進，但卻體現了Delphi處處為用戶方便著想的特點。

我們將要建立的程式目的是把截獲到剪貼簿上的點陣圖存檔下來。在本書的寫作過程中，這一工作是大量存在的。雖然利用Windows工具PaintBrush(畫筆），通過貼上去、存檔等操作可以實現這一功能，但卻存在以下一些問題：

1.程式頻繁切換影響效率，當有大量點陣圖存在時更是如此；

2.畫筆有一個很討厭的缺陷：當剪貼簿上的點陣圖比畫筆介面的用戶區大時，用戶區外的點陣圖被截斷。因而往往需要根據所截獲點陣圖的大小來調整畫筆用戶區的大小，並重新進行貼上去。而如果開始就把畫筆用戶區調整到足夠大，又會覆蓋掉螢幕上一些有用的資訊。

為解決這些問題，我開發了下面的程式。程式啟動時，以極小化方式執行。此時只要剪貼簿中存入點陣圖，則自動彈出一個對話方塊請求用戶存檔。如果用戶希望查看確認，則可以連續按兩下執行程式圖示，選擇相應按鈕，剪貼簿中的點陣圖就會顯示在螢幕上。

部件關鍵屬性設計如下：　

ClipSaveForm：

Caption＝‘Save Bitmap in Clipboard '

Panel1:

Align = ' Top '

Image1:

Align = ' Client '

SaveDialog1:

FileEditStyle = fsEdit

FileName = '*.bmp'

Filter = 'Bitmap Files(*.bmp)|*.bmp|Any Files(*.*)|*.*'

InitialDir = 'c:\bmp'

Title = 'Save Bitmap'　

程式主視窗是TForm派生類TClipSaveForm的實例。TClipSaveForm通過定義一些私有數據成員和過程，使響應和處理Windows的相應訊息成為可能。下面是TClipSaveForm的類定義：　

type

TClipSaveForm = class(TForm)

SaveDialog1: TSaveDialog;

Image1: TImage;

Panel1: TPanel;

Button1: TButton;

SpeedButton1: TSpeedButton;

SpeedButton2: TSpeedButton;

Button2: TButton;

procedure FormCreate(Sender: TObject);

procedure FormDestroy(Sender: TObject);

procedure Button1Click(Sender: TObject);

procedure Button2Click(Sender: TObject);

procedure SpeedButton1Click(Sender: TObject);

procedure SpeedButton2Click(Sender: TObject);

private

{ Private declarations }

MyBitmap: TBitmap; { 存檔截獲的點陣圖 }

View: Boolean; { 判斷是否顯示 }

NextViewerHandle: HWND; { 下一剪貼簿觀察器的句柄 }

procedure WMDrawClipboard(var Msg:TWMDrawClipboard);

message WM_DRAWCLIPBOARD;

procedure WMChangeCBChain(var Msg:TWMChangeCBChain);

message WM_CHANGECBCHAIN;

{ 響應Windows的剪貼簿訊息 }

public

{ Public declarations }

end;

視窗建立時，把該視窗登入為剪貼簿觀察器，加入到剪貼簿觀察器鍊中，同時進行變數、部件和剪貼簿的初始化。　

procedure TClipSaveForm.FormCreate(Sender: TObject);

begin

View := False;

SpeedButton2.Down := True;

MyBitmap := TBitmap.create;

try

MyBitmap.Width := 0;

MyBitmap.Height := 0 ;

except

Application.terminate;

end;

Clipboard.Clear;

NextViewerHandle := SetClipboardViewer(Handle);

end;　

視窗關閉時，結束剪貼簿觀察器鍊，並釋放記憶體：　

procedure TClipSaveForm.FormDestroy(Sender: TObject);

begin

ChangeClipboardChain(Handle,NextViewerHandle);

MyBitmap.Free;

end;　

在以上兩段程式中用到的兩個Windows API函數SetClipboardViewer和ChangeClipboardChain分別用於登入和結束剪貼簿觀察器鍊。

程式存檔點陣圖的功能是在訊息響應過程WMDrawClipboard中實現的。該過程在剪貼簿內容有變化時被呼叫。　

procedure TClipSaveForm.WMDrawClipboard(var Msg: TWMDrawClipboard);

var

FileName: String;

begin

If NextViewerHandle <> 0 then

SendMessage(NextViewerHandle,msg.Msg,0,0);

If ClipBoard.HasFormat(CF_BITMAP) then

begin

MyBitmap.Assign(Clipboard);

If SaveDialog1.Execute then

begin

FileName := SaveDialog1.FileName;

MyBitmap.SaveToFile(FileName);

end;

If View then

begin

WindowState := wsNormal;

Image1.Picture.Bitmap := MyBitmap;

end;

end;

Msg.Result := 0;

end;　

程式首先判斷在剪貼簿觀察器鍊中是否還存在下一個觀察器。如果有，則把訊息傳遞下去，這是剪貼簿觀察器程式的義務。而後判斷剪貼簿上內容的格式是否為點陣圖。如是，則首先把剪貼簿上內容存檔到數據成員MyBitmap中，並激活一個文件存檔對話方塊把點陣圖存檔到文件中。如果View=True，則把視窗狀態(WindowState)設定為wsNormal，並把MyBitmap賦給Image部件的相應值，使用戶可以對剪貼簿上的點陣圖進行觀察。

訊息響應過程WMChangeCBChain在剪貼簿觀察器鍊上其它觀察器結束時被呼叫。根據被移出觀察器的不同位置決定了不同的處理方法。

procedure TClipSaveForm.WMChangeCBChain(var Msg: TWMChangeCBChain);

begin

if Msg.Remove = NextViewerHandle then

NextViewerHandle := Msg.Next

else

if NextViewerHandle <> 0 then

SendMessage(NextViewerHandle,Msg.Msg,Msg.Remove,Msg.Next);

Msg.Result := 0;

end;

視窗上有兩個加速按鈕，兩個按鈕。它們擊鍵(click)事件處理過程如下。每一程式段的意義是非常顯然的。　

procedure TClipSaveForm.Button1Click(Sender: TObject);

begin

Close;

end;

procedure TClipSaveForm.Button2Click(Sender: TObject);

begin

WindowState := wsMinimized;

end;

procedure TClipSaveForm.SpeedButton1Click(Sender: TObject);

begin

View := True;

Image1.Picture.Bitmap := MyBitmap;

end;　

procedure TClipSaveForm.SpeedButton2Click(Sender: TObject);

begin

View := False;

Image1.Picture.Bitmap := nil;

end;　

通過對這個程式的介紹，以下幾點是應該注意的：

1.提供了一種自己截獲和處理剪貼簿上內容的方法。讀者可以根據需要進一步擴充；

2.提供了響應Windows訊息的方法。在第三篇有關自定義部件開發的內容中，這一問題還要詳細論述；

3.最後的一點啟示是：在Delphi程式開發中巧妙應用傳統的Windows方法(如訊息處理、 API函數等)仍是很有必要的。而在應用這些方法中所體現的方便之處，正是Delphi勝過其它可視化開發工具的一個重要方面。　

7.2 Windows的DDE原理和 Dephi的DDE實現機制　

7.2.1 Windows的DDE原理　

Windows的DDE機制基於Windows的訊息機制。兩個Windows應用程式通過相互之間傳遞DDE訊息進行DDE交談(Conversation)，從而完成數據的請求、接聽、傳輸。這兩個應用程式分別稱為伺服器(Server)和用戶(Client)。伺服器是數據的提供者，用戶是數據的請求和接受者。

DDE交談由用戶程式啟動。用戶程式把一條訊息(WM_DDE_INITIATE)傳播給目前執行的所有Windows程式。這條訊息指明了用戶程式所需要的一般數據(應用程式、主題)。擁有這些數據的DDE伺服器可以響應這條被傳播的訊息。此時，DDE交談就開始了。

由於在每個主題中，DDE伺服器可以支援一個或多個數據項，所以在用戶請求數據時應同時指明應用程式名、主題名和項目名。應用程式、主題、項目是DDE中三個最基本的概念。

利用Windows本身提供的DDE訊息和API進行DDE程式設計是一件相當棘手的問題。 雖然使用DDE管理庫(ddeml.dll)可以一定程度上減輕開發者的工作負擔，但開發DDE程式仍不是一件輕鬆的事情。

此時Delphi出現了！Delphi通過其自身巧妙的設計使開發一個DDE應用程式同開發一個普通程式一樣地快捷、方便。　

7.2.2 Delphi的DDE實現機制簡介　

Delphi把所有的DDE功能做到四個部件中，它們是:

● TDDEClientConv ： 用於用戶程式建立和維護一個DDE交談

● TDDEClientItem ： 用於用戶程式建立和維護數據交換通道

● TDDEServerConv ： 用於伺服器程式響應DDE交談

● TDDEServerItem ： 用於伺服器程式維護數據交換通道　

　 前兩個部件用於產生一個DDE用戶程式，後兩個部件用於產生一個DDE伺服器程式。如果一個應用程式同時擁有這些部件，則這一程式既可以充當DDE用戶，也可以充當DDE伺服器。

交談部件TDDEClientConv、TDDEServerConv用於建立和維護一個DDE交談。DDE交談包括DDE服務和DDE主題兩部分。

DDE服務是DDE伺服器的標簽，即在一般的Windows DDE機制中所講的應用程式名。一般說來這一標簽是DDE伺服器應用程式執行檔案標簽去掉 .EXE後綴。比如你的應用程式要和Word 6.0建立交談，則DDE服務為WINWORD。但也不盡然。比如你的應用程式要和Borland ReportSmith ( RPTSMITH.EXE ) 建立交談，則DDE 服務為 Report Smith。DDE服務到底如何，讀者可參看相關的DDE伺服器應用程式文檔。

DDE主題是一個包含了聯接資訊的數據單元。一般說來DDE 主題是一個包括檔案附加名的完整檔案標簽。例如和Excel中的一個文件建立DDE交談，則主題可能是　

Topic = 'c:\excel\Example\sale.xls'　

如果伺服器是一個Delphi應用程式，缺省情況下主題是包含欲聯接數據窗體的標題。如果伺服器使用了DDEServerConv部件，則要求使用部件DDEServerConv的標簽作為DDE主題。

項目部件TDDEclientItem、TDDEServerItem用於建立和維護DDE數據的傳輸通道。 DDE項目中包含著實際欲傳輸的數據。DDE項目的格式取決於DDE伺服器應用程式。一個可能的DDE項目例子是電子表格中的單元和資料庫表中的欄位。如果伺服器是Delphi應用程式，則項目是連接的 DDEServerItem部件的標簽。

Delphi的DDE實現機制方便、實用，但也有一個令人遺憾的缺陷：只能傳輸文本數據以及命令、宏，而不能傳輸圖像數據。在這一點上微軟公司推出的Visual Basic 要略勝一籌。不過在目前文本數據的使用仍是最廣泛的，而且圖像傳輸可以利用剪貼簿和OLE來實現，則這一缺陷也並無很大的影響　

7.3 DDE用戶程式的實現

DDE用戶程式啟動DDE交談，向伺服器請求並從伺服器接收數據。同時還可以向伺服器發送數據、命令、宏，改變伺服器的狀態並控制伺服器的執行。　

7.3.1 聯接模式(ConnectMode)

Delphi的DDE提供了兩種聯接模式：自動和人工。這可以通過DDEClinetConv 部件的ConnectMode屬性進行設定。如下表所示。　

表 7.5 DDE的聯接模式

───────────────────────────────

　　　　　值　　　　　　　　　　　意　　　　　　義

———————————————————————————————

ddeAutomatic 在執行中當包含TDDEClientConv部件的視窗建立時

聯接自動建立

ddeManual 只有當呼叫OpenLink方法時聯接才建立

───────────────────────────────　　　

不同聯接模式，DDE用戶程式的實現方式不同。

對於自動模式：

1. 向窗體中加入DDEClientConv和DDEClientItem部件並命名；

2. 把DDEClientItem部件的DdeConv屬性設定為DDEClientConv部件的標簽；

如果在設計時建立，則通過物件觀察器進行選擇；如果在執行時建立聯繫， 則通過如下的一條語句設定屬性的值：　

DDEClientItem1.DdeConv := 'DDEClientConv1' ;　

3. 和伺服器建立聯繫，實現數據共享。

對於人工模式：

1.向窗體中加入DDEClientConv部件；

2.和伺服器建立聯繫；

3. 數據更新時呼叫RequestData方法申請並獲得數據。　

7.3.2 和DDE伺服器建立聯繫　

和DDE伺服器建立聯繫，既可以在設計時進行，也可以在執行時進行。

在設計時，DDE聯接可以通過剪貼簿進行貼上去。具體步驟如下：

1. 激活伺服器程式，並選中你的用戶程式欲聯接的數據；

2. 把數據和DDE聯接資訊拷貝到剪貼簿上。一般說來這只需要選擇伺服器應用程式的 Edit|Copy 選擇表；

3. 在Delphi IDE的設計窗體中選中DDEClientConv部件；

4. 在Object Inspector(物件觀察器)中按一下DDEService屬性或DDETopic屬性，然後再按一下Ellipsis按鈕，打開DDE Info對話方塊；

5.選擇Paste Link按鈕。此時App編輯框和Topic編輯框被自動填充。如果Paste Link按鈕變灰，敘述你準備用作伺服器的應用程式不支援DDE或者DDE資訊沒有被成功地拷貝到剪貼簿上；

6.選擇OK 按鈕。此時Object Inspector中的DDEService、DDETopic 屬性包含了建立一個DDE聯接的正確值。

對於人工模式以下步驟是不需要的。

7.選中DDEClientItem部件，並在Object Inspector中設定DdeConv屬性為已完成聯接的DDEClientConv部件標簽；

8.假如剪貼簿上的DDE 聯接資訊仍保留的話，從Object Inspector的下拉列示方塊中選擇 DDEItem 屬性的值。否則輸入正確的值。

在執行時，呼叫 SetLink 方法來建立DDE聯接。

SetLink有兩個String型式的參數，分別用來接受DDEService和DDETopic的值。過程執行後DDEClientConv部件的DDEService 和DDeTopic屬性被設定。要注意的是：在執行時直接設定DDEService和DDETopic的值並不能建立一個DDE聯接，而必須呼叫SetLink 方法進行初始化。

比如，下面的語句和Excel的System主題建立聯接：　

DDEClietnConv. SetLink('Excel','System')；　

呼叫SetLink方法後，還需要設定DDEClientItem部件的DDEItem屬性。

比如，下面的語句聯接Excel的Topics項目，用以獲取目前活躍文件的檔案標簽：　

DDEClietnItem.DDEItem := 'Topics';　

當DDE聯接建立後，聯接的數據存檔在DDEClientItem部件的Text和Lines 屬性中，Text用於存檔一個字元串(String)，Lines用於存檔一個字元串鍊表(TStrings)物件。

為了顯示聯接數據，可以在DDEClientItem的OnChange事件中把數值賦給一個可視部件。

下面的事件過程把聯接數據即時地顯示在一個編輯框中。

procedure Form1.DDEClientItemChange(Sender: Tobject);

begin

Edit1.Text := DDEClientItem1.Text;

end;　

執行狀態下也可以從剪貼簿上貼上去DDE聯接資訊，並呼叫SetLink建立DDE交談。下面的例子顯示了當用戶按下應用程式中的Paste Link按鈕時，動態建立DDE交談的過程。　

procedure Form1.OnPasteLink(Sender: Tobject)；

var

Service, Topic, Item: String;

begin

if GetPasteLinkInfo (Service, Topic, Item) then

begin

AppName.Text := Service;

TopicName.Text := Topic;

ItemName.Text := Item;

DDEClient.SetLink (Service, Topic);

DDEClientItem.DdeConv := DDEClient;

DDEClientItem.DDEItem := ItemName.Text;

end;

end;　

GetPasteLinkInfo是DDEMan 庫單元中定義的一個過程。如果返回True，則DDE聯接資訊存檔在三個參數中；如果返回False，敘述剪貼簿上沒有正確格式的DDE聯接資訊。　

7.3.3 數據申請　

雖然自動模式快捷、方便，但仍有一些理由使用DDE的人工模式：

1.伺服器程式可能不支援自動數據傳輸，用戶必須顯式申請伺服器更新一個特定的項目；

2.節省通信費用。假如沒有即時傳輸的要求，則人工模式可以大幅度降低通信的開銷；

3.若用戶程式只用於控制伺服器的執行，則往往沒有必要使用自動模式。

人工模式下用戶程式的數據更新需要採用數據申請的方式。數據申請需要呼叫DDEClientConv部件的RequestData方法。RequestData有一個參數，指向要申請的DDE項目。RequestData返回一個Pchar型式的無結束符字元串，包含了申請到的文本。返回字元串佔用的記憶體必須在程式終止前顯式釋放。

在人工模式下，即使存在一個DDEClientItem部件且與DDEClientConv相聯接，數據更新後DDEClientItem部件的Text、Lines屬性的值也不會改變。　

7.3.4 數據發送　

數據發送與一般的DDE數據流向正好相反，是把數據從DDE用戶應用程式發送到DDE伺服器應用程式。

數據發送使用DDEClientConv部件的兩個方法PokeData 和 PokeDataLines， 它們的語法是：　

function PokeData (Item: String ; Data: PChar): Boolean;

function PokeDataLines (Item: String ; Data: TStrings): Boolean;　

參數Item是DDE伺服器中被聯接的項目，Data是要發送的數據。如果數據是一個字元串，則把它轉化為PChar型式並呼叫PokeData方法；如果數據是一個字元串鍊表物件，可呼叫PokeDataLines方法。

方法的返回值標誌數據轉送是否成功。因為有一些DDE伺服器應用程式並不接收發送的數據。

下面的語句把編輯框中的內容發送給伺服器：　

StrPCopy(TheText , Edit1.text);

DDEClientConv1.PokeData(DDEClientItem1.DDEItem , TheText);　

過程StrPCopy把一個Pascal型式的字元串拷貝到一個無結束符的PChar型式字元串中。

解決Excel2010插入圖片變成連結方式存檔

使用方法二可解決以下狀況

Excel 2010 插入圖片後, 發到收件人後, 圖片不能正確顯示, 只顯示"無法顯示連結的圖像"

//use  office2000,comobj;

procedure DBGrid3Excel(var DBGrid: TINFODBGrid;  ExcelFileName: string);
var  MyExcel: Variant;
     x,y, Z:integer;
     aGONO1:String;
     aPIC: Variant;
     iPic:Integer;
     aRange: Variant;

begin
  Z:=dbgrid.FieldCount;
  deletefile(ExcelFileName);
  MyExcel := CreateOleOBject('Excel.Application');
  MyExcel.WorkBooks.Add;
  MyExcel.Visible := True;
  MyExcel.WorkBooks[1].Saveas(ExcelFileName);
  dbgrid.DataSource.DataSet.First;
  MyExcel.Range['A1:N1'].Select;//選取一整行
  MyExcel.Selection.Merge;
  MyExcel.WorkBooks[1].WorkSheets[1].Cells[1,1] := Printstr;

  y:=2;
  for x:=1 to dbgrid.FieldCount do
  begin
    if dbgrid.Columns[x-1].Visible then
    begin
      MyExcel.WorkBooks[1].WorkSheets[1].Cells[y,x] := dbgrid.Columns[x-1].title.caption;
      // 將該欄設為標選
      MyExcel.WorkBooks[1].WorkSheets[1].Cells[y,x].Select;
      // 將標題欄位變粗體字
      MyExcel.Selection.Font.Bold := true;
      // 設定欄位寬度
      MyExcel.WorkBooks[1].WorkSheets[1].Columns[x].ColumnWidth := dbgrid.Fields[x-1].DisplayWidth;
    end;
  end;
  inc(y);
  iPic:=1;
  aGONO1:='';
  while not dbgrid.DataSource.DataSet.eof do
  begin
    for x:=1 to dbgrid.FieldCount do
    begin
      if  dbgrid.Fields[x-1].FieldName='PICNAM' then
      begin
          MyExcel.WorkBooks[1].WorkSheets[1].Columns[x].ColumnWidth := 19;
          MyExcel.WorkBooks[1].WorkSheets[1].Rows[y].RowHeight:= 53;//recycle
          if (FileExists(Pchar(dbgrid.DataSource.DataSet.FieldByName('PICNAM').AsString)))then
          begin
            MyExcel.WorkBooks[1].WorkSheets[1].Cells[y,1].Select;
            //方法一
            aPIC:= MyExcel.WorkBooks[1].WorkSheets[1].Pictures.Insert(dbgrid.DataSource.DataSet.FieldByName('PICNAM').Value);
            aPIC.Select;
            //aPIC.ShapeRange.IncrementLeft(0);
            //aPIC.ShapeRange.IncrementTop(0);
            //aPIC.ShapeRange.LockAspectRatio := msoFalse; //圖檔大小LOCK          
            aPIC.ShapeRange.height:=50;//指定高度
            //aPIC.ShapeRange.Width:=50;
            //aPIC.ShapeRange.ScaleWidth:=0.5;

            //取消底色
            aPIC.ShapeRange.PictureFormat.TransparentBackground := 1;
            aPIC.ShapeRange.PictureFormat.TransparencyColor := RGB(255, 255, 255);
            aPIC.ShapeRange.Fill.Visible := 0;
                       
            //方法二 Shapes.AddPicture
            aPIC:= MyExcel.WorkBooks[1].WorkSheets[1].Shapes.AddPicture(dbgrid.DataSource.DataSet.FieldByName('PICNAM').Value, msoTrue, msoTrue, 0, 33+52.5*(y-3), 50, 50);

            //MyExcel.WorkBooks[1].WorkSheets[iSheets].Pictures.Insert(dbgrid.DataSource.DataSet.FieldByName('PICNAM').Value);
            //MyExcel.WorkBooks[1].WorkSheets[iSheets].Pictures.Insert('\\127.0.0.1\PICT\10WEG011001.jpg');
            //設定圖檔大小
            //MyExcel.WorkBooks[1].WorkSheets[iSheets].Pictures[iPic].ShapeRange.height:=200;
            //MyExcel.WorkBooks[1].WorkSheets[iSheets].Pictures[iPic].ShapeRange.width:=40;

            Inc(iPic);//記錄目前圖檔陣列
          end;
      end
      else if dbgrid.Columns[x-1].Visible then
      begin
        if dbgrid.Fields[x-1].DataType =ftString then
          MyExcel.WorkBooks[1].WorkSheets[1].Cells[y,x] := ''''+dbgrid.Fields[x-1].DisplayText
        else
         MyExcel.WorkBooks[1].WorkSheets[1].Cells[y,x] := dbgrid.Fields[x-1].DisplayText;
      end;
    end;
    inc(y);
    //aGONO1 := dbgrid.DataSource.DataSet.FieldByName('GONO1').AsString;
    dbgrid.DataSource.DataSet.next;
  end;
end;

以下節錄 Shapes.AddPicture 方法說明：
從已存在的檔案中建立圖片。傳回代表新圖片的 Shape 物件。
語法

ActiveSheet.AddPicture(Filename, LinkToFile, SaveWithDocument, Left, Top, Width, Height)

參數

名稱 必要/選用 資料類型 描述
Filename 必要 String 要建立 OLE 物件的來源檔案。
LinkToFile 必要 MsoTriState 要連結的檔案。
SaveWithDocument 必要 MsoTriState 要與文件一同儲存的圖片。
Left 必要 Single 圖片的左上角位置 (以點為單位)，與文件左上角相對。
Top 必要 Single 圖片的左上角位置 (以點為單位)，與文件頂端相對。
Width 必要 Single 圖片的寬度 (以點為單位)。
Height 必要 Single 圖片的高度 (以點為單位)。

傳回值 Shape

備註
MsoTriState 可以為下列其中一個 MsoTriState 常數。
msoCTrue
msoFalse ：將圖片建立成獨立的檔案複本。
msoTriStateMixed
msoTriStateToggle
msoTrue：建立圖片與其來源檔案之間的連結。

MsoTriState 可以為下列其中一個 MsoTriState 常數。
msoCTrue
msoFalse：只在文件中存放連結資訊。
msoTriStateMixed
msoTriStateToggle
msoTrue：將連結的圖片與其所插入的文件一同儲存。如果 LinkToFile 為 msoFalse，則此引數必須為 msoTrue。

修改showmessage的字型

from : Tform;

    from := CreateMessageDialog(str, mtInformation, [mbOK]);

    try

      from.font.size := 12;

      from.AutoSize := True;

      with from do

      begin

        lab := TLabel(FindComponent('Message')) ;

        if lab <> nil then

        begin

          lab.Font.Color := clNavy ; //你要的顏色在這裡設

          lab.Font.Size := 12;

        end ;

        from.ShowModal;

      end;

    finally

      from.free;

    end;

ASCII 碼

ASCII 碼大致可以分作三部分組成。

第一部分由 00H 到 1FH 共 32 個，一般用來通訊或作為控制之用，有些字元可顯示於螢幕，有些則無法顯示在螢幕上，但能看到其效果(例如換行字元、歸位字元)。如下表：

第二部分是由 20H 到 7FH 共 96 個，這 95 個字元是用來表示阿拉伯數字、英文字母大小寫和底線、括號等符號，都可以顯示在螢幕上。如下表：

第三部分由 80H 到 0FFH 共 128 個字元，一般稱為『擴充字元』，這 128 個擴充字元是由 IBM 制定的，並非標準的 ASCII 碼。這些字元是用來表示框線、音標和其他歐洲非英語系的字母。

條碼列印後條碼機無法讀取

原問題出處：

條碼列印出來後可是條碼機都無法讀取,我用過雷射印表機,噴墨式印表機,以及點矩陣印表機列印出來,用條碼機都無法讀取.而且用過各種條碼字形以及用條碼元件製作出來的條碼,結果都一樣,條碼機都辨識不出來.
PS:條碼機確定是好的,在辨識讀取一般商品上的條碼都沒問題.

解決方式：

條碼資料是 12345 必須在前後面加上 * 也就是 *12345*

如何輸出特殊字元給周邊設備

例如，發票印表機接在LPT1，欲送一行指令(escp000)給發票印表機

作法如下

1.建立一個文字檔：copy con test.txt

2.將指令輸入，esc ASCII十進位是char(27)，輸入方式為ALT建按著+數字鍵27

3.按CLRL+Z儲存檔案

4.將檔案內容傳給周邊設備：TYPE TEST.TXT>LPT1

Delphi音效轉入資源檔

1.使用文字編輯器編輯一個文字檔(如Sound.rc)，內容大致如下：
RING WAVE RING.WAV //有很多檔案，可以分成數行注意大小寫。
記得該文字檔同目錄中必須要有RING.WAV這個檔案。
2.使用brcc32(安裝DELPHI後就有)這個檔案編譯Sound.rc。
    brcc32 Sound.rc
編譯後會產生一個Sound.res。
3.在你的專案中加入Sound.res(記得把檔案放入專案的同目錄下)。
program Test;
uses
    Forms,
    Windows,
    .....;
{$R *.res}
{$R Sound.RES}
begin
    Application.Initialize;
    Application.Title := 'Test';
    ....
    Application.Run;
end.
4.在FORM的CREATE事件中，加入下列程式碼，並且記得uses MMSystem。
PlaySound('RING',hinstance,SND_ASYNC or SND_RESOURCE);
5.這樣連音源檔案都可以LINK進執行檔內，不需額外包裝。

Dos下測試com port

Dos指令測試 com port是

MODE COM1:96,N,8,1

可進行測試com port 裝置是否有正常連接

Note:若偵測結果有錯，請檢察com1是否有被其他裝置佔用住

以下做法可以直接將測試文字檔直接由dos視窗輸出(文字檔請見附件)

以下指令可將測試文字檔由com port輸出

QcickReport換行範例

函數：判斷是否中文
function IsLeadByteTw(InStr : String):Boolean;
var ws:widestring;
begin
   ws:=InStr;
   if IntToHex(Word(ws[Length(WS)]),2)='00' then
       Result := True // 中文
   else // 英文
       Result := False;
end;
換行實作範例
procedure DetailBand1BeforePrint(Sender: TQRCustomBand;
  var PrintBand: Boolean);
var
  a : integer;
  b, Str : string;
  AString : TStringList;
  ROWS : integer;
begin
  inherited;
  rows := 0;
  //決定BANK的高度。
  QRLabel3.Caption := '';
//  QRMemo1.Lines.Clear;
  b:='';
  AString := TStringList.Create;
  AString.Text := cdsPrintSCUNO.AsString;
  QRLabel3.Caption := '';
  if trim(AString.Text) <> '' then
  begin
    for a:= 0 to Astring.Count -1 do
    begin
     b := b + StringReplace(Trim(Astring.Strings[a]),'?','',[rfReplaceAll]);
    end;

    While Length(b) > 0 do
    begin
      Str := Copy(b, 1, 80);
      if IsLeadByteTw(Str) then
      begin
         Str := Copy(b, 1, 80);
         Delete(b, 1, 81);
      end
      else
         Delete(b, 1, 80);
      QRLabel3.Caption := QRLabel3.Caption + Str + #13;
//      QRMemo1.Lines.Add(Str);
      rows := rows + 1;
    end;
  end;
  AString.Free;
//  showmessage(inttostr(rows));
//  QRMemo1.Height := 16*rows;
  QRLabel3.Height := 16*rows;
  DetailBand1.Height := 20 + (rows-1)*16;
end;

第二次運行時自動關閉程式如何實現

以下做法可以實現：一支程式，第一次可正常運行，重複運行時，不但不能運行，還把第一次運行的程式關閉
uses Tlhelp32;

function FindProcess(AFileName: string): boolean;
var
hSnapshot: THandle;
lppe: TProcessEntry32;
Found: Boolean;
KillHandle: THandle;
begin
Result :=False;
hSnapshot := CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0);
lppe.dwSize := SizeOf(TProcessEntry32);
Found := Process32First(hSnapshot, lppe);
while Found do
begin
if ((UpperCase(ExtractFileName(lppe.szExeFile))=UpperCase(AFileName)) or (UpperCase(lppe.szExeFile )=UpperCase(AFileName))) then
begin
Result :=True;
end;
Found := Process32Next(hSnapshot, lppe);
end;
end;


procedure EndProcess(AFileName: string);
const
PROCESS_TERMINATE = $0001;
var
ContinueLoop: BOOL;
FSnapShotHandle: THandle;
FProcessEntry32: TProcessEntry32;
begin
FSnapShotHandle := CreateToolhelp32SnapShot(TH32CS_SNAPPROCESS, 0);
FProcessEntry32.dwSize := SizeOf(FProcessEntry32);
ContinueLoop := Process32First(FSnapshotHandle, FProcessEntry32);
while integer(ContinueLoop) <> 0 do
begin
if ((UpperCase(ExtractFileName(FProcessEntry32.szExeFile))=UpperCase(AFileName)) or (UpperCase(FProcessEntry32.szExeFile )=UpperCase(AFileName))) then
TerminateProcess(OpenProcess(PROCESS_TERMINATE, BOOL(0),FProcessEntry32.th32ProcessID), 0);
ContinueLoop := Process32Next(FSnapshotHandle, FProcessEntry32);
end;
end;


procedure TForm1.FormCreate(Sender: TObject);
begin
if FindProcess('notepad.exe') then
begin
EndProcess('notepad.exe');
end;
end;


Dataset存成CSV檔

use Excel2000;

procedure TFMstGDS_1903R14.SaveToExcel_CSV(var DBGrid: TInfoDBGrid);
var aExeclFile:TSaveDialog;
begin
if DBGrid.DataSource=nil then Exit;
if not DBGrid.DataSource.DataSet.Active then Exit;
if DBGrid.DataSource.DataSet.RecordCount = 0 then Exit;
aExeclFile:=TSaveDialog.Create(nil);
try
aExeclFile.DefaultExt:='.CSV';
aExeclFile.Filter:='*.CSV|*.CSV';
aExeclFile.Title:='請選擇EXECL(CSV)的目錄';
aExeclFile.Options:=[ofOverwritePrompt,ofHideReadOnly,ofEnableSizing];
if aExeclFile.Execute then DBGrid3Excel_CSV(DBGrid,aExeclFile.filename);
finally
aExeclFile.Free;
end;
end;


procedure TFMstGDS_1903R14.DBGrid3Excel_CSV(var DBGrid: TINFODBGrid;
ExcelFileName: string);
var
lcid: integer;
Temp_Worksheet: _WorkSheet;
SheetType:OleVariant;
ExCelApplication1 : TExCelApplication;
ExcelWorkBook1 : TExcelWorkBook;
ExcelWorksheet1 : TExcelWorksheet;
ExcelChart1 : TExcelChart;

begin
inherited;

SaveDataSet(DBGrid.DataSource.DataSet,ExcelFileName, ',');
try
//開始轉換
lcid := GetUserDefaultLCID;
//動態新增；
ExCelApplication1 := TExCelApplication.Create(nil);
ExcelWorkBook1 := TExcelWorkBook.Create(nil);
ExcelWorksheet1 := TExcelWorksheet.Create(nil);
ExcelChart1 := TExcelChart.Create(nil);
//開啟現存的檔案
ExcelApplication1.Connect;
ExcelWorkbook1.ConnectTo(
ExcelApplication1.Workbooks.Open (ExcelFileName, EmptyParam,EmptyParam,EmptyParam,EmptyParam,
EmptyParam,EmptyParam,EmptyParam,EmptyParam, EmptyParam,EmptyParam,EmptyParam,EmptyParam,0));
ExcelWorksheet1.ConnectTo(ExcelWorkbook1.Worksheets[1] as _Worksheet);
ExcelWorksheet1.Name := '資料';
except
ON E: EXCEPTION DO
BEGIN
showmessage(e.Message);
showmessage('無法連上Excel');
END;
end;
end;


procedure TFMstGDS_1903R14.SaveDataSet(TT: TDataSet; FileName,
Delimiter: String);
var
i, j : integer;line : string;
M : TStringList;
begin
TT.Active := true;
TT.First;
M := TStringList.Create;
//M.Add(Printstr); //條件
{//抬頭
Line := TT.Fields[0].DisplayName;
For i := 1 to TT.FieldCount -1 do
begin
if TT.Fields[i].Visible then
Line := Line + Delimiter + TT.Fields[i].DisplayLabel;
end;
M.Add(Line);
}
j:=0;
while not TT.Eof do
begin
Line := TT.Fields[0].AsString;
For i := 1 to TT.FieldCount -1 do
begin
if TT.Fields[i].Visible then
begin
if TT.Fields[i].DataType = ftString then
begin
if Copy(TT.Fields[i].AsString, 1, 1) = '0' then Line := Line + Delimiter +''''+ TT.Fields[i].AsString
else Line := Line + Delimiter + TT.Fields[i].AsString;
end
else
begin
Line := Line + Delimiter + TT.Fields[i].AsString;
end;
end;
end;
M.Add(Line);
inc(j);
// Label1.Caption := '第' + inttostr(j) + '筆';
Application.ProcessMessages;
TT.Next;
end;
M.SaveToFile(FileName);
end;


ESC/POS指令以及ESC/POS指令集

ESC/POS指令集，打印控制命令（WPSON StandardCode for Printer）是EPSON公司自己制定的针式打印机的标准化指令集，现在已成为针式打印机控制语言事实上的工业标准。ESC/POS打印命令集是ESC打印控制命令的简化版本，现在大多数票据打印都采用ESC/POS指令集。其显著特征是：其中很大一部分指令都是以ESC控制符开始的一串代码。英文模式下的命令
代码 功能
CR 回车
ESC ! 设置打印方式
ESC % 选择或取消用户自定义字符集
ESC & 定义用户自定义字符集
ESC * 设置位映射方式
ESC @ 初始化打印机
ESC ~ LED ON/OFF
ESC < 返回行首
ESC 2 选择行间距为1/6英寸
ESC 3 设置行进为最小间距
ESC BEL 蜂鸣器ON/OFF
ESC C 设置单页长度
ESC c0 选择打印页
ESC c1 选择行间距
ESC c3 选择纸结束信号输出
ESC c4 选择打印纸及检测器（终止打印）
ESC c5 禁止/使能面板开关
ESC c6 禁止/使能ON-LINE开关
ESC d 打印及N行进纸
ESC D 设置TAB位置
ESC e 打印病退回N行
ESC f 设单页等待时间
ESC F 选择或取消单页退纸区
ESC i 全切割
ESC J 以最小间距进行打印和进纸
ESC K 以最小间距进行打印和退纸
ESC l 选择或取消倒过来的字符
ESC m 局部切割
ESC o 印章
ESC p 产生指定脉冲
ESC q 释放纸
ESC r 选择打印颜色
ESC R 选择国际字符子集
ESC SP 设置右边界
ESC t 选择字符码表
ESC U 选择或取消单向打印
ESC V 发送打印机状态
ESC z 设置或取消两页并行打印
FF 打印送出单页
HT 水平TAB
LF 换行
RS 流水TAB

BDE出現Insufficient memory for this operation的官方處理方式

設定值必須要關掉AP，重開AP 的服務才會有效Insufficient memory for this operation" ($2501)
Problem: Your application (or another BDE application) has exhausted the memory available to the BDE.
Solution:
1) Close all BDE applications.
2) Find the program BDEADMIN.EXE. This is usually in a directory somewhere under "\Program Files\Borland...".
3) Run BDEADMIN.EXE and click on the Configuration tab.
4) There should be an item in the treeview on the left side called "Configuration". If it's not expanded, expand it.
5) Next, expand the System entry below it. Under System, select INIT.
6) In the right-side window, find the entry called "SHAREDMEMSIZE". Change this value to 4096.
7) Next, click on the word "Object" in the main window's menu bar, and select Apply.
8) Answer "OK" to the confirmation to "Save all edits...".

You can now try to start your application again. If you still have trouble running the application and you are running Windows NT or Windows 2000, follow the same instructions above, but this time leave the SHAREDMEMSIZE property at 4096, and change the SHAREDMEMLOCATION property to "0x5BDE". Then apply the changes as before, and retry your application. If you still receive the same error, try changing SHAREDMEMSIZE to 8192. If the error continues to persist, you can also try "0x6BDE" for SHAREDMEMLOCATION. If the error still continues to persist, you can also try other values for SHAREDMEMLOCATION. (See solution for error $210D below.)