Unidad uswlmselectda;
{$ S-, W-, r-}
{$ C precarga}
interfaz
usos
Windows, mensajes, sysutils, tipos, clases, gráficos, controles, stdctrls, formularios,
Strutils, Matemáticas, ADODB, TflatButtonUnit, uswlmStyleEdit;
tipo
Teditdatatype = (sdstring, sdinteger, sdfloat, sdmoney);
Tvalignment = (TVATOPJustify, TVACenter, tvabottOmjustify);
Tdatastyle = (DSBM, DSZJ, DSMC);
tipo
Tselectda = class (tcustomControl)
privado
Fpen: tpen;
FBRUSH: TBRUSH;
Ffont: tfont;
Fcaption: string;
Fbmtext: string;
FZJText: String;
FmcText: string;
Fdatatype: teditdatatype;
Fprecision: entero;
Freadonly: booleano;
FeditFont: tfont;
Fhalignment: Talignment;
Fvalignment: tvalignment;
Fedit: tstyleedit;
FBUTTON: TflatButton;
Ftitlename: string;
FtableName: string;
FDATASTYLE: TDATASTYLE;
Fbmfield: cadena;
Fzjfield: cadena;
Fmcfield: cadena;
Fonclick: tnotifyEvent;
Fonenter: tnotifyEvent;
Fonexit: tnotifyEvent;
Fonkeypress: tkeypressevent;
procedimiento setPen (valor const: tpen);
procedimiento setBrush (valor const: tbrush);
procedimiento setFont (constante const: tfont);
procedimiento setCaption (valor const: string);
procedimiento setBmText (valor const: string);
procedimiento setzjText (valor const: string);
procedimiento setMcText (valor const: string);
procedimiento setDatatype (valor const: teditdatatype);
procedimiento setprecision (valor const: integer);
procedimiento setReadonly (valor const: boolean);
procedimiento setEditFont (valor const: tfont);
Procedimiento Setalignment (valor const: talignamento);
procedimiento setValignment (valor const: tvalignment);
procedimiento settitLename (constante const: cadena);
procedimiento settableName (constante const: cadena);
procedimiento setDatastyle (valor const: tdatastyle);
procedimiento setBMfield (valor const: string);
procedimiento setzjfield (valor const: string);
procedimiento setmcfield (valor const: string);
función getAsfloat (): string;
function getAmsoney (): string;
función getAsInteger (): string;
función getastext (): string;
procedimiento setAsfloat (valor const: string);
procedimiento setasmoney (constante const: cadena);
procedimiento setAsInteger (constante const: cadena);
procedimiento setastext (constante const: string);
procedimiento styLechanged (remitente: tobject);
Procedimiento SECUPTACKColor (valor const: tcolor);
procedimiento setColoronenter (valor const: tcolor);
procedimiento DoClick (remitente: tobject);
procedimiento doENTER (remitente: tobject);
procedimiento doexit (remitente: tobject);
procedimiento doKeyPress (remitente: tobject; var key: char);
protegido
pintura de procedimiento; anular;
público
constructor create (Awner: tComponent); anular;
destructor destruir; anular;
publicado
PROPIEDAD PEN: TPEN Leer fpen Write SetPen;
PROPIEDAD: TBRUSH Leer fbrush SETBRUSH de escritura;
Propiedad Font: tfont Read Ffont Write SetFont;
Título de la propiedad: cadena Leer fcaption Write setCaption;
Propiedad BM: String Read FBMText Write setBmText;
propiedad zjf: cadena leer fzjText Write setzjText;
Propiedad MC: cadena Leer fmcText Write setMcText;
texto de propiedad: cadena leer fmcText Write setMcText;
Tipo de datos de propiedad: teditdatatype lee fdatatype escriba setDatatype predeterminado sdtring;
Propiedad Precisión: Integer Read Fprecision Escribir setPrecision predeterminado 2;
Propiedad Readonly: Boolean Read Freadonly Write SetReadonly predeterminado falso;
Propiedad EditFont: tfont lee FeditFont Write setEditFont;
Halignment de propiedad: Talignment lea fhalignment escriba setalignment predeterminado taleftjustify;
Valignación de propiedad: tvalignment lea fValignment escriba setValignment predeterminado tvabottomjustify;
Propiedad TitLename: String Read FtitLename Write SettitLename;
Propiedad TableName: String Read FtableName Write SettableName;
Propiedad DataStyle: TDATASTYLE lea fdatastyle Write setDatastyle predeterminado dsbm;
Propiedad Bmfield: String Read FBMFIELD Write SetBmfield;
Propiedad Zjfield: cadena Leer fzjfield Write setzjfield;
Propiedad McField: cadena Leer fmcfield Write setMcfield;
propiedad asfloat: cadena leer getAsfloat {escribir setasfloat};
Propiedad Asmoney: String Read getAmmoney {escribir setasmoney};
Propiedad Asint: String Read getAsInteger {escriba setAsInteger};
propiedad astr: cadena leer getastext escritura setastext;
Propiedad OnClick: tnotifyEvent lea fonclick escribir fonclick;
Propiedad OnKeyPress: tkeyPressevent lea fonkeypress escribir fonkeypress;
PROPIEDAD ONENTER: tnotifyEvent lea fonenter escribir fonenter;
propiedad Onexit: tnotifyEvent lea fonexit escribir fonexit;
Propiedad Backcolor: tcolor write sendbackColor;
Propiedad ColorOnenter: tcolor write setColoronenter;
propiedad alignDisable;
propiedad VisibilDockClientCount;
Control de propiedades;
propiedad parentwindow;
propiedad que muestra;
Propiedad Taborder;
Propiedad Tabstop;
fin;
registro de procedimientos;
implementación
usa consts;
procedimiento tselectda.setPen (valor const: tpen);
comenzar
Fpen.assign (valor);
Invalidar;
fin;
procedimiento tselectda.setBrush (valor const: tbrush);
comenzar
Fbrush.assign (valor);
Invalidar;
fin;
procedimiento tselectda.setFont (valor const: tfont);
comenzar
Ffont.assign (valor);
Invalidar;
fin;
procedimiento tselectda.setCaption (valor const: string);
comenzar
Si fcaption <> valor entonces
comenzar
Fcaption: = valor;
Invalidar;
fin;
fin;
procedimiento tselectda.setBMText (valor const: string);
comenzar
Si FBMText <> valor entonces
comenzar
Fbmtext: = valor;
Invalidar;
fin;
fin;
procedimiento tselectda.setzJText (valor const: string);
comenzar
Si FZJText <> valor entonces
comenzar
FzjText: = valor;
fin;
fin;
procedimiento tselectda.setMcText (valor const: string);
comenzar
Si fmcText <> valor entonces
comenzar
FmcText: = valor;
Invalidar;
fin;
fin;
procedimiento tselectda.setReadonly (valor const: boolean);
comenzar
Si vale Freadonly <> entonces
comenzar
Freadonly: = valor;
Invalidar;
fin;
fin;
procedimiento tselectda.seteditfont (valor const: tfont);
comenzar
FeditFont.Assign (valor);
Invalidar;
fin;
procedimiento tselectda.setPrecision (valor const: entero);
comenzar
Si fprecision <> valor entonces
comenzar
valor de caso de
1..6: fprecision: = valor;
más fprecision: = 2;
fin;
Invalidar;
fin;
fin;
procedimiento tselectda.setDatatype (valor const: teditdatatype);
comenzar
Si FDATATYPE <> valor entonces
comenzar
Fdatatype: = valor;
case fdatatype de
Sdstring: fedit.inputStyle: = isstring;
Sdinteger: fedit.inputStyle: = isInTeger;
Sdfloat: fedit.inputStyle: = isfloat;
Sdmoney: fedit.inputStyle: = isMoney;
else fedit.inputStyle: = isstring;
fin;
Invalidar;
fin;
fin;
procedimiento tselectda.sethalignment (valor const: talignment);
comenzar
Si el valor de fhalignment <> entonces
comenzar
Fhalignment: = valor;
Invalidar;
fin;
fin;
procedimiento tselectda.setValignment (valor const: tvalignment);
comenzar
Si fValignment <> valor entonces
comenzar
FValignment: = valor;
Invalidar;
fin;
fin;
procedimiento tselectda.settitlename (valor const: string);
comenzar
si ftitlename <> valor entonces ftitlename: = valor;
fin;
procedimiento tselectda.settableName (valor const: string);
comenzar
Si ftableName <> valor entonces
comenzar
FtableName: = valor;
Invalidar;
fin;
fin;
procedimiento tselectda.setDatastyle (valor const: tdatastyle);
comenzar
Si fdatastyle <> value entonces fdatastyle: = valor;
fin;
procedimiento tselectda.setbmfield (valor const: string);
comenzar
Si FBMFIELD <> valor entonces
comenzar
Fbmfield: = valor;
Invalidar;
fin;
fin;
procedimiento tselectda.setzjfield (valor const: string);
comenzar
if fzjfield <> valor entonces fzjfield: = valor;
fin;
procedimiento tselectda.setMcfield (valor const: string);
comenzar
Si fmcfield <> valor entonces
comenzar
Fmcfield: = valor;
Invalidar;
fin;
fin;
función tselectda.getAsfloat: string;
función strtodouble (s: string): double;
comenzar
Si no es trystrtofloat (s, resultado), entonces resultado: = 0;
fin;
comenzar
Caso Fprecision de
1..6: resultado: = formatfloat ('### 0.'+DuPestring ('0', fprecision), strtodouble (fmcText));
el más resultado: = formatfloat ('### 0.00', strtodouble (fmcText));
fin;
fin;
función tselectda.getMoney: string;
función strtodouble (s: string): double;
comenzar
Si no es trystrtofloat (s, resultado), entonces resultado: = 0;
fin;
comenzar
Resultado: = formatfloat ('### 0.00', strtodouble (fmcText));
fin;
función tselectda.getAsInteger: string;
Función strTointeger (s: string): integer;
comenzar
si no trystrToint (s, resultado) entonces resultado: = 0;
fin;
comenzar
Resultado: = intToStr (strTointeger (fmcText));
fin;
función tselectda.getastext: string;
comenzar
Resultado: = fmcText;
fin;
procedimiento tselectda.setasfloat (valor const: string);
función strtodouble (s: string): double;
comenzar
Si no es trystrtofloat (s, resultado), entonces resultado: = 0;
fin;
varilla
F: doble;
comenzar
f: = strtodouble (valor);
Caso Fprecision de
1..6:
comenzar
f: = Roundto (f, -fprecision);
SetmcText (formatfloat ('### 0.'+duPeString ('0', fprecision), f));
fin
demás
comenzar
F: = Roundto (f, -2);
SetmcText (formatfloat ('### 0.00', f));
fin;
fin;
fin;
procedimiento tselectda.setasmoney (const valor: string);
función strtodouble (s: string): double;
comenzar
Si no es trystrtofloat (s, resultado), entonces resultado: = 0;
fin;
varilla
F: doble;
comenzar
f: = strtodouble (valor);
F: = Roundto (f, -2);
SetmcText (formatfloat ('### 0.00', f));
fin;
procedimiento tselectda.setAsInTeger (valor const: string);
Función strTointeger (s: string): integer;
comenzar
si no trystrToint (s, resultado) entonces resultado: = 0;
fin;
varilla
I: entero;
comenzar
i: = strTointeger (valor);
SetMcText (intToStr (i));
fin;
procedimiento tselectda.setastext (valor const: string);
comenzar
SetMcText (valor);
fin;
procedimiento tselectda.stylechanged (remitente: tobject);
comenzar
Invalidar;
fin;
procedimiento tselectda.setbackColor (valor const: tcolor);
comenzar
Fedit.BackColor: = Value;
fin;
procedimiento tselectda.setColoronenter (valor const: tcolor);
comenzar
Fedit.coloronenter: = valor;
fin;
constructor tselectda.create (Awner: tComponent);
comenzar
creación hereditaria (un downer);
Ancho: = 188;
Altura: = 20;
Fcaption: = '未命名';
Fbmtext: = '';
FzjText: = '';
FmcText: = '';
Freadonly: = false;
Fhalignment: = taleftjustify;
FValignment: = tvabottOmjustify;
Fdatatype: = sDtring;
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.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;
fin;
procedimiento tselectda.Paint;
varilla
atext: pchar;
ARECTO: Trect;
Bandera: DWORD;
comenzar
con lienzo do
comenzar
Fuente: = ffont;
Pluma: = fpen;
Cepillo: = fbrush;
Fillrect (ClientRect);
if fbmtext <> '' entonces atext: = pchar (fcaption+'['+fbmtext+']') else atext: = pchar (fcaption);
arecto: = 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 o dt_vcenter) o dt_left);
Inc (arect.left, textwidth (atext));
Dec (arecto. Right, fbutton.width);
Moveto (ARECT.LFT, ARECT.BOTTOM);
Lineto (arecto. Right, arect.bottom);
Inc (arect.left, fpen.width);
Si frase entonces entonces
comenzar
Fedit.visible: = false;
Fbutton.visible: = false;
Bandera: = dt_singline;
caso Fhalignment de
taleftjustify: flag: = flag o dt_left;
TarightJustify: Flag: = flag o dt_right;
tacenter: bandera: = flag o dt_center;
el más bandera: = flag o dt_left;
fin;
CASO FVALINEMENT de
TVATOPJustify: Flag: = flag o dt_top;
tvacenter: bandera: = flag o dt_vcenter;
tvabottomjustify: flag: = flag o dt_bottom;
el más bandera: = flag o dt_bottom;
fin;
Fuente: = FeditFont;
case fdatatype de
Sdstring: drawText (Handle, Pchar (astr), strlen (pchar (astr)), arecto, indicador);
Sdinteger: drawText (Handle, Pchar (Asint), strlen (pChar (asint)), arecto, bandera);
SDFLOAT: DrawText (Handle, PChar (Asfloat), Strlen (PChar (Asfloat)), Aguecto, Bandera);
SdMoney: DrawText (Handle, Pchar (Asmoney), Strlen (PChar (Asmoney)), ARECT, FLAG);
fin;
fin
demás
comenzar
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;
CASO FVALINEMENT de
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;
fin;
Fbutton.left: = arect.right;
Fbutton.top:=arect.top;
Fbutton.Height: = arect.bottom-arect.top;
if (fdatatype = sdstring) y (fbmfield <> '') y (fmcfield <> '') y (ftableName <> '') entonces fbutton.visible: = true
else fbutton.visible: = false;
fin;
fin;
fin;
destructor tselectda.destroy;
comenzar
Fpen.free;
FBRUSH.Free;
Ffont.Free;
Feditfont.Free;
si se asigna (Fedit), entonces Freeandnil (Fedit);
si se asigna (fbutton) entonces freeandnil (fbutton);
destrucción hereditaria;
fin;
procedimiento tselectda.doClick (remitente: tobject);
comenzar
si se asigna (fonclick) entonces fonclick (self);
fin;
procedimiento tselectda.doenter (remitente: tobject);
comenzar
si se asigna (Fonenter) entonces Fonenter (self);
fin;
procedimiento tselectda.doexit (remitente: tobject);
comenzar
si se asigna (fonexit) entonces fonexit (self);
fin;
procedimiento tselectda.dokeypress (remitente: tobject; var clave: char);
comenzar
si se asigna (fonkeypress) entonces fonkeypress (self, key);
fin;
registro de procedimientos;
comenzar
RegisterComponents ('swlmSoft', [tselectda]);
fin;
fin.