Delphi Control Production Skills [2]

Автор：Eve Cole Время обновления：2025-02-16 02:00:02

единица uswlmselectda;

{$ S-, w-, r-}

{$ C предварительная нагрузка}

интерфейс

Использование

Windows, сообщения, Sysutils, типы, классы, графика, управления, Stdctrls, Forms,

Strutils, Math, Adodb, Tflatbuttonunit, Uswlmstyleedit;

тип

Teditdatatype = (sdstring, sdinteger, sdfloat, sdmoney, sddate);

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;

function getAsdate (): 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);

}

процедура setOnClick (const value: tnotifyevent);

процедура setOnKeyPress (const value: tkeypressevent);

процедура setOntoner (const value: tnotifyevent);

процедура setOnexit (const value: tnotifyevent);

защищен

процедура краска; переопределить;

публичный

конструктор 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};

Свойство Asdate: String Read GetaSdate;

свойство Asstr: строка getastext write setastext;

свойство Onclick: tnotifyevent Read Fonclick Write SetonClick;

недвижимость OnKeyPress: TKEYPRESSEVENT Читать FonkeyPress написать SetOnKeyPress;

Свойство OnEnter: TnotifyEvent Read Fonenter write setonenter;

Свойство onexit: tnotifyevent read fonexit write setonexit;

Свойство 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;

Sddate: fedit.inputstyle: = isdate;

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.getasdate (): string;

вар

Tempdate: tdateTime;

начинать

Если Tristrtodate (fmctext, tempdate), то Result: = formatdateTime ('yyyy-mm-dd', tempdate)

иначе результат: = '';

конец;

функция 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);

Sddate: drawText (ручка, pchar (asdate), strlen (pchar (asdate)), 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 <> '' '))

или (fdatatype = sddate) затем 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);

конец;

}

Процедура tselectda.setonClick (const value: tnotifyevent);

начинать

Если @fonclick <> @value, то

начинать

Fonclick: = value;

Fbutton.onclick: = fonclick;

конец;

Процедура tselectda.setonkepress (const value: tkeypressevent);

начинать

Если @fonkeypress <> @value, то

начинать

Fonkeypress: = value;

Fedit.onkeypress: = fonkeypress;

конец;

Процедура tselectda.setonentorer (const value: tnotifyevent);

начинать

Если @fonenter <> @value, то

начинать

FONENTER: = value;

FedIt.Onenter: = FONENTER;

конец;

Процедура tselectda.setonexit (const value: tnotifyevent);

начинать

Если @fonexit <> @value, тогда

начинать

Fonexit: = value;

Fedit.onexit: = fonexit;

конец;

Регистр процедур;

начинать

RegisterComponents ('swlmsoft', [tselectda]);

конец;

конец.