единица uswlmselectda;
{$ S-, w-, r-}
{$ C предварительная нагрузка}
интерфейс
Использование
Windows, сообщения, Sysutils, типы, классы, графика, управления, Stdctrls, Forms,
Strutils, Math, Adodb, Tflatbuttonunit, Uswlmstyleedit;
тип
Teditdatatype = (sdstring, sdinteger, sdfloat, sdmoney);
TVALINMENT = (TVATOPJUSTIFY, TVACENTER, TVABOTTOMJUSTIFY);
Tdatastyle = (dsbm, dszj, dsmc);
тип
Tselectda = class (tcustomControl)
частный
Fpen: tpen;
Fbrush: Tbrush;
Ffont: tfont;
Fcaption: String;
FBMText: String;
FZJText: String;
FMCText: String;
Fdatatype: teditdatatype;
Fpresision: целое число;
Freadonly: логический;
FedItFont: TFONT;
Фхалинг: ТАКАНСТВО;
Фворит: TVALIGNEMENT;
Fedit: tStyleedit;
Fbutton: tflatbutton;
Ftitlename: String;
Ftablename: String;
Fdatastyle: tdatastyle;
Fbmfield: String;
Fzjfield: String;
FMCFIELD: String;
Fonclick: tnotifyevent;
FONENTER: TnotifyEvent;
Fonexit: tnotifyevent;
Fonkeypress: tkeypressevent;
процедура setPen (const value: tpen);
Процедура SetBrush (const value: tbrush);
процедура setFont (значение const: tfont);
Процедура setCaption (const value: string);
процедура setBmText (const value: string);
процедура setzJText (const value: string);
процедура setMctext (const value: string);
процедура setDatatype (const value: teditdatatype);
Процедура setPrecision (const value: integer);
процедура setReadonly (const value: boolean);
Процедура seteditFont (const value: tfont);
Процедура Sethalenment (Const value: Talignment);
Процедура SetValenment (Const value: Tvalignment);
Процедура SettitLename (const value: String);
Процедура CettableName (const value: String);
процедура setDatastastyle (const value: tdatastyle);
процедура setBmfield (const value: string);
Процедура setzjfield (const value: string);
процедура setMcfield (const value: string);
function getAsfloat (): string;
функция getAsmoney (): string;
function getAsinteger (): string;
function getaStxt (): string;
процедура setAsfloat (const value: string);
процедура setASMoney (const value: string);
процедура setAsInteger (const value: string);
процедура setaStext (const value: string);
Процедура стилевой (отправитель: Tobject);
процедура BetbackColor (const value: tcolor);
Процедура SetColoronenter (значение CONST: TCOLOR);
процедура DOCLICK (отправитель: TOBCET);
Процедура DoEnter (отправитель: tobject);
Процедура doExit (отправитель: tobject);
Процедура DokeyPress (отправитель: tobject; var Key: char);
защищен
процедура краска; переопределить;
публичный
конструктор Create (AOWNER: TCOMPONENT); переопределить;
разрушитель разрушил; переопределить;
опубликовано
Property Pen: TPEN Read FPEN WRITE SETPEN;
щетка для недвижимости: Tbrush Read fbrush write setbrush;
Свойство шрифт: tfont read ffont write setfont;
Подпись Свойства: Строка Читать FCAPTION WRITE SETCAPTION;
Свойство BM: String Read Fbmtext write setbmtext;
Свойство zjf: строка читать fzjtext write setzjtext;
Свойство MC: String Read Fmctext write setmctext;
Свойство текст: строка чтение fmctext write setmctext;
Свойство Датпип: TEDITDATATYPE Read FDATATYPE Запись SETDATATYPE SDSTRING;
Точность свойства: целочисленное чтение fprecision write set -procecision по умолчанию 2;
Свойство Readonly: логическое чтение Freadonly Write SetReadonly Default false;
Собственность EditFont: TFONT Read FeditFont write seteditFont;
Оплата имущества: Talignment Читайте фхалинг. Напишите Sethalenment по умолчанию taleftjustify;
Собственность оценка: TVALINGEMENT Читать FVAlignment Написать SetValignment Default TvabottomJustify;
Свойство Titlename: String Read Ftitlename write settitlename;
Свойство TableName: String Read FtableName write centableName;
свойство Datastyle: tdatastyle читать fdatastyle write setdatastyle default dsbm;
Свойство BMFIELD: String Read FBMFIELD WRITE SETBMFIELD;
Свойство ZJFIELD: String Read Fzjfield Write SetzJfield;
свойство McField: String Read Fmcfield write setmcfield;
Свойство Asfloat: String Read GetaSfloat {write setAsfloat};
Свойство Asmoney: String Read Getasmoney {write setasmoney};
Свойство ASINT: String Read GetAsinteger {write setAsinteger};
свойство Asstr: строка getastext write setastext;
Собственность Onclick: TnotifyEvent Read Fonclick написать fonclick;
Собственность OnkeyPress: TKEYPRESSEVENT Читать FonkeyPress написать FonkeyPress;
Свойство OnEnter: TnotifyEvent Read Fonenter Write Fonenter;
Свойство Onexit: tnotifyevent Read fonexit write fonexit;
Свойство BACKCOLOR: TCOLOR WRITE BETBACKCOLOR;
Свойство Coloronerter: Tcolor write setColoronenter;
свойство Aligndisabled;
Property VisibledockClientCount;
Управление имущество;
Property ParentWindow;
Показ имущества;
Свойство табочка;
свойство Tabstop;
конец;
Регистр процедур;
выполнение
использует Consts;
Процедура tselectda.setpen (const value: tpen);
начинать
Fpen.assign (значение);
Недействителен;
конец;
Процедура tselectda.setbrush (const value: tbrush);
начинать
Fbrush.assign (значение);
Недействителен;
конец;
Процедура tselectda.setfont (const value: tfont);
начинать
Ffont.assign (значение);
Недействителен;
конец;
Процедура tselectda.setCaption (const value: string);
начинать
Если fcaption <> значение, тогда
начинать
Fcaption: = значение;
Недействителен;
конец;
конец;
Процедура tselectda.setbmtext (const value: string);
начинать
Если fbmtext <> значение, тогда
начинать
Fbmtext: = value;
Недействителен;
конец;
конец;
Процедура tselectda.setzjtext (const value: string);
начинать
Если fzjtext <> значение, тогда
начинать
Fzjtext: = value;
конец;
конец;
Процедура tselectda.setmctext (const value: string);
начинать
Если fmctext <> значение, тогда
начинать
Fmctext: = value;
Недействителен;
конец;
конец;
Процедура tselectda.setReadonly (const value: boolean);
начинать
Если Freadonly <> значение, тогда
начинать
Freadonly: = значение;
Недействителен;
конец;
конец;
Процедура tselectda.setEditFont (const value: tfont);
начинать
FedItFont.Assign (значение);
Недействителен;
конец;
Процедура tselectda.setprecision (const value: integer);
начинать
Если fpresision <> значение, тогда
начинать
Стоимость случая
1..6: fpresision: = value;
иначе fpresision: = 2;
конец;
Недействителен;
конец;
конец;
Процедура tselectda.setDatatype (const value: teditdatatype);
начинать
Если fdatatype <> значение, тогда
начинать
Fdatatype: = value;
случай fdatatype of
Sdstring: fedit.inputstyle: = Issstring;
Sdinteger: Fedit.inputStyle: = ISinteger;
Sdfloat: fedit.inputstyle: = isfloat;
Sdmoney: Fedit.inputstyle: = ismoney;
else fedit.inputstyle: = Isstring;
конец;
Недействителен;
конец;
конец;
Процедура tselectda.sethalignment (const value: talenment);
начинать
Если значение <> значение, тогда
начинать
Фхалингенция: = значение;
Недействителен;
конец;
конец;
Процедура tselectda.setValignment (const value: Tvalignment);
начинать
Если значение <> значение, тогда
начинать
FVAlignment: = значение;
Недействителен;
конец;
конец;
Процедура tselectda.setTitlename (const value: string);
начинать
Если ftitlename <> значение, то ftitlename: = value;
конец;
Процедура tselectda.settablename (const value: string);
начинать
Если ftablename <> значение, тогда
начинать
Ftablename: = value;
Недействителен;
конец;
конец;
Процедура tselectda.setDatastastyle (const value: tdatastyle);
начинать
Если fdatastyle <> значение, то fdatastyle: = value;
конец;
Процедура tselectda.setbmfield (const value: string);
начинать
Если fbmfield <> значение, тогда
начинать
Fbmfield: = value;
Недействителен;
конец;
конец;
Процедура tselectda.setzjfield (const value: string);
начинать
Если fzjfield <> значение, то fzjfield: = value;
конец;
Процедура tselectda.setmcfield (const value: string);
начинать
Если fmcfield <> значение, тогда
начинать
Fmcfield: = value;
Недействителен;
конец;
конец;
функция tselectda.getasfloat: string;
функция strtodouble (s: string): двойной;
начинать
Если не Tristrtofloat (s, результат), то результат: = 0;
конец;
начинать
Дело FPRESISION
1..6: Результат: = Formatfloat ('### 0.'+dupestring ('0', fprecision), strtodouble (fmctext));
иначе результат: = formatfloat ('### 0,00', strtodouble (fmctext));
конец;
конец;
функция tselectda.getasmoney: String;
функция strtodouble (s: string): двойной;
начинать
Если не Tristrtofloat (s, результат), то результат: = 0;
конец;
начинать
Результат: = formatfloat ('### 0.00', strtodouble (fmctext));
конец;
функция tselectda.getAsInteger: String;
Функция strtointeger (s: string): целое число;
начинать
Если не Tristrtoint (s, результат), то результат: = 0;
конец;
начинать
Результат: = inttoStr (strtoInteger (fmctext));
конец;
function tselectda.getastext: String;
начинать
Результат: = FMCText;
конец;
Процедура tselectda.setasfloat (const value: string);
функция strtodouble (s: string): двойной;
начинать
Если не Tristrtofloat (s, результат), то результат: = 0;
конец;
вар
F: двойной;
начинать
f: = strtodouble (значение);
Дело FPRESISION
1..6:
начинать
f: = roundto (f, -fprecision);
Setmctext (formatfloat ('### 0.'+dupestring ('0', fprecision), f));
конец
еще
начинать
f: = roundto (f, -2);
Setmctext (formatfloat ('### 0,00', f));
конец;
конец;
конец;
Процедура tselectda.setasmoney (const value: string);
функция strtodouble (s: string): двойной;
начинать
Если не Tristrtofloat (s, результат), то результат: = 0;
конец;
вар
F: двойной;
начинать
f: = strtodouble (значение);
f: = roundto (f, -2);
Setmctext (formatfloat ('### 0,00', f));
конец;
Процедура tselectda.setAsInteger (const value: string);
Функция strtointeger (s: string): целое число;
начинать
Если не Tristrtoint (s, результат), то результат: = 0;
конец;
вар
я: целое число;
начинать
i: = strtointeger (значение);
Setmctext (inttoStr (i));
конец;
Процедура tselectda.setaStext (const value: string);
начинать
SetMctext (значение);
конец;
Процедура tselectda.stylechanged (отправитель: tobject);
начинать
Недействителен;
конец;
Процедура tselectda.setbackcolor (const value: tcolor);
начинать
Fedit.backcolor: = value;
конец;
Процедура tselectda.setColoronenter (const value: tcolor);
начинать
Fedit.coloronenter: = value;
конец;
конструктор tselectda.create (aowner: tcomponent);
начинать
унаследованное создание (аоаллер);
Ширина: = 188;
Высота: = 20;
Fcaption: = '未命名';
Fbmtext: = '';
Fzjtext: = '';
Fmctext: = '';
Freadonly: = false;
FhAlenction: = taleftJustify;
FVAlignment: = TVABOTTOMJUSTIFY;
Fdatatype: = sdstring;
Fpresision: = 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_CHARSE;
Feditfont.name:= '宋体';
FedItFont.Size: = 9;
Fedit: = tStyleedit.create (self);
Fedit.parent: = self;
Fedit.borderstyle: = bsnone;
Fedit.inputstyle: = Issstring;
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.colorcocused: = fbrush.color;
Fbutton.width: = 19;
Fbutton.caption: = '…';
Fbutton.onclick: = doclick;
конец;
Процедура tselectda.paint;
вар
atext: pchar;
ARECT: TRECT;
Флаг: DWORD;
начинать
с холстом
начинать
Font: = ffont;
Ручка: = fpen;
Щетка: = fbrush;
FillRect (ClientRect);
Если fbmtext <> '' then atext: = pchar (fcaption+'['+fbmtext+']') else 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 или DT_VCENTER) или 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);
Если, то, тогда
начинать
Fedit.visible: = false;
Fbutton.visible: = false;
Флаг: = DT_SINGLELINE;
Случай
taleftjustify: flag: = flag или dt_left;
tarightjustify: flag: = flag или dt_right;
Tacenter: flag: = flag или dt_center;
иначе флаг: = флаг или dt_left;
конец;
Случай
TvatoPjustify: flag: = flag или dt_top;
TVACENTER: FLAG: = FLAG или DT_VCenter;
tvabottomjustify: flag: = flag или dt_bottom;
иначе флаг: = флаг или dt_bottom;
конец;
Font: = FeditFont;
случай fdatatype of
Sdstring: drawtext (handle, 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 (handle, pchar (asmoney), strlen (pchar (asmoney)), arect, flag);
конец;
конец
еще
начинать
FedIt.Lencement: = FHALINGENT;
Fedit.Font: = FedItFont;
Fedit.text: = fmctext;
Fedit.width: = arect.right-arect.left;
Fedit.height: = min (max (textheight (fmctext), textheeth (fcaption)), arect.bottom-arect.top);
Fedit.left: = arect.left;
Случай
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;
if (fdatatype = sdstring) и (fbmfield <> '') и (fmcfield <> '') и (ftablename <> ''), затем fbutton.visible: = true
иначе fbutton.visible: = false;
конец;
конец;
конец;
деструктор tselectda.destroy;
начинать
Fpen.free;
Fbrush.free;
Ffont.free;
Feditfont.free;
Если назначено (FedIt), то FreAndnil (FedIt);
Если назначено (fbutton), то Freeandnil (fbutton);
унаследованное уничтожение;
конец;
Процедура tselectda.doclick (отправитель: tobject);
начинать
Если назначено (fonclick), то fonclick (self);
конец;
Процедура tselectda.doenter (отправитель: tobject);
начинать
Если назначено (Fonenter), то FONENTER (SEFT);
конец;
Процедура tselectda.doexit (отправитель: tobject);
начинать
Если назначено (fonexit), то fonexit (self);
конец;
Процедура tselectda.dokeypress (отправитель: tobject; var key: char);
начинать
Если назначено (fonkeypress), то Fonkeypress (Self, Key);
конец;
Регистр процедур;
начинать
RegisterComponents ('swlmsoft', [tselectda]);
конец;
конец.