Subscribe

RSS Feed (xml)

Powered By

Skin Design:
Free Blogger Skins

Powered by Blogger

星期一, 12月 31, 2007

SaveDioalog覆蓋檔案要注意到的事

檔執行開啟視窗後,有時候你用點擊的方式去想要覆蓋檔案,又或者是你想要自己打檔名而在檔名自己有加副檔名了,為了避免又多了一個副檔名,你可以用以下的方式,先將所有副檔名清除掉,然後再自己手動加上副檔名。
首先新增一個SaveDialog,並在filter設定好,及FileName可以預設一下檔案名稱
然後在按鈕事件下加入以下程式碼:

procedure TFmain.Button1Click(Sender: TObject);
var
MsgRlt : integer;
sFileName, sExeName : string;
begin
if Savedialog1.Execute then
begin
sFileName := SaveDialog1.FileName;

sExeName :=ExtractFileExt(sFileName);
if (StrIComp(PChar(sExeName),'.exe' ) =0 ) then //有的話要清掉
begin
sFileName := DeleteFileExt(sFileName); // 匯出記錄程序
end;
sFileName := sFileName+ '.exe'; //最後再加上去


//showmessage(sFileName);
if (FileExists(sFileName)) then //會自動再加exe判斷
begin
//showmessage(SaveDialog1.FileName);
MsgRlt:=MessageBox(SaveDialog1.Handle,'檔案已存在,是否覆蓋?','MessageBox',MB_YESNO);

end;
if MsgRlt=IDNO then
begin
Button1.Click;
exit;
end;
end;
end;

星期二, 12月 25, 2007

新增一個圖片式的進度列

有ProgressBar、Gauge、LMDProgressFill及cxProgressBar元件可用,其中若要有底圖可用LMDProgressFill,並在屬性FillObject用Bitmap的方式,並記得TileMode改為tmStretch

procedure TForm1.WebBrowser1ProgressChange(ASender: TObject; Progress,
ProgressMax: Integer);
begin
Gauge1.MaxValue :=ProgressMax;
Gauge1.Progress:=progress;

LMDProgressFill1.MaxValue :=ProgressMax;
LMDProgressFill1.UserValue := PROGRESS;

cxProgressBar1.Properties.Max:= ProgressMax;
cxProgressBar1.position:=progress;
end;

星期五, 12月 21, 2007

能使得視窗form半透明效果


procedure TForm1.FormCreate(Sender: TObject);
var l:longint;
begin
l:=getWindowLong(Handle, GWL_EXSTYLE);
l := l Or WS_EX_LAYERED;
SetWindowLong (handle, GWL_EXSTYLE, l);
SetLayeredWindowAttributes (handle, 0, 180, LWA_ALPHA);
end

星期四, 12月 20, 2007

TLabel內的文字要在其寬度的中間顯示,要如何做呢

在TLabel屬性設置:
Alignment := taCenter;
Autosize := false;

星期一, 12月 17, 2007

要如何在memo1中對齊文字

首先你要將memo1的字型設成"細明體" or "Courier New" or "Fixedsys"
然後用Format的方式去%s設定字串格式即可

星期五, 12月 14, 2007

上下兩個panel要同樣高度時(在放大也一樣)

上下兩個panel初始高度在介面設成一樣,上面的panel1為altop,下面為alclient,然後在form的Resize事件加入下面程式碼即可。

procedure TForm1.FormResize(Sender: TObject);
begin
panel1.Height := form1.clientheight div 2;
end;

星期四, 12月 13, 2007

動態為所有TLabel加Caption上去

這個功能主要是給,你一次有太多的TLabel要用for迴圈給值,但是你又不想用動能新增的方式,因為每個位置如果都差異很大,還要一個一個給,所以你就可以用讀入form內所有的物件,在此我又針對爸爸在在Tabsheet1才去判斷。


unit Unit1;

interface

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

const
lb : array [1..4, 1..2] of string = (('Label1', '3'), ('Label2', '29'), ('Label3', '63'), ('Label4', '35'));

type
TForm1 = class(TForm)
Button1: TButton;
PageControl1: TPageControl;
TabSheet1: TTabSheet;
TabSheet2: TTabSheet;
Label5: TLabel;
Label6: TLabel;
Label7: TLabel;
Label8: TLabel;
Label1: TLabel;
Label2: TLabel;
Label3: TLabel;
Label4: TLabel;
procedure FormCreate(Sender: TObject);
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);
var
i,j : integer;
sStr : string;
proInfo : PPropInfo;
begin
j:=1;

for i:=0 to Componentcount-1 do
begin
if TControl(Components[i]).Parent = TabSheet1 then //找他爸
begin
proInfo := GetPropInfo(Components[i].ClassInfo, 'Caption'); //得到有Caption的物件
if (proInfo <> nil) then
begin
if Components[i].name = lb[j][1] then
begin
sStr := inttostr(j);
SetStrProp(Components[i], proInfo, sStr);
j:=j+1;
end;
end;
end;
end;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin

showmessage(inttostr(TabSheet1.ComponentCount));
end;

end.

星期一, 12月 03, 2007

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

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

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

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

星期五, 11月 30, 2007

能自動關閉的訊息視窗

加到common.pas內

procedure ShowMsg(const STitle,SText:String; const ITimeOut:Integer);
var
aFrm:TForm2;
begin
aFrm:=TForm2.Create(nil);
aFrm.Caption := STitle;
aFrm.Label1.Caption := SText;
aFrm.Timer1.Interval := ITimeOut;
try
aFrm.ShowModal;
finally
aFrm.Free;
end;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
ShowMsg('訊息測試','訊息內容................',4000);
end;

新增1個TButton,1個TLabel,2個Timer(1個顯示用interval用1000,2個enabled用false,並都加入事件)

unit Unit2;

interface

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

type
TForm2 = class(TForm)
Timer1: TTimer;
Label1: TLabel;
Button1: TButton;
Timer2: TTimer;
procedure FormCreate(Sender: TObject);
procedure Timer1Timer(Sender: TObject);
procedure Button1Click(Sender: TObject);
procedure Timer2Timer(Sender: TObject);
private
i : integer;
{ Private declarations }
public
{ Public declarations }
end;

var
Form2: TForm2;

implementation

{$R *.dfm}

