Unidade USWLMSElectda;
{$ S-, w-, r-}
{$ C Preload}
interface
usos
Janelas, mensagens, sysutils, tipos, classes, gráficos, controles, stdctrls, formulários,
Strutils, Math, Adodb, Tflatbuttonunit, Uswlmstyleedit;
tipo
Teditdatatype = (sdstring, sdinteger, sdfloat, sdmoney);
TValignment = (TVATOPJUSTIFY, TVACENTER, TVABOTTOMJUSTIFY);
Tdatastyle = (dsbm, dszj, dsmc);
tipo
TSELECTDA = classe (tcustomControl)
privado
FPEN: TPEN;
Fbrush: Tbrush;
Ffont: tfont;
Fcaption: string;
FBMText: String;
Fzjtext: string;
FMCTEXT: String;
Fdatatype: teditdatatype;
FPRECISION: INTEGER;
Freadonly: booleano;
Feditfont: tfont;
Fhalignment: Talignment;
Fvaligno: TValignment;
Fedit: tstyleedit;
Fbutton: tflatbutton;
FtitleName: string;
FtableName: string;
Fdatastyle: tdatastyle;
Fbmfield: string;
Fzjfield: string;
Fmcfield: string;
FONCLICK: tnotifyEvent;
Fenter: tnotifyEvent;
Fonexit: tnotifyEvent;
Fonkeypress: tKeyPressEvent;
Procedimento setPen (Valor const: TPEN);
Procedimento SetBrush (Valor const: tbrush);
Procedimento setFont (Valor const: TFont);
Procedimento setCaption (const valor: string);
Procedimento setBMText (const Value: String);
Procedimento setZjText (Valor const: String);
Procedimento setMcText (const valor: string);
Procedimento SetDatatype (Valor const: TeditDatatype);
Procedimento setPrecision (Valor const: Inteiro);
Procedimento SetReadonly (Valor const: booleano);
procedimento SetEditFont (Valor const: TFont);
Procedimento Sethalignment (Valor Const: Talignment);
Procedimento setValignment (const Value: TValIignment);
Procedimento SettitleName (const Value: String);
Procedimento SettableName (const valor: string);
Procedimento SetDatastyle (Valor const: Tdatastyle);
procedimento setbmfield (const valor: string);
procedimento setzjfield (const valor: string);
procedimento setMcfield (const valor: string);
função getasfloat (): string;
função getasMoney (): string;
function getasInteger (): string;
function getastext (): string;
procedimento setAsfloat (const valor: string);
Procedimento setasMoney (const valor: string);
Procedimento SetAsInteger (Valor const: String);
Procedimento SeterStasxt (const valor: string);
Procedimento StyChanGed (remetente: Tobject);
Procedimento SetbackColor (Valor const: TColor);
Procedimento setColorOnenter (Valor const: tcolor);
Procedimento Doclick (remetente: Tobject);
Procedimento Doenter (remetente: TOBJECT);
Procedimento DoExit (remetente: Tobject);
Procedimento dokeyPress (remetente: TOBJECT; VAR Tecla: CHAR);
protegido
Pintura de procedimento; substituir;
público
Construtor Create (Anowner: TComponent); substituir;
destruidor destruir; substituir;
publicado
Propriedade caneta: tpen leia fpen write setpen;
Brush de propriedade: tbrush leia fbrush write setbrush;
Fonte da propriedade: tfont leia ffont write setfont;
Legenda da propriedade: string leia fcaption write setCaption;
Propriedade BM: String Read FBMText Write setBMText;
Propriedade ZJF: String Leia FZJText Write setZJText;
Propriedade MC: String Leia FMCText Write setMcText;
Texto da propriedade: String leia FMCText Write setMcText;
Datatype de propriedade: TEDITDATATYPE LEIA FDATATYPY SetDatatype padrão SDSTRING;
PROPRIEDADE Precisão: Inteiro Read Fprecision Write setPrecision padrão 2;
Propriedade ReadOnly: Boolean Read FreaDonly Write SetReadyly padrão false;
propriedade editfont: tfont leu feditfont write seteditfont;
Propriedade Halignment: Talignment Leia o Fhalignment Escreva Sethalignment Padrão Taleftjustify;
Propriedade Valinhamento: TValignment Leia Fvalignment Write SetValignment padrão TVABOTTOMJUSTIFY;
Propriedade TitleName: String Leia FtitleName Write SettitleName;
Propriedade tableName: string leia ftableName Write SettableName;
Propriedade Datastyle: tdatastyle leia fdatastyle write setDatastyle padrão dsbm;
Propriedade bmfield: string leia fbmfield write setbmfield;
Propriedade ZJfield: String Leia Fzjfield Write Setzjfield;
Propriedade mcfield: string leia fmcfield write setmcfield;
Propriedade asfloat: string leia getasfloat {write setasfloat};
Propriedade Asmoney: String Read GetasMoney {Write setasMoney};
Propriedade asint: string leia getasInteger {write setasinteger};
Propriedade Asstr: String Leia Getastext Write ScaSteStext;
Propriedade OnClick: tnotifyEvent leia FoNClick Write FonClick;
Propriedade OnKeyPress: tKeyPressEvent Leia Fonkeypress Write Fonkeypress;
Propriedade Onenter: tnotifyEvent Leia Fenter Write Fonenter;
Propriedade Onexit: tnotifyEvent leia fonexit write fonexit;
Propriedade backcolor: tcolor write setbackcolor;
Propriedade Colorentener: tcolor write setColoroneder;
Propriedade alignDisabled;
Propriedade VisibledockClientCount;
Controle de propriedades;
Propriedade parentwindow;
propriedade mostrando;
Propriedade Taborder;
Propriedade tabstop;
fim;
registro de procedimentos;
implementação
usa constações;
procedimento TSELECTDA.SETPEN (Valor const: TPEN);
começar
Fpen.assign (valor);
Invalidar;
fim;
procedimento TSELECTDA.setBrush (Valor const: tbrush);
começar
Fbrush.assign (valor);
Invalidar;
fim;
procedimento TSELECTDA.SETFont (Valor const: TFont);
começar
Ffont.assign (valor);
Invalidar;
fim;
procedimento TSELECTDA.SETCAPTION (Valor const: String);
começar
Se fcaption <> valor então
começar
Fcaption: = value;
Invalidar;
fim;
fim;
procedimento tSelectDA.setBMText (const valor: string);
começar
Se FBMText <> valor então
começar
FBMText: = Value;
Invalidar;
fim;
fim;
procedimento TSELECTDA.SETZJTEXT (Valor const: String);
começar
se fzjtext <> valor então
começar
Fzjtext: = value;
fim;
fim;
procedimento TSELECTDA.SETMCTEXT (Valor const: String);
começar
Se fmcText <> valor então
começar
FMCText: = Value;
Invalidar;
fim;
fim;
procedimento TSELECTDA.SETRADONLY (Valor const: booleano);
começar
Se freadonly <> valor então
começar
Freadonly: = value;
Invalidar;
fim;
fim;
procedimento TSELECTDA.SETEDITFont (Valor const: TFont);
começar
Feditfont.assign (valor);
Invalidar;
fim;
procedimento TSELECTDA.SETPRECISION (Valor const: Inteiro);
começar
Se fprecision <> valor então
começar
valor de caso de
1..6: fprecision: = value;
else fprecision: = 2;
fim;
Invalidar;
fim;
fim;
procedimento tSelectDA.setDatatype (Valor const: TeditDatatype);
começar
Se fdatatype <> valor então
começar
Fdatatype: = value;
Caso fdatatype de
Sdstring: fedit.inputStyle: = Isstring;
Sdinteger: fedit.inputStyle: = isinteger;
Sdfloat: fedit.inputStyle: = isfloat;
Sdmoney: fedit.inputStyle: = ismoney;
else fedit.inputStyle: = Isstring;
fim;
Invalidar;
fim;
fim;
Procedimento TSELECTDA.SETHALIGNAMENTO (Valor const: Talignment);
começar
Se fhalignment <> valor então
começar
Fhalignment: = value;
Invalidar;
fim;
fim;
procedimento TSELECTDA.setValignment (Valor const: TValignment);
começar
Se o valor <> valor então
começar
Fvalignment: = value;
Invalidar;
fim;
fim;
procedimento tSelectDA.setTitleName (const valor: string);
começar
Se ftitleName <> valor, então ftitleName: = value;
fim;
procedimento tSelectDA.setTableName (const valor: string);
começar
Se ftableName <> valor então
começar
FtableName: = value;
Invalidar;
fim;
fim;
procedimento TSELECTDA.SETDATASTYLE (Valor const: Tdatastyle);
começar
Se fdatastyle <> valor então fdatastyle: = value;
fim;
procedimento TSELECTDA.SETBMFIELD (Valor const: String);
começar
Se fbmfield <> valor então
começar
Fbmfield: = value;
Invalidar;
fim;
fim;
procedimento TSELECTDA.SETZJFIELD (Valor const: String);
começar
Se fzjfield <> valor então fzjfield: = value;
fim;
procedimento TSELECTDA.SETMCFIELD (Valor const: String);
começar
Se fmcfield <> valor então
começar
Fmcfield: = value;
Invalidar;
fim;
fim;
função tSelectDA.getasfloat: string;
função strtodouble (s: string): duplo;
começar
se não for Trystrtofloat (s, resultado), resulte: = 0;
fim;
começar
Caso Frecision of
1 ..
caso contrário, resultado: = formatfloat ('### 0,00', strtodouble (fmcText));
fim;
fim;
função tSelectDA.GetasMoney: string;
função strtodouble (s: string): duplo;
começar
se não for Trystrtofloat (s, resultado), resulte: = 0;
fim;
começar
Resultado: = formatfloat ('### 0,00', strtodouble (fmcText));
fim;
função tSelectda.getAsInteger: string;
Função strTointEger (s: string): inteiro;
começar
se não for TrystroToint (s, resultado), resulte: = 0;
fim;
começar
Resultado: = inttoStr (strTointEger (FMCText));
fim;
função tSelectDA.getastext: string;
começar
Resultado: = fmcText;
fim;
procedimento TSELECTDA.SETASFLOAT (Valor const: String);
função strtodouble (s: string): duplo;
começar
se não for Trystrtofloat (s, resultado), resulte: = 0;
fim;
var
f: duplo;
começar
f: = strtodouble (valor);
Caso Frecision of
1..6:
começar
F: = RoundTo (f, -fprecision);
SetMcText (formatfloat ('### 0.'+dupestring ('0', fprecision), f));
fim
outro
começar
F: = RoundTo (F, -2);
SetMcText (formatfloat ('### 0,00', f));
fim;
fim;
fim;
procedimento TSELECTDA.SETASMONEY (Valor const: String);
função strtodouble (s: string): duplo;
começar
se não for Trystrtofloat (s, resultado), resulte: = 0;
fim;
var
f: duplo;
começar
f: = strtodouble (valor);
F: = RoundTo (F, -2);
SetMcText (formatfloat ('### 0,00', f));
fim;
procedimento TSELECTDA.SETASINTEGER (Valor const: String);
Função strTointEger (s: string): inteiro;
começar
se não for TrystroToint (s, resultado), resulte: = 0;
fim;
var
I: Inteiro;
começar
i: = strTointEger (valor);
SetMcText (inttostr (i));
fim;
procedimento TSELECTDA.SETASTEXT (Valor const: String);
começar
SetMcText (valor);
fim;
procedimento TSELECTDA.STYLECHANGED (remetente: Tobject);
começar
Invalidar;
fim;
procedimento TSELECTDA.setBackColor (Valor const: tcolor);
começar
Fedit.backColor: = value;
fim;
procedimento TSELECTDA.SETCOLORONDER (Valor const: tcolor);
começar
Fedit.coloroneder: = value;
fim;
Construtor TSELECTDA.CREATE (AOWNER: TCOMPONENT);
começar
Criar Herited (AOWNER);
Largura: = 188;
Altura: = 20;
Fcaption: = '' ';
FBMText: = '';
FZJText: = '';
FMCText: = '';
Freadonly: = false;
Fhalignment: = Taleftjustify;
Fvalignamento: = 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.Ender: = 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;
fim;
procedimento TSELECTDA.PAINT;
var
ATEXT: PCHAR;
arect: Trect;
Sinalizador: dword;
começar
com tela
começar
Fonte: = ffont;
Caneta: = fpen;
Pincel: = fbrush;
FILLRECT (ClientRect);
se fbmtext <> '' então atext: = pchar (fcaption+'['+fbmText+']) else ATEXT: = pchar (fcaption);
arect: = ret (clientrect.left+fpen.width, clientrect.top+fpen.width, clientrect.right-fpen.width, clientrect.bottom-fpen.width);
DrawText (alça, atext, strlen (atext), arect, (dt_singleline ou dt_vcenter) ou dt_left);
Inc (arect.left, textwidth (atext));
Dez (arect.right, fbutton.width);
Moveto (arect.left, arect.bottom);
Lineto (arect.right, arect.bottom);
Inc (arect.left, fpen.width);
Se freadonly, então
começar
Fedit.Visible: = false;
Fbutton.Visible: = false;
Sinalizador: = dt_singLeline;
Caso Fhalignment of
Taleftjustify: sinalizador: = sinalizador ou dt_left;
Tarightjustify: sinalizador: = sinalizador ou dt_right;
Tacenter: sinalizador: = sinalizador ou dt_center;
bandeira else: = sinalizador ou dt_left;
fim;
Caso Fvalignamento de
TVATOPJustify: sinalizador: = sinalizador ou dt_top;
TVACenter: sinalizador: = sinalizador ou dt_vcenter;
TVABOTTOMJUSTIFY: sinalizador: = sinalizador ou dt_bottom;
bandeira else: = sinalizador ou dt_bottom;
fim;
Fonte: = feditFont;
Caso fdatatype de
Sdstring: drawtext (alça, pchar (asstr), strlen (pchar (asstr)), arect, sinalizador);
Sdinteger: drawtext (alça, pchar (asint), strlen (pchar (asint)), arect, sinalizador);
Sdfloat: drawtext (alça, pchar (asfloat), strlen (pchar (asfloat)), arect, sinalizador);
Sdmoney: drawtext (alça, pchar (asmoney), strlen (pchar (asmoney)), arect, sinalizador);
fim;
fim
outro
começar
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 Fvalignamento 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;
fim;
Fbutton.left: = arect.right;
Fbutton.top:=arect.top;
Fbutton.Height: = arect.bottom-arect.top;
if (fdatatype = sdstring) e (fbmfield <> '') e (fmcfield <> '') e (ftableName <> '') então fbutton.visible: = true
else fbutton.Visible: = false;
fim;
fim;
fim;
Destrutor TSELECTDA.Destroy;
começar
Fpen.Free;
Fbrush.free;
Ffont.Free;
Feditfont.free;
se atribuído (fedit), então Freeandnil (Fedit);
se atribuído (fbutton), então Freeandnil (FButton);
Destrução herdada;
fim;
procedimento TSELECTDA.Doclick (remetente: TOBJECT);
começar
se atribuído (fonclick), então foneClick (self);
fim;
procedimento TSELECTDA.DOENTER (remetente: TOBJECT);
começar
se atribuído (Fenter), então Foneser (self);
fim;
procedimento TSELECTDA.DOEXIT (remetente: TObject);
começar
se atribuído (fonexit) então fonexit (self);
fim;
procedimento TSELECTDA.DOKEYPRESS (remetente: TOBJECT; VAR Tecla: CHAR);
começar
se atribuído (fonkeypress), o fonkeypress (self, chave);
fim;
registro de procedimentos;
começar
RegisterComponents ('swlmsoft', [tSelectda]);
fim;
fim.