Delphi Control Production Skills [1]

Autor：Eve Cole Aktualisierungszeit：2025-03-10 08:48:01

Einheit USWLMSelectda;

{$ S-, w-, r-}

{$ C Preload}

Schnittstelle

Verwendung

Windows, Nachrichten, Systeme, Typen, Klassen, Grafiken, Steuerelemente, STDCtrls, Formulare,

Strutils, Math, Adodb, TflatButtonunit, USWLMStyleedit;

Typ

TeditDatatype = (SDString, SDInteger, Sdfloat, SDMoney);

TVALLIGNMENT = (TVatOpjustify, TVAcenter, TVABOTTOMJUFIFIGY);

Tdatastyle = (dsbm, dszj, dsmc);

Typ

Tselectda = Klasse (tcustomcontrol)

Privat

Fpen: tpen;

Fbrush: tbrush;

Ffont: tfont;

FCaption: String;

Fbmtext: String;

Fzjtext: String;

FmcText: String;

Fdatatype: TeditDatatype;

FPRECISION: Ganzzahl;

Freadonly: Boolean;

Feditfont: tfont;

Fhalignierung: Talignment;

Fvalignment: tvalignment;

Fedit: TStyleedit;

Fbutton: TflatButton;

FtitLename: String;

FtableName: String;

Fdatastyle: tdatastyle;

Fbmfield: String;

Fzjfield: String;

Fmcfield: String;

Fonclick: tnotifyEvent;

Fonenter: tnotifyEvent;

Fonexit: tnotifyEvent;

Fonkeypress: TkeypressEvent;

Prozedur -SetPen (const value: tpen);

Prozedur setBrush (const value: tbrush);

Prozedur setFont (const value: tfont);

Prozedur setCaption (const value: String);

procedure setBmtext (const value: string);

procedure detzjtext (const value: string);

procedure setMcText (const value: string);

Prozedur setDatatype (const -Wert: TeditDatatype);

Prozedur SetPrecision (const -Wert: Integer);

Verfahren setReadonly (const value: boolean);

Prozedur SETEDITFONT (const value: tfont);

Verfahren Sethalignment (Const Value: Talignment);

Verfahrens -SetValignment (const -Wert: TV -Alignment);

Verfahrensabbau (const Value: String);

Verfahren settableName (const value: String);

Prozedur setDatastyle (const value: tdatastyle);

procedure setBmfield (const value: String);

Prozedur SETZJFIELD (const value: String);

Prozedur setMcfield (const value: String);

Funktion getasfloat (): String;

Funktion getasasoney (): String;

Funktion getaSinteger (): String;

Funktion Getastext (): String;

Prozedur setAsfloat (const value: String);

Prozedur SetasMoney (const Value: String);

Procedure SetaSinterger (const Value: String);

procedure setAtext (const value: string);

procedure stylechanged (sender: tobject);

Prozedur SetBackColor (const value: tcolor);

Prozedur SetColoronenter (const value: tcolor);

Prozedur Doclick (Absender: Tobject);

Prozedur Doenter (Absender: Tobject);

Prozedur doexit (Absender: Tobject);

PROCEDURE DOYYPRESS (Absender: Tobject; var key: char);

geschützt

Verfahrensfarbe; überschreiben;

öffentlich

Konstruktor create (aowner: tcomponent); überschreiben;

Zerstörer zerstören; überschreiben;

veröffentlicht

Property Pen: TPEN Read Fpen Write SetPen;

Immobilienbürste: TBRUSH Read fbrush write setBrush;

Eigenschaft Schriftart: TFONT LESE FFONT SETFONT;

Eigenschaftsunterschrift: String Read fCaption write setCaption;

Eigenschaft BM: String lesen fbmtext write setBmtext;

Eigenschaft ZJF: String lesen Fzjtext schreiben SETZJTEXT;

Eigenschaft MC: String lesen fmcText write setMcText;

Eigenschaft Text: String lesen fmcText write setMcText;

Eigenschaft Datentyp: TeditDatatype lesen

Eigenschaft Präzision: Ganzzahl lesen fPrecision write setPrecision Standard 2;

Eigenschaft Readonly: Boolean lesen frei von SetReadonly Standard False;

Eigenschaft editfont: tfont lesen Feditfont Write Seteditfont;

Eigentumshalnment: Talignment Lesen Sie Fhalignment Schreiben Sie Sethalignment -Standard -Taleftjustify;