procedure TForm2.FormCreate(Sender: TObject);
begin
i := Timer1.Interval div 1000;
Button1.Caption := 'OK ('+inttostr(i)+')';
Timer2.Enabled := true;
Timer1.Enabled := true;
end;

procedure TForm2.Timer1Timer(Sender: TObject);
begin
Timer2.Enabled := false;
Timer1.Enabled := false;
self.close;
end;

procedure TForm2.Button1Click(Sender: TObject);
begin
self.close;
end;

procedure TForm2.Timer2Timer(Sender: TObject);
begin
Dec(i);
Button1.Caption := 'OK ('+inttostr(i)+')';
end;

end.

星期一, 11月 26, 2007

thread用子覆蓋方式去執行各種方法


unit Unit2;

interface

uses
Classes, StdCtrls, SysUtils, Windows, Messages, Dialogs;

const
WM_IN = WM_USER + 1;
WM_OUT = WM_USER + 2;

type
TMyThread = class(TThread)
private
num : integer;
Lb1 : TLabel;
//hd : THandle;
procedure Download;
//procedure DoVisible;
//procedure showVisible(Lbt: TLAbel; B: Integer);
{ Private declarations }
protected
procedure calculate(A: Integer); virtual; abstract;
procedure Execute; override;
public
constructor Create(lbc: TLabel; fund_name : string; sn:integer);
end;

TinFund = class(TMyThread)
protected
procedure calculate(C : Integer); override;
end;
ToutFund = class(TMyThread)
protected
procedure calculate(C : Integer); override;
end;

implementation

uses Unit1;

constructor TMyThread.Create(lbc: TLabel; fund_name : string; sn:integer);
begin
//idhttp去抓sl
//Lb1 := TLabel.Create(nil);
num := sn;
Lb1 := lbc;
//hd:=hhd;
FreeOnTerminate := True;
inherited Create(False);
end;

{
procedure TMyThread.DoVisible;
begin
Lb1.caption := inttostr(num);
end;


procedure TMyThread.showVisible(Lbt: TLAbel; B : Integer);
begin
Lb1 := Lbt;
num := B;
Synchronize(DoVisible);
end;
}
procedure ToutFund.calculate(C : Integer);
var
i : integer;
begin
for i:=1 to C do
begin
//PostMessage(hd,WM_OUT,i,0);
//if Terminated then Exit;
if Assigned(Lb1) then
Lb1.caption := inttostr(i);

end;
ShowMessage('kobe');
end;

procedure TinFund.calculate(C : Integer);
var
i : integer;
begin
for i:=1 to 5000 do
begin
//if Terminated then Exit;
if Assigned(Lb1) then
Lb1.caption := inttostr(i);
//PostMessage(hd,WM_IN,i,0);


end;
end;

procedure TMyThread.Execute;
begin
Download;
calculate(num);
{ Place thread code here }
end;

procedure TMyThread.Download;
begin

end;



end.





unit Unit1;

interface

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

type
TForm1 = class(TForm)
Button1: TButton;
Edit1: TEdit;
Label1: TLabel;
Button2: TButton;
Edit2: TEdit;
Label2: TLabel;
ApplicationEvents1: TApplicationEvents;
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure ApplicationEvents1Message(var Msg: tagMSG;
var Handled: Boolean);
private
ThreadsRunning : integer;
procedure ThreadDoe(Sender: TObject);
procedure ThreadDoe1(Sender: TObject);
{ Private declarations }
public
{ Public declarations }
end;


var
Form1: TForm1;

implementation

uses Unit2;

{$R *.dfm}

procedure TForm1.ThreadDoe(Sender: TObject);
begin
Dec(ThreadsRunning); //減到為0又可以可以重跑
if ThreadsRunning = 0 then
begin
Button1.Enabled := True; //Thread跑完後
Button2.Enabled := True; //Thread跑完後
end;
end;

procedure TForm1.ThreadDoe1(Sender: TObject);
begin
//Dec(ThreadsRunning); //減到為0又可以可以重跑
Button2.Enabled := True; //Thread跑完後
end;

procedure TForm1.Button1Click(Sender: TObject);
var
fund_name : string;
sn : integer;
begin
ThreadsRunning := 2;//2個Thread會同時跑

button1.enabled:=false;
//TDownLoad.Create.OnTerminate := ThreadDoe;
fund_name := 'kobe1';
sn := 100000;
TinFund.Create(Label1, fund_name, sn).OnTerminate := ThreadDoe;

button2.enabled:=false;
sn := 500000;
ToutFund.Create(Label2, fund_name, sn).OnTerminate := ThreadDoe;
end;

procedure TForm1.Button2Click(Sender: TObject);
var
fund_name : string;
sn : integer;
begin
button2.enabled:=false;
sn := 5000000;
ToutFund.Create(Label2, fund_name, sn).OnTerminate := ThreadDoe1;

end;

procedure TForm1.ApplicationEvents1Message(var Msg: tagMSG;
var Handled: Boolean);
begin
{
if Msg.message = WM_IN then
Label1.Caption:=IntToStr(Msg.wParam);
if Msg.message = WM_OUt then
Label2.Caption:=IntToStr(Msg.wParam);
}
end;

end.

讓視窗程式開啟時,位置在螢幕的中間偏上

通常是設定在position屬性=poScreenCenter,但是那個是正中間,對於一般人的眼睛視線應該是中間偏上比較息慣,所以你可以在FormShow時加入下列程式碼:


procedure TForm1.FormShow(Sender: TObject);
begin
left := (screen.Width - Width) div 2; //等寬
top := (screen.Height - Height)*1 div 3; //高度偏上
end;

星期五, 11月 23, 2007

用執行序去跑ADO資料庫更新


unit Unit1;

uses unit2;

procedure TForm1.Button3Click(Sender: TObject);
begin
jjj := strtoint(Edit6.text); //jjj為記錄資料庫塞爆的全域變收

button1.enabled:=false;
TDownLoad.Create.OnTerminate := ThreadDoe;
end;

procedure TForm1.ThreadDoe(Sender: TObject);
begin
//Dec(ThreadsRunning); //減到為0又可以可以重跑 //如果TDownLoad.Create很多個同時
Button1.Enabled := True; //Thread跑完後
end;



unit Unit2;

