Kinh doanh nhà qua mạng Client/Server

temIndex; if index < 0 then Exit; with TDeleteThread.Create(index) do WaitFor; end; end; procedure TChatForm.AdminLTBtnModifyClick(Sender: TObject); var Index : Longint; begin Index := VLB.ItemIndex; if Index < 0 then Exit; if SetHomeInfo(true) then with TModifyDataThread.Create(index, fhome) do WaitFor; end; procedure TChatForm.TextSearchChange(Sender: TObject); begin with THomeSearchTextThread.Create(TextSearch.Text, true, -1) do WaitFor; VLB.ItemIndex := findex; end; procedure TChatForm.TextSearchKeyPress(Sender: TObject; var Key: Char); begin if Key = #13 then ShowData; end; procedure TChatForm.AdminLTBtnRepThueClick(Sender: TObject); begin RepThueForm := TRepThueForm.Create(self); with RepThueForm do begin isThue := true; ShowModal; Release; end; end; procedure TChatForm.AdminLTBtnRepBanClick(Sender: TObject); begin RepThueForm := TRepThueForm.Create(self); with RepThueForm do begin isThue := false; ShowModal; Release end end; procedure TChatForm.QFButton1Click(Sender: TObject); begin close end; procedure TChatForm.ChangeIndex(var msg : TMessage); var Index : integer; begin Index := msg.WParam; if index < 0 then exit; VLB.ItemIndex := index; VLBClick(nil); end; procedure TChatForm.FormActivate(Sender: TObject); begin VLB.ItemIndex := 0; VLBClick(nil); end; initialization InitializeCriticalSection(CritSect); finalization DeleteCriticalSection(CritSect); end. ConectDlg.pas ConectDlg.pas chöùa khung trao ñoåi yeâu caàu nhaäp username, password… khi baét ñaàu chöông trình. (* ConectDlg.pas Written by Le Tuan *) unit conectdlg; interface uses Windows, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, Buttons, ExtCtrls, Tranbtn; type TConnectDlg = class(TForm) HostName: TEdit; Label1: TLabel; Label2: TLabel; UserName: TEdit; Label3: TLabel; Level: TComboBox; Label4: TLabel; Password: TEdit; Image1: TImage; LTBtnNhan: TLTBtn; LTBtn2: TLTBtn; Bevel1: TBevel; procedure FormCreate(Sender: TObject); procedure OKClick(Sender: TObject); procedure FormPaint(Sender: TObject); procedure LTBtn2Click(Sender: TObject); procedure FormKeyPress(Sender: TObject; var Key: Char); private { Private declarations } procedure PaintBack(fCanvas : TCanvas); public { Public declarations } end; var ConnectDlg : TConnectDlg; implementation {$R *.DFM} uses Informf; type TUser = record aname : string[20]; apassword : string[20]; alevel : Byte; end; const UserCount = 3; arrUser : array[1..UserCount] of TUser = ( (aName : 'admin'; apassword : 'admin'; alevel : 2), (aName : 'update'; apassword : 'update'; alevel : 1), (aName : 'customer' ; apassword : 'customer'; alevel : 0) ); procedure TConnectDlg.FormCreate(Sender: TObject); begin Level.ItemIndex := 2; end; procedure TConnectDlg.OKClick(Sender: TObject); var i : byte; begin for i := 1 to UserCount do with ArrUser[i] do begin if (aName = UserName.Text) and (aPassword = Password.Text) and (Level.ItemIndex = aLevel) then begin ModalResult := mrOK; exit; end; end; ShowMessage('User not found'); ModalResult := mrNone; end; procedure TConnectDlg.PaintBack(fCanvas : TCanvas); var X, Y, W, H: LongInt; begin with Image1.Picture.Bitmap do begin W := Width; H := Height; end; Y := 0; while Y < Height do begin X := 0; while X < Width do begin fCanvas.Draw(X, Y, Image1.Picture.Bitmap); Inc(X, W); end; Inc(Y, H); end; end; procedure TConnectDlg.FormPaint(Sender: TObject); begin PaintBack(Canvas); end; procedure TConnectDlg.LTBtn2Click(Sender: TObject); begin Close; ModalResult := mrCancel; end; procedure TConnectDlg.FormKeyPress(Sender: TObject; var Key: Char); begin if Key = #13 then OKClick(nil); end; end. Findf.pas Khung trao ñoåi tìm kieám theo tuøy choïn (* findf.pas Written by Le Tuan *) unit findf; interface uses Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, ExtCtrls, Buttons, VLB, HomeTools, Tranbtn, ShadowForm, QFButton; type TFindForm = class(TShadowForm) VLBFilter: TVLB; Nha: TComboBox; ViTri: TComboBox; Label1: TLabel; EditTriGiaMin: TEdit; ComboTiGiaMin: TComboBox; ComboTigiaMax: TComboBox; EditTriGiaMax: TEdit; Label2: TLabel; Label6: TLabel; Label7: TLabel; Label4: TLabel; EditSMin: TEdit; EditSMax: TEdit; Label5: TLabel; Bevel1: TBevel; OK: TLTBtn; LTBtn2: TLTBtn; Bevel2: TBevel; Image1: TImage; QFButton1: TQFButton; Bevel3: TBevel; Label3: TLabel; procedure BitBtnFindClick(Sender: TObject); procedure FormCreate(Sender: TObject); procedure VLBFilterGetItem(Sender: TObject; Index: Integer; var ItemString: String); procedure FormPaint(Sender: TObject); procedure LTBtn2Click(Sender: TObject); procedure VLBFilterClick(Sender: TObject); procedure QFButton1Click(Sender: TObject); private procedure wmNcHitTest(var Msg : TwmNcHitTest); message wm_NcHitTest; function TestTLTBtn(p : TPoint) : boolean; public Filter : PArrInt; FilterCount : Integer; FindResult : Boolean; FFHome : THomeInfo; end; var FindForm: TFindForm; implementation {$R *.DFM} uses nhaf; procedure TFindForm.BitBtnFindClick(Sender: TObject); var Home : THomeInfo; Find : TFind; begin FindResult := False; with Find do begin ThueBan := Nha.ItemIndex; NgoaiNoiThanh := ViTri.ItemIndex; TriGiaMax := myStrToReal(EditTriGiaMax.Text); TriGiaMin := myStrToReal(EditTriGiaMin.Text); RaVND(TriGiaMax, ComboTigiaMax.ItemIndex); RaVND(TriGiaMin, ComboTigiaMin.ItemIndex); DienTichMax := myStrToReal(EditSMax.Text); DienTichMin := myStrToReal(EditSMin.Text); end; Move(Find, Home, sizeof(Find)); ChatForm.SendMessageToServer(ChatForm.ClientSocket.Socket, idFind, 0, Home); end; procedure TFindForm.FormCreate(Sender: TObject); begin Filter := nil; end; procedure TFindForm.VLBFilterGetItem(Sender: TObject; Index: Integer; var ItemString: String); begin if FindResult then begin ItemReceived := False; ChatForm.SendMessageToServer(ChatForm.ClientSocket.Socket, idGetItemFilter, Filter[Index], ChatForm.fHome); repeat Application.ProcessMessages; until ItemReceived; ItemString := ffHome.TenNha; end; end; procedure TFindForm.FormPaint(Sender: TObject); begin ChatForm.PaintBack(Canvas, ChatForm.Image1.Picture.Bitmap); end; procedure TFindForm.LTBtn2Click(Sender: TObject); begin Close; end; function TFindForm.TestTLTBtn(p : TPoint) : boolean; var i : integer; begin result := false; for i := 0 to ControlCount - 1 do begin if (Controls[i] is TLTBtn) and (PtInRect((Controls[i] as TLTBtn).BoundsRect, p)) then Exit; if (Controls[i] is TQFButton) and (PtInRect((Controls[i] as TQFButton).BoundsRect, p)) then Exit; end; result := true; end; procedure TFindForm.wmNcHitTest(var Msg : TwmNcHitTest); begin inherited; if TestTLTBtn(ScreenToClient(Point(Msg.Pos.X, Msg.Pos.Y))) then Msg.Result := HTCAPTION; end; procedure TFindForm.VLBFilterClick(Sender: TObject); var Index : longint; begin if not FindResult then Exit; index := VLBFilter.ItemIndex; if index < 0 then exit; SendMessage(ChatForm.Handle, WM_ChangeIndex, Filter[Index], 0); end; procedure TFindForm.QFButton1Click(Sender: TObject); begin Close; ModalResult := mrCancel; end; end. HomeInfo.pas Khung trao ñoåi ñeå cho pheùp ngöôøi duøng theâm hay söûa ñoåi thoâng tin veà moät nhaø. (* Homeinfo.pas Written by Le Tuan *) unit homeInfo; interface uses Windows, Messages, Classes, Controls, Forms, StdCtrls, Buttons, Spin, ExtCtrls, ComCtrls, Tranbtn, TransCheckBox; type THomeInfoForm = class(TForm) Bevel1: TBevel; Label1: TLabel; EditTenNha: TEdit; Label8: TLabel; EditCapNha: TEdit; Label2: TLabel; EditChieuDai: TEdit; Label3: TLabel; EditChieuRong: TEdit; Label12: TLabel; EditTangLau: TEdit; EditPhongTam: TEdit; EditPhongNgu: TEdit; Label10: TLabel; EditPhongKhach: TEdit; Label9: TLabel; Label4: TLabel; Label7: TLabel; EditDiaChi: TEdit; EditThanhPho: TEdit; Label6: TLabel; Label5: TLabel; EditDuong: TEdit; EditQuan: TEdit; Label11: TLabel; Bevel2: TBevel; ChkNhaChoThue: TTransCheckBox; Label15: TLabel; EditGiaMoiThang: TEdit; ComboTienThueTinhTheo: TComboBox; Bevel3: TBevel; ChkNhaBan: TTransCheckBox; Label16: TLabel; EditTriGia: TEdit; ComboTienBanTinhTheo: TComboBox; Bevel4: TBevel; ChkNhaNgoaiThanh: TTransCheckBox; ChkNhaCoHoBoi: TTransCheckBox; chkCoNuocMay: TTransCheckBox; chkNhaCoNuocGieng: TTransCheckBox; chkNhaCoHeThongNuocNong: TTransCheckBox; Bevel5: TBevel; chkNhaTrongHem: TTransCheckBox; ChieuRongHem: TLabel; EditChieuRongHem: TEdit; Label14: TLabel; EditVaoHemBaoSau: TEdit; Bevel6: TBevel; Label18: TLabel; DateTimePickerNamXayDung: TDateTimePicker; ComboTinhTrangNha: TComboBox; Label13: TLabel; Label19: TLabel; ComboTrangTriNoiThat: TComboBox; Bevel7: TBevel; ChkNhaCoVuon: TTransCheckBox; Label20: TLabel; EditChieuRongVuon: TEdit; Bevel8: TBevel; Label17: TLabel; ComboHuongNha: TComboBox; ComboChuQuyen: TComboBox; LabelChuQuyen: TLabel; OK: TLTBtn; LTBtn2: TLTBtn; procedure EditTenNhaChange(Sender: TObject); procedure FormCreate(Sender: TObject); procedure FormPaint(Sender: TObject); procedure OKClick(Sender: TObject); procedure LTBtn2Click(Sender: TObject); private { Private declarations } public { Public declarations } end; implementation {$R *.DFM} uses Nhaf; procedure THomeInfoForm.EditTenNhaChange(Sender: TObject); begin Ok.Enabled := (EditTenNha.Text '')// and not found; end; procedure THomeInfoForm.FormCreate(Sender: TObject); begin comboTienThueTinhTheo.ItemIndex := 0; comboTienBanTinhTheo.ItemIndex := 0; comboTinhTrangNha.ItemIndex := 0; comboTrangTriNoiThat.ItemIndex := 0; comboHuongNha.ItemIndex := 0; comboChuQuyen.ItemIndex := 0; end; procedure THomeInfoForm.FormPaint(Sender: TObject); begin ChatForm.PaintBack(Canvas, ChatForm.Image2.Picture.Bitmap); end; procedure THomeInfoForm.OKClick(Sender: TObject); begin Close; ModalResult := mrOK; end; procedure THomeInfoForm.LTBtn2Click(Sender: TObject); begin Close; // ModalResult := mrNone; end; end. HomeTools.pas HomeTools.pas laø moät thö vieän caùc haøm thao taùc treân döõ lieäu nhö: Caäp nhaät nhaø, laáy thoâng tin nhaø …. (* homeTools.pas Written by Le Tuan *) {$i-} unit hometools; interface const _USD : real = 14000; _CAY : real = 5000000; procedure myDelay(x : longint); function myStrToReal(s : string) : real; function myStrToInt(s : string) : integer; function myRealToStr(x : real) : string; function myIntToStr(x : integer) : string; procedure RaVND(var x : real; o : integer); type THomeInfo = packed record TenNha : string[30]; // ten nha CapNha : byte; // cap nha ChieuDai, // chieu dai ChieuRong : real; // chieu rong TangLau : byte; // so lau PhongKhach : byte; // so phong PhongNgu : byte; // so phong ngu PhongTam : byte; // so phong tam DiaChi, // dia chi Duong, // ten duong ThanhPho : string[30]; // thanh pho Quan : string[30]; // quan NhaChoThue : boolean; // co phai nha cho thue? GiaMoiThang : real; // gia tien thue moi thang NhaBan : boolean; // co phai nha muon ban? TriGia : real; // gia tien ban NhaNgoaiThanh : boolean; // ngoa.i hay noi thanh? CoNuocMay : Boolean; // co nuoc may khong? NhaCoHeThongNuocNong : Boolean; // co he thong nuoc nong? NhaCoHoBoi : boolean; // nha co ho khong? NhaCoNuocGieng : boolean; // nha co nuoc gieng? NhaTrongHem : boolean; // nha trong hem? ChieuRongHem : real; // chieu rong hem VaoHemBaosau : real; // NamXayDung : TDateTime; // TinhTrangNha : Byte; // TrangTriNoiThat : Byte; // NhaCoVuon : boolean; // nha co vuon khong? ChieuRongVuon : real; // HuongNha : Byte; // ChuQuyen : Byte; // DienTich : real; // dien tich nha rent_roi : boolean; // nha da thue roi sell_roi : boolean; // nha da ban roi NgayDauThue : TDateTime; // ngay bat dau thue nha NgayCuoiThue : TDateTime; // ngay ket thuc thue nha end; type TFind = packed record ThueBan : integer; NgoaiNoiThanh : integer; TriGiaMax : real; TriGiaMin : real; DienTichMax : real; DienTichMin : real; end; TIndexFile = file of longint; arrInt = array[0..0] of longint; PArrInt = ^arrInt; THomeData = class private datafile : file of THomeInfo; indexFile : TIndexFile; rentFile, sellFile : TIndexFile; procedure GetPath; public PathName : string; constructor Create; destructor Destroy; override; function HomeSearch(Name : PChar; var found : Boolean): longint; function HomeGet(index : longint) : THomeInfo; function HomeInsert(home : THomeInfo; var Index : longint) : boolean; function HomeModify(home : THomeInfo; var Index : longint) : boolean; function HomeDelete(index : longint) : boolean; function HomeGetCount : longint; function HomeSell(index : longint) : boolean; function HomeGetCountSell : longint; function HomeGetSell(index: longint): THomeInfo; function HomeRent(index : longint; NgayDau, NgayCuoi : TDateTime) : boolean; function HomeUnRent(delindex : longint) : boolean; function HomeGetCountRent : longint; function HomeGetRent(index: longint): THomeInfo; function HomeFind(ThueBan, ViTri : Integer; GiaMin, GiaMax, SMin, SMax : real; var ListSelect : PArrInt; var FilterCount : longint) : boolean; end; const idxtypeSize = sizeof(longint); var MaxFilterCount : longint; implementation uses VNIChar, Windows, SysUtils, Forms; const const_datafilename = 'ltdata.dic'; const_indexFilename = 'ltidx.dic'; const_rentFilename = 'ltrent.dic'; const_sellFilename = 'ltsell.dic'; var datafilename : string; indexfilename : string; rentfilename : string; sellfilename : string; procedure myDelay(x : longint); var y : longint; begin y := GetTickCount; repeat Application.ProcessMessages; until GetTickCount > y + x; end; function myStrToReal(s : string) : real; var j : integer; begin Val(s, result, j); if j 0 then result := -1; end; function myStrToInt(s : string) : integer; begin try result := StrToInt(s); except result := -1; end; end; function myRealToStr(x : real) : string; begin try Str(x:0:2, result); except result := ''; end; end; function myIntToStr(x : integer) : string; begin try result := IntToStr(x); except result := ''; end; end; constructor THomeData.Create; begin inherited Create; GetPath; assignfile(datafile, datafilename); reset(datafile); if IOResult 0 then rewrite(datafile); assignfile(indexfile, indexfilename); reset(indexfile); if IOResult 0 then rewrite(indexfile); assignfile(rentfile, rentfilename); reset(rentfile); if IOResult 0 then rewrite(rentfile); assignfile(sellfile, sellfilename); reset(sellfile); if IOResult 0 then rewrite(sellfile); end; destructor THomeData.Destroy; begin closefile(datafile); closefile(indexfile); closefile(rentfile); closefile(sellfile); end; function THomeData.HomeInsert(home : THomeInfo; var Index : longint) : boolean; function findIndex : longint; var l, r, m, ListCount : Longint; ByteCmp : char; iHome : THomeInfo; begin ListCount := HomeGetCount; l := 0; r := ListCount - 1; m := 0; bytecmp := #0; while l <= r do begin m := (l + r) shr 1; iHome := HomeGet(m); bytecmp := VNI_StrComp(Home.TenNha, iHome.TenNha); if bytecmp = '>' then l := m + 1 else if bytecmp = '<' then r := m - 1 else begin result := -1; Exit; end; end; if (m ') then inc(m); result := m; end; label 1, 2; var ftIdx : TIndexFile; Count, Size, fsdata : longint; buf : PChar; begin Result := False; Index := FindIndex; if index < 0 then Exit; assignfile(ftidx, pathname + '1z2y3x4w.qgb'); rewrite(ftidx); count := index; seek(indexFile , 0); if count > 0 then begin size := count * idxtypeSize; getmem(buf, size); blockread(indexfile, buf^, count); blockwrite(ftIdx, buf^, count); freemem(buf, size); end; fsdata := filesize(datafile); write(ftidx, fsdata); count := filesize(indexfile) - count; if count > 0 then begin size := count*idxtypeSize; getmem(buf, size); blockread(indexfile, buf^, count); blockwrite(ftidx, buf^, count); freemem(buf, size); end; CloseFile(ftIdx); CloseFile(indexFile); if IOresult = 0 then begin Erase(indexfile); Rename(ftIdx, indexFilename); Reset(indexFile); seek(datafile, fsdata); write(datafile, home); Result := True; end; end; function THomeData.HomeGet(index : longint) : THomeInfo; begin fillchar(result, sizeof(result), 0); seek(indexfile, index); read(indexfile, index); seek(datafile,index); read(datafile, result); end; function THomeData.HomeGetCount : longint; begin result := filesize(indexfile); end; function THomeData.HomeSearch(Name : PChar; var found : Boolean): longint; var byteCmp : char; Listcount, l, r, m : longint; Home : THomeInfo; begin Found := False; if name[0] = #0 then begin result := 0; exit; end; ListCount := HomeGetcount; l := 0; m := 0; r := ListCount - 1; ByteCmp := #0; while (not Found) and (l <= r) do begin m := (l + r) shr 1; Home := HomeGet(m); Bytecmp := VNI_StrComp(Name, Home.TenNha); if Bytecmp = '>' then l := m + 1 else if Bytecmp = '<' then r := m - 1 else Found := True; end; result := m; if not found then begin if VNI_StrComp(copy(Home.TenNha, 1, length(name)), Name) '=' then begin Home := HomeGet(m + 1); if (m + 1 < ListCount) and (VNI_StrComp(copy(Home.TenNha, 1, length(name)), name) = '=') then inc(Result) else if (m > 0) and (bytecmp = '<') then dec(result); end; end; end; procedure THomeData.GetPath; var i : byte; begin pathname := paramstr(0); i := length(pathname); while (i > 0) and (pathname[i] '\') do dec(i); pathname := Copy(pathname, 1, i); datafilename := pathname + const_datafilename; indexFilename := pathname + const_indexFilename; rentfilename := pathname + const_rentfilename; sellFilename := pathname + const_sellFilename; end; function THomeData.HomeDelete(index : longint) : boolean; var count : longint; buf : pchar; ftidx : TIndexfile; begin result := false; if index < 0 then exit; assignfile(ftidx, pathname + '1z2y3x4w.qgb'); rewrite(ftidx); count := index; if count > 0 then begin getmem(buf, count*idxtypeSize); seek(IndexFile, 0); blockread(IndexFile, buf^, count); blockwrite(ftIdx, buf^, count); freemem(buf, count*idxtypeSize); end; count := filesize(IndexFile)- count - 1; if count > 0 then begin getmem(buf, count*idxtypeSize); seek(IndexFile, index + 1); blockread(IndexFile, buf^, count); blockwrite(ftidx, buf^, count); freemem(buf, count*idxtypeSize); end; result := IOResult = 0; if result then begin CloseFile(ftIdx); CloseFile(IndexFile); Erase(IndexFile); Rename(ftIdx, indexfilename); AssignFile(IndexFile, indexfilename); Reset(IndexFile); end; end; function THomeData.HomeModify(home : THomeInfo; var Index : longint) : boolean; begin result := HomeDelete(index); if result then result := HomeInsert(home, index); end; function THomeData.HomeSell(index : longint) : boolean; var count, dataIndex : longint; buf : pchar; ftidx : TIndexfile; begin result := false; if index < 0 then exit; seek(indexfile, index); read(indexfile, dataindex); seek(sellfile, filesize(sellfile)); write(sellfile, dataindex); assignfile(ftidx, pathname + '1z2y3x4w.qgb'); rewrite(ftidx); count := index; if count > 0 then begin getmem(buf, count*idxtypeSize); seek(IndexFile, 0); blockread(IndexFile, buf^, count); blockwrite(ftIdx, buf^, count); freemem(buf, count*idxtypeSize); end; count := filesize(IndexFile)- count - 1; if count > 0 then begin getmem(buf, count*idxtypeSize); seek(IndexFile, index + 1); blockread(IndexFile, buf^, count); blockwrite(ftidx, buf^, count); freemem(buf, count*idxtypeSize); end; result := IOResult = 0; if result then begin CloseFile(ftIdx); CloseFile(IndexFile); Erase(IndexFile); Rename(ftIdx, indexfilename); AssignFile(IndexFile, indexfilename); Reset(IndexFile); end; end; function THomeData.HomeGetCountSell : longint; begin result := filesize(sellfile); end; function THomeData.HomeGetSell(index: longint): THomeInfo; begin seek(sellfile, index); read(sellfile, index); seek(datafile, index); read(datafile, result); end; function THomeData.HomeRent(index : longint; NgayDau, NgayCuoi : TDateTime) : boolean; var dataindex, count : longint; buf : pchar; ftidx : TIndexfile; fHome : THomeInfo; begin result := false; if index < 0 then exit; seek(indexfile, index); read(indexfile, dataindex); seek(datafile, dataindex); read(datafile, fhome); fhome.NgayDauThue := NgayDau; fHome.NgayCuoiThue := NgayCuoi; seek(datafile, dataindex); write(datafile, fhome); seek(rentfile, filesize(rentfile)); write(rentfile, dataindex); assignfile(ftidx, pathname + '1z2y3x4w.qgb'); rewrite(ftidx); count := index; if count > 0 then begin getmem(buf, count*idxtypeSize); seek(IndexFile, 0); blockread(IndexFile, buf^, count); blockwrite(ftIdx, buf^, count); freemem(buf, count*idxtypeSize); end; count := filesize(IndexFile)- count - 1; if count > 0 then begin getmem(buf, count*idxtypeSize); seek(IndexFile, index + 1); blockread(IndexFile, buf^, count); blockwrite(ftidx, buf^, count); freemem(buf, count*idxtypeSize); end; result := IOResult = 0; if result then begin CloseFile(ftIdx); CloseFile(IndexFile); Erase(IndexFile); Rename(ftIdx, indexfilename); AssignFile(IndexFile, indexfilename); Reset(IndexFile); end; end; function THomeData.HomeGetCountRent : longint; begin result := filesize(rentfile); end; function THomeData.HomeGetRent(index: longint): THomeInfo; begin seek(rentfile, index); read(rentfile, index); seek(datafile, index); read(datafile, result); end; function THomeData.HomeFind(ThueBan, ViTri : Integer; GiaMin, GiaMax, SMin, SMax : real; var ListSelect : PArrInt; var FilterCount : longint) : boolean; var Index : longint; Home : THomeInfo; Count : longint; begin Result := true; Count := FilterCount; FilterCount := 0; for Index := 0 to Count - 1 do begin Home := HomeGet(Index); case ThueBan of 1 : if not Home.Nhaban then Continue; 0 : if not Home.NhaChoThue then Continue; end; if ViTri >= 0 then if Home.NhaNgoaiThanh (ViTri = 0) then Continue; if GiaMin >= 0 then if ThueBan = 0 then if Home.GiaMoiThang < GiaMin then Continue else else if (ThueBan = 1) and (Home.TriGia < GiaMin) then Continue; if GiaMax >= 0 then if ThueBan = 0 then if Home.GiaMoiThang > GiaMax then Continue else else if (ThueBan = 1) and (Home.TriGia > GiaMax) then Continue; if SMin >= 0 then if Home.DienTich < SMin then Continue; if SMax >= 0 then if Home.DienTich > SMax then Continue; ListSelect[FilterCount] := Index; Inc(FilterCount); if FilterCount >= MaxFilterCount then Break; end; end; procedure RaVND(var x : real; o : integer); begin case o of 1 : x := x * _USD; //USD 2 : x := x * _CAY; //Cayvang end; end; function THomeData.HomeUnRent(delindex : longint) : boolean; var buf : pchar; fHome : THomeInfo; index, count : longint; trent: TIndexFile; begin seek(rentfile, delindex); read(rentfile, index); seek(datafile, index); read(datafile, fHome); HomeInsert(fHome, index); //remove recdeleted from rentfile assignfile(trent, pathname + '1z2y3x4w.qgb'); rewrite(trent); count := delindex; if count > 0 then begin getmem(buf, count*idxtypeSize); seek(rentfile, 0); blockread(rentfile, buf^, count); blockwrite(trent, buf^, count); freemem(buf, count*idxtypesize); end; count := filesize(rentfile) - count - 1; if count > 0 then begin getmem(buf, count*idxtypesize); seek(rentfile, delindex + 1); blockread(rentfile, buf^, count); blockwrite(trent, buf^, count); freemem(buf, count*idxTypesize); end; result := IOResult = 0; if result then begin CloseFile(trent); CloseFile(rentfile); Erase(rentfile); Rename(trent, rentfilename); AssignFile(rentfile, rentfilename); Reset(rentfile); end; result := IOresult = 0; end; begin MaxFilterCount := Sizeof(THomeInfo) div 4; end. Informf.pas Khung trao ñoåi duøng ñeå thoâng baùo loãi hoaëc cho ngöôøi duøng thaáy moät thoâng tin naøo ñoù. (* informf.pas Written by Le Tuan *) unit informf; interface uses Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, ShdWin, ExtCtrls, Tranbtn, StdCtrls; type TInfoForm = class(TShdwin) Label1: TLabel; OK: TLTBtn; Bevel1: TBevel; LTBtn2: TLTBtn; procedure FormPaint(Sender: TObject); procedure OKClick(Sender: TObject); procedure LTBtn2Click(Sender: TObject); private { Private declarations } public { Public declarations } // isConfirm : Boolean; end; function ShowInfo(s : string; isConfirm : Boolean) : integer; implementation {$R *.DFM} uses nhaf; function ShowInfo(s : string; isConfirm : Boolean) : integer; begin with TInfoForm.Create(ChatForm) do begin Label1.Caption := s; if isConfirm then begin OK.Left := 70; LTBtn2.Visible := true; end else begin LTBtn2.Visible := false; OK.Left := 77; end; result := ShowModal; Release; end; end; procedure TInfoForm.FormPaint(Sender: TObject); begin Chatform.PaintBack(Canvas, ChatForm.Image4.Picture.Bitmap); end; procedure TInfoForm.OKClick(Sender: TObject); begin Close; ModalResult := mrOK; end; procedure TInfoForm.LTBtn2Click(Sender: TObject); begin Close; ModalResult := mrCancel; end; end. InputThuef.pas Khung trao ñoåi cho pheùp khaùch haøng nhaäp thôøi gian ngaøy thueâ nhaø. (* inputthuef.pas Written by Le Tuan *) unit inputthuef; interface uses Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, Tranbtn, StdCtrls, ComCtrls, VNForm; type TInputThue = class(TVNForm) DateTimePickerDau: TDateTimePicker; Label1: TLabel; Label2: TLabel; DateTimePickerCuoi: TDateTimePicker; OK: TLTBtn; LTBtn2: TLTBtn; procedure FormPaint(Sender: TObject); procedure LTBtn2Click(Sender: TObject); procedure OKClick(Sender: TObject); private { Private declarations } public { Public declarations } end; implementation {$R *.DFM} uses nhaf; procedure TInputThue.FormPaint(Sender: TObject); begin ChatForm.PaintBack(Canvas, Chatform.Image1.Picture.Bitmap); end; procedure TInputThue.LTBtn2Click(Sender: TObject); begin Close; ModalResult := mrCancel; end; procedure TInputThue.OKClick(Sender: TObject); begin Close; ModalResult := mrOK; end; end. MytdRTF.pas MytdRTF.pas laø moät thö vieän caùc haøm duøng vaøo vieäc hieän thò thoâng tin veà nhaø cöûa ra moät memo daïng RichTextFormat. (* mytdrtf.pas Written by Le Tuan *) unit mytdrtf; interface uses Classes, SysUtils, HomeTools; procedure RecToRTF(Home : THomeInfo; var rtf : TMemoryStream); implementation const header : pchar = '{\rtf1\ansi\deff4\deflang1033\deftab10' + '{\fonttbl' + '{\f0\froman Vietnam;}' + '{\f1\froman thanhoa;}' + '{\f2\fcharset2 Wingdings;}' + '{\f3\froman VNI-FreeWrite\tlul;}' + '{\f4\fnil\fprq2 VNI Times;}' + '}' + '{\colortbl\red54\green80\blue252;' + '\red0\green128\blue0;' + '\red0\green0\blue255;' + '\red43\green10\blue10;' + '\red0\green0\blue0;}'; sTen_F : pchar = '\plain\cf4\fs18\f0\b '; sTen : pchar = '\par\plain\cf4\fs18\f0\b '; sGiaTri : pchar = '\pard\tx1950\tab \plain\cf4\fs18\f0 '; TenNha : pchar = 'Tˆn nh…'; CapNha : pchar = 'Cãp nh…'; ChieuDai : pchar = 'Chi‹u d…i'; ChieuRong : pchar = 'Chi‹u r›ng'; TangLau : pchar = 'S– täng läu'; PhongKhach : pchar = 'S– ph•ng khÿch'; PhongNgu : pchar = 'S– ph•ng ngœ'; PhongTam : pchar = 'S– ph•ng tém'; DiaChi : pchar = '®«a ch©'; Duong : pchar = 'Tˆn ­Ÿõng'; ThanhPho : pchar = 'Tˆn th…nh ph–'; Quan : pchar = 'Tˆn quçn'; NhaChoThue : pchar = 'Nh… thuˆ'; GiaMoiThang : pchar = 'Giÿ thuˆ mši thÿng'; NhaBan : pchar = 'Nh… bÿn'; TriGia : pchar = 'Tr« giÿ cèn nh…'; NhaNgoaiThanh : pchar = 'Nh… ngoâi th…nh'; CoNuocMay : pchar = 'Nh… c¢ nŸôc mÿy'; NhaCoHeThongNuocNong : pchar = 'H¬ th–ng nŸôc n¢ng'; NhaCoHoBoi : pchar = 'Nh… c¢ h˜ bói'; NhaCoNuocGieng : pchar = 'Nh… c¢ nŸôc gi‰ng'; NhaTrongHem : pchar = 'Nh… trong hm'; ChieuRongHem : pchar = 'Chi‹u r›ng hm'; VaoHemBaosau : pchar = 'Chi‹u sƒu hm'; NamXayDung : pchar = 'Nèm xƒy d¨ng'; TinhTrangNha : pchar = 'Tnh trâng nh…'; TrangTriNoiThat : pchar = 'Trang tr¡ n›i thãt'; NhaCoVuon : pchar = 'Nh… c¢ vŸõn'; ChieuRongVuon : pchar = 'Chi‹u r›ng vŸõn'; HuongNha : pchar = 'HŸông nh…'; ChuQuyen : pchar = 'Chœ quy‹n nh… cãp'; NgayThueDau : pchar = 'Ngay bét ­äu thuˆ'; NgayThueCuoi : pchar = 'Ngay thuˆ cu–i c—ng'; procedure WriteEOFRTF(var rtf : TMemoryStream); var c : char; begin c := '}'; rtf.Write(c, 1); end; procedure RecToRTF(Home : THomeInfo; var rtf : TMemoryStream); const noyes : array[Boolean] of pchar = ( 'Kh“ng', 'C¢' ); saidung : array[Boolean] of pchar = ( 'Sai', '®£ng' ); sTinhtrang : array[0..3] of pchar = ( 'Rãt t–t', 'T–t', 'Trung bnh', 'K‚m' ); sTrangTriNoiThat : array[0..3] of pchar = ( 'Sang tr”ng', 'T–t', 'Trung bnh', 'K‚m' ); sHuongNha : array[0..7] of pchar = ( '®“ng', 'Tƒy', 'Nam', 'Béc', '®“ng béc', '®“ng nam', 'Tƒy béc', 'Tƒy nam' ); sCapChuQuyen : array[0..3] of pchar = ( 'Cãp th…nh ph–', 'Cãp quçn', 'Cãp phŸõng', 'Kh“ng giãy' ); snoinfo : pchar = 'Kh“ng c¢ th“ng tin'; procedure WriteRTF(ten, giatri : pchar; f : boolean); begin if f then rtf.Write(sTen_f^, strlen(sTen_f)) else rtf.Write(sTen^, strlen(sTen)); rtf.Write(Ten^, strlen(Ten)); rtf.Write(sGiaTri^, strlen(sGiaTri)); if giatri[0] '-' then rtf.Write(giatri^, length(giatri)) else rtf.Write(snoinfo^, strlen(snoinfo)) end; begin rtf.Write(header^, strlen(header)); WriteRTF(TenNha, @Home.TenNha[1], true); WriteRTF(DiaChi, @Home.Diachi[1], false); WriteRTF(Duong, @Home.Duong[1], false); WriteRTF(NhaNgoaiThanh, saidung[Home.NhaNgoaiThanh], false); WriteRTF(ThanhPho, @Home.ThanhPho[1], false); WriteRTF(Quan, @Home.Quan[1], false); WriteRTF(NhaTrongHem, saidung[Home.NhaTrongHem], false); WriteRTF(ChuQuyen, sCapChuQuyen[Home.ChuQuyen], false); WriteRTF(CapNha, @IntToStr(Home.CapNha)[1], false); WriteRTF(ChieuDai, @myRealToStr(Home.ChieuDai)[1], false); WriteRTF(ChieuRong, @myRealToStr(Home.ChieuRong)[1], false); WriteRTF(TangLau, @IntToStr(Home.TangLau)[1], false); WriteRTF(PhongKhach, @IntToStr(Home.PhongKhach)[1], false); WriteRTF(PhongNgu, @IntToStr(Home.PhongNgu)[1], false); WriteRTF(PhongTam, @IntToStr(Home.PhongTam)[1], false); WriteRTF(NhaChoThue, noyes[Home.NhaChoThue], false); WriteRTF(GiaMoiThang, @myRealToStr(Home.GiaMoithang)[1], false); WriteRTF(NhaBan, noyes[Home.NhaBan], false); WriteRTF(TriGia, @myRealToStr(Home.TriGia)[1], false); WriteRTF(CoNuocMay, noyes[Home.CoNuocMay], false); WriteRTF(NhaCoHeThongNuocNong, noyes[ Home.NhaCoHeThongNuocNong], false); WriteRTF(NhaCoHoBoi, noyes[Home.NhaCoHoBoi], false); WriteRTF(NhaCoNuocGieng, noyes[Home.NhaCoNuocGieng], false); WriteRTF(ChieuRongHem, @myRealToStr(Home.ChieuRongHem)[1], false); WriteRTF(VaoHemBaosau, @myRealToStr(Home.VaoHemBaoSau)[1], false); WriteRTF(NamXayDung, @DateToStr(Home.NamXayDung)[1], false); WriteRTF(TinhTrangNha, sTinhTrang[Home.TinhTrangNha], false); WriteRTF(TrangTriNoiThat, sTrangTriNoithat[ Home.TrangTriNoiThat], false); WriteRTF(NhaCoVuon, noyes[Home.NhaCoVuon], false); WriteRTF(ChieuRongVuon, @myRealToStr(Home.ChieuRongVuon)[1], false); WriteRTF(HuongNha, sHuongNha[Home.HuongNha], false); WriteRTF(NgayThueDau, @DateToStr(Home.NgayDauThue)[1], false); WriteRTF(NgayThueCuoi, @DateToStr(Home.NgayCuoiThue)[1], false); WriteEOFRTF(rtf); rtf.seek(0, 0); end; end. MyThread.pas MyThread.pas laø moät thö vieän chöùa caùc lôùp TThread nhö : TInsertDataThread, TMuaNhaThread… (* myThread.pas Written by Le Tuan *) unit myThread; interface uses Classes, Windows, hometools, SysUtils, Forms, dialogs; type TInsertDataThread = class(TThread) private FHome : THomeInfo; procedure DoTerminate; override; procedure DoThread; protected procedure Execute; override; public constructor Create(Home : THomeInfo); end; TModifyDataThread = class(TThread) private FHome : THomeInfo; FIndex : Longint; procedure DoTerminate; override; procedure DoThread; protected procedure Execute; override; public constructor Create(Index : longint; Home : THomeInfo); end; TMuaNhaThread = class(TThread) private FIndex : Longint; procedure DoThread; protected procedure Execute; override; public constructor Create(Index: Longint); end; TThueNhaThread = class(TThread) private FIndex : Longint; FNgayDauThue, FNgayCuoiThue : TDateTime; procedure DoTerminate; override; procedure DoThread; protected procedure Execute; override; public constructor Create(Index: Longint; NgayDauThue, NgayCuoiThue : TDateTime); end; THomeGetThread = class(TThread) private FIndex : longint; FIsServer : Boolean; FClient : Integer; procedure DoTerminate; override; procedure DoThread; protected procedure Execute; override; public constructor Create(Index : longint; IsServer : Boolean; Client : Integer); end; THomeSearchTextThread = class(TThread) private FName : string; FIsServer : Boolean; FClient : Integer; procedure DoTerminate; override; procedure DoThread; protected procedure Execute; override; public constructor Create(Name : string; IsServer : Boolean; Client : Integer); end;  THomeGetFilterThread = class(TThread) private FIndex : longint; FIsServer : Boolean; FClient : Integer; procedure DoTerminate; override; procedure DoThread; protected procedure Execute; override; public constructor Create(Index : longint; IsServer : Boolean; Client : Integer); end; THomeGetDataThread = class(TThread) private FIndex : longint; FIsServer : Boolean; FClient : Integer; procedure DoTerminate; override; procedure DoThread; protected procedure Execute; override; public constructor Create(Index : longint; IsServer : Boolean; Client : Integer); end; TFindThread = class(TThread) private FFilter : PArrInt; FFind : TFind; FClient : Integer; FFilterCount : Longint; procedure DoTerminate; override; procedure DoThread; protected procedure Execute; override; public constructor Create(Find : TFind; Client : Integer); end; TDeleteThread = class(TThread) private FIndex : Longint; procedure DoTerminate; override; procedure DoThread; protected procedure Execute; override; public constructor Create(Index: Longint); end; THomeRentGetDataThread = class(TThread) private FIndex : longint; procedure DoThread; protected procedure Execute; override; public constructor Create(Index : longint); end; TUnRentThread = class(TThread) private FIndex : Longint; procedure DoThread; protected procedure Execute; override; public constructor Create(Index : longint); end; THomeSellGetDataThread = class(TThread) private FIndex : longint; procedure DoThread; protected procedure Execute; override; public constructor Create(Index : longint); end; THomeRentCountThread = class(TThread) private procedure DoThread; protected procedure Execute; override; public constructor Create; end; THomeSellCountThread = class(TThread) private procedure DoThread; protected procedure Execute; override; public constructor Create; end; implementation { Important: Methods and properties of objects in VCL can only be used in a method called using Synchronize, for example, Synchronize(UpdateCaption); and UpdateCaption could look like, procedure ModifyDataThread.UpdateCaption; begin Form1.Caption := 'Updated in a thread'; end; } uses nhaf, repthuef; procedure myDelay(x : longint); var y : longint; begin y := GetTickCount; repeat Application.ProcessMessages; until GetTickCount > y + x; end; { TInsertDataThread } constructor TInsertDataThread.Create; begin FreeOnTerminate := True; FHome := Home; inherited Create(False); end; procedure TInsertDataThread.DoThread; begin ChatForm.InsertData(FHome); end; procedure TInsertDataThread.Execute; begin EnterCriticalSection(CritSect); Synchronize(DoThread); LeaveCriticalSection(CritSect); end; procedure TInsertDataThread.DoTerminate; begin inherited; end; {TModifyDataThread} constructor TModifyDataThread.Create; begin FreeOnTerminate := True; FIndex := Index; FHome := Home; inherited Create(False); end; procedure TModifyDataThread.DoThread; begin ChatForm.ModifyData(FIndex, FHome); end; procedure TModifyDataThread.Execute; begin EnterCriticalSection(CritSect); Synchronize(DoThread); LeaveCriticalSection(CritSect); end; procedure TModifyDataThread.DoTerminate; begin inherited; end; {TMuaNhaThread} constructor TMuaNhaThread.Create; begin FreeOnTerminate := True; FIndex := Index; inherited Create(False); end; procedure TMuaNhaThread.DoThread; begin ChatForm.MuaNha(FIndex); end; procedure TMuaNhaThread.Execute; begin EnterCriticalSection(CritSect); Synchronize(DoThread); LeaveCriticalSection(CritSect); end; {TThueNhaThread} constructor TThueNhaThread.Create; begin FreeOnTerminate := True; FIndex := Index; FNgayDauThue := NgayDauThue; FNgayCuoiThue := NgayCuoiThue; inherited Create(False); end; procedure TThueNhaThread.DoThread; begin ChatForm.ThueNha(FIndex, FNgayDauThue, FNgayCuoiThue); end; procedure TThueNhaThread.Execute; begin EnterCriticalSection(CritSect); Synchronize(DoThread); LeaveCriticalSection(CritSect); end; procedure TThueNhaThread.DoTerminate; begin inherited; end; {THomeGetThread} constructor THomeGetThread.Create; begin FreeOnTerminate := True; FIndex := Index; FIsServer := IsServer; FClient := Client; inherited Create(False); end; procedure THomeGetThread.DoThread; var x : xxType; begin ChatForm.ffHome := ChatForm.HomeData.HomeGet(FIndex); if not FIsServer then begin FillChar(x, sizeof(x), 0); StrCopy(x.mess, idSetItem); x.Home := ChatForm.ffHome; ChatForm.ServerSocket.Socket.Connections[FClient].SendBuf(x, sz); end; end; procedure THomeGetThread.Execute; begin EnterCriticalSection(CritSect); Synchronize(DoThread); LeaveCriticalSection(CritSect); end; procedure THomeGetThread.DoTerminate; begin inherited; end; {THomeSearchTextThread} constructor THomeSearchTextThread.Create; begin FreeOnTerminate := True; FName := Name; FIsServer := IsServer; FClient := Client; inherited Create(False); end; procedure THomeSearchTextThread.DoThread; var x : xxType; found : boolean; begin ChatForm.fIndex := ChatForm.HomeData.HomeSearch(Pchar(FName), found); if not FIsServer then begin FillChar(x, sizeof(x), 0); StrCopy(x.mess, idSetIndex); x.index := ChatForm.fIndex; ChatForm.ServerSocket.Socket.Connections[FClient].SendBuf(x, sz); end end; procedure THomeSearchTextThread.Execute; begin EnterCriticalSection(CritSect); Synchronize(DoThread); LeaveCriticalSection(CritSect); end; procedure THomeSearchTextThread.DoTerminate; begin inherited; end; {THomeGetFilterThread} constructor THomeGetFilterThread.Create; begin FreeOnTerminate := True; FIndex := Index; FIsServer := IsServer; FClient := Client; inherited Create(False); end; procedure THomeGetFilterThread.DoThread; var x : xxType; begin ChatForm.ffHome := ChatForm.HomeData.HomeGet(FIndex); if not FIsServer then begin FillChar(x, sizeof(x), 0); StrCopy(x.mess, idSetItemfilter); x.Home := ChatForm.ffHome; ChatForm.ServerSocket.Socket.Connections[FClient].SendBuf(x, sz); end; end; procedure THomeGetFilterThread.Execute; begin EnterCriticalSection(CritSect); Synchronize(DoThread); LeaveCriticalSection(CritSect); end; procedure THomeGetFilterThread.DoTerminate; begin inherited; end; {THomeGetDataThread} constructor THomeGetDataThread.Create; begin FreeOnTerminate := True; FIndex := Index; FIsServer := IsServer; FClient := Client; inherited Create(False); end; procedure THomeGetDataThread.DoThread; var x : xxType; begin ChatForm.fHome := ChatForm.HomeData.HomeGet(FIndex); if not FIsServer then begin FillChar(x, sizeof(x), 0); StrCopy(x.mess, idSetData); x.Home := ChatForm.fHome; ChatForm.ServerSocket.Socket.Connections[FClient].SendBuf(x, sz); end; end; procedure THomeGetDataThread.Execute; begin EnterCriticalSection(CritSect); Synchronize(DoThread); LeaveCriticalSection(CritSect); end; procedure THomeGetDataThread.DoTerminate; begin inherited; end; { TFindThread } constructor TFindThread.Create; begin FreeOnTerminate := True; FFind := Find; FClient := Client; inherited Create(False); end; procedure TFindThread.DoThread; var x : xxType; begin FFilterCount := ChatForm.HomeData.HomeGetCount; Getmem(FFilter, FFilterCount * sizeof(longint)); ChatForm.HomeData.HomeFind(FFind.ThueBan, FFind.NgoaiNoiThanh, FFind.TriGiaMin, FFind.TriGiaMax, FFind.DienTichMin, FFind.DienTichMax, FFilter, FFilterCount); FillChar(x, sizeof(x), 0); x.index := FFilterCount; StrCopy(x.mess, idFindResult); move(FFilter^, x.Home, FFilterCount * sizeof(longint)); ChatForm.ServerSocket.Socket.Connections[FClient].SendBuf(x, sz); Freemem(FFilter); end; procedure TFindThread.Execute; begin EnterCriticalSection(CritSect); Synchronize(DoThread); LeaveCriticalSection(CritSect); end; procedure TFindThread.DoTerminate; begin inherited; end; {TDeleteThread} constructor TDeleteThread.Create; begin FreeOnTerminate := True; FIndex := Index; inherited Create(False); end; procedure TDeleteThread.DoThread; begin ChatForm.DeleteNha(FIndex); end; procedure TDeleteThread.Execute; begin EnterCriticalSection(CritSect); Synchronize(DoThread); LeaveCriticalSection(CritSect); end; procedure TDeleteThread.DoTerminate; begin inherited; end; {THomeRentGetDataThread} constructor THomeRentGetDataThread.Create; begin FreeOnTerminate := True; FIndex := Index; inherited Create(False); end; procedure THomeRentGetDataThread.DoThread; begin RepThueForm.fHome := ChatForm.HomeData.HomeGetRent(FIndex); end; procedure THomeRentGetDataThread.Execute; begin EnterCriticalSection(CritSect); Synchronize(DoThread); LeaveCriticalSection(CritSect); end; { TUnRentThread } constructor TUnRentThread.Create; begin FreeOnTerminate := True; FIndex := Index; inherited Create(False); end; procedure TUnRentThread.DoThread; var i, count : integer; fHome : THomeInfo; begin if ChatForm.HomeData.HomeUnRent(FIndex) then begin Count := ChatForm.homeData.HomeGetCount; for i := 0 to ChatForm.ServerSocket.Socket.ActiveConnections - 1 do ChatForm.SendMessageToClient( ChatForm.ServerSocket.Socket.Connections[i], idSetVLBNumItems, Count, fHome); end; end; procedure TUnRentThread.Execute; begin EnterCriticalSection(CritSect); Synchronize(DoThread); LeaveCriticalSection(CritSect); end; {THomeSellGetDataThread} constructor THomeSellGetDataThread.Create; begin FreeOnTerminate := True; FIndex := Index; inherited Create(False); end; procedure THomeSellGetDataThread.DoThread; begin RepThueForm.fHome := ChatForm.HomeData.HomeGetSell(FIndex); end; procedure THomeSellGetDataThread.Execute; begin EnterCriticalSection(CritSect); Synchronize(DoThread); LeaveCriticalSection(CritSect); end; {THomeRentCountThread} constructor THomeRentCountThread.Create; begin FreeOnTerminate := True; inherited Create(False); end; procedure THomeRentCountThread.DoThread; begin RepThueForm.fHomeRentCount := ChatForm.HomeData.HomeGetCountRent; end; procedure THomeRentCountThread.Execute; begin EnterCriticalSection(CritSect); Synchronize(DoThread); LeaveCriticalSection(CritSect); end; {THomeSellCountThread} constructor THomeSellCountThread.Create; begin FreeOnTerminate := True; inherited Create(False); end; procedure THomeSellCountThread.DoThread; begin RepThueForm.fHomeSellCount := ChatForm.HomeData.HomeGetCountSell; end; procedure THomeSellCountThread.Execute; begin EnterCriticalSection(CritSect); Synchronize(DoThread); LeaveCriticalSection(CritSect); end; end. RepThuef.pas Khung trao ñoåi ñeå hieän thò danh saùch caùc nhaø cho thueâ hoaëc möôùn. (* repthuef.pas Written by Le Tuan *) unit repthuef; interface uses Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, ComCtrls, ExtCtrls, VLB, HomeTools, myThread, Tranbtn, ShadowForm, MyDialog, informf, QFButton; type TRepThueForm = class(TShadowForm) VLB: TVLB; Bevel2: TBevel; Bevel3: TBevel; RichEdit: TRichEdit; Bevel4: TBevel; Label1: TLabel; AdminLTBtnUnThue: TLTBtn; AdminLTBtnCount: TLTBtn; LabelName: TLabel; QFButton1: TQFButton; Bevel1: TBevel; ImageBan: TImage; ImageThue: TImage; procedure VLBGetItem(Sender: TObject; Index: Integer; var ItemString: String); procedure AdminLTBtnUnThueClick(Sender: TObject); procedure FormPaint(Sender: TObject); procedure VLBClick(Sender: TObject); procedure FormActivate(Sender: TObject); procedure AdminLTBtnCountClick(Sender: TObject); procedure QFButton1Click(Sender: TObject); private procedure ShowData; function TestTLTBtn(p : TPoint) : boolean; procedure wmNcHitTest(var Msg : TwmNcHitTest); message wm_NcHitTest; public fHome : THomeInfo; isThue : Boolean; fHomeRentCount : longint; fHomeSellCount : longint; end; var RepThueForm: TRepThueForm; implementation {$R *.DFM} uses nhaf, mytdrtf; procedure TRepThueForm.VLBGetItem(Sender: TObject; Index: Integer; var ItemString: String); begin if (index < 0) then exit; if isThue then with THomeRentGetDataThread.Create(Index) do WaitFor else with THomeSellGetDataThread.Create(Index) do WaitFor; ItemString := fHome.TenNha; end; procedure TRepThueForm.AdminLTBtnUnThueClick(Sender: TObject); var index : longint; begin index := VLB.ItemIndex; if (index < 0) or (self = nil) then exit; if ShowInfo( 'Bân c¢ mu–n ­Ÿa nh… n…y v‹ danh sÿch nh… cho thuˆ kh“ng?', true) mrOK then Exit; with TUnRentThread.Create(index) do WaitFor; VLB.NumItems := ChatForm.homeData.HomeGetCountRent; ChatForm.VLB.NumItems := ChatForm.homeData.HomeGetCount; end; procedure TRepThueForm.FormPaint(Sender: TObject); begin ChatForm.PaintBack(Canvas, ChatForm.Image1.Picture.Bitmap); end; procedure TRepThueForm.ShowData; var rtf : TMemoryStream; begin LabelName.Caption := fHome.TenNha; rtf := TMemoryStream.Create; RecToRTF(fHome, rtf); RichEdit.Lines.LoadFromStream(rtf); rtf.Free; end; procedure TRepThueForm.VLBClick(Sender: TObject); var index : longint; begin index := VLB.ItemIndex; if (index < 0) or (self = nil) then begin RichEdit.Clear; Exit; end; if isThue then with THomeRentGetDataThread.Create(Index) do WaitFor else with THomeSellGetDataThread.Create(Index) do WaitFor; ShowData; end; procedure TRepThueForm.FormActivate(Sender: TObject); begin if isThue then begin ImageThue.Visible := true; Caption := 'Th–ng kˆ nh… cho thuˆ'; Label1.Caption := '&Nh… ­á cho thuˆ:'; AdminLTBtnUnThue.Visible := true; AdminLTBtnCount.Hint := 'Th–ng kˆ t™ng s– nh… ­á cho thuˆ'; VLB.NumItems := ChatForm.homeData.HomeGetCountRent; end else begin ImageBan.Visible := true; Caption := 'Th–ng kˆ nh… ­á bÿn'; Label1.Caption := '&Nh… ­á bÿn:'; AdminLTBtnUnThue.Visible := false; AdminLTBtnCount.Hint := 'Th–ng kˆ t™ng s– nh… ­á bÿn'; VLB.NumItems := ChatForm.homeData.HomeGetCountSell; end; VLB.ItemIndex := 0; VLBClick(nil); // NamePanel.Color := rgb(9, 115, 25); end; procedure TRepThueForm.AdminLTBtnCountClick(Sender: TObject); begin if isThue then begin with THomeRentCountThread.Create do WaitFor; ShowInfo('C¢ ' + IntToStr(fHomeRentCount) + ' ng“i nh… ­á cho thuˆ.', false); end else begin with THomeSellCountThread.Create do WaitFor; ShowInfo('C¢ ' + IntToStr(fHomeSellCount) + ' ng“i nh… ­á bÿn.', false); end end; procedure TRepThueForm.QFButton1Click(Sender: TObject); begin Close; ModalResult := mrCancel; end; function TRepThueForm.TestTLTBtn(p : TPoint) : boolean; var i : integer; begin result := false; for i := 0 to ControlCount - 1 do begin if (Controls[i] is TLTBtn) and (PtInRect((Controls[i] as TLTBtn).BoundsRect, p)) then Exit; if (Controls[i] is TQFButton) and (PtInRect((Controls[i] as TQFButton).BoundsRect, p)) then Exit; end; result := true; end; procedure TRepThueForm.wmNcHitTest(var Msg : TwmNcHitTest); begin inherited; if TestTLTBtn(ScreenToClient(Point(Msg.Pos.X, Msg.Pos.Y))) then Msg.Result := HTCAPTION; end; end.