Eigentum Valignment: TVALLIGNMENT LESEN FVALGNMENT SETVALGENMENT STAG TVABOTTOM JUNIGY;

Eigenschaft Titlename: String lesen

Property TabLename: String lesen ftableName write settableName;

Eigenschaftsdatastyle: Tdatastyle Read fdatastyle write setDatastyle Standard DSBM;

Eigenschaft BMField: String Read fbmfield write setBmfield;

Eigenschaft ZJField: String lesen Fzjfield schreiben SETZJField;

Eigenschaft McField: String Read fmcfield write setMcfield;

Eigenschaft Asfloat: String Lesen Sie getasfloat {write setAsfloat};

Eigenschaft Asmoney: String Read GetasMoney {write setasmoney};

Eigenschaft AST: String Lesen Sie getaSinderer {write setaSinderer};

Eigenschaft ASSTR: String Lesen Sie GetAsxt schreiben setaStext;

Eigenschaft Onclick: TnotifyEvent lesen Fonclick Write Fonclick;

Immobilie Onkeypress: TkeypressEvent Read Fonkeypress Write Fonkeypress;

Eigenschaft ONENTER:

Eigenschaft Onexit: TnotifyEvent lesen Fonexit Write Fonexit;

Immobilien -Backcolor: TCOLOR Write SetBackColor;

Eigenschaft Coloronenter: TCOLOR Write setColoronenter;

Eigentum ausgerichtet;

Immobilien VisibledockClientCount;

Property ControlCount;

Eigentum parentwindow;

Eigentum anzeigen;

Eigenschaft Taborder;

Registerkarte Eigenschaft;

Ende;

Verfahrensregister;

Durchführung

verwendet consts;

Prozedur tSelectda.setPen (const value: tpen);

beginnen

Fpen.ssign (Wert);

Ungültig;

Ende;

Prozedur tSelectda.setBrush (const value: tbrush);

beginnen

FBrush.Sign (Wert);

Ungültig;

Ende;

Prozedur tSelectda.setFont (const value: tfont);

beginnen

Ffont.assisign (Wert);

Ungültig;

Ende;

Prozedur tSelectda.SetCaption (const value: String);

beginnen

Wenn fkaption <> Wert dann

beginnen

Fcaption: = Wert;

Ungültig;

Ende;

procedure tselectda.setbmtext (const value: string);

beginnen

Wenn fbmtext <> Wert dann dann

beginnen

Fbmtext: = Wert;

Ungültig;

Ende;

procedure tselectda.setzjtext (const value: string);

beginnen

Wenn fzjtext <> Wert dann dann

beginnen

Fzjtext: = Wert;

Ende;

procedure tselectda.setMcText (const value: string);

beginnen

Wenn fmcText <> Wert dann dann

beginnen

FmcText: = Wert;

Ungültig;

Ende;

Verfahren tselectda.setReadonly (const value: boolean);

beginnen

Wenn Sie frei von <> Wert sind, dann

beginnen

Frei: = Wert;

Ungültig;

Ende;

Prozedur tSelectda.SetEditfONT (const value: tfont);

beginnen

Feditfont.Sign (Wert);

Ungültig;

Ende;

Prozedur Telectda.setPrecision (const value: Integer);

beginnen

Wenn fPrecision <> Wert dann

beginnen

Fallwert von

1..6: fPrecision: = Wert;

sonst fprecision: = 2;

Ende;

Ungültig;

Ende;

Prozedur tSelectda.setDatatype (const -Wert: TeditDatatype);

beginnen

Wenn fDatatype <> Wert dann

beginnen

Fdatatype: = Wert;

Fall fdatatype von

Sdstring: fedit.inputStyle: = isstring;

SDInteger: Fedit.InputStyle: = Issinterer;

Sdfloat: fedit.inputStyle: = isfloat;

Sdmoney: fedit.inputStyle: = ismoney;

sonst fedit.inputStyle: = isstring;

Ende;

Ungültig;

Ende;

Verfahren tselectda.sethalignment (Const Value: Talignment);

beginnen

Wenn fhalignment <> Wert dann

beginnen

Fhalignment: = Wert;

Ungültig;

Ende;

Verfahren tselectda.setValignment (const value: tvalignment);

beginnen

Wenn fvalignment <> Wert dann

beginnen

Fvalignment: = Wert;

Ungültig;

Ende;

Prozedur tSelectda.settitLename (const value: String);

beginnen