interface

uses
Classes, ADODB, Dialogs, Forms;//這裡也使用Forms不太好

type
TDownload = class(TThread)
private
procedure Download;
{ Private declarations }
protected
procedure Execute; override;
public
constructor Create;
end;

implementation

uses Unit1;

{ TDownload }
constructor TDownload.Create;
begin
FreeOnTerminate := True;
inherited Create(False);
end;

procedure TDownload.Execute;
begin
Download;
{ Place thread code here }
end;

procedure TDownload.Download;
var
i : integer;
query1 : string;
FADOQuery : TADOQuery;
FADOConn : TADOConnection;
begin

//showmessage(Edit3.text);
FADOConn := TADOConnection.Create(nil);
FADOQuery:=TADOQuery.Create(nil);
FADOConn.ConnectionString := svr_string;
FADOConn.Connected := True;

FADOQuery.Connection := FADOConn;
try
try
for i := 0 to jjj - 1 do
begin
if not SQLExecuteOK(FADOQuery, 'insert into test (k) values (3)') then
ShowMessage('Query ERROR!!');
Application.ProcessMessages;

end;
except
showmessage('error');
end;
finally
FADOQuery.free;
FADOConn.Free;

end;
end;

end.

星期四, 11月 22, 2007

一個TLabel文字用不同顏色

首先在Label1的Caption文字設定 '台灣股票 漲▲▼ 36.52'
然後在你要變化的事件加入

Label1.Canvas.Font.Color := clBlue;
Label1.Canvas.textout(Label1.Canvas.TextWidth('台灣股票 漲'),0,'▲');

//另外一種寫法,記得前面不可用Label1.Caption否則要按兩次才可以顯示
Label1.Canvas.TextOut(0,0,'台灣股票 漲▲546.3');
Label1.canvas.Font.Color:=RGB(255,45,45);
Label1.Canvas.TextOut(Label1.Canvas.TextWidth('台灣股票 漲'),0,'▲');

星期一, 11月 19, 2007

ElTree使用


procedure TForm1.FormShow(Sender: TObject);
var
old_dept: string;
i: integer;
Node,NewNode:TELTreeItem;
begin
VirtualTable1.Filtered:=True;
VirtualTable1.Active:=True;
Node:=nil; // 避免編譯時出現警告訊息
ElTree1.Selected:=Nil;
ElTree1.Items.Clear();
ElTree1.Items.BeginUpdate();
try
old_dept := #13#10;
VirtualTable1.First;
for i:=0 to VirtualTable1.RecordCount-1 do
begin
if VirtualTable1.FieldByName('bank').AsString <> old_dept then
begin
Node:=ElTree1.Items.Add(Nil,VirtualTable1.FieldByName('bank').AsString);
Node.ShowCheckBox:= True ;
//Node.CheckBoxType := ectCheckBox ;
//Node.CheckBoxEnabled := True ;
Node.UseStyles := True ;
Node.MainStyle.OwnerProps := False;
Node.MainStyle.FontSize:=10;
Node.MainStyle.FontName:=Screen.MenuFont.Name;
//Node.ImageIndex:=13;
old_dept:=VirtualTable1.FieldByName('bank').AsString;
end;
NewNode:=ElTree1.Items.AddChild(Node,VirtualTable1.FieldByName('accout').AsString);
NewNode.ColumnText.Add(VirtualTable1.FieldByName('money').AsString);
//NewNode.ShowCheckBox:= True ;
//NewNode.CheckBoxType := ectCheckBox ;
//NewNode.CheckBoxEnabled := True ;
NewNode.UseStyles := True ;
NewNode.MainStyle.OwnerProps := False;
NewNode.MainStyle.FontSize:=10;
NewNode.MainStyle.FontName:=Screen.MenuFont.Name;
//NewNode.ImageIndex:=12;

VirtualTable1.Next;
end;
finally
ElTree1.Items.EndUpdate();
end;

end;

procedure TfrmMain.TreeItemFocused(Sender: TObject);
begin
//顯示所按的標籤文字
//Caption:=ElTree1.ItemFocused.text;
//顯示他爸爸的標籤文字
if ElTree1.itemFocused.Parent <> nil then
Caption:=ElTree1.ItemFocused.Parent.text;
//顯示第一個結點的標籤文字
//Caption := ElTree1.Items.GetFirstNode.Text;
//顯示所有結點的數目
//Caption := inttostr(ElTree1.Items.Count);
end;

(2)說明
ElTree1.Items.GetFirstNode 返回TREEVIEW的第一個節點,函數類型為
:TTreeNode
ElTree1.Items.Count 返回當前TreeView的全部節點數,整數
ElTree1.Selected.Level 返回當前選中節點的在目錄樹中的級別,
根目錄為0
ElTree1.Selected.Parent 返回當前選中節點上級節點,函數類型為
:TTreeNode

參考網址
http://www.delphibbs.com/keylife/iblog_show.asp?xid=19823

星期五, 11月 16, 2007

日期相差多少年、月、日、時、分、秒


procedure TForm1.BitBtn1Click(Sender: TObject);
var
a,b: Tdatetime;
c: string;
begin
a:=2007/3/13;
b:=2006/3/2;
c := '';
if (daysbetween(a,b) div 30) <> 0 then
c := inttostr(daysbetween(a,b) div 30)+'個月';

if ((daysbetween(a,b) mod 30) <> 0)and ((daysbetween(a,b) div 30) <> 0)then
c := c + '又' + inttostr(daysbetween(a,b) mod 30)+'天'
else if (daysbetween(a,b) mod 30) <> 0 then
c := inttostr(daysbetween(a,b) mod 30)+'天';

showmessage(c);
showmessage(inttostr(yearsbetween(a,b))+'年');
showmessage(inttostr(monthsbetween(a,b))+'月');
showmessage(inttostr(daysbetween(a,b))+'天');
showmessage(inttostr(hoursbetween(a,b))+'小時');
showmessage(inttostr(minutesbetween(a,b))+'分鐘');
showmessage(inttostr(secondsbetween(a,b))+'秒');
end;

星期三, 11月 14, 2007

把idhttp寫成一個執行序


