home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / pascal / das_buch / windows / gdi / textout.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1993-06-04  |  2.5 KB  |  103 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'));
  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.  
  50. PROCEDURE tGDIFenster.WMLButtonDown (VAR Msg: tMessage);
  51. VAR
  52.   EinDC: hDC;
  53.   R: tRect;
  54.   x,y: INTEGER;
  55.   i: WORD;
  56.   MyString: ARRAY [0..20] OF CHAR;
  57.   OldFont, NewFont: hFont;
  58.   ALogFont: tLogFont;
  59. BEGIN
  60.   FOR i := 0 TO 99 DO
  61.   BEGIN
  62.     EinDC := GetDC (hWindow);
  63.     GetClientRect (hWindow, R);
  64.     WITH ALogFont DO
  65.     BEGIN
  66.       lfHeight := 10;   (* H÷he der Zeichen *)
  67.       lfWidth := 6;    (* Breite der Zeichen *)
  68.       lfEscapement := 0;
  69.       lfOrientation := 0;
  70.       lfWeight := fw_Bold;
  71.       lfItalic := 0;
  72.       lfUnderline := 0;
  73.       lfStrikeOut := 0;
  74.       lfCharSet := ANSI_CharSet;
  75.       lfOutPrecision := out_Default_Precis;
  76.       lfClipPrecision:= clip_Default_Precis;
  77.       lfQuality := Default_Quality;
  78.       lfPitchAndFamily := Fixed_Pitch OR ff_Swiss;
  79.       (* StrCopy (@lfFaceName, 'Helv'); *)
  80.     END;
  81.     NewFont := CreateFontIndirect (ALogFont);
  82.     OldFont := SelectObject (EinDC, NewFont);
  83.     x := Random(R.Right);
  84.     y := Random(R.Bottom);
  85.     StrCopy (MyString, 'Windows, saustark !');
  86.     TextOut (EinDC, x, y, MyString, StrLen(MyString));
  87.     SelectObject (EinDC, OldFont);
  88.     ReleaseDC (hWindow, EinDC);
  89.     DeleteObject (NewFont);
  90.   END;
  91. END;
  92.  
  93. PROCEDURE tGDIFenster.WMRButtonDown (VAR Msg: tMessage);
  94. BEGIN
  95.   InvalidateRect (hWindow, NIL, TRUE);
  96. END;
  97.  
  98. BEGIN
  99.   MyApp.Init ('MyApp');
  100.   MyApp.Run;
  101.   MyApp.Done;
  102. END.
  103.