وحدة USWLMSelectda ؛
{$ s- ، w- ، r-}
{$ c preload}
واجهة
يستخدم
Windows ، الرسائل ، sysutils ، الأنواع ، الفئات ، الرسومات ، عناصر التحكم ، stdctrls ، النماذج ،
Strutils ، Math ، Adodb ، Tflatbuttonunit ، Uswlmstyleedit ؛
يكتب
teditdatatype = (sdstring ، sdinteger ، sdfloat ، sdmoney) ؛
tvalignment = (tvatopjustify ، tvacenter ، tvabottomjustify) ؛
tdatastyle = (DSBM ، DSZJ ، DSMC) ؛
يكتب
tselectda = فئة (tcustomControl)
خاص
fpen: tpen ؛
fbrush: tbrush ؛
ffont: tfont ؛
fcaption: سلسلة ؛
fbmtext: سلسلة ؛
fzjtext: سلسلة ؛
fmctext: سلسلة ؛
fdatatype: teditdatatype ؛
fprecision: عدد صحيح ؛
Freadonly: Boolean ؛
Feditfont: Tfont ؛
fhalignment: التالين.
fvalignment: tvalignment ؛
Fedit: tstyleedit ؛
fbutton: tflatbutton ؛
ftitlename: سلسلة ؛
ftablename: سلسلة ؛
fdatastyle: tdatastyle ؛
FBMfield: String ؛
fzjfield: سلسلة ؛
FMCfield: String ؛
fonclick: tnotifyevent ؛
Fonenter: tnotifyevent ؛
fonexit: tnotifyevent ؛
fonkeypress: tkeypressevent ؛
الإجراء setPen (قيمة const: tpen) ؛
الإجراء setBrush (قيمة const: tbrush) ؛
الإجراء setFont (قيمة const: tfont) ؛
الإجراء setCaption (قيمة const: سلسلة) ؛
الإجراء setBMtext (قيمة const: سلسلة) ؛
الإجراء setzjtext (const value: string) ؛
الإجراء setMcText (const value: string) ؛
الإجراء setDatatyPe (قيمة const: teditdatatype) ؛
الإجراء setPrecision (قيمة const: عدد صحيح) ؛
الإجراء setReadonly (const قيمة: منطقية) ؛
الإجراء seteditfont (قيمة const: tfont) ؛
الإجراء sethalignment (قيمة const: التالفة) ؛
الإجراء setValignment (قيمة const: tvalignment) ؛
الإجراء stetitlename (قيمة const: سلسلة) ؛
الإجراء settablename (قيمة const: سلسلة) ؛
الإجراء setDatastyle (قيمة const: tdatastyle) ؛
الإجراء setbmfield (const value: string) ؛
الإجراء setzjfield (قيمة const: سلسلة) ؛
الإجراء setMCfield (const value: string) ؛
وظيفة getasfloat (): سلسلة ؛
وظيفة getAsmoney (): سلسلة ؛
وظيفة getAsinteger (): سلسلة ؛
وظيفة getastext (): سلسلة ؛
الإجراء setasfloat (قيمة const: سلسلة) ؛
الإجراء setasmoney (قيمة const: سلسلة) ؛
الإجراء setasinteger (قيمة const: سلسلة) ؛
الإجراء setastext (قيمة const: سلسلة) ؛
الإجراء stylechanged (المرسل: tobject) ؛
الإجراء setbackColor (قيمة const: tcolor) ؛
الإجراء setColoronenter (قيمة const: tcolor) ؛
الإجراء dclick (المرسل: TOBJECT) ؛
الإجراء doenter (المرسل: TOBJECT) ؛
الإجراء DOEXIT (المرسل: TOBJECT) ؛
الإجراء DoKeypress (المرسل: TOBJECT ؛ VAR KEY: char) ؛
محمية
الطلاء الإجراء ؛ تجاوز؛
عام
إنشاء مُنشئ (مالك: tcomponent) ؛ تجاوز؛
تدمير المدمر. تجاوز؛
المنشورة
Property Pen: tpen قراءة fpen اكتب setPen ؛
فرشاة خاصية: tbrush قراءة fbrush كتابة setbrush ؛
خط خاصية: tfont قراءة ffont اكتب setfont ؛
تسمية التسمية التوضيحية: سلسلة قراءة fcaption اكتب setCaption ؛
خاصية BM: سلسلة قراءة fbmtext اكتب setBmtext ؛
Property ZJF: سلسلة قراءة fzjtext اكتب setzjtext ؛
Property MC: سلسلة قراءة fmctext اكتب setMcText ؛
خاصية النص: سلسلة قراءة fmctext اكتب setMcText ؛
Property datatype: teditdatatype قراءة fdatatype اكتب setDatatype الافتراضي sdstring ؛
Property Precision: integer read fprecision write setPrecision Default 2 ؛
Property ReadOnly: Boolean Read Freadonly اكتب SetReadonly Default False ؛
Property Editfont: Tfont Read Feditfont write seteditfont ؛
Property Halignment: Tarignment قراءة fhalignment اكتب sethalignment default taleftjustify ؛
Property valignment: tvalignment اقرأ fvalignment اكتب setValignment الافتراضي tvabottomustify ؛
خاصية titlename: سلسلة قراءة ftitlename اكتب setTitLename ؛
Property TableName: سلسلة قراءة ftablename كتابة settablename ؛
Property datastyle: tdatastyle قراءة fdatastyle كتابة setDatastyle الافتراضية dsbm ؛
Property BMfield: String Read FBMfield Write Setbmfield ؛
Property ZJfield: سلسلة قراءة fzjfield اكتب setzjfield ؛
Property McField: String Read FMCfield Write Setmcfield ؛
Property asfloat: string read getasfloat {write setasfloat} ؛
Property Asmoney: String Read GetAsmoney {write setasmoney} ؛
Property ASINT: string read getASInteger {write setasinteger} ؛
خاصية ASSTR: سلسلة قراءة getastext اكتب setastext ؛
Property onClick: tnotifyevent قراءة fonclick اكتب fonclick ؛
Property onkeypress: tkeypressevent قراءة fonkeypress اكتب fonkeypress ؛
Property OnEnter: tnotifyevent قراءة fonenter الكتابة fonenter ؛
Property Onexit: tnotifyevent قراءة fonexit اكتب fonexit ؛
Property BackColor: tcolor اكتب setbackcolor ؛
Property Coloronenter: tcolor اكتب setColoronenter ؛
خاصية محاذاة ؛
Property VisiblockClientCount ؛
Property ControlCount ؛
Property ParentWindow ؛
خاصية تظهر ؛
خاصية Taborder ؛
خاصية التبويب ؛
نهاية؛
سجل الإجراءات ؛
تطبيق
يستخدم consts.
الإجراء tselectda.setpen (قيمة const: tpen) ؛
يبدأ
fpen.assign (القيمة) ؛
تبطل
نهاية؛
الإجراء tselectda.setbrush (قيمة const: tbrush) ؛
يبدأ
fbrush.assign (القيمة) ؛
تبطل
نهاية؛
الإجراء tselectda.setfont (قيمة const: tfont) ؛
يبدأ
ffont.assign (القيمة) ؛
تبطل
نهاية؛
الإجراء tselectda.setCaption (قيمة const: سلسلة) ؛
يبدأ
إذا كان fcaption <> قيمة ثم
يبدأ
fcaption: = القيمة ؛
تبطل
نهاية؛
نهاية؛
الإجراء tselectda.setbmtext (قيمة const: سلسلة) ؛
يبدأ
إذا كان fbmtext <> قيمة ثم
يبدأ
fbmtext: = value ؛
تبطل
نهاية؛
نهاية؛
الإجراء tselectda.setzjtext (قيمة const: سلسلة) ؛
يبدأ
إذا كان fzjtext <> قيمة ثم
يبدأ
fzjtext: = القيمة ؛
نهاية؛
نهاية؛
الإجراء tselectda.setMcText (قيمة const: سلسلة) ؛
يبدأ
إذا كان fmctext <> قيمة ثم
يبدأ
FMCText: = value ؛
تبطل
نهاية؛
نهاية؛
الإجراء tselectda.setReadonly (قيمة const: منطقية) ؛
يبدأ
إذا فريدري <> القيمة ثم
يبدأ
freadonly: = القيمة ؛
تبطل
نهاية؛
نهاية؛
الإجراء tselectda.seteditfont (قيمة const: tfont) ؛
يبدأ
feditfont.assign (القيمة) ؛
تبطل
نهاية؛
الإجراء tselectda.setPrecision (قيمة const: عدد صحيح) ؛
يبدأ
إذا كان fprecision <> قيمة ثم
يبدأ
قيمة القضية
1..6: fprecision: = value ؛
آخر fprecision: = 2 ؛
نهاية؛
تبطل
نهاية؛
نهاية؛
الإجراء tselectda.setDatatype (قيمة const: teditdatatype) ؛
يبدأ
إذا كان fdatatype <> قيمة ثم
يبدأ
fdatatype: = القيمة ؛
حالة fdatatype من
sdstring: fedit.inputstyle: = isString ؛
sdinteger: fedit.inputstyle: = isInteger ؛
sdfloat: fedit.inputstyle: = isfloat ؛
sdmoney: fedit.inputstyle: = iSmoney ؛
else fedit.inputstyle: = isString ؛
نهاية؛
تبطل
نهاية؛
نهاية؛
الإجراء tselectda.Sethalignment (قيمة const: التالين) ؛
يبدأ
إذا كان fhalignment <> قيمة ثم
يبدأ
fhalignment: = القيمة ؛
تبطل
نهاية؛
نهاية؛
الإجراء tselectda.setValignment (قيمة const: tvalignment) ؛
يبدأ
إذا كانت القيمة <> القيمة
يبدأ
fvalignment: = القيمة ؛
تبطل
نهاية؛
نهاية؛
الإجراء tselectda.SettitLename (قيمة const: سلسلة) ؛
يبدأ
إذا كان ftitlename <> value ثم ftitlename: = value ؛
نهاية؛
الإجراء tselectda.Settablename (قيمة const: سلسلة) ؛
يبدأ
إذا كان ftablename <> قيمة ثم
يبدأ
ftablename: = القيمة ؛
تبطل
نهاية؛
نهاية؛
الإجراء tselectda.setDatastyle (قيمة const: tdatastyle) ؛
يبدأ
إذا كان fdatastyle <> قيمة ثم fdatastyle: = value ؛
نهاية؛
الإجراء tselectda.setbmfield (const value: string) ؛
يبدأ
إذا كان FBMfield <> قيمة ثم
يبدأ
FBMfield: = القيمة ؛
تبطل
نهاية؛
نهاية؛
الإجراء tselectda.setzjfield (قيمة const: سلسلة) ؛
يبدأ
إذا كان fzjfield <> قيمة ثم fzjfield: = value ؛
نهاية؛
الإجراء tselectda.setmcfield (const value: string) ؛
يبدأ
إذا كان FMCfield <> قيمة ثم
يبدأ
FMCfield: = القيمة ؛
تبطل
نهاية؛
نهاية؛
وظيفة tselectda.getasfloat: سلسلة ؛
وظيفة strtodouble (s: سلسلة): مزدوجة ؛
يبدأ
إذا لم يكن triststrtofloat (s ، النتيجة) ثم النتيجة: = 0 ؛
نهاية؛
يبدأ
قضية fprecision من
1..6: النتيجة: = formatfloat ('### 0.'+dupestring ('0' ، fprecision) ، strtodouble (fmctext)) ؛
النتيجة الأخرى: = formatfloat ('### 0.00' ، strtodouble (fmctext)) ؛
نهاية؛
نهاية؛
وظيفة tselectda.getasmoney: سلسلة ؛
وظيفة strtodouble (s: سلسلة): مزدوجة ؛
يبدأ
إذا لم يكن triststrtofloat (s ، النتيجة) ثم النتيجة: = 0 ؛
نهاية؛
يبدأ
النتيجة: = formatfloat ('### 0.00' ، strtodouble (fmctext)) ؛
نهاية؛
وظيفة tselectda.getAsinteger: سلسلة ؛
وظيفة strtointeger (s: سلسلة): عدد صحيح ؛
يبدأ
إذا لم يكن triststroint (s ، النتيجة) ثم النتيجة: = 0 ؛
نهاية؛
يبدأ
النتيجة: = inttoStr (strtointeger (fmctext)) ؛
نهاية؛
وظيفة tselectda.getastext: سلسلة ؛
يبدأ
النتيجة: = fmctext ؛
نهاية؛
الإجراء tselectda.setasfloat (قيمة const: سلسلة) ؛
وظيفة strtodouble (s: سلسلة): مزدوجة ؛
يبدأ
إذا لم يكن triststrtofloat (s ، النتيجة) ثم النتيجة: = 0 ؛
نهاية؛
var
واو: مزدوج ؛
يبدأ
F: = strtodouble (قيمة) ؛
قضية fprecision من
1..6:
يبدأ
F: = Roundto (F ، -frecision) ؛
setMcText (formatfloat ('### 0.'+dupestring ('0' ، fprecision) ، f)) ؛
نهاية
آخر
يبدأ
F: = Roundto (F ، -2) ؛
setMcText (formatfloat ('### 0.00' ، f)) ؛
نهاية؛
نهاية؛
نهاية؛
الإجراء tselectda.setasmoney (قيمة const: سلسلة) ؛
وظيفة strtodouble (s: سلسلة): مزدوجة ؛
يبدأ
إذا لم يكن triststrtofloat (s ، النتيجة) ثم النتيجة: = 0 ؛
نهاية؛
var
واو: مزدوج ؛
يبدأ
F: = strtodouble (قيمة) ؛
F: = Roundto (F ، -2) ؛
setMcText (formatfloat ('### 0.00' ، f)) ؛
نهاية؛
الإجراء tselectda.setasinteger (قيمة const: سلسلة) ؛
وظيفة strtointeger (s: سلسلة): عدد صحيح ؛
يبدأ
إذا لم يكن triststroint (s ، النتيجة) ثم النتيجة: = 0 ؛
نهاية؛
var
أنا: عدد صحيح.
يبدأ
i: = strtointeger (القيمة) ؛
setMcText (inttoStr (i)) ؛
نهاية؛
الإجراء tselectda.setastext (قيمة const: سلسلة) ؛
يبدأ
setMcText (القيمة) ؛
نهاية؛
الإجراء tselectda.stylechanged (المرسل: tobject) ؛
يبدأ
تبطل
نهاية؛
الإجراء tselectda.setbackColor (قيمة const: tcolor) ؛
يبدأ
fedit.backColor: = value ؛
نهاية؛
الإجراء tselectda.setColoronenter (قيمة const: tcolor) ؛
يبدأ
fedit.coloronenter: = القيمة ؛
نهاية؛
مُنشئ tsleectda.create (Oenler: tcomponent) ؛
يبدأ
خلق ورث (مالك) ؛
العرض: = 188 ؛
الارتفاع: = 20 ؛
fcaption: = '未命名' ؛
fbmtext: = '' ؛
fzjtext: = '' ؛
fmctext: = '' ؛
freadonly: = خطأ ؛
fhalignment: = taleftjustify ؛
fvalignment: = tvabottomjustify ؛
fdatatype: = sdstring ؛
fprecision: = 2 ؛
ftitlename: = '' ؛
ftablename: = '' ؛
fdatastyle: = 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 (الذات) ؛
fedit.parent: = الذات ؛
fedit.borderstyle: = bsnone ؛
fedit.inputstyle: = isString ؛
fedit.onkeypress: = dokeypress ؛
fedit.onenter: = doenter ؛
fedit.Onexit: = doexit ؛
fbutton: = tflatbutton.create (self) ؛
fbutton.parent: = الذات ؛
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: = dockick ؛
نهاية؛
الإجراء tselectda.paint ؛
var
ATXTER: PCHAR ؛
ARECT: TRECT ؛
العلم: DWORD ؛
يبدأ
مع قماش تفعل
يبدأ
الخط: = ffont ؛
القلم: = fpen ؛
فرشاة: = fbrush ؛
FillRect (ClientRect) ؛
إذا كان fbmtext <> '' ثم atext: = pchar (fcaption+'['+fbmtext+']') آخر atext: = pchar (fcaption) ؛
arect: = rect (clientRect.left+fpen.width ، clientRect.top+fpen.width ، clientRect.Right-ppen.width ، clientRect.bottom-fpen.width) ؛
drawText (مقبض ، atext ، strlen (atext) ، arect ، (dt_singleline أو dt_vcenter) أو dt_left) ؛
INC (arect.left ، textwidth (atext)) ؛
ديسمبر (arect.Right ، fbutton.width) ؛
Moveto (arect.left ، arect.bottom) ؛
Lineto (arect.right ، arect.bottom) ؛
INC (arect.left ، fpen.width) ؛
إذا فريدري ثم
يبدأ
fedit.visible: = false ؛
fbutton.visible: = false ؛
العلم: = dt_singleline ؛
قضية fhalignment من
taleftjustify: flag: = flag أو dt_left ؛
tarightjustify: flag: = flag أو dt_right ؛
Tacenter: Flag: = flag أو dt_center ؛
علم آخر: = العلم أو dt_left ؛
نهاية؛
قضية fvalignment من
tvatopjustify: flag: = flag أو dt_top ؛
TVAcenter: Flag: = flag أو dt_vcenter ؛
tvabottomjustify: flag: = flag أو dt_bottom ؛
علم آخر: = العلم أو dt_bottom ؛
نهاية؛
الخط: = feditfont ؛
حالة fdatatype من
sdstring: drawtext (مقبض ، pCHAR (ASSTR) ، strlen (pCHAR (ASSTR)) ، arect ، flag) ؛
sdinteger: drawtext (مقبض ، pCHAR (ASINT) ، strlen (pCHAR (ASINT)) ، arect ، flag) ؛
sdfloat: drawtext (مقبض ، pchar (asfloat) ، strlen (pchar (asfloat)) ، arect ، flag) ؛
SDMoney: DrawText (مقبض ، PCHAR (ASMoney) ، Strlen (PCHAR (ASMoney)) ، ARECT ، Flag) ؛
نهاية؛
نهاية
آخر
يبدأ
Fedit.Alignment: = fhalignment ؛
fedit.font: = feditfont ؛
fedit.text: = fmctext ؛
fedit.width: = arect.right-arect.left ؛
fedit.hight: = min (max (textheight (fmctext) ، textheight (fcaption)) ، arect.bottom-arect.top) ؛
fedit.left: = arect.left ؛
قضية fvalignment من
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) ؛
else fedit.top:=arect.top ؛
نهاية؛
fbutton.left: = arect.Right ؛
fbutton.top:=arect.top ؛
fbutton.Height: = arect.bottom-arect.top ؛
إذا (fdatatype = sdstring) و (fbmfield <> '') و (fmcfield <> '') و (ftablename <> '') ثم fbutton.visible: = true
آخر fbutton.visible: = خطأ ؛
نهاية؛
نهاية؛
نهاية؛
Destructor tsleectda.destroy ؛
يبدأ
fpen.free ؛
fbrush.free ؛
ffont.free ؛
feditfont.free ؛
إذا تم تعيينه (FEDIT) ثم FREEANDNIL (FEDIT) ؛
إذا تم تعيينه (fbutton) ثم freeandnil (fbutton) ؛
تدمير الموروث.
نهاية؛
الإجراء tselectda.doclick (المرسل: tobject) ؛
يبدأ
إذا تم تعيين (fonclick) ثم fonclick (الذات) ؛
نهاية؛
الإجراء tselectda.doenter (المرسل: tobject) ؛
يبدأ
إذا تم تعيينه (fonenter) ثم fonenter (self) ؛
نهاية؛
الإجراء tselectda.doexit (المرسل: tobject) ؛
يبدأ
إذا تم تعيين (fonexit) ثم fonexit (الذات) ؛
نهاية؛
الإجراء tselectda.dokeypress (المرسل: tobject ؛ var المفتاح: char) ؛
يبدأ
إذا تم تعيين (fonkeypress) ثم fonkeypress (الذات ، المفتاح) ؛
نهاية؛
سجل الإجراءات ؛
يبدأ
registerComponents ('swlmsoft' ، [tsleectda]) ؛
نهاية؛
نهاية.