1、在idhttp.OnWork事件裡加Application.ProcessMessages;
在窗體上放個idhttp控件,寫他的OnWork方法。
procedure TForm1.IdHTTP1Work(Sender: TObject; AWorkMode: TWorkMode;
const AWorkCount: Integer);
begin
Application.ProcessMessages;
end;

2、
//在主窗體中定義一個線程類
type
TMyDownLoad=class(TThread)
protected
procedure Execute;override;
procedure Download;
end;

type
TFMain = class(TForm)
....

procedure TMyDownLoad.Download;
Var
UnitName,PathName:String;
MyStream:TMemoryStream;
filepath:string;
IDHTTP: TIDHttp;
begin
IDHTTP:= TIDHTTP.Create(nil);
MyStream:=TMemoryStream.Create;
try
IdHTTP.Get('http://127.0.0.1/aiyouasp/testcode/11.exe',MyStream);
except
showmessage('網絡出錯未能下載完成!');
MyStream.Free;
Exit;
end;
filepath:=ExtractFilePath(ParamStr(0));
MyStream.SaveToFile(filepath+'\DownLoadFiles\11.exe');
MyStream.Free;
showmessage('下載完成!');
end;
procedure TMyDownLoad.Execute
begin
inherited;
Download;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
TMyDownLoad.Create(false);
end;

星期四, 11月 08, 2007

如何使TProgressBar與TStatusBar結合在一起



新增1個TButoon、1個TProgressBar及1個TStatusBar
事件加入FormCreate及OnDrawPanel

procedure TForm1.Button1Click(Sender: TObject);
var
i : integer;
begin
ProgressBar1.Position := 0;
ProgressBar1.Max := 100;

for i := 0 to 100 do
begin
ProgressBar1.Position := i;
Sleep(25);
end;
end;

procedure TForm1.FormCreate(Sender: TObject);
var
ProgressBarStyle : integer;
begin
//將狀態列的第二塊面板設為的自繪(即psOwnerDraw)
StatusBar1.Panels[1].Style := psOwnerDraw;

//將進程條放入狀態列
ProgressBar1.Parent := StatusBar1;

//去除狀態列的邊框,這樣就與狀態列溶為一體了
ProgressBarStyle := GetWindowLong(ProgressBar1.Handle,GWL_EXSTYLE);
ProgressBarStyle := ProgressBarStyle - WS_EX_STATICEDGE;
SetWindowLong(ProgressBar1.Handle, GWL_EXSTYLE, ProgressBarStyle);
end;

procedure TForm1.StatusBar1DrawPanel(StatusBar: TStatusBar; Panel: TStatusPanel;
const Rect: TRect);
begin
progressbar1.BoundsRect:=rect;
end;

CheckBox、RadioButton、ListBox

CheckBox
可以拿來做複選的方式。重要屬性如下:
checked : true 或 false ,gray及unchecked皆為 false,而 checked 為 true。
state : 如果 allowgrayed為true,則有三種狀態
type TCheckBoxState = (cbUnchecked, cbChecked, cbGrayed);
allowgrayed:是否需要灰階的選項
常用程式碼

function showState(state: TCheckBoxState):string;
begin
case state of
cbUnchecked : result:='unchecked';
cbChecked : result:='checked';
cbGrayed : result:='grayed';
end;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
checkbox1.AllowGrayed:= not checkbox1.AllowGrayed;
end;
procedure TForm1.Button2Click(Sender: TObject);
begin
if checkbox1.Checked=true then
showmessage('checkbox1 = true')
else
showmessage('checkbox1 = false');
end;
procedure TForm1.Button3Click(Sender: TObject);
begin
showmessage(showState(checkbox1.state));
end;



RadioButton
常放在Panel、RadioBox及GroupBox中,才能形成一組多選一的狀態

