home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / pascal / das_buch / windows / gdi / textout2.pas < prev   
Encoding:
Pascal/Delphi Source File  |  1993-06-04  |  2.7 KB  |  104 lines
  1. PROGRAM LittleGDI;
  2.  
  3. {$X+}
  4. USES WinTypes, WinProcs, Strings, WObjects;
  5.  
  6. TYPE
  7.   pGDIFenster = ^tGDIFenster;
  8.   tGDIFenster = OBJECT (tWindow)
  9.     PROCEDURE WMLButtonDown (VAR Msg: tMessage); VIRTUAL wm_First + wm_LButtonDown;
  10.     PROCEDURE WMRButtonDown (VAR Msg: tMessage); VIRTUAL wm_First + wm_RButtonDown;
  11.   END;
  12.  
  13.   tMyApp = OBJECT (tApplication)
  14.     PROCEDURE InitMainWindow; VIRTUAL;
  15.   END;
  16.  
  17. VAR
  18.   MyApp: tMyApp;
  19.  
  20. PROCEDURE tMyApp.InitMainWindow;
  21. BEGIN
  22.   MainWindow := New (pGDIFenster, Init(NIL, 'GDI Fenster mit Font und TextOut (special Guest: SetBkColor)'));
  23. END;
  24.  
  25. (*  Original : *)
  26. (*
  27. PROCEDURE TGDIFenster.WMLButtonDown (VAR Msg: TMessage);
  28. VAR
  29.   EinDC: HDC;
  30.   R: TRect;
  31.   i: WORD;
  32.   OldPen, NewPen: HPen;
  33. BEGIN
  34.   FOR i := 0 TO 199 DO
  35.   BEGIN
  36.     EinDC := GetDC (HWindow);
  37.     GetClientRect (HWindow, R);
  38.     NewPen := CreatePen (ps_Solid, Random(10), RGB(Random(256), Random(256), Random(256)));
  39.     OldPen := SelectObject(EinDC, NewPen);
  40.     MoveTo (EinDC, Random(R.Right), Random(R.Bottom));
  41.     LineTo (EinDC, Random(R.Right), Random(R.Bottom));
  42.     SelectObject (EinDC, OldPen);
  43.     ReleaseDC (HWindow, EinDC);
  44.     DeleteObject (NewPen);
  45.   END;
  46. END;
  47. *)
  48.  
  49. PROCEDURE tGDIFenster.WMLButtonDown (VAR Msg: tMessage);
  50. VAR
  51.   EinDC: hDC;
  52.   R: tRect;
  53.   x,y: INTEGER;
  54.   i: WORD;
  55.   MyString: ARRAY [0..20] OF CHAR;
  56.   OldFont, NewFont: hFont;
  57.   ALogFont: tLogFont;
  58. BEGIN
  59.   FOR i := 0 TO 199 DO
  60.   BEGIN
  61.     EinDC := GetDC (hWindow);
  62.     GetClientRect (hWindow, R);
  63.     WITH ALogFont DO
  64.     BEGIN
  65.       lfHeight := Random(30);   (* H÷he der Zeichen *)
  66.       lfWidth := Random(30);    (* Breite der Zeichen *)
  67.       lfEscapement := 0;
  68.       lfOrientation := 0;
  69.       lfWeight := fw_Bold;
  70.       lfItalic := 0;
  71.       lfUnderline := 0;
  72.       lfStrikeOut := 0;
  73.       lfCharSet := ANSI_CharSet;
  74.       lfOutPrecision := out_Default_Precis;
  75.       lfClipPrecision:= clip_Default_Precis;
  76.       lfQuality := Default_Quality;
  77.       lfPitchAndFamily := Variable_Pitch OR ff_Swiss;
  78.       StrCopy (@lfFaceName, 'Helv');
  79.     END;
  80.     NewFont := CreateFontIndirect (ALogFont);
  81.     OldFont := SelectObject (EinDC, NewFont);
  82.     x := Random(R.Right);
  83.     y := Random(R.Bottom);
  84.     StrCopy (MyString, 'Windows, saustark !');
  85.     SetTextColor (EinDC, RGB(Random(256),Random(256),Random(256)));
  86.     SetBkColor (EinDC, RGB(Random(256),Random(256),Random(256)));
  87.     TextOut (EinDC, x, y, MyString, StrLen(MyString));
  88.     SelectObject (EinDC, OldFont);
  89.     ReleaseDC (hWindow, EinDC);
  90.     DeleteObject (NewFont);
  91.   END;
  92. END;
  93.  
  94. PROCEDURE tGDIFenster.WMRButtonDown (VAR Msg: tMessage);
  95. BEGIN
  96.   InvalidateRect (hWindow, NIL, TRUE);
  97. END;
  98.  
  99. BEGIN
  100.   MyApp.Init ('MyApp');
  101.   MyApp.Run;
  102.   MyApp.Done;
  103. END.
  104.