Keterampilan Produksi Kontrol Delphi [2]

Penulis：Eve Cole Waktu Pembaruan：2025-02-16 02:00:02

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, Sddate);

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;

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

}

Prosedur setOnclick (nilai const: tnotifyevent);

Prosedur SetonkeyPress (Nilai Const: TKeyPressEvent);

Prosedur setonenter (nilai const: tnotifyevent);

prosedur setonexit (nilai const: tnotifyevent);

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 Asdate: String baca getAsdate;

Properti Assstr: String baca getastext tulis setastext;

Properti OnClick: tnotifyEvent membaca fonclick write setOnclick;

Properti OnKeyPress: TKeyPressEvent Baca FonKeyPress menulis setonkeypress;

Properti Onenter: tnotifyEvent baca fonenter write setonenter;

Properti Onexit: tnotifyEvent membaca fonexit menulis setonexit;

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;

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;

Prosedur tselectda.setBmText (nilai const: string);

mulai

Jika fbmtext <> nilai maka

mulai

FbmText: = nilai;

Membatalkan;

akhir;

Prosedur tselectda.setzjtext (nilai const: string);

mulai

Jika fzjtext <> nilai maka

mulai

Fzjtext: = nilai;

akhir;

Prosedur tselectda.setMctext (nilai const: string);

mulai

Jika nilai fmctext <>

mulai

Fmctext: = value;

Membatalkan;

akhir;

prosedur tselectda.setreadonly (nilai const: boolean);

mulai

Jika freadonly <> nilai maka

mulai

Freadonly: = nilai;

Membatalkan;

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;

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;

Sddate: fedit.inputstyle: = isDate;

lain fedit.inputStyle: = isstring;

akhir;

Membatalkan;

akhir;

prosedur tselectda.sethalignment (nilai const: talignment);

mulai

Jika fhalignment <> nilai maka

mulai

Fhalignment: = nilai;

Membatalkan;

akhir;

prosedur tselectda.setValignment (nilai const: tvalignment);

mulai

Jika fValignment <> nilai maka

mulai

Fvalignment: = nilai;

Membatalkan;

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;

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;

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;

fungsi tselectda.getAsdate (): string;

var

Tempdate: tDateTime;

mulai

Jika trystrtodate (fmctext, tempdate) maka hasilnya: = formatDateTime ('yyyy-mm-dd', tempdate)

Hasil lain: = '';

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;

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;

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);

Sddate: drawtext (handle, pchar (asdate), strlen (pchar (asdate)), arect, flag);

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 <> '')))

atau (fdataType = sddate) lalu fbutton.visible: = true

lain fbutton.visible: = false;

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;

}

Prosedur tselectda.setonClick (nilai const: tnotifyevent);

mulai

Jika @Fonclick <> @nilai maka

mulai

FONCLICK: = nilai;

Fbutton.onClick: = fonclick;

akhir;

Prosedur tselectda.setonkeypress (nilai const: tkeypressEvent);

mulai

Jika @FonKeyPress <> @nilai maka

mulai

Fonkeypress: = nilai;

Fedit.onkeypress: = fonkeypress;

akhir;

prosedur tselectda.setonenter (nilai const: tnotifyevent);

mulai

Jika @Fonenter <> @nilai maka

mulai

Fonenter: = nilai;

Fedit.onenter: = fonenter;

akhir;

Prosedur tselectda.setOnexit (nilai const: tnotifyevent);

mulai

Jika @Fonexit <> @nilai maka

mulai

Fonexit: = nilai;

Fedit.onexit: = fonexit;

akhir;

mulai

RegisterComponents ('swlmsoft', [tselectda]);

akhir;

akhir.