//先選擇一組內的所有Radio(shift選取),然後選擇共同的事件
var
blood : string;//blood為全域變數
procedure TForm1.RadioButton1Click(Sender: TObject);
var i: integer;
begin
blood:=Tradiobutton(sender).Caption + '型';
end;
//最後確定的按鈕就為
procedure TForm1.Button2Click(Sender: TObject);
begin
showmessage( blood + #10); //#10多加(自己亂加的)跳行意思
end;
//動態加入radiobuttoon於radiogoup中
procedure TForm1.Button1Click(Sender: TObject);
begin
radiogroup1.Items.Add(edit1.Text);
end;
//將剛剛動態加入radiobuttoon清除
procedure TForm1.Button3Click(Sender: TObject);
begin
radiogroup1.Items.clear;
end;
//將剛剛動態加入radiobuttoon清除
procedure TForm1.Button4Click(Sender: TObject);
begin
radiogroup1.Columns:=2;
end;



ListBox

//單選,並得知ListBox1選哪一個
procedure TForm1.Button1Click(Sender: TObject);
begin
listbox1.MultiSelect:=false;
showmessage(listbox1.Items[listbox1.ItemIndex]);
end;
//排序或不排序,一直做反向處理
procedure TForm1.Button3Click(Sender: TObject);
begin
listbox1.Sorted:=not listbox1.Sorted;
end;
//加新的Item進去
procedure TForm1.aa1Click(Sender: TObject);
begin
listbox1.AddItem(edit1.Text ,nil );
end;
//刪除Item
procedure TForm1.delete1Click(Sender: TObject);
begin
listbox1.DeleteSelected;
end;
//顯示所有選到,這是可複選才要喔
procedure TForm1.showSelected1Click(Sender: TObject);
var
i: integer;
s: string;
begin
for i:= 0 to listbox1.Items.Count -1 do
begin
if listbox1.Selected[i] then
s:= s + ' ' + listbox1.Items.Strings[i];
end;



ComboBox
重要屬性
items
text
maxLength
dropDownCount
style
autocomplete
autodropdown//自動下拉到你要的

procedure TForm1.ComboBox1Click(Sender: TObject);
//加入一個新的Item
begin
listbox1.Items.Add(combobox1.Text );
end;

星期三, 11月 07, 2007

換好看的介面囉

最好看的商業界面元件
BSF BusinessSkinForm
http://www.2ccc.com/article.asp?articleid=4436

換膚元件
VCLSkin Skinpack
http://www.cnblogs.com/support/archive/2007/05/10/741878.html

指標的使用


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

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

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

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

星期二, 11月 06, 2007

元件一起設定屬性(事件)

按Shift然後選所有要更動的元件,然後你就可以一起設定他們的屬性或事件囉!!

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

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

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

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

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

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

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

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

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

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

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

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

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

星期五, 11月 02, 2007

判斷資料表是否存在



Function TableExist( pConn:TADOConnection; pcTable : string ) : boolean ; overload ;
var
tmpFldList : TStrings ;
nLoop : integer ;
begin
Result := False ;
tmpFldList := TStringList.Create ;
pConn.GetTableNames( tmpFldList, True ); // 包含系統表
for nLoop := 0 to tmpFldList.Count - 1 do
begin
if uppercase( tmpFldList[nLoop] ) = uppercase( pcTable ) then
begin
Result := True ;
break ;
end;
end;
tmpFldList.Free ;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin

if TableExist(ADOConnection1, '富達新興') then
showmessage('ok');
end;

判斷某一日期是否小於現在


procedure TForm1.Button1Click(Sender: TObject);
var
pDate : AnsiString;
begin
pDate:='2007/11/01';
if strtodate(pDate) < strtodate(FormatDateTime('yyyy/mm/dd', Now)) then
showmessage(datetostr(now()));
end;

星期四, 11月 01, 2007

如何快速的跳到所要的函式位置

通常要追蹤函式位置時,會先按Ctrl然後點函式名字,接著跳到函式宣告的地方,然後再按Ctrl + Shift + "下"方向鍵,然後便自動跳到函式內容地方。

星期一, 10月 29, 2007

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

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

例外處理

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

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

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


try ... except ... 的範例:

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

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

範例一

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


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

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

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


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

格式如下

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


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

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

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


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

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

範例:

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



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

使用步驟如下:

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

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

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


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

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

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

物件 : 多型(三)

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

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

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

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

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

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

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

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

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

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

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

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

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


procedure TPolygon.static_draw;

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

end;
procedure TTriangle.static_draw;

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

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

begin
F[0]:=TCircle.Create;
F[1]:=TPolygon.Create;
F[2]:=TSquare.Create;
F[3]:=TTriangle.Create;
for i:=0 to 3 do
F[i].draw; // 所謂的一種樣式多種表現形式
for i:=0 to 3 do // 釋放物件之記憶體,或可用 F[i].destroy;
F[i].Free; // 但 Free會先判斷是否有有被建立物件

//測試static function 與 virtual function 或 dynamic function之差異
p1:= TTriangle.create;

p1.static_draw; // 雖然p1由TTriangle所建立,仍靜態連結到Tpolygon
Ttriangle(p1).static_draw; //須強制轉態方能執行Ttriangle中的static_draw函數
p1.draw; // 這個會執行Ttriangle的draw,由此可了解virtual(dynamic)與static之差異

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


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

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

物件 : 繼承性(二)

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

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

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

uint1.pas

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

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

end.

uint2.pas

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

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

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

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

end;
end.


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

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

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

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

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

end.

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


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

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


unit Unit1;

interface

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

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

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

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

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

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

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

end;

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

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

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

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


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

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

end.

變數存取空間

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

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


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

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


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

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

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


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

unit Unit1;

interface

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

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

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

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

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



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

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

星期五, 10月 26, 2007

集合

集合型態的宣告

type Tmyset = set of 基本型態;

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

範例:

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

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


或簡化為

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



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

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


集合的設定

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

集合的運算

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

數獨



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

unit Unit1;

interface

uses
Windows, Graphics, Forms, Classes, Controls, StdCtrls, Dialogs, Grids;

type
TByteSet = set of Byte;
TBytes = array of Byte;

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

var
Form1: TForm1;

implementation

uses SysUtils;

{$R *.dfm}

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

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

Repaint;//繪出數讀表

end;

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

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

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

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

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

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

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

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

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

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

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

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

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

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

begin
Clear;
DrawColsRows;
DrawColsRows2;

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

end.

好玩的MSN遊戲機器人設計

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

星期三, 10月 24, 2007

cxSplitter 物件使用

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

cxSplitter
屬性Control = cxGrid1
屬性HotZone = MediaPlayer9

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

星期一, 10月 22, 2007

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

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

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

視窗繪圖基本概念

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

星期五, 10月 19, 2007

大數運算

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

uses FGInt;

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

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

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

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

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

星期四, 10月 18, 2007

矩陣操作



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

unit Unit1;

interface

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

end.

很無聊時學寫Power函數


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

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

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


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

unit Unit1;

interface

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

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

var
Form1: TForm1;

implementation

{$R *.dfm}

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

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

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

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

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

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

end.

星期二, 10月 16, 2007

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


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

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

unit Unit1;

interface

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

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

var
Form1 : TForm1;
Path : string;

implementation

{$R *.dfm}

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

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

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

end.

星期一, 10月 15, 2007

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


program Project1;

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

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

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

參數傳遞


unit Unit1;

interface

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

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

type
TString20 = String[20];

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

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

var
Form1: TForm1;

implementation

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

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

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

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

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

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

end;

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

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

end;

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

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

Check('CC');

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

end.

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


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

如何寫入程式報告的Log檔記錄


unit Unit1;

interface

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

type
TForm1 = class(TForm)
Button1: TButton;
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure Button1Click(Sender: TObject);
private
m_Report: TStringList;
{ Private declarations }
public
procedure ReportLog(str: string); overload;
procedure ReportLog(str: string; Args: array of const); overload;
{ Public declarations }
end;

var
Form1: TForm1;

implementation

{$R *.dfm}
//---------------------------------------------------------

procedure TForm1.FormCreate(Sender: TObject);
begin
m_Report:=TStringList.Create();
end;
//---------------------------------------------------------

procedure TForm1.FormDestroy(Sender: TObject);
begin
m_Report.SaveToFile('Report.log');
m_Report.Free();
m_Report:=nil;
end;
//---------------------------------------------------------

procedure TForm1.ReportLog(str: string);
begin
if(not Assigned(m_Report)) then
Exit;
m_Report.Add(FormatDateTime('yyyy"/"mm"/"dd" "hh:nn:ss ', Now())+str);
end;
//---------------------------------------------------------

procedure TForm1.ReportLog(str: string; Args: array of const);
var
buf: string;

begin
//Format string.
buf:=Format(str, Args);
//Put Log to Log Factory.
ReportLog(buf);
end;
//---------------------------------------------------------

procedure TForm1.Button1Click(Sender: TObject);
const
sFilename = 'test.txt';
sPath = 'c:\';
begin
m_Report.Clear();
ReportLog('Prepare to clear.'); //未來修改此行
ReportLog('Begin to show %s file(s) in %s .', [sFilename, sPath]); //sFilename改sPath
ReportLog('End.');
end;

end.

星期五, 10月 12, 2007

正確的刪除檔案步驟


procedure TForm1.Button1Click(Sender: TObject);
bDelete : boolean;
i : integer;
filename : string;
begin
filename := 'C:\1.txt';
if(not SetFileAttributes(PChar(filename), FILE_ATTRIBUTE_NORMAL)) then
begin
showmessage('file attribute to normal error !');
end;
i:=0;
bDelete:=DeleteFile(filename);
//刪5次試試
while((i<5) and (not bDelete)) do
begin
Sleep(1000);
bDelete:=DeleteFile(PChar(filename));
Inc(i);
end;
end;

星期二, 10月 09, 2007

TStringList與TObject的完美搭配


var
sl:TStringList;

begin
if .. then
sl.AddObject(sPath, TObject(4)) //給這個sPath對應的值4
else
sl.AddObject(sPath, TObject(1)); //或給這個sPath對應的值1
end;

//用到時可以
//sl.Strings[i]搭配sl.Objects[i].......(你甚至可用自定的結構喔,就像你給他更多的值,如爸爸然後加3個小孩一樣)

//傳到其它函數,可以轉換成Int64再使用
//Int64(sl.Objects[i])


以下就是一個指標結構的範例

unit Unit1;

interface

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

type
TForm1 = class(TForm)
Button1: TButton;
Memo1: TMemo;
Edit1: TEdit;
Button2: TButton;
Edit2: TEdit;
Edit3: TEdit;
Edit4: TEdit;
Edit5: TEdit;
Button3: TButton;
procedure Button1Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure Button3Click(Sender: TObject);
private
SL: tstrings;
{ Private declarations }
public
{ Public declarations }
end;

type
pmyRec = ^myRec;
myRec=Record
item : String;
para1 : Integer;
para2 : Integer;
para3 : Integer;
para4 : Integer;
end;
var
Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);
var

