RSS Feed (xml)
首先在Additional->新增一個ApplicationEvents，然後在事件OnShortCut新增下列程式碼：
procedure TFmain.ApplicationEvents1ShortCut(var Msg: TWMKey;
var Handled: Boolean);
begin
if (TWMKey(Msg).CharCode = VK_ESCAPE) then
self.close
end;
星期五, 8月 31, 2007
如何能隨時按ESC離開視窗
首先在Additional->新增一個ApplicationEvents，然後在事件OnShortCut新增下列程式碼：
星期四, 8月 30, 2007
讀取ini檔案
function GetContext(const AIniFilename: string): string;
var
FIniFile: TIniFile;
Context_Main, Context_Function: string;
begin
if not FileExists(AIniFilename) then exit;
FIniFile:= TIniFile.Create(AIniFilename);
try
Context_Main:= FIniFile.ReadString('Context', 'Main', '');
Context_Function:= FIniFile.ReadString('Context', 'Function', '');
Result:= format('%s%s', [Context_Main, Context_Function]);
finally
FIniFile.Free;
end;
end;
procedure TForm1.Button1Click(Sender: TObject);
var
Filename: string;
begin
Filename:= 'Context.ini';
Edit1.Text:= GetContext(Filename);
end;
ini內容:
[Context]
Main=123456
Function=ABCDEFG
Procedure=hello
Function=wxyz
Procedure=World
更完整的範例：
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,IniFiles,
Dialogs, StdCtrls;
type
TForm1 = class(TForm)
Button1: TButton;
Button2: TButton;
Button3: TButton;
Memo1: TMemo;
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure Button3Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
const
AIniFileName = 'funds.ini';
implementation
{$R *.dfm}
//讀取資訊
procedure TForm1.Button1Click(Sender: TObject);
var
FIniFile: TIniFile;
begin
//if not FileExists(AIniFilename) then exit;
FIniFile:= TIniFile.Create(AIniFilename);
try
memo1.Lines.add(FIniFile.ReadString('基金顯示資訊','國內或國外基金', ''));
memo1.Lines.add(FIniFile.ReadString('基金顯示資訊','基金公司', ''));
memo1.Lines.add(FIniFile.ReadString('基金顯示資訊','基金名稱', ''));
memo1.Lines.add(FIniFile.ReadString('基金顯示資訊','指標數目', ''));
finally
FIniFile.Free;
end;
end;
//寫入ini
procedure TForm1.Button2Click(Sender: TObject);
var
FIniFile: TIniFile;
begin
//if not FileExists(AIniFilename) then exit;
FIniFile:= TIniFile.Create(AIniFilename);
try
FIniFile.WriteString('基金顯示資訊','指標數目', '0');
FIniFile.WriteString('指標1','指標名稱', 'MACD');
FIniFile.WriteString('指標1','參數1', '5');
FIniFile.WriteString('指標1','參數2', '3');
FIniFile.WriteString('指標1','參數3', '3');
FIniFile.WriteString('指標1','參數4', '3');
finally
FIniFile.Free;
end;
end;
//刪除
procedure TForm1.Button3Click(Sender: TObject);
var
FIniFile: TIniFile;
begin
FIniFile:= TIniFile.Create(AIniFilename);
try
FIniFile.EraseSection('基金顯示資訊');
FIniFile.DeleteKey('指標1','指標名稱');
finally
FIniFile.Free;
end;
end;
procedure TForm1.FormCreate(Sender: TObject);
var
FIniFile: TIniFile;
begin
if not FileExists(AIniFilename) then //可以放在temp目錄內好了
begin
FIniFile:= TIniFile.Create(AiniFileName);
try
FIniFile.WriteString('基金顯示資訊','國內或國外基金', '國內基金');
FIniFile.WriteString('基金顯示資訊','基金公司', '富達證券');
FIniFile.WriteString('基金顯示資訊','基金名稱', '富達新興市場基金');
FIniFile.WriteString('基金顯示資訊','指標數目', '0');
FIniFile.WriteString('指標1','指標名稱', '');
FIniFile.WriteString('指標1','參數1', '');
FIniFile.WriteString('指標1','參數2', '');
FIniFile.WriteString('指標1','參數3', '');
FIniFile.WriteString('指標1','參數4', '');
FIniFile.WriteString('指標2','指標名稱', '');
FIniFile.WriteString('指標2','參數1', '');
FIniFile.WriteString('指標2','參數2', '');
FIniFile.WriteString('指標2','參數3', '');
FIniFile.WriteString('指標2','參數4', '');
FIniFile.WriteString('指標3','指標名稱', '');
FIniFile.WriteString('指標3','參數1', '');
FIniFile.WriteString('指標3','參數2', '');
FIniFile.WriteString('指標3','參數3', '');
FIniFile.WriteString('指標3','參數4', '');
finally
FIniFile.Free;
end;
end;
end;
end.
Delphi ShellExecute 執行外部程式
uses
ShellAPI;
procedure TForm1.FormCreate(Sender: TObject);
begin
// 「執行 notepad」
ShellExecute(Handle, nil, 'notepad', nil, nil, SW_SHOWNORMAL);
// 「打開 word 檔」
ShellExecute(Handle, 'oppen', 'C:\a.doc', nil, nil, SW_SHOWNORMAL);
// 「列印 excel 檔」
ShellExecute(Handle, 'print', 'C:\a.xls', nil, nil, SW_SHOWNORMAL);
// 「開網頁」
ShellExecute(Handle, nil, 'http://www.borland.com/', nil, nil, SW_SHOWNORMAL);
// 「寄信」
ShellExecute(Handle, nil, 'mailto:name@host.com?subject=主旨&body=內文', nil, nil, SW_SHOWNORMAL);
// 「我的電腦」
ShellExecute(0, 'open', '::{20D04FE0-3AEA-1069-A2D8-08002B30309D}', nil, nil, SW_NORMAL);
// 「網路上的芳鄰」
ShellExecute(0, 'open', '::{208D2C60-3AEA-1069-A2D7-08002B30309D}', nil, nil, SW_NORMAL);
// 「我的文件」
ShellExecute(0, 'open', '::{450D8FBA-AD25-11D0-98A8-0800361B1103}', nil, nil, SW_NORMAL);
// 「控制台」
ShellExecute(0, 'open', '::{20D04FE0-3AEA-1069-A2D8-08002B30309D}\::{21EC2020-3AEA-1069-A2DD-08002B30309D}', nil, nil, SW_NORMAL);
// 「印表機」
ShellExecute(0, 'open', '::{20D04FE0-3AEA-1069-A2D8-08002B30309D}\::{2227A280-3AEA-1069-A2DE-08002B30309D}', nil, nil, SW_NORMAL);
end;
end;
指令
WinExec(LPCSTR lpCmdLine,UINT uCmdShow);
lpCmdLine:指令執行字串
此應用程式必須可以執行
目錄及路徑必須正確
自己可以呼叫自己
被呼叫的程式為獨立的執行緒，和呼叫者無關
不可遠端呼叫
uCmdShow:執行模式
包括
SW_HIDE 將程式隱藏
SW_MAXIMIXE 將程式最大化
SW_MINIMIZE 將程式最小化
SW_SHOW 將程式顯示在正確位置
SW_SHOWDEFAULT 將程式顯示在預設位置
SW_SHOWMAXIMIZED 將程式顯示最大化
SW_SHOWMINIMIZED 將程式顯示最小化
SW_SHOWMINNOACTIVATE 將程式顯示最小化,但不Active
SW_SHOWNA 將程式顯示,但Active
SW_SHOWNOACTIVATE 將程式顯示,但不Active
SW_SHOWNORMAL 將程式顯示一般狀態
傳回值
>=31 成功
0 系統沒有記憶體資源
ERROR_BADFORMAT 此程式不是Wind32格式或不是執行檔
ERROR_FILE_NOT_FOUND 該檔案找不到
ERROR_PATH_NOT_FOUND 該路徑找不到
//呼叫計算機
WinExec('Calc.exe',SW_SHOWDEFAULT);
//呼叫命令提示字元
WinExec('Command.com',SW_SHOWDEFAULT);
//呼叫自己範例
WinExec('project1.exe',SW_SHOW);
計算字串及檔案的md5
因為網路上常須計算md5值作驗證，所以我把它規到網際網路這裡。
首先須先加入md5.pas到你的專案內。
接著新增二個Label、三個Button、及二個Edit還有一個Memo跟OpenDialog
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls;
type
TForm1 = class(TForm)
Button1: TButton;
Button2: TButton;
Button3: TButton;
Edit1: TEdit;
Edit2: TEdit;
Label1: TLabel;
Label2: TLabel;
Memo1: TMemo;
OpenDialog1: TOpenDialog;
procedure Button1Click(Sender: TObject);
procedure Button3Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
uses
md5;
function LogEntry(Cmd, Msg: string; Dig: MD5Digest): string;
begin
Result := Format('%s(''%s'') =' + #13#10 + ' %s', [Cmd, Msg, MD5Print(Dig)]); //以後要拿來用就MD5Print(Edit1.Text)
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
Memo1.Lines.add(LogEntry('MD5String', Edit1.Text, MD5String(Edit1.Text)));
end;
procedure TForm1.Button3Click(Sender: TObject);
begin
if OpenDialog1.Execute then
Edit2.Text := OPenDialog1.FileName;
end;
procedure TForm1.Button2Click(Sender: TObject);
begin
Screen.Cursor := crHourGlass;
Memo1.Lines.add(LogEntry('MD5File', Edit2.Text, MD5File(Edit2.Text)));
Screen.Cursor := crDefault;
end;
end.
md5.pas
unit md5;
// ------------------------------------------------------------------
interface
// ------------------------------------------------------------------
uses
Windows;
type
MD5Count = array[0..1] of DWORD;
MD5State = array[0..3] of DWORD;
MD5Block = array[0..15] of DWORD;
MD5CBits = array[0..7] of byte;
MD5Digest = array[0..15] of byte;
MD5Buffer = array[0..63] of byte;
MD5Context = record
State: MD5State;
Count: MD5Count;
Buffer: MD5Buffer;
end;
procedure MD5Init(var Context: MD5Context);
procedure MD5Update(var Context: MD5Context; Input: pChar; Length: longword);
procedure MD5Final(var Context: MD5Context; var Digest: MD5Digest);
function MD5String(M: string): MD5Digest;
function MD5File(N: string): MD5Digest;
function MD5Print(D: MD5Digest): string;
function MD5Match(D1, D2: MD5Digest): boolean;
// ------------------------------------------------------------------
IMPLEMENTATION
// ------------------------------------------------------------------
var
PADDING: MD5Buffer = (
$80, $00, $00, $00, $00, $00, $00, $00,
$00, $00, $00, $00, $00, $00, $00, $00,
$00, $00, $00, $00, $00, $00, $00, $00,
$00, $00, $00, $00, $00, $00, $00, $00,
$00, $00, $00, $00, $00, $00, $00, $00,
$00, $00, $00, $00, $00, $00, $00, $00,
$00, $00, $00, $00, $00, $00, $00, $00,
$00, $00, $00, $00, $00, $00, $00, $00
);
function F(x, y, z: DWORD): DWORD;
begin
Result := (x and y) or ((not x) and z);
end;
function G(x, y, z: DWORD): DWORD;
begin
Result := (x and z) or (y and (not z));
end;
function H(x, y, z: DWORD): DWORD;
begin
Result := x xor y xor z;
end;
function I(x, y, z: DWORD): DWORD;
begin
Result := y xor (x or (not z));
end;
procedure rot(var x: DWORD; n: BYTE);
begin
x := (x shl n) or (x shr (32 - n));
end;
procedure FF(var a: DWORD; b, c, d, x: DWORD; s: BYTE; ac: DWORD);
begin
inc(a, F(b, c, d) + x + ac);
rot(a, s);
inc(a, b);
end;
procedure GG(var a: DWORD; b, c, d, x: DWORD; s: BYTE; ac: DWORD);
begin
inc(a, G(b, c, d) + x + ac);
rot(a, s);
inc(a, b);
end;
procedure HH(var a: DWORD; b, c, d, x: DWORD; s: BYTE; ac: DWORD);
begin
inc(a, H(b, c, d) + x + ac);
rot(a, s);
inc(a, b);
end;
procedure II(var a: DWORD; b, c, d, x: DWORD; s: BYTE; ac: DWORD);
begin
inc(a, I(b, c, d) + x + ac);
rot(a, s);
inc(a, b);
end;
// ------------------------------------------------------------------
// Encode Count bytes at Source into (Count / 4) DWORDs at Target
procedure Encode(Source, Target: pointer; Count: longword);
var
S: PByte;
T: PDWORD;
I: longword;
begin
S := Source;
T := Target;
for I := 1 to Count div 4 do begin
T^ := S^;
inc(S);
T^ := T^ or (S^ shl 8);
inc(S);
T^ := T^ or (S^ shl 16);
inc(S);
T^ := T^ or (S^ shl 24);
inc(S);
inc(T);
end;
end;
// Decode Count DWORDs at Source into (Count * 4) Bytes at Target
procedure Decode(Source, Target: pointer; Count: longword);
var
S: PDWORD;
T: PByte;
I: longword;
begin
S := Source;
T := Target;
for I := 1 to Count do begin
T^ := S^ and $ff;
inc(T);
T^ := (S^ shr 8) and $ff;
inc(T);
T^ := (S^ shr 16) and $ff;
inc(T);
T^ := (S^ shr 24) and $ff;
inc(T);
inc(S);
end;
end;
// Transform State according to first 64 bytes at Buffer
procedure Transform(Buffer: pointer; var State: MD5State);
var
a, b, c, d: DWORD;
Block: MD5Block;
begin
Encode(Buffer, @Block, 64);
a := State[0];
b := State[1];
c := State[2];
d := State[3];
FF (a, b, c, d, Block[ 0], 7, $d76aa478);
FF (d, a, b, c, Block[ 1], 12, $e8c7b756);
FF (c, d, a, b, Block[ 2], 17, $242070db);
FF (b, c, d, a, Block[ 3], 22, $c1bdceee);
FF (a, b, c, d, Block[ 4], 7, $f57c0faf);
FF (d, a, b, c, Block[ 5], 12, $4787c62a);
FF (c, d, a, b, Block[ 6], 17, $a8304613);
FF (b, c, d, a, Block[ 7], 22, $fd469501);
FF (a, b, c, d, Block[ 8], 7, $698098d8);
FF (d, a, b, c, Block[ 9], 12, $8b44f7af);
FF (c, d, a, b, Block[10], 17, $ffff5bb1);
FF (b, c, d, a, Block[11], 22, $895cd7be);
FF (a, b, c, d, Block[12], 7, $6b901122);
FF (d, a, b, c, Block[13], 12, $fd987193);
FF (c, d, a, b, Block[14], 17, $a679438e);
FF (b, c, d, a, Block[15], 22, $49b40821);
GG (a, b, c, d, Block[ 1], 5, $f61e2562);
GG (d, a, b, c, Block[ 6], 9, $c040b340);
GG (c, d, a, b, Block[11], 14, $265e5a51);
GG (b, c, d, a, Block[ 0], 20, $e9b6c7aa);
GG (a, b, c, d, Block[ 5], 5, $d62f105d);
GG (d, a, b, c, Block[10], 9, $2441453);
GG (c, d, a, b, Block[15], 14, $d8a1e681);
GG (b, c, d, a, Block[ 4], 20, $e7d3fbc8);
GG (a, b, c, d, Block[ 9], 5, $21e1cde6);
GG (d, a, b, c, Block[14], 9, $c33707d6);
GG (c, d, a, b, Block[ 3], 14, $f4d50d87);
GG (b, c, d, a, Block[ 8], 20, $455a14ed);
GG (a, b, c, d, Block[13], 5, $a9e3e905);
GG (d, a, b, c, Block[ 2], 9, $fcefa3f8);
GG (c, d, a, b, Block[ 7], 14, $676f02d9);
GG (b, c, d, a, Block[12], 20, $8d2a4c8a);
HH (a, b, c, d, Block[ 5], 4, $fffa3942);
HH (d, a, b, c, Block[ 8], 11, $8771f681);
HH (c, d, a, b, Block[11], 16, $6d9d6122);
HH (b, c, d, a, Block[14], 23, $fde5380c);
HH (a, b, c, d, Block[ 1], 4, $a4beea44);
HH (d, a, b, c, Block[ 4], 11, $4bdecfa9);
HH (c, d, a, b, Block[ 7], 16, $f6bb4b60);
HH (b, c, d, a, Block[10], 23, $bebfbc70);
HH (a, b, c, d, Block[13], 4, $289b7ec6);
HH (d, a, b, c, Block[ 0], 11, $eaa127fa);
HH (c, d, a, b, Block[ 3], 16, $d4ef3085);
HH (b, c, d, a, Block[ 6], 23, $4881d05);
HH (a, b, c, d, Block[ 9], 4, $d9d4d039);
HH (d, a, b, c, Block[12], 11, $e6db99e5);
HH (c, d, a, b, Block[15], 16, $1fa27cf8);
HH (b, c, d, a, Block[ 2], 23, $c4ac5665);
II (a, b, c, d, Block[ 0], 6, $f4292244);
II (d, a, b, c, Block[ 7], 10, $432aff97);
II (c, d, a, b, Block[14], 15, $ab9423a7);
II (b, c, d, a, Block[ 5], 21, $fc93a039);
II (a, b, c, d, Block[12], 6, $655b59c3);
II (d, a, b, c, Block[ 3], 10, $8f0ccc92);
II (c, d, a, b, Block[10], 15, $ffeff47d);
II (b, c, d, a, Block[ 1], 21, $85845dd1);
II (a, b, c, d, Block[ 8], 6, $6fa87e4f);
II (d, a, b, c, Block[15], 10, $fe2ce6e0);
II (c, d, a, b, Block[ 6], 15, $a3014314);
II (b, c, d, a, Block[13], 21, $4e0811a1);
II (a, b, c, d, Block[ 4], 6, $f7537e82);
II (d, a, b, c, Block[11], 10, $bd3af235);
II (c, d, a, b, Block[ 2], 15, $2ad7d2bb);
II (b, c, d, a, Block[ 9], 21, $eb86d391);
inc(State[0], a);
inc(State[1], b);
inc(State[2], c);
inc(State[3], d);
end;
// ------------------------------------------------------------------
// Initialize given Context
procedure MD5Init(var Context: MD5Context);
begin
with Context do begin
State[0] := $67452301;
State[1] := $efcdab89;
State[2] := $98badcfe;
State[3] := $10325476;
Count[0] := 0;
Count[1] := 0;
ZeroMemory(@Buffer, SizeOf(MD5Buffer));
end;
end;
// Update given Context to include Length bytes of Input
procedure MD5Update(var Context: MD5Context; Input: pChar; Length: longword);
var
Index: longword;
PartLen: longword;
I: longword;
begin
with Context do begin
Index := (Count[0] shr 3) and $3f;
inc(Count[0], Length shl 3);
if Count[0] < (Length shl 3) then inc(Count[1]);
inc(Count[1], Length shr 29);
end;
PartLen := 64 - Index;
if Length >= PartLen then begin
CopyMemory(@Context.Buffer[Index], Input, PartLen);
Transform(@Context.Buffer, Context.State);
I := PartLen;
while I + 63 < Length do begin
Transform(@Input[I], Context.State);
inc(I, 64);
end;
Index := 0;
end else I := 0;
CopyMemory(@Context.Buffer[Index], @Input[I], Length - I);
end;
// Finalize given Context, create Digest and zeroize Context
procedure MD5Final(var Context: MD5Context; var Digest: MD5Digest);
var
Bits: MD5CBits;
Index: longword;
PadLen: longword;
begin
Decode(@Context.Count, @Bits, 2);
Index := (Context.Count[0] shr 3) and $3f;
if Index < 56 then PadLen := 56 - Index else PadLen := 120 - Index;
MD5Update(Context, @PADDING, PadLen);
MD5Update(Context, @Bits, 8);
Decode(@Context.State, @Digest, 4);
ZeroMemory(@Context, SizeOf(MD5Context));
end;
// ------------------------------------------------------------------
// Create digest of given Message
function MD5String(M: string): MD5Digest;
var
Context: MD5Context;
begin
MD5Init(Context);
MD5Update(Context, pChar(M), length(M));
MD5Final(Context, Result);
end;
// Create digest of file with given Name
function MD5File(N: string): MD5Digest;
var
FileHandle: THandle;
MapHandle: THandle;
ViewPointer: pointer;
Context: MD5Context;
begin
MD5Init(Context);
FileHandle := CreateFile(pChar(N), GENERIC_READ, FILE_SHARE_READ or FILE_SHARE_WRITE,
nil, OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL or FILE_FLAG_SEQUENTIAL_SCAN, 0);
if FileHandle <> INVALID_HANDLE_VALUE then try
MapHandle := CreateFileMapping(FileHandle, nil, PAGE_READONLY, 0, 0, nil);
if MapHandle <> 0 then try
ViewPointer := MapViewOfFile(MapHandle, FILE_MAP_READ, 0, 0, 0);
if ViewPointer <> nil then try
MD5Update(Context, ViewPointer, GetFileSize(FileHandle, nil));
finally
UnmapViewOfFile(ViewPointer);
end;
finally
CloseHandle(MapHandle);
end;
finally
CloseHandle(FileHandle);
end;
MD5Final(Context, Result);
end;
// Create hex representation of given Digest
function MD5Print(D: MD5Digest): string;
var
I: byte;
const
Digits: array[0..15] of char =
('0', '1', '2', '3', '4', '5', '6', '7', '8', '9', 'a', 'b', 'c', 'd', 'e', 'f');
begin
Result := '';
for I := 0 to 15 do Result := Result + Digits[(D[I] shr 4) and $0f] + Digits[D[I] and $0f];
end;
// -----------------------------------------------------------------------------------------------
// Compare two Digests
function MD5Match(D1, D2: MD5Digest): boolean;
var
I: byte;
begin
I := 0;
Result := TRUE;
while Result and (I < 16) do begin
Result := D1[I] = D2[I];
inc(I);
end;
end;
end.
取得電腦資訊，以後可供註冊參考~呵
以下為程式碼
unit getinfo;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, sockets, Registry;
type
TForm1 = class(TForm)
Edit1: TEdit;
Edit2: TEdit;
Edit3: TEdit;
Edit4: TEdit;
Label1: TLabel;
Label2: TLabel;
Label3: TLabel;
Label4: TLabel;
Button1: TButton;
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
function MacAddress: string;
implementation
{$R *.dfm}
function MacAddress: string;
var
Lib: Cardinal;
Func: function(GUID: PGUID): Longint; stdcall;
GUID1, GUID2: TGUID;
begin
Result := '';
Lib := LoadLibrary('rpcrt4.dll');
if Lib <> 0 then
begin
if Win32Platform <>VER_PLATFORM_WIN32_NT then
@Func := GetProcAddress(Lib, 'UuidCreate')
else @Func := GetProcAddress(Lib, 'UuidCreateSequential');
if Assigned(Func) then
begin
if (Func(@GUID1) = 0) and
(Func(@GUID2) = 0) and
(GUID1.D4[2] = GUID2.D4[2]) and
(GUID1.D4[3] = GUID2.D4[3]) and
(GUID1.D4[4] = GUID2.D4[4]) and
(GUID1.D4[5] = GUID2.D4[5]) and
(GUID1.D4[6] = GUID2.D4[6]) and
(GUID1.D4[7] = GUID2.D4[7]) then
begin
Result :=
IntToHex(GUID1.D4[2], 2) + '-' +
IntToHex(GUID1.D4[3], 2) + '-' +
IntToHex(GUID1.D4[4], 2) + '-' +
IntToHex(GUID1.D4[5], 2) + '-' +
IntToHex(GUID1.D4[6], 2) + '-' +
IntToHex(GUID1.D4[7], 2);
end;
end;
FreeLibrary(Lib);
end;
end;
procedure TForm1.Button1Click(Sender: TObject);
var
sock : TIpSocket;
GlobalMemoryInfo:TMemoryStatus;
rg:tregistry;
skey:string;
begin
sock := TIpSocket.Create(self);
Edit1.text:=sock.localHostName;
rg:=tregistry.create;
rg.RootKey:=HKEY_LOCAL_MACHINE;
skey:='HARDWARE\\DESCRIPTION\\System\\CentralProcessor\\0';
if rg.KeyExists(skey) then
begin
rg.openkey(skey,true);
Edit2.text:=trim(rg.ReadString('ProcessorNameString'));
rg.closekey;
end;
rg.free;
GlobalMemoryStatus(GlobalMemoryInfo);
Edit3.Text:=Format('%.0n',[GlobalMemoryInfo.dwTotalPhys/1024]);
Edit4.text:=MacAddress;
end;
end.
讓你的電腦一直嗶嗶叫的程式
program Project2;
uses
Windows;
var
n: integer;
begin
for n:=1 to 32767 do
Windows.Beep(n,30);
end.
讓你的Form慢慢展開顯示，慢慢隱形消失
只要在Form的onShow事件加入
只要在Form的onShow事件加入
並在Form的OnCloseQuery事件加入
AnimateWindow(handle,500,AW_Center);
只要在Form的onShow事件加入
AnimateWindow(handle,500,AW_BLEND or AW_ACTIVATE);
並在Form的OnCloseQuery事件加入
AnimateWindow(handle,500,AW_Center or AW_Hide or AW_BLEND);
四捨五入、無條件進入、floor & ceil & round
符點數四捨五入
formatfloat('3.##',浮點數); //##是要四捨五入到第幾位數，輸出為字串
符點數無條件捨去
format('%0.2f',[浮點數])； //輸出為字串
若是有小數點第一位要四捨五入成整數可以
trunc(浮點數+0.5); //輸出為整數，trunc於負數時不能使用
若是有小數點第一位要無條件進入成整數可以
trunc(浮點數+0.9); //輸出為整數
若是有小數點第一位要無條件捨去成整數可以
trunc(浮點數); //輸出為整數
另外要四捨五入的方法還有
round(浮點數); //輸出為整數，如round(3.2); //=3; round(3.5); //=4
地板函數
floor(浮點數); //輸出為整數，floor(3.5); //=3; floor(-3.5); //=-4
地板函數
ceil(浮點數); //輸出為整數，ceil(3.5); //=4; ceil(-3.5); //=-3
formatfloat('3.##',浮點數); //##是要四捨五入到第幾位數，輸出為字串
符點數無條件捨去
format('%0.2f',[浮點數])； //輸出為字串
若是有小數點第一位要四捨五入成整數可以
trunc(浮點數+0.5); //輸出為整數，trunc於負數時不能使用
若是有小數點第一位要無條件進入成整數可以
trunc(浮點數+0.9); //輸出為整數
若是有小數點第一位要無條件捨去成整數可以
trunc(浮點數); //輸出為整數
另外要四捨五入的方法還有
round(浮點數); //輸出為整數，如round(3.2); //=3; round(3.5); //=4
地板函數
floor(浮點數); //輸出為整數，floor(3.5); //=3; floor(-3.5); //=-4
地板函數
ceil(浮點數); //輸出為整數，ceil(3.5); //=4; ceil(-3.5); //=-3
星期三, 8月 29, 2007
log檔成長塞爆硬碟解決方法
以下是我自己做的管理程式，在登入SQL Server以後，能看目前擁有的硬碟空間，資料庫的資料檔及記錄檔佔用的空間，然後可以清鬆以一鍵做清空Log檔及壓縮資料庫的功能，並能調整資料檔及記錄檔的設定。
資料庫包含資料檔及記錄檔(log)
資料檔有
Data (資料)
Indexes (索引)
Unused (未使用)
Unreserved (未分派)
記錄檔包括
Used (已使用)
Unused (未使用)
清空log記錄檔
'backup log database_name with Truncate_only'
壓縮資料庫(包括資料檔及記錄檔(log))
'DBCC SHRINKDATABASE database_name';
查詢資料庫
'sp_spaceused';
可查到下列欄位
database_name
database_size
unallocated space
reserved
data
index_size
unused
查詢資料檔設定
'SELECT * FROM sysfiles where name = database_name';
查詢log檔設定
'SELECT * FROM sysfiles where name = database_name_log';
fileid
grouid (0表示記錄檔，1表示資料檔)
size (檔案大小以8k頁面為單位)
maxsize(-1表示無限制，0表示不成長，268435456 表示能成長的最大值)
growth(0表示不成長)
status (status>=1048576表示growth為百分比表示(0x100000))
perf (已保留)
name (檔案名稱)
filename (實體位置加檔案名稱)
查詢log檔案情況
'DBCC SQLPERF(LOGSPACE)';
可以查到下列欄位
Database Name
Log Size(MB)
Log Space Used(%)
Status
顯示
資料庫大小 = 查詢語法database_size即可
資料庫未使用大小 = 查詢語法unallocated space即可
資料檔大小 = 查詢語法size即可
資料檔未使用大小 = 查詢語法reserved的相反即可
記錄檔大小 = 查詢語法size即可
記錄檔未使用大小 = 查詢Log Space Used(%)相反即可
變更log檔大小要注意的是：
初始大小不能小於目前的大小，且不能大於2097152
檔案成長要界於1~10000
檔案成長不能大於檔案大小上限
檔案成長要界於1~1048572
檔案大小上限要大於或等於初始大小
檔案大小上限要界於1~2097152
每個資料庫的權限大小可能有設定，而初始大小不能大於限定的大小。
變更log檔所下的語法
'ALTER DATABASE kobe MODIFY FILE (NAME = database_log_name, MAXSIZE = 26MB, SIZE = 11MB, FILEGROWTH = 21MB)';
查詢資料庫硬碟大小空間
'master.dbo.xp_fixeddrives';
資料庫包含資料檔及記錄檔(log)
資料檔有
Data (資料)
Indexes (索引)
Unused (未使用)
Unreserved (未分派)
記錄檔包括
Used (已使用)
Unused (未使用)
清空log記錄檔
'backup log database_name with Truncate_only'
壓縮資料庫(包括資料檔及記錄檔(log))
'DBCC SHRINKDATABASE database_name';
查詢資料庫
'sp_spaceused';
可查到下列欄位
database_name
database_size
unallocated space
reserved
data
index_size
unused
查詢資料檔設定
'SELECT * FROM sysfiles where name = database_name';
查詢log檔設定
'SELECT * FROM sysfiles where name = database_name_log';
fileid
grouid (0表示記錄檔，1表示資料檔)
size (檔案大小以8k頁面為單位)
maxsize(-1表示無限制，0表示不成長，268435456 表示能成長的最大值)
growth(0表示不成長)
status (status>=1048576表示growth為百分比表示(0x100000))
perf (已保留)
name (檔案名稱)
filename (實體位置加檔案名稱)
查詢log檔案情況
'DBCC SQLPERF(LOGSPACE)';
可以查到下列欄位
Database Name
Log Size(MB)
Log Space Used(%)
Status
顯示
資料庫大小 = 查詢語法database_size即可
資料庫未使用大小 = 查詢語法unallocated space即可
資料檔大小 = 查詢語法size即可
資料檔未使用大小 = 查詢語法reserved的相反即可
記錄檔大小 = 查詢語法size即可
記錄檔未使用大小 = 查詢Log Space Used(%)相反即可
變更log檔大小要注意的是：
初始大小不能小於目前的大小，且不能大於2097152
檔案成長要界於1~10000
檔案成長不能大於檔案大小上限
檔案成長要界於1~1048572
檔案大小上限要大於或等於初始大小
檔案大小上限要界於1~2097152
每個資料庫的權限大小可能有設定，而初始大小不能大於限定的大小。
變更log檔所下的語法
'ALTER DATABASE kobe MODIFY FILE (NAME = database_log_name, MAXSIZE = 26MB, SIZE = 11MB, FILEGROWTH = 21MB)';
查詢資料庫硬碟大小空間
'master.dbo.xp_fixeddrives';
如何編寫多國語言版的軟體
首先加入下列二個pas檔
然後在你要讀取form的視窗內編寫
然後在form oncreate的地方加上
讀出來已有大部分的元件標題，然後再開啟剛剛在同目錄下已產生的txt檔，並加上未能讀入的字串變數，以後供使用：
[Message]
1=請選擇ini檔案
2=檔案不存在!!!
3=檔案格式錯誤!!!
4=與DB連線失敗'
以上步驟已經存好多國語言的字串，你只要去翻譯這些字串，在另外的wording2.txt、wording3.txt檔案(按照設定的語言的檔案)。
要用時，只要將下列程式碼加入每個form視窗中的oncreate即可。
同時剛有宣告額外字串部分可用下列去呼叫出來：
unit ULang;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, inifiles, TypInfo,UOsLang;
function InitStringFile():boolean;//初始化字串檔(解檔及取得檔名)
procedure LoadStringFile();//經由初始化過後，再讀取字串檔。
procedure SaveWording(var frm:TForm; sWordingFile:string);
procedure ReadWording(var frm:TForm; sWordingFile:string);
procedure InitGlobalVariable;
function GetWorkDirectory:String;
function GetTmpDirectory(): string ;
var
g_cLang :char;
g_saMsg :array[1..3600] of String; // 訊息字串表
g_sStrFile :string; // 字串檔名
g_sTempPath :string; // (WorkingPath)
g_sWorkPath :string; // (WorkingPath)
implementation
procedure InitGlobalVariable;
begin
g_sWorkPath:=GetWorkDirectory();
g_sTempPath:=GetTmpDirectory();
end;
//初始化字串檔(解檔及取得檔名) by v
function InitStringFile():boolean;
var
sStringFileName:string;
begin
//result:=false;
g_cLang := GetLanguage;// 取得系統語系
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
ErrMsgBox('Extract wording file failed !');
exit;
end ;
end;
}
result:=true;
end;
//讀取訊息字串
procedure LoadStringFile();
var
ini:TIniFile;
i:integer;
//sReportLanguageFile:String;
begin
ini := TIniFile.Create(g_sStrFile);
try
for i:=Low(g_saMsg) to High(g_saMsg) do
g_saMsg[i] := ini.ReadString('Message', IntToStr(i), '');
finally
ini.Free;
end;
end;
{=============================================================================
=}
{ 函式敘
述： }
{ 儲存控制項字串
表 }
{=============================================================================
=}
procedure SaveWording(var frm:TForm; sWordingFile:string);
var
i: Integer;
ini: TIniFile;
proInfo: PPropInfo;
sStr: String;
begin
with frm do
begin
ini := TIniFile.Create(sWordingFile);
try
ini.WriteString(Name, Name, Caption);
for i:=0 to ComponentCount-1 do
begin
// caption
proInfo := GetPropInfo(Components[i].ClassInfo, 'Caption');
if (proInfo <> nil) then
begin
sStr := GetStrProp(Components[i], proInfo);
if( Length(sStr) <> 0 ) then
ini.WriteString(Name, Components[i].Name, sStr);
end;
end;
finally
ini.Free;
end;
end;
end;
{=============================================================================
=}
{ 函式敘
述： }
{ 讀取控制項字串表並設定控制項字
串 }
{=============================================================================
=}
procedure ReadWording(var frm:TForm; sWordingFile:string);
var
i: Integer;
ini: TIniFile;
proInfo: PPropInfo;
sStr: String;
FontObject: TFont;
begin
with frm do
begin
frm.PixelsPerInch := 96 ;
frm.Scaled := false ;
ini := TIniFile.Create(sWordingFile);
try
//讀入元件字串
Caption := ini.ReadString(Name, Name, '');
Font.Name:=Screen.MenuFont.Name; //940304 by v 新增
Font.Charset:=Screen.MenuFont.Charset;//940304 by v 新增
Font.Size:=10;
for i:=0 to ComponentCount-1 do
begin
proInfo := GetPropInfo(Components[i].ClassInfo, 'Caption');
if (proInfo <> nil) then
begin
sStr := ini.ReadString(Name, Components[i].Name, GetStrProp
(Components[i], proInfo));
SetStrProp(Components[i], proInfo, sStr);
end;
// 設定字型
proInfo := GetPropInfo(Components[i].ClassInfo, 'Font');
if (proInfo <> nil) then
begin
FontObject := TFont(GetObjectProp(Components[i], proInfo, TFont));
FontObject.Name := Screen.MenuFont.Name;
FontObject.Charset := Screen.MenuFont.Charset;
FontObject.Size := 10;
//為了解決eltree上半部頭會被截掉1pixel的問題 因此更改為12
//FontObject.Size := 10;
//FontObject.
//FontObject.Height := 14;
//FontObject.Size := 8;//20050909 by v 芝瓏說要改8 (效果很差)
end;
end;
finally
ini.Free;
end;
end;
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;
end.
unit UOsLang;
interface
uses
Windows, IniFiles, SysUtils, Registry;
function CreateLogFile:Boolean;
function GetLanguage:Char;
function GetSystemDefaultFontName(FixedFont: Boolean=false): String;
implementation
(*-------------------------------------------------------------------------
取得OS主語系
*)
function PRIMARYLANGID(lgid: WORD): WORD;
begin
Result:=lgid and $03FF;
end;
(*-------------------------------------------------------------------------
取得OS副語系
*)
function SUBLANGID(lgid: WORD): WORD;
begin
Result:=lgid shr 10;
end;
(*-------------------------------------------------------------------------
傳回語系代碼
*)
function GetLanguage(): char;
var
wLangID: LANGID;
wPrimaryLangID, wSubLangID: WORD;
begin
//取得OS預設語系
wLangID:=GetSystemDefaultLangID();
wPrimaryLangID:=PRIMARYLANGID(wLangID);
wSubLangID:=SUBLANGID(wLangID);
case wPrimaryLangID of
//中文...
LANG_CHINESE:
begin
case wSubLangID of
SUBLANG_CHINESE_TRADITIONAL, //繁體
SUBLANG_CHINESE_HONGKONG: //香港也是用繁體
begin
Result:='0';
end;//break
SUBLANG_CHINESE_SIMPLIFIED: //簡體
begin
Result:='1';
end;//break
else
Result:='0'; //預設為繁體中文
end;//case end
end;
//英文...
LANG_ENGLISH:
begin
Result:='2';
end;
//日文...
LANG_JAPANESE:
begin
Result:='3';
end;
//韓文...
LANG_KOREAN:
begin
Result:='4';
end;
//泰文...
LANG_THAI:
begin
Result:='5';
end;
//法文...
LANG_FRENCH:
begin
Result:='9';
end;
//德文...
LANG_GERMAN:
begin
Result:='A';
end;
//義大利文...
LANG_ITALIAN:
begin
Result:='B';
end;
//西班牙文...
LANG_SPANISH:
begin
Result:='C';
end;
//葡萄牙文...
LANG_PORTUGUESE:
begin
Result:='D';
end;
//俄文...
LANG_RUSSIAN:
begin
Result:='F';
end;
//荷蘭文...
LANG_DUTCH:
begin
Result:='I';
end;
//預設語系是英文...
else //defualt
Result:='2';
end;
end;
{===========================================================================}
{ 函式敘述： }
{ 取得系統預設的字型名稱 }
{ 例如：繁體中文Windows => 新細明體 }
{===========================================================================}
function GetSystemDefaultFontName(FixedFont: Boolean=false): String;
const
OEM_CodePage = 'MIME\Database\Codepage\';
ProportionalFont = 'ProportionalFont';
FixWidthFont = 'FixedWidthFont';
var
reg: TRegistry;
CodePage: String;
begin
Result := 'System';
CodePage := IntToStr(GetOEMCP);
reg := TRegistry.Create;
try
reg.RootKey := HKEY_CLASSES_ROOT;
if reg.OpenKeyReadOnly(OEM_CodePage) then
begin
if reg.KeyExists(CodePage) and reg.OpenKeyReadOnly(CodePage) then
begin
if FixedFont then
Result := reg.ReadString(FixWidthFont)
else
if reg.ValueExists(ProportionalFont) then
Result := reg.ReadString(ProportionalFont)
else if reg.ValueExists(FixWidthFont) then
Result := reg.ReadString(FixWidthFont);
end;
end;
finally
reg.CloseKey;
reg.Free;
end;
end;
function CreateLogFile:Boolean;
const
_sLangFile='Language.ini';
var
ini: TIniFile;
begin
Result:=true;
ini:=TIniFile.Create(_sLangFile);
try
try
ini.WriteString('vars','language',GetLanguage);
except
Result:=false;
end;
finally
ini.Free;
end;
end;
end.
然後在你要讀取form的視窗內編寫
uses ULang
然後在form oncreate的地方加上
SaveWording(TForm(self), g_sStrFile);
讀出來已有大部分的元件標題，然後再開啟剛剛在同目錄下已產生的txt檔，並加上未能讀入的字串變數，以後供使用：
[Message]
1=請選擇ini檔案
2=檔案不存在!!!
3=檔案格式錯誤!!!
4=與DB連線失敗'
以上步驟已經存好多國語言的字串，你只要去翻譯這些字串，在另外的wording2.txt、wording3.txt檔案(按照設定的語言的檔案)。
要用時，只要將下列程式碼加入每個form視窗中的oncreate即可。
InitGlobalVariable; //加到主要Form即可
InitStringFile; //加到主要Form即可
LoadStringFile; //加到主要Form即可
ReadWording(TForm(self), g_sStrFile); //每個Form都要加
同時剛有宣告額外字串部分可用下列去呼叫出來：
g_saMsg[1] //其中數字1在[Message]的1的字串
星期三, 8月 22, 2007
用ADOStoredProc1去執行access上的更新語法
須新增TADOConnect,TADOStoreProc,TButton,TEdit。
在TADOConnect的connected屬性改為True及LoginPrompt屬性改為False，以及ConnectionString設定好access位置。
TADOStoreProc的connection屬性設ADOConnect1。
TButton1點一下後
貼上程式碼
access的資料庫新增一個資料表ccc，及查詢q1，ccc資料表有a、b欄位(a為整數，b為文字)，q1的程式碼如下：
update ccc set ccc.b='ok' where ccc.a=[va];
在TADOConnect的connected屬性改為True及LoginPrompt屬性改為False，以及ConnectionString設定好access位置。
TADOStoreProc的connection屬性設ADOConnect1。
TButton1點一下後
貼上程式碼
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, FMTBcd, StdCtrls, DB, ADODB, SqlExpr, Grids, DBGrids;
type
TForm1 = class(TForm)
ADOStoredProc1: TADOStoredProc;
ADOConnection1: TADOConnection;
Button1: TButton;
Edit1: TEdit;
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
procedure TForm1.Button1Click(Sender: TObject);
begin
ADOStoredProc1.ProcedureName:='q1';
ADOStoredProc1.parameters.clear;
ADOStoredProc1.parameters.CreateParameter('va', ftInteger, pdInput, 1, edit1.text);
ADOStoredProc1.Prepared;
ADOStoredProc1.execproc;
end;
end.
access的資料庫新增一個資料表ccc，及查詢q1，ccc資料表有a、b欄位(a為整數，b為文字)，q1的程式碼如下：
update ccc set ccc.b='ok' where ccc.a=[va];
星期五, 8月 17, 2007
網頁瀏覽器製作
新增元件
1. 須新增"上一頁"、"下一頁"、"停止"、"更新"、"進入網站"共五個TButton
2. 一個TEdit輸入網址用
3. 顯示網頁的元件TWebBrowser
4. 顯示目前進度的TGauge
5. 一個TLabel顯示處理進度文字
1. 須新增"上一頁"、"下一頁"、"停止"、"更新"、"進入網站"共五個TButton
2. 一個TEdit輸入網址用
3. 顯示網頁的元件TWebBrowser
4. 顯示目前進度的TGauge
5. 一個TLabel顯示處理進度文字
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, OleCtrls, SHDocVw, Gauges;
type
TForm1 = class(TForm)
WebBrowser1: TWebBrowser;
Button1: TButton;
Button2: TButton;
Button3: TButton;
Button4: TButton;
Edit1: TEdit;
Label1: TLabel;
Button5: TButton;
Gauge1: TGauge;
procedure FormActivate(Sender: TObject);
procedure Edit1KeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
procedure WebBrowser1ProgressChange(ASender: TObject; Progress,
ProgressMax: Integer);
procedure WebBrowser1CommandStateChange(ASender: TObject; Command: Integer;
Enable: WordBool);
procedure WebBrowser1NavigateComplete2(ASender: TObject;
const pDisp: IDispatch; var URL: OleVariant);
procedure Button4Click(Sender: TObject);
procedure Button3Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure Button1Click(Sender: TObject);
procedure Button5Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
//上一頁
procedure TForm1.Button1Click(Sender: TObject);
begin
WebBrowser1.GoBack;
end;
//下一頁
procedure TForm1.Button2Click(Sender: TObject);
begin
WebBrowser1.GoForward ;
end;
//停止
procedure TForm1.Button3Click(Sender: TObject);
begin
WebBrowser1.Stop;
end;
//更新
procedure TForm1.Button4Click(Sender: TObject);
begin
WebBrowser1.Refresh ;
end;
//進入網站
procedure TForm1.Button5Click(Sender: TObject);
begin
WebBrowser1.Navigate(Edit1.Text);
end;
//當鍵盤按Enter
procedure TForm1.Edit1KeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
begin
if key=13 then Button5.Click ;
end;
//當視窗活動時，設定焦點，記得focus都要在Activate才能設喔!
procedure TForm1.FormActivate(Sender: TObject);
begin
Edit1.SetFocus ;
end;
//網頁連結成功，網址列顯示URL
procedure TForm1.WebBrowser1NavigateComplete2(ASender: TObject;
const pDisp: IDispatch; var URL: OleVariant);
begin
Edit1.Text:=URL;
end;
//處理進度情況設定
procedure TForm1.WebBrowser1ProgressChange(ASender: TObject; Progress,
ProgressMax: Integer);
begin
Gauge1.MaxValue :=ProgressMax;
Gauge1.Progress:=progress;
end;
//上一頁及下一頁按紐判斷可否被按
procedure TForm1.WebBrowser1CommandStateChange(ASender: TObject;
Command: Integer; Enable: WordBool);
begin
if (Command = CSC_NAVIGATEFORWARD) then
Button3.Enabled := Enable
else if (Command = CSC_NAVIGATEBACK) then
Button2.Enabled := Enable
end;
end.
cxGrid元件屬性要注意的
VirtualTable1
按右鍵Fields Editor->New Fiels(Name用英文字喔)
然後在VirtualTable1點兩下加入資料
屬性
Active = True
Filtered = True
DataSource1
屬性
DataSet = VirtualTable1
在cxGrid點兩下
Columns -> Add(記得要編輯其DataBinding->FieldName及ValueType；類型要對喔)
Summary -> Groups -> Add(點加入的Groups，並在Items按Add)
cxGrid1DBTableView1
DataController屬性
DataSource = DataSource1
Filter -> Options -> FcoCaselnsensitive = True
OptionsBehavior屬性
FocusCellOnTab = True
IncSearch = True
OptionsData屬性
Deleting = False 刪除
DeletingConfirmation = False 刪除確認
Editing = False 編輯
Inserting = False 插入
OptionsSelect屬性
CellSelect = False 代表同列同時選擇
OptionsView屬性
ColumnAutoWidth = True 自動調整欄寬
GroupByBox = False 最上面那一排不見
FocusRect = False 顯示按鈕框
Styles屬性
Content = cxStyleContent
FilterBox = cxStyleFilterBox
GroupByBox = cxStyleGroupByBox
Header = cxStyleHeader
Inactive = cxStyleSelection
Selection = cxStyleSelection
直接加入資料的方法
cxGrid2TableView1.DataController.recordCount:=2;
cxGrid2TableView1.DataController.Values[0, 0] := 'A';
cxGrid2TableView1.DataController.Values[0, 1] := 'B';
cxGrid2TableView1.DataController.Values[0, 2] := 'C';
cxGrid2TableView1.DataController.Values[1, 2] := 'ABC';
加入虛擬欄位，可改變欄位的資料，或像Excel計算
比如：
資料庫有三個欄位
[申購日期] [基金名稱] [漲跌幅]
但是想要顯示來格式如下；
[申購日期] [基金名稱] [漲跌幅(顯示百分比)] [訊號]
此時
ADOQuery應該有下列
[申購日期] 格式為date
[基金名稱] 格式為string
[漲跌幅] 格式為double
[漲跌幅t] 格式為string 因為我們要多加個百分比 FieldKind=fkCalculated
[訊號t] 格式為string FieldKind=fkCalculated
SQL語法同樣下
select 申購日期, 基金名稱, 漲跌幅
ADOQuery1的onCalcFields事件加入
DataSet.FieldValues['漲跌幅t'] := floattostr(DataSet.FieldByName('漲跌幅').Asfloat) + '%';
DataSet.FieldValues['訊號'] := DataSet.FieldByName('基金名稱').AsString;
cxGrid
新增欄位完後，去選擇每個欄位的FieldName
[申購日期] [基金名稱] [漲跌幅t] [訊號]
[漲跌幅t]的caption 改成"漲跌幅" 比較好看
如果要兩行的標題欄合併
點擊兩下cxgrid，將cxgrid1Level右邊的cxgrid1DBTabelView1刪除，然後自己新增cxgrid1BandedTabelView1，然後在Bands按add新增進去就是最上層的合併欄位了。
如果要將相同資料的列合併，可以點擊要合併相同資料的欄位，然後在Option->CellMerging->true
1：展開所有行cxGrid1DBTableView1.ViewData.Expand(True);
2：收起所有行cxGrid1DBTableView1.ViewData.Collapse(True);
3：展開當前行cxGrid1DBTableView1.ViewData.Rows[cxGrid1DBTableView1.DataController.FocusedRowIndex].Expand(True);
4：收起當前行cxGrid1DBTableView1.ViewData.Rows[cxGrid1DBTableView1.DataController.FocusedRowIndex].Collapse(True);
在特定欄位用不同的顏色，你可以在onCustomDrawCell事件中加入以下程式碼去判斷
var
str:string;
begin
str:=trim(VarAsType(AViewInfo.GridRecord.DisplayTexts[TcxGridDBTableView(Sender).GetColumnByFieldName('漲跌幅').Index], varString));
按右鍵Fields Editor->New Fiels(Name用英文字喔)
然後在VirtualTable1點兩下加入資料
屬性
Active = True
Filtered = True
DataSource1
屬性
DataSet = VirtualTable1
在cxGrid點兩下
Columns -> Add(記得要編輯其DataBinding->FieldName及ValueType；類型要對喔)
Summary -> Groups -> Add(點加入的Groups，並在Items按Add)
cxGrid1DBTableView1
DataController屬性
DataSource = DataSource1
Filter -> Options -> FcoCaselnsensitive = True
OptionsBehavior屬性
FocusCellOnTab = True
IncSearch = True
OptionsData屬性
Deleting = False 刪除
DeletingConfirmation = False 刪除確認
Editing = False 編輯
Inserting = False 插入
OptionsSelect屬性
CellSelect = False 代表同列同時選擇
OptionsView屬性
ColumnAutoWidth = True 自動調整欄寬
GroupByBox = False 最上面那一排不見
FocusRect = False 顯示按鈕框
Styles屬性
Content = cxStyleContent
FilterBox = cxStyleFilterBox
GroupByBox = cxStyleGroupByBox
Header = cxStyleHeader
Inactive = cxStyleSelection
Selection = cxStyleSelection
直接加入資料的方法
cxGrid2TableView1.DataController.recordCount:=2;
cxGrid2TableView1.DataController.Values[0, 0] := 'A';
cxGrid2TableView1.DataController.Values[0, 1] := 'B';
cxGrid2TableView1.DataController.Values[0, 2] := 'C';
cxGrid2TableView1.DataController.Values[1, 2] := 'ABC';
加入虛擬欄位，可改變欄位的資料，或像Excel計算
比如：
資料庫有三個欄位
[申購日期] [基金名稱] [漲跌幅]
但是想要顯示來格式如下；
[申購日期] [基金名稱] [漲跌幅(顯示百分比)] [訊號]
此時
ADOQuery應該有下列
[申購日期] 格式為date
[基金名稱] 格式為string
[漲跌幅] 格式為double
[漲跌幅t] 格式為string 因為我們要多加個百分比 FieldKind=fkCalculated
[訊號t] 格式為string FieldKind=fkCalculated
SQL語法同樣下
select 申購日期, 基金名稱, 漲跌幅
ADOQuery1的onCalcFields事件加入
DataSet.FieldValues['漲跌幅t'] := floattostr(DataSet.FieldByName('漲跌幅').Asfloat) + '%';
DataSet.FieldValues['訊號'] := DataSet.FieldByName('基金名稱').AsString;
cxGrid
新增欄位完後，去選擇每個欄位的FieldName
[申購日期] [基金名稱] [漲跌幅t] [訊號]
[漲跌幅t]的caption 改成"漲跌幅" 比較好看
如果要兩行的標題欄合併
點擊兩下cxgrid，將cxgrid1Level右邊的cxgrid1DBTabelView1刪除，然後自己新增cxgrid1BandedTabelView1，然後在Bands按add新增進去就是最上層的合併欄位了。
如果要將相同資料的列合併，可以點擊要合併相同資料的欄位，然後在Option->CellMerging->true
1：展開所有行cxGrid1DBTableView1.ViewData.Expand(True);
2：收起所有行cxGrid1DBTableView1.ViewData.Collapse(True);
3：展開當前行cxGrid1DBTableView1.ViewData.Rows[cxGrid1DBTableView1.DataController.FocusedRowIndex].Expand(True);
4：收起當前行cxGrid1DBTableView1.ViewData.Rows[cxGrid1DBTableView1.DataController.FocusedRowIndex].Collapse(True);
在特定欄位用不同的顏色，你可以在onCustomDrawCell事件中加入以下程式碼去判斷
var
str:string;
begin
str:=trim(VarAsType(AViewInfo.GridRecord.DisplayTexts[TcxGridDBTableView(Sender).GetColumnByFieldName('漲跌幅').Index], varString));
星期三, 8月 15, 2007
用Webbrowser讀取網頁
使用方法，開啟專案，加入一個TWebBrowser TButton TMemo，然後貼上下列程式碼，之後在元件TWebBrowser事件WebBrowser1DocumentComplete 及 TButton元件上點兩下即可。 IHTMLDocument2此元件為mshtml;
unit readhtmleasy;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, IdBaseComponent, IdComponent, IdTCPConnection,
IdTCPClient, IdHTTP, OleCtrls, SHDocVw, mshtml, Grids, ComCtrls, StrUtils,activex;
type
TForm1 = class(TForm)
Button1: TButton;
Memo1: TMemo;
WebBrowser1: TWebBrowser;
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
procedure TForm1.Button1Click(Sender: TObject);
var
slTemp: TStringList;
HTMLDoc: IHTMLDocument2;
begin
Cursor := crHourGlass;
webbrowser1.Navigate('http://www.stockq.org');
HTMLDoc := webbrowser1.Document as IHTMLDocument2;
while Webbrowser1.ReadyState <> READYSTATE_COMPLETE do
Application.ProcessMessages;
Cursor := crDefault;
HTMLDoc := webbrowser1.Document as IHTMLDocument2;
slTemp := TStringList.Create;
slTemp.text := HTMLDoc.body.innertext;
memo1.text := slTemp.text;
end;
end.
星期一, 8月 13, 2007
方便連結與中斷及操作資料庫的函式
no e
uses ADODB, ComObj;
var
function SQLOpenOK(ADO:TADOQuery; sSQL:string): boolean;
function SQLExecuteOK(ADO:TADOQuery; sSQL:string): boolean;
{-------------------------------------------}
//執行SQL命令，成功=true ，失敗=false
function SQLOpenOK(ADO:TADOQuery; sSQL:string): boolean;
function QuotedMsg(sMsg:string): string;
begin
sMsg:=Trim(sMsg);
if sMsg='' then Result:=''
else Result:=' ['+sMsg+']';
end;
begin
Result:=False;
try
ADO.Close;
ADO.SQL.Clear;
ADO.SQL.Add(sSQL);
ADO.Open;
except
On E:EOleException Do
begin
ShowMessage(E.Message);
if E.ErrorCode=E_FAIL then //連線失敗
begin
ShowMessage('與DB連線失敗');
Application.Terminate;
end;
exit;
end;
end;
Result:=True;
end;
{-------------------------------------------}
function SQLExecuteOK(ADO:TADOQuery; sSQL:string): boolean;
function QuotedMsg(sMsg:string): string;
begin
sMsg:=Trim(sMsg);
if sMsg='' then Result:=''
else Result:=' ['+sMsg+']';
end;
begin
Result:=False;
try
ADO.Close;
ADO.SQL.Clear;
ADO.SQL.Add(sSQL);
ADO.ExecSQL;
except
On E:EOleException Do
begin
ShowMessage(E.Message);
if E.ErrorCode=E_FAIL then //連線失敗
begin
ShowMessage('與DB連線失敗');
Application.Terminate;
end;
exit;
end;
end;
Result:=True;
end;
如何使用呢？
ADOConnection1的屬性Connectted=True及LoginPrompt=Flase。
try
ADOConnection1.Connected := True;
except
Showmessage('連線失敗!');
end;
if not SQLOpenOK(ADOQuery1,'SELECT * FROM 資料表名') then
ShowMessage('Query ERROR!!');
s := 'create table 富達新興 (';
s := s + '流水號 AUTOINCREMENT NOT NULL';
s := s + ', [日期] Date';
s := s + ', 淨值 int';
s := s + ', PRIMARY KEY (流水號)';
s := s + ');';
if not SQLExecuteOK(ADOQuery1,s) then
ShowMessage('Query ERROR!!');
insert into 資料表(column1, column2, column3..) values(v1, v2, v3...);
記得是整數時前後不用加'''，若是字串時則要加''''，若是時間時則不用加'''，但要加個#。
星期二, 8月 07, 2007
Delphi初學者應小心的六大陷阱
Delphi初學者應小心的六大陷阱2005-07-26 08:10 作者： 子夜編譯 出處： 天極網 責任編輯：方舟 天極軟體專題專區精選
Google專區 POPO專區 QQ專區
Flash MX 視頻教程 Photoshop視頻教程 網頁設計視頻教程
PowerPoint動畫演示教程 Excel動畫教程集 Word動畫演示教程
特洛伊木馬專區 駭客知識教程專區 註冊表應用專區
Windows API開發專區 網路程式設計專區 VB資料庫程式設計專區
圖像與多媒體程式設計
初學DelphiI的人，由於各種原因，對DelphiI中的許多概念不能很好的理解，並由此帶來了許多的問題，或者是開發出的程式穩性不好，一會能運行，一會又不能運行；或者是遇到一個問題久思不得其解，還誤以為是DelphiI自身的BUG，等等這些，浪費了我們大量的時間、精力，也影響了我們的開發效率。
那麼如何才能避免這些錯誤了，儘量少走彎路了？筆者從事DelphiI開發多年，下面就把我的經驗總結介紹給大家，希望幫助到初學DelphiI的朋友。
問題一：對類的概念理解不到位，程式開發中不能靈活運用。請看下面的程式：
在DelphiI中新建一個程式，然後添加一個按鈕，就得到了下面這段程式。這應該是大家相當熟悉的一段程式，可也就是這段程式，讓許多的人在做開發很長時間後，還不能很好理解。 該程式可分為三個個部分：第一部分，單元頭（從起始位置到TYPE之前）；第二部分（從TYPE到END的部分），定義了一個從Tform繼承過來的窗體類，它包含一個Tbuttton類型的成員。最後一部分（Var到結束的部分），定義了一個Tform1類型的變量。問題就出在這裡了，許多人誤以為這最後一段也是窗體類的一部分，在該窗體類中經常寫出這樣的代碼，Form1.caption = ’窗體標題’，導致程式運行時得不到所要的結果。其實最後一部分根本就屬於窗體類的定義，它們不過是在同一個UNIT中而已，所以代碼應該這樣寫：self.caption = ’窗體標題’；
問題二：將釋放對象的代碼寫在窗體的CLOSE事件中，導致Access Violation…的錯誤。
一個窗體的關閉（CLOSE）與窗體的析構（Destory），在系統處理上是有區別的，當一個窗體關閉時，窗體實際上只是隱藏起來了，它佔用的資源並未從記憶體中釋放了，我們還是可訪問到窗體中的數據；而當窗體響應DESTORY事件時，窗體不僅僅是隱藏起來了，而且佔用的系統資源也釋放出來了。因此，如果一個窗體關閉後，我們還想訪裏面的對象，就應該將這些對象的FREE代碼寫的窗體的（DESTORY）事件中。
問題三：不加區別地使用String與shortString數據類型。
String類型與shortString類型是有區別的，在默認的情況下（取決於$H開關），如果你將一個變量定義為string類型，那麼會被處理成一個ANSIString類型。這種類型是動態分配記憶體的，以NULL為結尾，最大長度為4G，而shortString的最大長度是不能超過255個字元的。由於ANSIstring是生存期自管理類型的數據，這意昧著這種類型的數據需要更多的系統開銷，所以在程式開發中，shortString能滿足要求的話，就儘量使用它，以提高程式的運行速度。
問題四：進行數據類型轉換時處理不當，犯錯誤最多的就是字元型到數字/浮點型的轉換。
當將一個字元型數據轉換為整型時，我們經常這樣寫 I := StrToInt(aEdit.Text); 表面上看這一句，沒有任何問題，函數的使用，格式的寫法，都是正確的。可有一種情況我們卻沒有考慮到，如果用戶在aEdit文字方塊中輸入的不是數字文本的話，會怎麼樣呢？調用還會成功嗎？顯然是不會的，系統肯定會彈出一個英文的錯誤，讓我們的用戶不知所措的。正確的寫法是：I := StrToIntDef(aEdit.Text, 0); 這樣當轉換不成功時，第二個參數就會賦給I。類似的函數還有strToInt64Def，StrToFloatDef等等。
問題五：單元引用的問題。使用那個函數，就一定要引用函數所在的單元。
比如在程式開發中我們要用到一個API函數ExtractIconEx（從程式或是文件中穫得一個圖示），那麼就一要在它的USES中把單元shellApi加入進來，否則是不能透過編譯了。類似的情況還有很多，我們常常使用幫助文檔，從中查找需要的函數，可當程式編譯時，卻通不過，為什麼呢？就是因為沒有在USES中引用函數所在的單元。這個問題初學者犯得最多，應該加倍注意。
問題六：避免循環引用，盡可能透過第三個單元實現。如果確實不可避免，應在不同位置進行引用。所謂循環引用就是A單元引用了B單元，而反過來，B單元又引用了A單元，產生循環。我們還看上面的那一段程式，在interface的下面有一個USES語句，而在implementation的下面，又有一個USES語句。循環如果確實不可避免，那麼就應該在將A單元中的引用寫在第一個USES語句中，而將B單元中的引用寫在第二個USES語句中。
Google專區 POPO專區 QQ專區
Flash MX 視頻教程 Photoshop視頻教程 網頁設計視頻教程
PowerPoint動畫演示教程 Excel動畫教程集 Word動畫演示教程
特洛伊木馬專區 駭客知識教程專區 註冊表應用專區
Windows API開發專區 網路程式設計專區 VB資料庫程式設計專區
圖像與多媒體程式設計
初學DelphiI的人，由於各種原因，對DelphiI中的許多概念不能很好的理解，並由此帶來了許多的問題，或者是開發出的程式穩性不好，一會能運行，一會又不能運行；或者是遇到一個問題久思不得其解，還誤以為是DelphiI自身的BUG，等等這些，浪費了我們大量的時間、精力，也影響了我們的開發效率。
那麼如何才能避免這些錯誤了，儘量少走彎路了？筆者從事DelphiI開發多年，下面就把我的經驗總結介紹給大家，希望幫助到初學DelphiI的朋友。
問題一：對類的概念理解不到位，程式開發中不能靈活運用。請看下面的程式：
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs;
type
TForm1 = class(TForm)
Button1: TButton;
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
uses CommonUni;
{$R *.dfm}
end.
在DelphiI中新建一個程式，然後添加一個按鈕，就得到了下面這段程式。這應該是大家相當熟悉的一段程式，可也就是這段程式，讓許多的人在做開發很長時間後，還不能很好理解。 該程式可分為三個個部分：第一部分，單元頭（從起始位置到TYPE之前）；第二部分（從TYPE到END的部分），定義了一個從Tform繼承過來的窗體類，它包含一個Tbuttton類型的成員。最後一部分（Var到結束的部分），定義了一個Tform1類型的變量。問題就出在這裡了，許多人誤以為這最後一段也是窗體類的一部分，在該窗體類中經常寫出這樣的代碼，Form1.caption = ’窗體標題’，導致程式運行時得不到所要的結果。其實最後一部分根本就屬於窗體類的定義，它們不過是在同一個UNIT中而已，所以代碼應該這樣寫：self.caption = ’窗體標題’；
問題二：將釋放對象的代碼寫在窗體的CLOSE事件中，導致Access Violation…的錯誤。
一個窗體的關閉（CLOSE）與窗體的析構（Destory），在系統處理上是有區別的，當一個窗體關閉時，窗體實際上只是隱藏起來了，它佔用的資源並未從記憶體中釋放了，我們還是可訪問到窗體中的數據；而當窗體響應DESTORY事件時，窗體不僅僅是隱藏起來了，而且佔用的系統資源也釋放出來了。因此，如果一個窗體關閉後，我們還想訪裏面的對象，就應該將這些對象的FREE代碼寫的窗體的（DESTORY）事件中。
問題三：不加區別地使用String與shortString數據類型。
String類型與shortString類型是有區別的，在默認的情況下（取決於$H開關），如果你將一個變量定義為string類型，那麼會被處理成一個ANSIString類型。這種類型是動態分配記憶體的，以NULL為結尾，最大長度為4G，而shortString的最大長度是不能超過255個字元的。由於ANSIstring是生存期自管理類型的數據，這意昧著這種類型的數據需要更多的系統開銷，所以在程式開發中，shortString能滿足要求的話，就儘量使用它，以提高程式的運行速度。
問題四：進行數據類型轉換時處理不當，犯錯誤最多的就是字元型到數字/浮點型的轉換。
當將一個字元型數據轉換為整型時，我們經常這樣寫 I := StrToInt(aEdit.Text); 表面上看這一句，沒有任何問題，函數的使用，格式的寫法，都是正確的。可有一種情況我們卻沒有考慮到，如果用戶在aEdit文字方塊中輸入的不是數字文本的話，會怎麼樣呢？調用還會成功嗎？顯然是不會的，系統肯定會彈出一個英文的錯誤，讓我們的用戶不知所措的。正確的寫法是：I := StrToIntDef(aEdit.Text, 0); 這樣當轉換不成功時，第二個參數就會賦給I。類似的函數還有strToInt64Def，StrToFloatDef等等。
問題五：單元引用的問題。使用那個函數，就一定要引用函數所在的單元。
比如在程式開發中我們要用到一個API函數ExtractIconEx（從程式或是文件中穫得一個圖示），那麼就一要在它的USES中把單元shellApi加入進來，否則是不能透過編譯了。類似的情況還有很多，我們常常使用幫助文檔，從中查找需要的函數，可當程式編譯時，卻通不過，為什麼呢？就是因為沒有在USES中引用函數所在的單元。這個問題初學者犯得最多，應該加倍注意。
問題六：避免循環引用，盡可能透過第三個單元實現。如果確實不可避免，應在不同位置進行引用。所謂循環引用就是A單元引用了B單元，而反過來，B單元又引用了A單元，產生循環。我們還看上面的那一段程式，在interface的下面有一個USES語句，而在implementation的下面，又有一個USES語句。循環如果確實不可避免，那麼就應該在將A單元中的引用寫在第一個USES語句中，而將B單元中的引用寫在第二個USES語句中。
訂閱：
文章 (Atom)