unit uswlmselectda;
{$ S-, w-, r-}
{$ C preload}
antarmuka
penggunaan
Windows, pesan, sysutils, jenis, kelas, grafik, kontrol, stdctrls, formulir,
Strutils, matematika, adodb, tflatbuttonunit, uswlmstyleedit;
jenis
TeditDataType = (sdstring, sdinteger, sdfloat, sdmoney);
Tvalignment = (tvatopjustify, tvacenter, tvabottomjustify);
TDataTyle = (DSBM, DSZJ, DSMC);
jenis
Tselectda = kelas (tcustomcontrol)
pribadi
Fpen: tpen;
FBrush: tbrush;
Ffont: tfont;
Fcaption: string;
FbmText: string;
Fzjtext: string;
Fmctext: string;
FDataType: teditDataType;
Fprecision: integer;
Freadonly: Boolean;
FedItfont: tfont;
Fhalignment: tarignment;
FValignment: TVAlignment;
Fedit: tstyleedit;
Fbutton: tflatbutton;
Ftitlename: string;
Ftablename: string;
FDataStile: tDataTyle;
Fbmfield: string;
Fzjfield: string;
Fmcfield: string;
Fonclick: tnotifyevent;
Fonenter: tnotifyevent;
Fonexit: tnotifyevent;
FonKeyPress: TKeyPressEvent;
Prosedur Setpen (Nilai Const: TPEN);
Prosedur SetBrush (Nilai Const: TBrush);
Prosedur SetFont (Nilai Const: Tfont);
Prosedur setCaption (nilai const: string);
Prosedur SetBMText (Nilai Const: String);
Prosedur SetZjText (Const Value: String);
Prosedur SetMCtext (Const Value: String);
Prosedur setDataType (nilai const: teditdatatype);
Prosedur SetPrecision (Nilai Const: Integer);
Prosedur SetReadOnly (Nilai Const: Boolean);
Prosedur setEdItFont (nilai const: tfont);
Prosedur SetHalignment (Nilai Const: Talignment);
prosedur setValignment (nilai const: tvalignment);
Prosedur SettitLename (Const Value: String);
Prosedur SettableName (Const Value: String);
Prosedur SetDataStile (Nilai Const: TDATastyle);
Prosedur SetBMField (Nilai Const: String);
Prosedur Setzjfield (Const Value: String);
Prosedur SetMcfield (Nilai Const: String);
function getAsfloat (): string;
fungsi getasmoney (): string;
fungsi getasInteger (): string;
fungsi getastext (): string;
prosedur setasfloat (nilai const: string);
Prosedur Setasmoney (Nilai Const: String);
Prosedur setasInteger (nilai const: string);
prosedur setastext (value const: string);
Prosedur stylechanged (pengirim: tobject);
Prosedur Kemundurancolor (Nilai Const: TColor);
Prosedur setColoronenter (nilai const: tcolor);
Prosedur DOCLICK (Pengirim: Tobject);
Prosedur Doenter (Pengirim: Tobject);
Prosedur DoExit (Pengirim: Tobject);
Prosedur DokeyPress (Pengirim: Tobject; Var Key: Char);
terlindung
Cat Prosedur; mengesampingkan;
publik
constructor create (aowner: tComponent); mengesampingkan;
Destructor menghancurkan; mengesampingkan;
diterbitkan
Pena Properti: Tpen Baca FPEN Write Setpen;
Brush Properti: Tbrush Baca fBrush Tulis SetBrush;
Font properti: tfont baca ffont write setFont;
Judul Properti: String baca fcaption tulis setCaption;
Properti BM: String Baca fbmText Tulis setBmText;
properti zjf: string baca fzjtext tulis setzjtext;
Properti MC: String baca fmctext tulis setMctext;
Teks Properti: String Baca FMCTEXT Tulis SetMCtext;
Properti DataType: TeditDataType Read fDataType Write setDataType default SDSTRING;
Precision Properti: Integer Read FPrecision Write SetPrecision Default 2;
Properti Readonly: Boolean baca freadonly tulis setReadonly default false;
Properti EditFont: tfont baca feditfont write setEditFont;
Halignment properti: talignment baca fhalignment tulis sethalignment default taleftjustify;
Valignment Properti: TVAlignment Baca fvalignment menulis setValignment default tvabottomjustify;
Properti Titlename: String Baca ftitlename Tulis settitlename;
Tablename Properti: String Baca ftableName Tulis settableName;
Properti DataTyle: TDataTyle Baca fdataTyle menulis setDataTyle default DSBM;
Properti BMFIELD: String baca fbmfield menulis setbmfield;
properti zjfield: string baca fzjfield menulis setzjfield;
Properti McField: String Read fmcfield menulis setmcfield;
properti asloat: string baca getasfloat {tulis setasfloat};
properti asmoney: string baca getasmoney {tulis setasmoney};
properti asint: string baca getasinteger {tulis setasinteger};
Properti Assstr: String baca getastext tulis setastext;
Property OnClick: tnotifyEvent baca fonClick write fonclick;
Properti Onkeypress: TKeyPressEvent Baca FonKeyPress Write FonKeyPress;
Properti Onenter: tnotifyEvent baca fonenter write fonenter;
Properti Onexit: tnotifyEvent membaca fonexit write fonexit;
Properti Backcolor: Tcolor menulis setKackColor;
Property Coloronenter: TColor Write SetColoronenter;
properti AlignDisabled;
Properti VisibledockClientCount;
ControlCount properti;
Property ParentWindow;
menunjukkan properti;
Taborder Properti;
Tabstop Properti;
akhir;
register prosedur;
pelaksanaan
menggunakan consts;
Prosedur tselectda.setpen (nilai const: tpen);
mulai
Fpen.assign (nilai);
Membatalkan;
akhir;
Prosedur tselectda.setBrush (nilai const: tbrush);
mulai
FBrush.assign (nilai);
Membatalkan;
akhir;
Prosedur tselectda.setfont (nilai const: tfont);
mulai
Ffont.assign (nilai);
Membatalkan;
akhir;
Prosedur tselectda.setCaption (nilai const: string);
mulai
Jika fcaption <> nilai maka
mulai
Fcaption: = nilai;
Membatalkan;
akhir;
akhir;
Prosedur tselectda.setBmText (nilai const: string);
mulai
Jika fbmtext <> nilai maka
mulai
FbmText: = nilai;
Membatalkan;
akhir;
akhir;
Prosedur tselectda.setzjtext (nilai const: string);
mulai
Jika fzjtext <> nilai maka
mulai
Fzjtext: = nilai;
akhir;
akhir;
Prosedur tselectda.setMctext (nilai const: string);
mulai
Jika nilai fmctext <>
mulai
Fmctext: = value;
Membatalkan;
akhir;
akhir;
prosedur tselectda.setreadonly (nilai const: boolean);
mulai
Jika freadonly <> nilai maka
mulai
Freadonly: = nilai;
Membatalkan;
akhir;
akhir;
Prosedur tselectda.setEditfont (nilai const: tfont);
mulai
Feditfont.assign (nilai);
Membatalkan;
akhir;
Prosedur tselectda.setprecision (nilai const: integer);
mulai
Jika nilai <> nilai maka
mulai
nilai kasus dari
1..6: fprecision: = nilai;
lain fprecision: = 2;
akhir;
Membatalkan;
akhir;
akhir;
Prosedur tselectda.setDataType (nilai const: teditDataType);
mulai
Jika nilai fDataType <>
mulai
FDataType: = nilai;
Kasus fdatatype dari
SDSTRING: FEDIT.InputStyle: = Isstring;
Sdinteger: fedit.inputStyle: = isInteger;
Sdfloat: fedit.inputStyle: = isFloat;
Sdmoney: fedit.inputStyle: = isMoney;
lain fedit.inputStyle: = isstring;
akhir;
Membatalkan;
akhir;
akhir;
prosedur tselectda.sethalignment (nilai const: talignment);
mulai
Jika fhalignment <> nilai maka
mulai
Fhalignment: = nilai;
Membatalkan;
akhir;
akhir;
prosedur tselectda.setValignment (nilai const: tvalignment);
mulai
Jika fValignment <> nilai maka
mulai
Fvalignment: = nilai;
Membatalkan;
akhir;
akhir;
Prosedur tselectda.settitlename (nilai const: string);
mulai
jika ftitlename <> nilai maka ftitlename: = nilai;
akhir;
Prosedur tselectda.setableName (nilai const: string);
mulai
Jika ftableName <> nilai maka
mulai
Ftablename: = nilai;
Membatalkan;
akhir;
akhir;
Prosedur tselectda.setDataTyle (nilai const: tDataTyle);
mulai
Jika fDataTyle <> nilai maka fDataTyle: = nilai;
akhir;
Prosedur tselectda.setBmfield (nilai const: string);
mulai
Jika fbmfield <> nilai maka
mulai
Fbmfield: = nilai;
Membatalkan;
akhir;
akhir;
Prosedur tselectda.setzjfield (nilai const: string);
mulai
jika fzjfield <> nilai maka fzjfield: = nilai;
akhir;
Prosedur tselectda.setMcfield (nilai const: string);
mulai
Jika fmcfield <> nilai maka
mulai
Fmcfield: = nilai;
Membatalkan;
akhir;
akhir;
fungsi tselectda.getAsfloat: string;
fungsi strtodouble (s: string): double;
mulai
Jika tidak trystrtofloat (s, hasil) maka hasilnya: = 0;
akhir;
mulai
kasus fprecision of
1..6: Hasil: = formatFloat ('### 0.'+dupestring ('0', fprecision), strtodouble (fmctext));
Hasil lain: = formatFloat ('### 0.00', strtodouble (fmctext));
akhir;
akhir;
fungsi tselectda.getasmoney: string;
fungsi strtodouble (s: string): double;
mulai
Jika tidak trystrtofloat (s, hasil) maka hasilnya: = 0;
akhir;
mulai
Hasil: = formatFloat ('### 0.00', strtodouble (fmctext));
akhir;
fungsi tselectda.getasInteger: string;
Fungsi strtointeger (s: string): integer;
mulai
Jika tidak trystrtoint (s, hasil) maka hasilnya: = 0;
akhir;
mulai
Hasil: = inttoStr (strtointeger (fmctext));
akhir;
fungsi tselectda.getastext: string;
mulai
Hasil: = fmctext;
akhir;
Prosedur tselectda.setAsfloat (nilai const: string);
fungsi strtodouble (s: string): double;
mulai
Jika tidak trystrtofloat (s, hasil) maka hasilnya: = 0;
akhir;
var
F: ganda;
mulai
f: = strtodouble (nilai);
kasus fprecision of
1..6:
mulai
f: = roundto (f, -fprecision);
SetMctext (formatFloat ('### 0.'+dupestring ('0', fprecision), f));
akhir
kalau tidak
mulai
f: = roundto (f, -2);
SetMctext (formatFloat ('### 0.00', f));
akhir;
akhir;
akhir;
Prosedur tselectda.setasmoney (nilai const: string);
fungsi strtodouble (s: string): double;
mulai
Jika tidak trystrtofloat (s, hasil) maka hasilnya: = 0;
akhir;
var
F: ganda;
mulai
f: = strtodouble (nilai);
f: = roundto (f, -2);
SetMctext (formatFloat ('### 0.00', f));
akhir;
Prosedur tselectda.setasInteger (nilai const: string);
Fungsi strtointeger (s: string): integer;
mulai
Jika tidak trystrtoint (s, hasil) maka hasilnya: = 0;
akhir;
var
I: Integer;
mulai
i: = strtointeger (nilai);
SetMctext (inttoStr (i));
akhir;
Prosedur tselectda.setastext (nilai const: string);
mulai
SetMctext (value);
akhir;
Prosedur tselectda.stylechanged (pengirim: tobject);
mulai
Membatalkan;
akhir;
Prosedur tselectda.setBackColor (nilai const: tcolor);
mulai
Fedit.backColor: = nilai;
akhir;
Prosedur tselectda.setColoronenter (nilai const: tcolor);
mulai
Fedit.coloronenter: = nilai;
akhir;
konstruktor tselectda.create (aowner: tcomponent);
mulai
warisan create (aowner);
Lebar: = 188;
Tinggi: = 20;
Fcaption: = '未命名';
FbmText: = '';
Fzjtext: = '';
Fmctext: = '';
Freadonly: = false;
Fhalignment: = taleftjustify;
Fvalignment: = tvabottomjustify;
FDataType: = sdstring;
Fprecision: = 2;
Ftitlename: = '';
Ftablename: = '';
FDataTyle: = DSBM;
Fbmfield: = '';
Fzjfield: = '';
Fmcfield: = '';
Fpen: = tpen.create;
Fpen.onchange: = stylechanged;
FBrush: = tbrush.create;
FBrush.onchange: = stylechanged;
Ffont: = tfont.create;
Ffont.onchange: = stylechanged;
Ffont.charset: = gb2312_charset;
Ffont.name := '宋体';
Ffont.size: = 9;
FedItfont: = tfont.create;
Feditfont.onchange: = stylechanged;
FedItfont.charset: = GB2312_Charset;
Feditfont.name := '宋体';
Feditfont.size: = 9;
Fedit: = tstyleedit.create (self);
Fedit.parent: = self;
Fedit.borderstyle: = bsnone;
Fedit.InputStyle: = ISSTRING;
Fedit.onkeypress: = dokeypress;
Fedit.onenter: = doenter;
Fedit.onexit: = doexit;
Fbutton: = tflatbutton.create (self);
Fbutton.parent: = self;
Fbutton.font: = ffont;
Fbutton.colorborder: = fbrush.color;
Fbutton.color: = fbrush.color;
Fbutton.colordown: = fbrush.color;
Fbutton.colorshadow: = fbrush.color;
Fbutton.colorfocused: = fbrush.color;
Fbutton.width: = 19;
Fbutton.caption: = '...';
Fbutton.onClick: = DOCLICK;
akhir;
Prosedur tselectda.paint;
var
ATEXT: PCHAR;
Arect: Trect;
Bendera: DWORD;
mulai
dengan kanvas lakukan
mulai
Font: = ffont;
Pena: = fpen;
Kuas: = fBrush;
Fillrect (clientrect);
jika fbmtext <> '' maka atext: = pchar (fcaption+'['+fbmtext+']') lain atext: = pchar (fcaption);
arect: = rect (clientrect.left+fpen.width, clientrect.top+fpen.width, clientrect.right-fpen.width, clientrect.bottom-fpen.width);
DrawText (handle, atext, strlen (atext), arect, (dt_singleline atau dt_vcenter) atau dt_left);
Inc (Arect.Left, TextWidth (ATEXT));
Dec (arect.right, fbutton.width);
Moveto (arect.left, arect.bottom);
Lineto (arect.right, arect.bottom);
Inc (Arect.Left, fpen.width);
Jika freadonly maka
mulai
Fedit.visible: = false;
Fbutton.visible: = false;
Bendera: = dt_singleline;
Kasus fhalignment dari
taleftjustify: flag: = flag atau dt_left;
tarightjustify: flag: = flag atau dt_right;
tacenter: flag: = flag atau dt_center;
Bendera lain: = bendera atau dt_left;
akhir;
kasus fvalignment dari
tvatopjustify: flag: = flag atau dt_top;
TVACENTER: Bendera: = Bendera atau DT_VCENTER;
tvabottomjustify: flag: = flag atau dt_bottom;
Bendera lain: = bendera atau dt_bottom;
akhir;
Font: = FedItfont;
Kasus fdatatype dari
Sdstring: drawtext (pegangan, pchar (asstr), strlen (pchar (asstr)), arect, bendera);
Sdinteger: drawtext (handle, pchar (asInt), strlen (pchar (asInt)), arect, flag);
Sdfloat: drawtext (pegangan, pchar (asloat), strlen (pchar (asloat)), arect, bendera);
Sdmoney: drawtext (pegangan, pchar (asmoney), strlen (pchar (asmoney)), arect, bendera);
akhir;
akhir
kalau tidak
mulai
Fedit.alignment: = fhalignment;
Fedit.font: = FedItfont;
Fedit.text: = fmctext;
Fedit.width: = arect.right-arect.left;
Fedit.height: = min (max (textheight (fmctext), textheight (fcaption)), arect.bottom-arect.top);
Fedit.Left: = arect.left;
kasus fvalignment dari
tvatopjustify: fedit.top: = arect.top;
tvacenter: fedit.top: = arect.top+(arect.bottom-arect.top-fedit.height) div 2;
tvabottomjustify: fedit.top: = arect.top+(arect.bottom-arect.top-fedit.height);
lain fedit.top:=arect.top;
akhir;
Fbutton.left: = arect.right;
Fbutton.top:=arect.top;
Fbutton.height: = arect.bottom-arect.top;
if (fdataType = sdstring) dan (fbmfield <> '' ') dan (fmcfield <>' '') dan (ftablename <> '') lalu fbutton.visible: = true
lain fbutton.visible: = false;
akhir;
akhir;
akhir;
Destructor tselectda.destroy;
mulai
Fpen.free;
FBrush.Free;
Ffont.free;
FedItfont.Free;
jika ditugaskan (fedit) maka freeandnil (fedit);
jika ditugaskan (fbutton) maka freeandnil (fbutton);
warisan warisan;
akhir;
Prosedur tselectda.doclick (pengirim: tobject);
mulai
jika ditugaskan (fonclick) maka fonclick (self);
akhir;
Prosedur tselectda.doenter (pengirim: tobject);
mulai
jika ditugaskan (fonenter) kemudian fonenter (self);
akhir;
Prosedur tselectda.doexit (pengirim: tobject);
mulai
jika ditugaskan (fonexit) maka fonexit (self);
akhir;
Prosedur tselectda.dokeypress (pengirim: tobject; var kunci: char);
mulai
jika ditugaskan (fonkeypress) maka fonkeypress (self, kunci);
akhir;
register prosedur;
mulai
RegisterComponents ('swlmsoft', [tselectda]);
akhir;
akhir.