Rec: pmyRec;
begin
new(Rec);
Rec.item := Edit1.text;
Rec.para1 := strtoint(Edit2.text);
Rec.para2 := strtoint(Edit3.text);
Rec.para3 := strtoint(Edit4.text);
Rec.para4 := strtoint(Edit5.text);

SL.AddObject(Rec.item, TObject(Rec));
memo1.Lines := SL;

//freemem(Rec);
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
SL := tstringlist.Create;
end;

procedure TForm1.FormDestroy(Sender: TObject);
var
i : integer;
begin
for i := 0 to SL.Count - 1 do
dispose(pmyRec(SL.Objects[i]));
SL.Free;
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
dispose(pmyRec(SL.Objects[1]));
sl.Delete(1);
memo1.Lines := SL;
end;

procedure TForm1.Button3Click(Sender: TObject);
begin
showmessage('sl(1)='+sl.strings[1]+', para1='+IntToStr(pmyRec(SL.Objects[1])^.para1));;
end;

end.

讓Delphi在編輯程式碼時,能打幾個字就自動顯示函數


ChgIME.exe,這是我們大師兄anderson寫的,沒有像windows一樣,一定要全禁掉才可以使用,他的程式可以關掉左邊Ctrl給Delphi用,然後右邊給輸入法切換使用。
ps:設定完要重開機喔~

星期五, 10月 05, 2007

拍賣大師: QooSale


要做的平台有:
@ 奇摩拍賣
@ 露天拍賣
@ 樂多拍賣
@ Hinet拍賣

須克服問題
1. 一切建立在奇摩會不會殺網頁,因為可能無法讀到結標後的資料
2. 了解奇摩延長結標等機制。
3. 先看可不可以用軟體來PO文 (若可以只要輸入商品管理就好;否則要多加拍賣管理,並要讓使用者去網頁PO文多一道程序)
4. php送Email技術 及 送資料到MySQL
5. 軟體讀取MySQL
6. 讀取網頁技術 (包括先下搜尋商品編號)
7. 有的人標價都用1元,結標處在別的地方。
8. 一次買多樣
9. 價格改變
10. 單樣買二、三個
11. 一個網頁,但標題就包括二、三種商品,裡面也有二、三種商品
12. 一個網頁,有size、長度...等問題

軟體
“商品管理” 目前技術可能無法自動PO
“拍賣管理”
“訂單管理” -> 只須輸入拍賣編號
“客戶管理” -> 不須輸入
“獲利管理”
“列印報表”

時程規畫(6個月時程規畫)
商品管理 "10月底完成" 寫入 access2007資料庫技術
拍賣管理 "11月底完成" 用idhttp讀取網頁及圖片存入資料庫技術
訂單管理 "12~1月底完成" php網頁表單及mysql上傳,軟體讀入mysql資料庫技術
客戶管理 "12~1月底完成" 軟體讀入mysql資料庫技術
獲利管理 "2月底完成" 圓餅圖、長條圖畫圖技術
備份及還原 "3月底完成"
線上更新、軟體內部加廣告(可能暫定於載入時才有,並有多一個bar)
支援vista、註冊、防止重覆執行程式、bug除錯記錄 "4月底完成"

客戶需求回報,備忘記事、商品比價、列印報表 "未來再定"

額外應該要做的功能
1。支援vista
2。線上更新
3。註冊碼
4。備忘記事
5。bug除錯記錄
6。防止重覆執行程式
7。客戶需求回報

“訂單管理”->“新增訂單” 只要輸入 拍賣編號(Yahoo)、商品編號(PChome)
當軟體開啟時會掃描已結標的客戶,並送Email給客戶(但只限特定連結到某一網頁輸入寄件資料,注意:”運送方式”及”費用”要供選擇)->而客戶輸入資料將Email到已限定的Email位址,當軟體開啟時並會掃描Email是否有已收到客戶端的Email資料。
最後結標後會去掃描評價。

數量可能要看看有無問題

