Delphi contrôle les compétences de production [2]

Auteur：Eve Cole Date de mise à jour：2025-02-16 02:00:02

UNIT USWLMSELECTDA;

{$ S-, w-, r-}

{$ C Preload}

interface

usages

Windows, messages, systèmes, types, classes, graphiques, contrôles, stdctrls, formulaires,

Strutils, mathématiques, Adodb, tflatbuttonunit, uswlmstyleedit;

taper

TeditDatatype = (sdsstring, sdinteger, sdfloat, sdmoney, sddate);

Tvalignment = (tvatopjustify, tvacenter, tvabottomjustify);

Tdatastyle = (dsbm, dszj, dsmc);

taper

Tselectda = classe (tCustomControl)

privé

FPEN: TPEN;

Fbrush: tbrush;

Ffont: tfont;

Fcaption: chaîne;

FbmText: String;

FzjText: String;

FmcText: String;

Fdatatype: teditdatatype;

Fprecision: entier;

Freadonly: Boolean;

Feditfont: tfont;

Fhalignment: talignment;

Fvalignment: Tvalignment;

Fedit: tStyleEdit;

FBUTTON: Tflatbutton;

FtiTLename: String;

FtableName: String;

Fdatastyle: tdatastyle;

Fbmfield: String;

Fzjfield: String;

Fmcfield: String;

FonClick: tnotifyEvent;

Fonateur: tnotifyEvent;

FONEXIT: tnotifyEvent;

Fonkeypress: TkeyPressEvent;

procédure setPen (constamment de const: TPEN);

Procédure setbrush (constamment de const: tbrush);

Procédure setFont (constamment de const: tfont);

Procédure setCaption (const Value: String);

Procédure setBmText (const Value: String);

Procédure setZjText (const Valeur: String);

Procédure setMcText (const Value: String);

Procédure setDatatype (constamment de const: teditDatatype);

Procédure setPrecision (const Value: Integer);

Procédure setReadOnly (const Value: Boolean);

procédure setteditfont (constamment de const: tfont);

Procédure Sethalignment (constante de const: talignment);

Procédure setValignment (const Value: Tvalignment);

Procédure SettITLename (const Value: String);

Procédure SettableName (const Value: String);

Procédure setDatastyle (const Value: Tdatastyle);

Procédure setBmfield (const de valeur: string);

procédure setzjfield (const de valeur: string);

Procédure setMcfield (const Value: String);

fonction getasfloat (): string;

fonction getAsmoney (): String;

fonction getasInteger (): String;

fonction getastext (): string;

fonction getasdate (): string;

Procédure setAsFloat (const Value: String);

Procédure setAmoney (const Value: String);

Procédure setAsInteger (const Value: String);

Procédure setStastext (constamment de valeur: chaîne);

Procédure StyleChanged (expéditeur: tobject);

Procédure SetBackColor (const Value: TColor);

Procédure setColorOenter (const Value: tcolor);

{

procédure doclick (expéditeur: tobject);

Procédure DOENTER (expéditeur: tobject);

procédure doExit (expéditeur: tobject);

Procédure dokeyPress (expéditeur: tobject; clés var: char);

}

Procédure setOnClick (const Value: tnotifyEvent);

Procédure setOnkeyPress (constamment de const: tkeyPressEvent);

Procédure Setononger (const Value: tnotifyEvent);

Procédure setOnExit (constamment de const: tnotifyEvent);

protégé

peinture de procédure; outrepasser;

publique

Constructor Create (Aowner: TComponent); outrepasser;

destructeur détruire; outrepasser;

publié

Propriété Pen: TPEN Read FPEN WRITE SETPEN;

Brosse de propriété: Tbrush Read Fbrush Write SetBrush;

Police de propriété: TFONT LEAD FFONT WRITE SETFONT;

Propriété Légende: String Read fcaption Write SetCaption;

Propriété BM: String Read FBMText Write SetBMText;

propriété zjf: chaîne read fzjtext write setzjText;

propriété MC: String Read fmcText Write SetMcText;

Texte de la propriété: chaîne Read fmcText Write SetMcText;

Propriété DataType: TeDitDatatype Read fdatatype Write SetDatatype par défaut SDSTRING;

Précision de la propriété: INTEGER LIRE FPRECISION ÉCRIT SETPRECISION DEUR 2;

Propriété Readonly: Booléen Lire Freadonly Write SetReadonly par défaut FAUX;

Propriété EditFont: TFONT LEAD FEDITFONT ÉCRIRE SEDEDITFONT;