Wenn ftitLename <> Wert ist, dann ftitLename: = Wert;

Ende;

Prozedur tSelectda.settableName (const value: String);

beginnen

Wenn ftableName <> Wert dann

beginnen

FtableName: = Wert;

Ungültig;

Ende;

Verfahren tselectda.setDatastyle (const value: tdatastyle);

beginnen

Wenn fdatastyle <> Wert ist, dann fdatastyle: = Wert;

Ende;

Prozedur tSelectda.setbmfield (const value: String);

beginnen

Wenn fbmfield <> Wert dann

beginnen

Fbmfield: = Wert;

Ungültig;

Ende;

Prozedur tselectda.setzjfield (const value: String);

beginnen

Wenn fzjfield <> Wert ist, dann fzjfield: = Wert;

Ende;

Prozedur tSelectda.setMcfield (const value: String);

beginnen

Wenn fmcfield <> Wert dann

beginnen

Fmcfield: = Wert;

Ungültig;

Ende;

Funktion tselectda.getasfloat: String;

Funktion Strtodouble (s: String): doppelt;

beginnen

Wenn nicht Trystrtofloat (s, Ergebnis), dann Ergebnis: = 0;

Ende;

beginnen

Fall frecision of

1..6: Ergebnis: = formatfloat ('### 0.'+Dupestring ('0', fPrecision), Strtodouble (fmctext));

sonst Ergebnis: = formatfloat ('### 0,00', strtodouble (fmctext));

Ende;

Funktion tselectda.getasmoney: String;

Funktion Strtodouble (s: String): doppelt;

beginnen

Wenn nicht Trystrtofloat (s, Ergebnis), dann Ergebnis: = 0;

Ende;

beginnen

Ergebnis: = formatfloat ('### 0,00', strtodouble (fmctext));

Ende;

Funktion tselectda.getaSinterer: String;

Funktion Strtointeger (s: String): Ganzzahl;

beginnen

Wenn nicht Trystrtoint (s, Ergebnis), dann Ergebnis: = 0;

Ende;

beginnen

Ergebnis: = inttoStr (strtointeger (fmcText));

Ende;

Funktion tselectda.getastext: String;

beginnen

Ergebnis: = fmcText;

Ende;

Prozedur tSelectda.setasfloat (const value: String);

Funktion Strtodouble (s: String): doppelt;

beginnen

Wenn nicht Trystrtofloat (s, Ergebnis), dann Ergebnis: = 0;

Ende;

var

F: Double;

beginnen

f: = strtodouble (Wert);

Fall frecision of

1..6:

beginnen

f: = rundo (f, -frecision);

SetMcText (formatfloat ('### 0.'+Dupestring ('0', fPrecision), f));

Ende

anders

beginnen

f: = rundo (f, -2);

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

Ende;

Prozedur tSelectda.Setasmoney (const value: String);

Funktion Strtodouble (s: String): doppelt;

beginnen

Wenn nicht Trystrtofloat (s, Ergebnis), dann Ergebnis: = 0;

Ende;

var

F: Double;

beginnen

f: = strtodouble (Wert);

f: = rundo (f, -2);

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

Ende;

Prozedur tSelectda.SetaSinterger (const value: String);

Funktion Strtointeger (s: String): Ganzzahl;

beginnen

Wenn nicht Trystrtoint (s, Ergebnis), dann Ergebnis: = 0;

Ende;

var

I: Ganzzahl;

beginnen

i: = strtointeger (Wert);

SetMcText (inttoStr (i));

Ende;

procedure tselectda.Setastext (const value: String);

beginnen

SetMcText (Wert);

Ende;

Verfahren tSelectda.Stylechanged (Absender: Tobject);

beginnen

Ungültig;

Ende;

Prozedur tSelectda.SetbackColor (const value: tcolor);

beginnen

Fedit.backColor: = Wert;

Ende;

Verfahren tselectda.setColoronenter (const value: tcolor);

beginnen

Fedit.Coloronenter: = Wert;

Ende;

Konstruktor Tselectda.Create (Aowner: tcomponent);

beginnen

ererbte erstellen (aowner);

Breite: = 188;

Höhe: = 20;

FCaption: = '未命名';

Fbmtext: = '';

Fzjtext: = '';

FmcText: = '';

Frei: = falsch;

Fhalignment: = taleftjustify;

Fvalignment: = TVABOTTOM JUNIGY;

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.borderSyle: = 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;

Ende;

Verfahren tselectda.paint;

var