欄位
商品管理(即進貨情況) (新增商品(手動輸入)、編輯商品、刪除商品、銷售排行(重點)、歷史進貨累積總數量)
編號 | 商品名稱* | 分類 | 成本* | 累積成本 | 購入數量* | 庫存量 | 成本/單位 | 備註(進貨日期、廠商、進貨單號碼、尚未結清帳款)
右鍵 | 新增 編輯 刪除 | 退貨
圖片顯示在右邊小視窗 及 備註

|_>銷售排行 – 應設計有銷售數量最多(依照同相同名稱去看購入數量-庫存量最多的)、銷售金額最多錢(依照同相同名稱去看購入數量-庫存量最多的,去乘以售價)、銷售獲利最多(依照同相同名稱去看購入數量-庫存量最多的,去乘以(成本-售價))、銷售金額最多的月份、銷售數量最多的月份、銷售獲利最多的月分。
|_>歷史進貨累積總數量

拍賣管理 (YAHOO) – 希望輸入拍賣編號就好,更好的是在商品管理就po文
名稱 | 圖片 | 目前出價 | 直接購買價 | 剩餘時間 | 最高出價者 | 商品數量 | 出價次數 | 起標價格 | 出價增額 | 商品新舊 | 所在地區 | 開始時間 | 結束時間 | 拍賣編號
拍賣管理 (PCHOME)
名稱 | 圖片 | 目前出價 | 直接購買價 | 剩餘時間 | 最高出價者 | 商品數量 | 出價次數 |      |      |      | 所在地區 | 開始時間 | 結束時間 | 拍賣編號
一般通路管理

結標管理(分“已出貨” 及 “未出貨”)
訂單編號 | 訂單日期 | 買方帳號 | 拍賣網站 | 拍賣編號 | 拍賣名稱 | 圖片 | 運費 | 結標價 | 折扣 | 匯款日 | 帳號末5碼 | 出貨數量 | 出貨日 | 運送方式 | 收件人 | 收件地址 | 希望收件時間 | 評價 | 備註
已出貨後 資料變到已出貨 拍賣管理判斷是否刪除(有的好像一直留下) 商品管理減少庫存量

客戶管理 (新增客戶、編輯客戶、刪除客戶、客戶歷史訂單)
拍賣帳號 | 拍賣網站 | 電話 | 手機 | Email | 曾經購買商品數量 | 曾經購買商品總金額 | 備註
|_>客戶歷史訂單(資料庫去搜尋,在此可能有很多筆)
訂單編號 | 訂單日期 | 買方帳號 | 拍賣網站 | (拍賣編號) | 拍賣標題名稱 | 圖片 | 運費 | 結標價 | (折扣) | 匯款日 | 帳號末5碼 | 出貨日 | 運送方式 | 收件人 | 收件地址 | 希望收件時間 | 評價 | 備註

獲利管理
每月的獲利表、年度獲利表
(皆包括銷售數量、銷售金額、銷售成本及獲利) PS:還可以算獲利率,依投資成本去計算,在此投資成本只在商品而已。

軟體發行
$ 說明使用步驟、流程
$ 與一般軟體比較表
$ 免費贈送軟體推廣告

理財大師:OooMoney (手動輸入)




因為須要輸入基金淨值及匯率才能計算很多東西
所以輸入時基金要能去抓淨值及匯率(做為買入用),且每次進入軟體也能抓淨值及匯率(做為賣出用)。

新增帳戶 | 各帳戶目前總損益表 | 年度報表 | 資產配置表 | 備份/還原

投資資產-|_
銀行帳戶-|_
投入
利息
郵局帳戶-|_
投入
利息
基金帳戶-|_
基金名稱1-|_
投入
配息
基金名稱2-|_
投入
有價物-|_
價值

銀行帳戶 -> 投入(資料欄位)
編號 | 日期 | 金額(原幣) | 累計金額(原幣) | 摘要 | 折合台幣 | 累積台幣金額 | 買入匯率 | 目前賣出匯率 | 摘要
銀行帳戶 -> 利息(資料欄位)
編號 | 日期 | 金額(原幣) | 累計金額(原幣) | 摘要 | 折合台幣 | 累積台幣金額 | 買入匯率 | 目前賣出匯率 | 摘要

基金帳戶 -> 投入(資料欄位) (有目前淨值與目前匯率)
編號 | 日期 | 金額(原幣) | 累計金額(原幣) | 投入淨值 | 投入匯率 | 目前賣出淨值 | 目前賣出匯率 | 單位數 | 累積單位數 | 手續費 | 基金帳戶 | 折合台幣 | 累積台幣金額 | 報酬 | 累計報酬 | 摘要
-> 投入(配息欄位)
編號 | 日期 | 金額(原幣) | 累計金額(原幣) | 摘要 | 折合台幣 | 累積台幣金額 | 買入匯率 | 目前賣出匯率 | 摘要

有價物 -> 價值(資料欄位)
編號 | 購入日期 | 商品名稱 | 最初價值 | 最初累計價值 | 目前價值 | 目前累計價值 | 累計價值 | 獲利 | 累計獲利 | 摘要

轉帳 要加入收續費喔

最上面5個按鈕
分別為:
新增帳戶()
各帳戶目前損益表
年度報表(即每月)
資產配置表
備份/還原

新所帳戶包括:
銀行、郵局帳戶
基金帳戶(計價幣別) (哪家銀行、哪一隻基金、計價幣別、有無配息、外幣帳戶扣款?)
有價物(珠寶、房地產、汽車、精品、古董、名畫、有價物,有最初價值及目前價值)

未來有的帳戶
黃金帳戶
外幣帳戶
股票帳戶
證券行賣的基金帳戶(上面想法是銀行的基金帳戶)

未未來有的帳戶
選擇權
連動債
債券
期貨
權證
保險
貸款 問題
信用卡帳戶


主要概念:
新增銀行、郵局帳戶皆分有投資及利息兩個資料夾。
而基金帳戶,若有配息則有兩個資料夾,若沒有則無。
不動產:只有一個資料夾,跟無配息基金一樣

簡單化:按鈕簡單化(學ie7)、並只提供個人記帳用即可。
幫助計算複利,20年後維持此複利可達到多少錢

XML自定規則的建檔及讀取方法



新增4個TButton,並點兩下加入事件。