Halignement de la propriété: talignment lisez fhalignment écrire sethalignment par défaut taleftjustify;

Valignment de la propriété: tvalignment lisez fvalignment écriture setValignment par défaut tvabottomjustify;

Property titLename: String Read ftitLename Write SetttLename;

Property TableName: String Read ftableName Write SettableName;

Property Datastyle: tdatastyle read fdatastyle write setDatastyle défaut dsbm;

propriété BMfield: String Read FBMfield Write SetBMfield;

Propriété Zjfield: String Read fzjfield Write Setzjfield;

Propriété McField: String Read FMCField Write SetMCfield;

propriété asfloat: string read getasfloat {write setasfloat};

Property asmoney: String read getasmoney {écrire setAmoney};

propriété asInt: String read getasInteger {write setaSInteger};

Property Asdate: String Read Getasdate;

Property Asstr: String Read getastext write setastext;

Property onClick: tnotifyEvent read Fonclick Write SetOnclick;

Propriété OnkeyPress: TkeyPressEvent Lire FonkeyPress écrire SetonkeyPress;

Property onenter: tnotifyEvent read fenonter write seenonger;

Propriété Onexit: tnotifyEvent read Fonexit write setOlExit;

Propriété BackColor: TCOLOR WRITE SETBACKCOLOR;

Property ColorOsenter: tcolor write setColorOenter;

la propriété AlignDisabled;

propriété VisibledockClientCount;

Contrôle de propriété;

propriété parentWindow;

Propriété montrant;

TabOrder de la propriété;

Tabstop de propriété;

fin;

Registre de procédure;

mise en œuvre

utilise consts;

Procédure tselectda.setpen (constamment de const: TPEN);

commencer

FPEN.Assign (valeur);

Invalider;

fin;

Procédure tSelectDa.setbrush (constamment de const: tbrush);

commencer

Fbrush.assign (valeur);

Invalider;

fin;

Procédure tselectda.setfont (constamment de const: tfont);

commencer

Ffont.assign (valeur);

Invalider;

fin;

Procédure tSelectDa.SetCaption (const Value: String);

commencer

Si fcaption <> valeur alors

commencer

Fcaption: = valeur;

Invalider;

fin;

Procédure tSelectda.setBmText (constamment de valeur: String);

commencer

Si fbmText <> valeur alors

commencer

FbmText: = valeur;

Invalider;

fin;

Procédure tselectda.setzjText (constamment const: chaîne);

commencer

Si fzjText <> valeur alors

commencer

FzjText: = valeur;

fin;

Procédure tSelectda.SetMcText (constamment de valeur: String);

commencer

Si fmcText <> valeur alors

commencer

FmcText: = valeur;

Invalider;

fin;

Procédure tselectda.setReadonly (constamment de const: booléen);

commencer

Si freadonly <> valeur alors

commencer

Freadonly: = valeur;

Invalider;

fin;

Procédure tSelectDa.SetEditFont (constamment de const: tfont);

commencer

FeditFont.assign (valeur);

Invalider;

fin;

Procédure tSelectDa.setPrecision (const Value: Integer);

commencer

Si fprecision <> valeur alors

commencer

Valeur de cas de

1..6: fPrecision: = valeur;

else fPrecision: = 2;

fin;

Invalider;

fin;

Procédure tselectda.setDatatype (Valeur const: teditDatatype);

commencer

Si fdatatype <> valeur alors

commencer

Fdatatype: = valeur;

cas fdatatype de

SDSTRING: Fedit.InputStyle: = ISSTRING;

SDInteger: Fedit.InputStyle: = IsInteger;

Sdfloat: fedit.inputStyle: = isfloat;

Sdmoney: fedit.inputStyle: = Ismoney;

Sddate: fedit.inputStyle: = isdate;

else Fedit.inputStyle: = ISSTRING;

fin;

Invalider;

fin;

Procédure tSelectDA.Sethalignment (constamment de constant: talignment);

commencer

Si fhalignment <> valeur alors

commencer

Fhalignment: = valeur;

Invalider;

fin;

Procédure tSelectda.SetValignment (const Value: Tvalignment);

commencer

Si fvalignment <> valeur alors

commencer

Fvalignment: = valeur;

Invalider;

fin;

Procédure tSelectDa.SetTitLename (const Value: String);

commencer

Si ftiTLename <> valeur alors ftitLename: = valeur;

fin;

Procédure tSelectDa.SetTableName (const Value: String);

commencer

Si ftableName <> valeur alors

commencer

FtableName: = valeur;

Invalider;

fin;

Procédure tSelectda.setDatastyle (constamment de const: tdatastyle);

