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);
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;
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);
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 Asstr: String Read getastext write setastext;
Property onclick: tnotifyEvent read Fonclick Write Fonclick;
Propriété OnKeypress: TkeyPressEvent Lire FonkeyPress Écrivez FonkeyPress;
Property onenter: tnotifyEvent read fonenter write fonenter;
propriété Onexit: tnotifyEvent read fonexit write fonexit;
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;
fin;
Procédure tSelectda.setBmText (constamment de valeur: String);
commencer
Si fbmText <> valeur alors
commencer
FbmText: = valeur;
Invalider;
fin;
fin;
Procédure tselectda.setzjText (constamment const: chaîne);
commencer
Si fzjText <> valeur alors
commencer
FzjText: = valeur;
fin;
fin;
Procédure tSelectda.SetMcText (constamment de valeur: String);
commencer
Si fmcText <> valeur alors
commencer
FmcText: = valeur;
Invalider;
fin;
fin;
Procédure tselectda.setReadonly (constamment de const: booléen);
commencer
Si freadonly <> valeur alors
commencer
Freadonly: = valeur;
Invalider;
fin;
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;
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;
else Fedit.inputStyle: = ISSTRING;
fin;
Invalider;
fin;
fin;
Procédure tSelectDA.Sethalignment (constamment de constant: talignment);
commencer
Si fhalignment <> valeur alors
commencer
Fhalignment: = valeur;
Invalider;
fin;
fin;
Procédure tSelectda.SetValignment (const Value: Tvalignment);
commencer
Si fvalignment <> valeur alors
commencer
Fvalignment: = valeur;
Invalider;
fin;
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;
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;
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;
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;
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;
fin;
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);
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 <> '') puis fbutton.visible: = true:
else fbutton.visible: = false;
fin;
fin;
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;
Registre de procédure;
commencer
RegisterComponents ('Swlmsoft', [TSelectDA]);
fin;
fin.