Attext: pchar;

Arect: Trect;

Flagge: DWORD;

beginnen

mit Leinwand tun

beginnen

Schriftart: = ffont;

Stift: = Fpen;

Pinsel: = fBrush;

FillRect (ClientRect);

wenn fbmtext <> '', dann text: = pchar (fcaption+'['+fbmtext+']') else text: = pchar (fcaption);

ARECT: = RECT (clientRect.left+fpen.width, clientRect.top+fpen.width, clientRect.right-fpen.width, clientRect.bottom-fpen.width);

DrawText (Handle, Atentext, Strlen (Atetext), ARECT, (DT_SINGLELINE oder DT_VCENTER) oder DT_LEFT);

Inc (ARECT.LEFT, Textwidth (Atetext));

Dec (Arect.Right, fbutton.width);

MoveTo (ARECT.LEFT, ARECT.BOTTOM);

Lineto (ARECT.Right, ARECT.Bottom);

Inc (ARECT.LEFT, FPEN.WIDTH);

Wenn es frei ist, dann

beginnen

Fedit.vissible: = false;

Fbutton.vissible: = false;

Flag: = dt_singline;

Fallfhalignierung von

TALEFT JUNIGYS: Flag: = Flag oder DT_LEFT;

Tarightjustify: Flag: = Flag oder DT_Right;

Tacenter: Flag: = Flag oder DT_Center;

sonst Flag: = Flag oder DT_LEFT;

Ende;

Fall fvalignment von

tvatopjustify: flag: = flag oder dt_top;

tvacenter: flag: = flag oder dt_vcenter;

TVABOTTOMSTICIFIFY: Flag: = Flag oder DT_BOTTOM;

sonst Flag: = Flag oder DT_BOTTOM;

Ende;

Schriftart: = Feditfont;

Fall fdatatype von

SDString: DrawText (Handle, PChar (Asstr), Strlen (pchar (asstr)), tect, flag);

SDInteger: DrawText (Handle, pchar (AST), Strlen (pchar (AST)), Arect, Flag);

Sdfloat: DrawText (Handle, pchar (Asfloat), Strlen (pchar (Asfloat)), Arect, Flag);

SDMoney: DrawText (Handle, PChar (Asmoney), Strlen (pchar (Asmoney)), Arect, Flag);

Ende;

Ende

anders

beginnen

Fedit.Alignment: = Fhalignment;

Fedit.font: = feditfont;

Fedit.text: = fmcText;

Fedit.width: = reak.right-actect.left;

Fedit.height: = min (max (max (textheight (fmctext), textheight (fcaption)), reap.bottom-actop.top);

Fedit.Left: = arect.left;

Fall fvalignment von

tvatopjustify: fedit.top: = arect.top;

tvacenter: fedit.top: = arect.top+(ARECT.Bottom-Arect.top-Fedit.Height) Div 2;

TVABOTTOMJUSTIFIGY: FEDIT.TOP: = ARECT.TOP+(ARECT.BOTTOM-ARECT.TOP-FEDIT.HELTY);

sonst fedit.top:=Arect.top;

Ende;

Fbutton.left: = reak.right;

Fbutton.top:=Arect.top;

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

if (fdatatype = sdstring) und (fbmfield <> '') und (fmcfield <> '') und (ftableName <> '') dann fbutton.visible: = true

sonst fbutton.vissible: = false;

Ende;

Destruktor Tselectda.Destroy;

beginnen

Fpen.free;

Fbrush.free;

Ffont.free;

Feditfont.Free;

wenn zugewiesen (fedit) dann freeandnil (fedit);

wenn zugewiesen (fbutton), dann freeandnil (fbutton);

erbte Zerstörung;

Ende;

Prozedur tselectda.doclick (Absender: Tobject);

beginnen

wenn zugewiesen (fonclick) dann fonclick (self);

Ende;

Prozedur tselectda.doenter (Absender: tobject);

beginnen

wenn zugewiesen (fonenter) dann fonenter (self);

Ende;

Prozedur Telectda.doexit (Absender: Tobject);

beginnen

wenn zugewiesen (fonexit) dann fonexit (self);

Ende;

Prozedur tselectda.DokEYPress (Absender: tobject; var key: char);

beginnen

wenn zugewiesen (fonkeypress), dann fonkeypress (self, key);

Ende;

Verfahrensregister;

beginnen

RegisterComponents ('swlmsoft', [tselectda]);

Ende;

Ende.