commencer

Si fdatastyle <> value alors fdatastyle: = valeur;

fin;

Procédure tselectda.setbmfield (constamment de valeur: chaîne);

commencer

Si fbmfield <> valeur alors

commencer

Fbmfield: = valeur;

Invalider;

fin;

Procédure tselectda.setzjfield (constamment de valeur: chaîne);

commencer

Si fzjfield <> valeur alors fzjfield: = valeur;

fin;

Procédure tselectda.setmcfield (constamment de valeur: chaîne);

commencer

Si fmcfield <> valeur alors

commencer

Fmcfield: = valeur;

Invalider;

fin;

fonction tSelectDa.getAsDate (): String;

var

Tempdate: tdatetime;

commencer

Si trystrtodate (fmcText, tempdate) alors résultat: = formatdatetime ('yyyy-mm-dd', tempdate)

Sinon Résultat: = '';

fin;

fonction tselectda.getasfloat: string;

fonction strtodouble (s: string): double;

commencer

Si non Trystrtofloat (s, résultat) alors résultat: = 0;

fin;

commencer

cas fprecision de

1..6: Résultat: = FormatFloat ('### 0.' + DUTESTRING ('0', fPrecision), strtodouble (fmcText));

Else Résultat: = FormatFloat ('### 0,00', strtodouble (fmcText));

fin;

fonction tSelectda.getAmoney: String;

fonction strtodouble (s: string): double;

commencer

Si non Trystrtofloat (s, résultat) alors résultat: = 0;

fin;

commencer

Résultat: = formatFloat ('### 0,00', strtodouble (fmcText));

fin;

fonction tSelectda.getAsInteger: String;

Fonction strTointeger (s: string): entier;

commencer

Sinon TrystrToint (S, résultat) alors résultat: = 0;

fin;

commencer

Résultat: = intToStr (strTointeger (fmcText));

fin;

fonction tSelectda.getastext: String;

commencer

Résultat: = fmcText;

fin;

Procédure tselectda.setasfloat (constamment de valeur: chaîne);

fonction strtodouble (s: string): double;

commencer

Si non Trystrtofloat (s, résultat) alors résultat: = 0;

fin;

var

F: Double;

commencer

f: = strtodouble (valeur);

cas fprecision de

1..6:

commencer

F: = Roundto (f, -fprecision);

