1: 2: 3: 4: 5: 6: 7: 8: 9: 10: 11: 12: 13: 14: 15: 16: 17: 18: 19: 20: 21: 22: 23: 24: 25: 26: 27: 28: 29: 30: 31: 32: 33: 34: 35: 36: 37: 38: 39: 40: 41: 42: 43: 44: 45: 46: 47: 48: 49: 50: 51: 52: 53: 54: 55: 56: 57: 58: 59: 60: 61: 62: 63: 64: 65: 66: 67: 68: 69: 70: 71: 72: 73: 74: 75: 76: 77: 78: 79: 80: 81: 82: 83: 84: 85: 86: 87: 88: 89: 90: 91: 92: 93: 94: 95: 96: 97: 98: 99: 100: 101: 102: 103: 104: 105: 106: 107: 108: 109: 110: 111: 112: 113: 114: 115: 116: 117: 118: 119: 120: 121: 122: 123: 124: 125: 126: 127: 128: 129: 130: 131: 132: 133: 134: 135: 136: 137: 138: 139: 140: 141: 142: 143: 144: 145: 146: 147: 148: 149: 150: 151: 152: 153: 154: 155: 156: 157: 158: 159: 160: 161: 162: 163: 164: 165: 166: 167: 168: 169: 170: 171: 172: 173: 174: 175: 176: 177: 178: 179: 180: 181: 182: 183: 184: 185: 186: 187: 188: 189: 190: 191: 192: 193: 194: 195: 196: 197: 198: 199: 200: 201: 202: 203: 204: 205: 206: 207: 208: 209: 210: 211: 212: 213: 214: 215: 216: 217: 218: 219: 220: 221: 222: 223: 224: 225: 226: 227: 228: 229: 230: 231: 232: 233: 234: 235: 236: 237: 238: 239: 240: 241: 242: 243: 244: 245: 246: 247: 248: 249: 250: 251: 252: 253: 254: 255: 256: 257: 258: 259: 260: 261: 262: 263: 264: 265: 266: 267: 268: 269: 270: 271: 272: 273: 274: 275: 276: 277: 278: 279: 280: 281: 282: 283: 284: 285: 286: 287: 288: 289: 290: 291: 292: 293: 294: 295: 296: 297: 298: 299: 300: 301: 302: 303: 304: 305: 306: 307: 308: 309: 310: 311: 312: 313: 314: 315: 316: 317: 318: 319: 320: 321: 322: 323: 324: 325: 326: 327: 328: 329: 330: 331: 332: 333: 334: 335: 336: 337: 338: 339: 340: 341: 342: 343: 344: 345: 346: 347: 348: 349: 350: 351: 352: 353: 354: 355: 356: 357: 358: 359: 360: 361: 362: 363: 364: 365: 366: 367: 368: 369: 370: 371: 372: 373: 374: 375: 376: 377: 378: 379: 380: 381: 382: 383: 384: 385: 386: 387: 388: 389: 390: 391: 392: 393: 394: 395: 396: 397: 398: 399: 400: 401: 402: 403: 404: 405: 406: 407: 408: 409: 410: 411: 412: 413: 414: 415: 416: 417: 418: 419: 420: 421: 422: 423: 424: 425: 426: 427: 428: 429: 430: 431: 432: 433: 434: 435: 436: 437: 438: 439: 440: 441: 442: 443: 444: 445: 446: 447: 448: 449: 450: 451: 452: 453: 454: 455: 456: 457: 458: 459: 460: 461: 462: 463: 464: 465: 466: 467: 468: 469: 470: 471: 472: 473: 474: 475: 476: 477: 478: 479:
|
unit mKnopf;
interface
uses Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, mSuM;
type TKnopf = class(tButtonControl) private
FFokusErhalten, FFokusVerloren, FGeklickt: tNotifyEvent; FDefault: Boolean; FCancel: Boolean; FActive: Boolean; FModalResult: TModalResult; procedure SetDefault(Value: Boolean); procedure CMDialogKey(var Message: TCMDialogKey); message CM_DIALOGKEY; procedure CMDialogChar(var Message: TCMDialogChar); message CM_DIALOGCHAR; procedure CMFocusChanged(var Message: TCMFocusChanged); message CM_FOCUSCHANGED; procedure CNCommand(var Message: TWMCommand); message CN_COMMAND; procedure WMEraseBkgnd(var Message: TWMEraseBkgnd); message WM_ERASEBKGND; protected procedure CreateParams(var Params: TCreateParams); override; procedure CreateWnd; override; procedure SetKnopfStyle(ADefault: Boolean); virtual;
constructor Create(AOwner: TComponent); override; procedure Click; override; function UseRightToLeftAlignment: Boolean; override;
property Action; property Anchors; property BiDiMode; property Cancel: Boolean read FCancel write FCancel default False; property Caption; property Constraints; property Default: Boolean read FDefault write SetDefault default False; property DragCursor; property DragKind; property DragMode; property Enabled; property ModalResult: TModalResult read FModalResult write FModalResult default 0; property ParentBiDiMode; property ParentFont; property ParentShowHint; property PopupMenu; property ShowHint; property TabOrder; property TabStop default True; property Visible; property OnClick; property OnDragDrop; property OnDragOver; property OnEndDock; property OnEndDrag; property OnEnter; property OnExit; property OnKeyDown; property OnKeyPress; property OnKeyUp; property OnMouseDown; property OnMouseMove; property OnMouseUp; property OnStartDock; property OnStartDrag;
procedure setzeZustand(pAktiv:Wahrheitswert); procedure setzeSichtbarkeit(pSichtbar:Wahrheitswert); procedure setzeText(pInhalt:Zeichenkette);
protected procedure doEnter; override; procedure doExit; override;
public
constructor init(pLinks,pOben, pBreite, pHoehe: Zahl); overload; constructor init(pLinks,pOben, pBreite, pHoehe: Zahl; pInhalt:Zeichenkette); overload;
procedure setzePosition(pLinks, pOben : Zahl); virtual; procedure setzeGroesse(pBreite, pHoehe : Zahl); virtual;
function links:Zahl; virtual; function oben:Zahl; virtual; function breite:Zahl; virtual; function hoehe:Zahl; virtual;
procedure verstecke; virtual; procedure zeige; virtual; function IstSichtbar:Wahrheitswert; virtual;
procedure aktiviere; virtual; procedure deaktiviere; virtual; function istAktiviert: Wahrheitswert; virtual;
procedure setzeFokus; virtual; function besitztFokus: Wahrheitswert; virtual;
procedure setzeInhalt(pInhalt:Zeichenkette); overload; virtual; procedure setzeInhalt(pInhalt:Zahl); overload; virtual;
function InhaltIstZeichenkette:Wahrheitswert; virtual; function InhaltIstZahl:Wahrheitswert; virtual; function InhaltIstGanzeZahl:Wahrheitswert; virtual;
function inhaltAlsText:Zeichenkette; virtual;
function inhaltAlsZahl:Zahl; virtual; function inhaltAlsGanzeZahl:GanzeZahl; virtual;
procedure setzeSchriftart(pArt:Zeichenkette); procedure setzeSchriftGroesse(pGroesse:GanzeZahl); procedure setzeSchriftFarbe(pFarbe:GanzeZahl); procedure setzeSchriftStil(pStil:GanzeZahl);
procedure gibFrei; virtual;
published
property _Inhalt: Zeichenkette read inhaltAlsText write setzeText; property _IstAktiviert : Wahrheitswert read istAktiviert write SetzeZustand; property _IstSichtbar : Wahrheitswert read IstSichtbar write SetzeSichtbarkeit; property font;
property Geklickt : tNotifyEvent read FGeklickt write FGeklickt; property FokusErhalten : tNotifyEvent read FFokusErhalten write FFokusErhalten; property FokusVerloren : tNotifyEvent read FFokusVerloren write FFokusVerloren;
end;
procedure Register;
implementation
constructor tKnopf.init(pLinks,pOben, pBreite, pHoehe: Zahl); begin inherited create(screen.activeForm); ControlStyle := [csSetCaption, csOpaque, csDoubleClicks]; TabStop := True; self.setzePosition(pLinks,pOben); self.setzeGroesse(pBreite,pHoehe); self.setzeText(''); self.parent:=screen.activeForm; end;
constructor tKnopf.init(pLinks,pOben, pBreite, pHoehe: Zahl; pInhalt:Zeichenkette); begin self.init(pLinks,pOben, pBreite, pHoehe); self.setzeInhalt(pInhalt); end;
procedure tKnopf.setzePosition(pLinks, pOben:Zahl); begin self.left:=round(pLinks); self.Top:=round(pOben); end;
procedure tKnopf.setzeGroesse(pBreite, pHoehe:Zahl); begin self.Width:=round(pBreite); self.Height:=round(pHoehe); end;
function tKnopf.links:Zahl; begin result:=self.left end;
function tKnopf.oben:Zahl; begin result:=self.top; end;
function tKnopf.breite:Zahl; begin result:=self.width; end;
function tKnopf.hoehe:Zahl; begin result:=self.height; end;
procedure tKnopf.verstecke; begin self.visible:=false; end;
procedure tKnopf.zeige; begin self.visible:=true; end;
function tKnopf.IstSichtbar:Wahrheitswert; begin result:=self.visible; end;
procedure tKnopf.aktiviere; begin self.enabled:=true; end;
procedure tKnopf.deaktiviere; begin self.enabled:=false; end;
function tKnopf.istAktiviert: Wahrheitswert; begin result:=self.enabled; end;
procedure tKnopf.setzeFokus; begin screen.ActiveForm.FocusControl(self); end;
function tKnopf.besitztFokus: Wahrheitswert; begin result:=self.focused; end;
procedure tKnopf.setzeText(pInhalt:Zeichenkette); begin self.caption:=pInhalt; end;
procedure tKnopf.setzeInhalt(pInhalt:Zeichenkette); begin self.caption:=pInhalt; end;
procedure tKnopf.setzeInhalt(pInhalt:Zahl); begin self.setzeText(floatToStr(pInhalt)); end;
function tKnopf.InhaltIstZeichenkette:Wahrheitswert; begin result:=true; end;
function tKnopf.InhaltIstZahl:Wahrheitswert; var lWert: Zahl; lcode : integer; begin val(self.inhaltAlsText,lWert,lCode); result:=(lcode=0); end;
function tKnopf.InhaltIstGanzeZahl:Wahrheitswert; var lWert: GanzeZahl; code : integer; begin val(self.inhaltAlsText,lWert,Code); result:=(code=0); end;
function tKnopf.InhaltAlsText:Zeichenkette; begin result := self.caption; end;
function tKnopf.inhaltAlsZahl:Zahl; begin if self.InhaltistZahl then result:=strTofloat(self.inhaltAlsText) else begin MessageDlg('Eingabe keine Zahl.',mtError,[mbOK],0); result:=0; end; end;
function tKnopf.inhaltAlsGanzeZahl:GanzeZahl; begin if self.InhaltIstGanzeZahl then result:=strToInt(self.inhaltAlsText) else begin MessageDlg('Eingabe keine ganze Zahl.',mtError,[mbOK],0); result:=0; end; end;
procedure tKnopf.setzeSchriftart(pArt:Zeichenkette); begin self.Font.Name:=pArt; end;
procedure tKnopf.setzeSchriftGroesse(pGroesse:GanzeZahl); begin self.Font.size:=pGroesse; end;
procedure tKnopf.setzeSchriftFarbe(pFarbe:GanzeZahl); begin self.Font.Color:=SuMfarbumrechnung(pFarbe); end;
procedure tKnopf.setzeSchriftStil(pStil:GanzeZahl); begin self.Font.Style:=SuMstilumrechnung(pStil); end;
procedure tKnopf.gibFrei; begin self.destroy; end;
procedure tKnopf.setzeZustand(pAktiv:Wahrheitswert); begin self.enabled:=pAktiv; end;
procedure tKnopf.setzeSichtbarkeit(pSichtbar:Wahrheitswert); begin self.visible:=pSichtbar; end;
procedure tKnopf.doEnter; begin if assigned(FokusErhalten) then FokusErhalten(self); inherited doEnter; end;
procedure tKnopf.doExit; begin if assigned(FokusVerloren) then FokusVerloren(self); inherited doExit; end;
procedure tKnopf.Click; var Form: TCustomForm; begin Form := GetParentForm(Self); if Form <> nil then Form.ModalResult := ModalResult; if Assigned(FGeklickt) then FGeklickt(Self); inherited Click; end;
procedure Register; begin RegisterComponents('Schule', [TKnopf]); end;
constructor tKnopf.Create(AOwner: TComponent); begin inherited Create(AOwner); ControlStyle := [csSetCaption, csOpaque, csDoubleClicks]; Width := 75; Height := 25; TabStop := True; end;
function tKnopf.UseRightToLeftAlignment: Boolean; begin Result := False; end;
procedure tKnopf.SetKnopfStyle(ADefault: Boolean); const BS_MASK = $000F; var Style: Word; begin if HandleAllocated then begin if ADefault then Style := BS_DEFPUSHBUTTON else Style := BS_PUSHBUTTON; if GetWindowLong(Handle, GWL_STYLE) and BS_MASK <> Style then SendMessage(Handle, BM_SETSTYLE, Style, 1); end; end;
procedure tKnopf.SetDefault(Value: Boolean); var Form: TCustomForm; begin FDefault := Value; if HandleAllocated then begin Form := GetParentForm(Self); if Form <> nil then Form.Perform(CM_FOCUSCHANGED, 0, Longint(Form.ActiveControl)); end; end;
procedure tKnopf.CreateParams(var Params: TCreateParams); const ButtonStyles: array[Boolean] of DWORD = (BS_PUSHBUTTON, BS_DEFPUSHBUTTON); begin inherited CreateParams(Params); CreateSubClass(Params, 'BUTTON'); Params.Style := Params.Style or ButtonStyles[FDefault]; end;
procedure tKnopf.CreateWnd; begin inherited CreateWnd; FActive := FDefault; end;
procedure tKnopf.CNCommand(var Message: TWMCommand); begin if Message.NotifyCode = BN_CLICKED then Click; end;
procedure tKnopf.CMDialogKey(var Message: TCMDialogKey); begin with Message do if (((CharCode = VK_RETURN) and FActive) or ((CharCode = VK_ESCAPE) and FCancel)) and (KeyDataToShiftState(Message.KeyData) = []) and CanFocus then begin Click; Result := 1; end else inherited; end;
procedure tKnopf.CMDialogChar(var Message: TCMDialogChar); begin with Message do if IsAccel(CharCode, Caption) and CanFocus then begin Click; Result := 1; end else inherited; end;
procedure tKnopf.CMFocusChanged(var Message: TCMFocusChanged); begin with Message do if Sender is tKnopf then FActive := Sender = Self else FActive := FDefault; SetKnopfStyle(FActive); inherited; end;
procedure tKnopf.WMEraseBkgnd(var Message: TWMEraseBkgnd); begin DefaultHandler(Message); end;
end. |