unit Unit1;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, XMLIntf, msxmldom, XMLDoc, XmlTool;

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

var
Form1: TForm1;

implementation

{$R *.dfm}
//自定規則的建檔方法1
procedure TForm1.Button1Click(Sender: TObject);
var
XD: IXMLDocument;
begin
XD := NewXMLDocument;
try
XD.StandAlone := 'yes';
XD.Encoding := 'UTF-8';
XD.Options := [doNodeAutoIndent];
XD.NodeIndentStr := #9;

//在這裡用with來寫反而比較清楚
with XD.AddChild('Family') do
begin
AddChild('Father').NodeValue := 'Bill Gates'; //子標籤
AddChild('Mother').NodeValue := 'Lin Chiling'; //子標籤
with AddChild('My') do //子標籤
begin
Attributes['Name'] := 'Mouse'; //屬性
Attributes['Age'] := 25; //屬性
with AddChild('Wife') do //子子標籤
begin
NodeValue := 'Cat';
Attributes['Age'] := 23; //屬性
end;
with AddChild('Child') do //子子標籤
begin
NodeValue := 'Mouse II';
Attributes['Age'] := 1; //屬性
end;
with AddChild('Child') do //子子標籤
begin
NodeValue := 'Mickey Mouse';
Attributes['Age'] := 15; //屬性
end;
with AddChild('Child') do //子子標籤
begin
NodeValue := 'Donald Duck';
Attributes['Age'] := 14; //屬性
end;
end;
with AddChild('Uncle') do //子標籤
begin
Attributes['Age'] := 35; //屬性
Attributes['Sex'] := 'Male'; //屬性
AddChild('Wife').NodeValue := 'Jolin'; //子子標籤
end;
end;
XD.SaveToFile('C:\Test.xml'); //存檔
showmessage('存檔完成');
finally
XD := nil; //釋放
end;
end;

//自定規則的建檔方法2
procedure TForm1.Button2Click(Sender: TObject);
var
XT: TXmlTool;
begin
XT := TXmlTool.Create;
try
XT['/Family//Father'] := 'Bill Gates'; //目前目錄 /Family//
XT['Mother'] := 'Lin Chiling'; //目前目錄 /Family//
XT['My//@Name/'] := 'Mouse'; //目前目錄 /Family//MY// 其屬性
XT['@Age'] := 25;
XT['Wife//'] := 'Cat'; //目前目錄 /Family//MY//Wife//
XT['@Age'] := 23;
XT['../Child//'] := 'Mouse II'; //目前目錄 /Family//MY//Child//
XT['@Age'] := 1;
XT['../Child[1]//'] := 'Mickey Mouse'; //目前目錄 /Family//MY//Child// 第2個相同名字
XT['@Age'] := 15;
XT['../Child[2]//'] := 'Donald Duck'; //目前目錄 /Family//MY//Child// 第3個相同名字
XT['@Age'] := 14;
XT['../../Uncle//@Age'] := 35; //目前目錄 /Family//Uncle// 其屬性
XT['@Sex'] := 'Male';
XT['Wife//'] := 'Jolin'; //目前目錄 /Family//Uncle//Wife// 其屬性
//目錄最後可以不寫//; 如XT['Wife//']->XT['Wife']; 但外加屬性的不行XT['../../Uncle//@Age'];
XT.SaveToFile('C:\Test.xml');
showmessage('存檔完成');
finally
XT.Free;
end;
end;

//自定規則的讀取方法1
procedure TForm1.Button3Click(Sender: TObject);
var
XD: IXMLDocument;
i: Integer;
begin
XD := LoadXMLDocument('C:\Test.xml');
try
ShowMessage(XD.ChildNodes['Family'].ChildValues['Father']); //內容
ShowMessage(XD.ChildNodes['Family'].ChildValues['Mother']); //內容
ShowMessage(XD.ChildNodes['Family'].ChildNodes['My'].Attributes['Name']); //屬性值
ShowMessage(XD.ChildNodes['Family'].ChildNodes['My'].Attributes['Age']); //屬性值
ShowMessage(XD.ChildNodes['Family'].ChildNodes['My'].ChildValues['Wife']); //內容
ShowMessage(XD.ChildNodes['Family'].ChildNodes['My'].ChildNodes['Wife'].Attributes['Age']); //屬性值
for i := 0 to XD.ChildNodes['Family'].ChildNodes['My'].ChildNodes.Count-1 do
if XD.ChildNodes['Family'].ChildNodes['My'].ChildNodes[i].NodeName = 'Child' then //如果是Child
begin
ShowMessage(XD.ChildNodes['Family'].ChildNodes['My'].ChildNodes[i].NodeValue); //內容
ShowMessage(XD.ChildNodes['Family'].ChildNodes['My'].ChildNodes[i].Attributes['Age']); //屬性值
end;
ShowMessage(XD.ChildNodes['Family'].ChildNodes['Uncle'].Attributes['Age']); //屬性值
ShowMessage(XD.ChildNodes['Family'].ChildNodes['Uncle'].Attributes['Sex']); //屬性值
ShowMessage(XD.ChildNodes['Family'].ChildNodes['Uncle'].ChildValues['Wife']); //內容
finally
XD := nil;
end;
end;

//自定規則的讀取方法2
procedure TForm1.Button4Click(Sender: TObject);
var
XT: TXmlTool;
begin
XT := TXmlTool.Create('C:\Test.xml');
try
ShowMessage(XT['/Family//Father']); //內容
ShowMessage(XT['Mother']); //內容
if XT.SubNodes['My/'].First then
repeat
ShowMessage('1. '+XT.SubNodes['My/'].NodeXPath + '=' + XT.SubNodes['My/'].NodeValue); //My Name、Age及Wife、Child值
if XT.SubNodes['My/'].SubNodes.First then
repeat
ShowMessage('2. '+XT.SubNodes['My/'].NodeXPath + '=' + XT.SubNodes['My/'].SubNodes.NodeValue); //Wife、Child的Age值
until not XT.SubNodes['My/'].SubNodes.Next;
until not XT.SubNodes['My/'].Next;
ShowMessage(XT['Uncle//@Age']); //屬性
ShowMessage(XT['@Sex']); //屬性
ShowMessage(XT['Wife']); //內容
finally
XT.Free;
end;
end;

end.