SetMcText (formatFloat ('### 0.

fin

autre

commencer

f: = roundto (f, -2);

SetMcText (formatfloat ('### 0,00', f));

fin;

Procédure tselectda.setAmoney (constamment de valeur: string);

fonction strtodouble (s: string): double;

commencer

Si non Trystrtofloat (s, résultat) alors résultat: = 0;

fin;

var

F: Double;

commencer

f: = strtodouble (valeur);

f: = roundto (f, -2);

SetMcText (formatfloat ('### 0,00', f));

fin;

Procédure tSelectDa.SetAsInteger (const Value: String);

Fonction strTointeger (s: string): entier;

commencer

Sinon TrystrToint (S, résultat) alors résultat: = 0;

fin;

var

I: entier;

commencer

i: = strTointeger (valeur);

SetMcText (inttoStr (i));

fin;

Procédure tSelectDa.Setastext (const Value: String);

commencer

SetMcText (valeur);

fin;

Procédure tselectda.stylechanged (expéditeur: tobject);

commencer

Invalider;

fin;

Procédure tSelectDa.setBackColor (const Value: tcolor);

commencer

Fedit.backColor: = valeur;

fin;

Procédure tSelectDa.SetColoronger (constamment de const: tcolor);

commencer

Fedit.coloronger: = valeur;

fin;

constructeur tSelectDa.Create (Aowner: tComponent);

commencer

hérité de création (aowner);

Largeur: = 188;

Hauteur: = 20;

Fcaption: = '未命名';

FbmText: = '';

FzjText: = '';

FmcText: = '';

Freadonly: = false;

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

Fedit.parent: = self;

Fedit.BordersTyle: = Bsnone;

Fedit.InputStyle: = ISSTRING;

{

Fedit.onKeyPress: = DokeyPress;

Fedit.onenter: = DOENTER;

Fedit.Oxit: = 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.colorfocus: = fbrush.color;

Fbutton.width: = 19;

Fbutton.caption: = '…';

{

Fbutton.onclick: = doclick;

}

fin;

procédure tselectda.paint;

var

atext: phar;

Arect: Trect;

Flag: dword;

commencer

avec toile font

commencer

FONT: = ffont;

Pen: = FPEN;

Brosse: = fbrush;

FillRect (ClientRect);

Si fbmText <> '' alors 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 (manche, atext, strlen (atext), arect, (dt_singleline ou dt_vcenter) ou 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);

Si Freadonly alors

commencer

Fedit.Visible: = false;

FButton.Visible: = false;

Flag: = dt_singLeline;

affaire fhalignment de

taleftJustify: Flag: = Flag ou dt_left;

TARightJustify: Flag: = Flag ou DT_RIGHT;

Tacenter: Flag: = Flag ou DT_Center;

Else Flag: = Flag ou DT_LEFT;

fin;

affaire fvalignment de

TVATOPJustify: Flag: = Flag ou DT_TOP;

tvacenter: Flag: = Flag ou dt_vcenter;

tvabottomJustify: Flag: = Flag ou dt_bottom;

Else Flag: = Flag ou DT_BOTTOM;

fin;

FONT: = FeditFont;

cas fdatatype de

SDSTRING: DrawText (Handle, PCHA (ASSTR), Strlen (PCHA (ASSTR)), Arect, Flag);

SDInteger: DrawText (Handle, PCHA (ASINT), strlen (phar (ASInt)), Arect, Flag);

Sdfloat: drawText (manche, pChar (asfloat), strlen (pChar (asfloat)), arect, drapeau);

Sdmoney: drawText (manche, phar (asmoney), strlen (phar (asmoney)), arect, drapeau);

Sddate: drawText (manche, pChar (asdate), strlen (phar (asdate)), arect, drapeau);

fin;

fin

autre

commencer

Fedit.alignment: = fhalignment;

Fedit.font: = FeditFont;

Fedit.Text: = fmcText;

Fedit.Width: = aRect.Right-Aarect.left;

Fedit.Height: = Min (Max (Textheight (fmcText), Textheight (fcaption)), arect.bottom-aarect.top);

Fedit.left: = arect.left;

affaire fvalignment de

tvatopjustify: fedit.top: = arect.top;

tvacenter: fedit.top: = arect.top + (arect.bottom-aarect.top-fedit.height) div 2;

tvabottomJustify: fedit.top: = arect.top + (arect.bottom-action.top-fedit.height);

else Fedit.top:=Arect.top;

fin;

Fbutton.left: = arect.Right;

Fbutton.top:=Arect.top;

Fbutton.height: = arect.bottom-arect.top;

if ((fdatatype = sdsstring) et (fbmfield <> '') et (fmcfield <> '') et (ftableName <> ''))

ou (fdatatype = sddate) puis fbutton.visible: = true

else fbutton.visible: = false;

fin;

destructeur tselectda.destroy;

commencer

Fpen.free;

Fbrush.free;

Ffont.free;

Feditfont.free;

si elle est attribuée (Fedit) alors freeandnil (fedit);

si elle est attribuée (fbutton) alors freeandnil (fbutton);

Hérité de détruire;

fin;

{

Procédure tSelectDa.Doclick (expéditeur: tobject);

commencer

si elle est affectée (FonClick) alors FonClick (self);

fin;

Procédure tSelectDa.Doenter (expéditeur: tobject);

commencer

si elle est attribuée (fosonger) alors fonenter (self);

fin;

Procédure tSelectDA.DoExit (expéditeur: tobject);

commencer

si elle est attribuée (FONEXIT) alors Fonexit (self);

fin;

Procédure tselectda.dokeyPress (expéditeur: tobject; clés var: char);

commencer

si elle est attribuée (FonkeyPress) alors FonkeyPress (self, key);

fin;

}

Procédure tselectda.setOnClick (constamment de const: tnotifyEvent);

commencer

Si @fonclick <> @ valeur alors

commencer

FonClick: = valeur;

Fbutton.onclick: = FonClick;

fin;

Procédure tselectda.setonKeyPress (constamment de const: tkeyPressEvent);

commencer

Si @fonkeypress <> @ valeur alors

commencer

FonkeyPress: = valeur;

Fedit.onKeyPress: = FonkeyPress;

fin;

Procédure tSelectDa.Setonger (const Value: tnotifyEvent);

commencer

Si @fonenger <> @ valeur alors

commencer

Fononger: = valeur;

Fedit.onenter: = Fenonger;

fin;

Procédure tSelectDa.SetOnExit (constamment de const: tnotifyEvent);

commencer

Si @fonexit <> @ valeur alors

commencer

Fonexit: = valeur;

Fedit.onexit: = Fonexit;

fin;

Registre de procédure;

commencer

RegisterComponents ('Swlmsoft', [TSelectDA]);

fin;

fin.