home *** CD-ROM | disk | FTP | other *** search
/ Turbo Toolbox / Turbo_Toolbox.iso / 1991 / 09_10 / tpw / littgdi4.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1991-06-12  |  3.0 KB  |  99 lines
  1. (* ------------------------------------------------------ *)
  2. (*                     LITTGDI4.PAS                       *)
  3. (*               kleine GDI-Demonstration                 *)
  4. (*         (c) 1991 Andreas Schallmeier & TOOLBOX         *)
  5. (* ------------------------------------------------------ *)
  6. PROGRAM LittleGDI;
  7.  
  8. {$X+}
  9.  
  10. USES WinTypes, WinProcs, Strings, WObjects;
  11.  
  12. TYPE
  13.   pGDIFenster = ^tGDIFenster;
  14.   tGDIFenster = OBJECT(tWindow)
  15.     PROCEDURE WMLButtonDown(VAR Msg : tMessage);
  16.       VIRTUAL wm_First+wm_LButtonDown;
  17.     PROCEDURE WMRButtonDown(VAR Msg : tMessage);
  18.       VIRTUAL wm_First+wm_RButtonDown;
  19.   END;
  20.  
  21.   tMyApp = OBJECT(tApplication)
  22.     PROCEDURE InitMainWindow;  VIRTUAL;
  23.   END;
  24.  
  25. VAR
  26.   MyApp : tMyApp;
  27.  
  28.   PROCEDURE tMyApp.InitMainWindow;
  29.   BEGIN
  30.     MainWindow := New(pGDIFenster, Init(NIL,'GDI Fenster'));
  31.   END;
  32.  
  33. (* ------------------------------------------------------ *)
  34. (*                     Listing 4                          *)
  35. (* ------------------------------------------------------ *)
  36.  
  37.   PROCEDURE TGDIFenster.WMLButtonDown(VAR Msg : tMessage);
  38.   VAR
  39.     EinDC            : hDC ;
  40.     R                : tRect ;
  41.     x, y             : INTEGER ;
  42.     i                : WORD ;
  43.     MyString         : ARRAY [0..20] OF CHAR;
  44.     OldFont, NewFont : hFont ;
  45.     aLogFont         : tLogFont ;
  46.   BEGIN
  47.     FOR i := 0 TO 199 DO BEGIN
  48.       EinDC := GetDC(hWindow);
  49.       GetClientRect(hWindow, R);
  50.       WITH aLogFont DO BEGIN
  51.         lfHeight         := Random(30);
  52.         lfWidth          := Random(30);
  53.         lfEscapement     := 0;
  54.         lfOrientation    := 0;
  55.         lfWeight         := fw_Bold;
  56.         lfItalic         := 0;
  57.         lfUnderline      := 0;
  58.         lfStrikeOut      := 0;
  59.         lfCharSet        := ANSI_CharSet;
  60.         lfOutPrecision   := Out_Default_Precis;
  61.         lfClipPrecision  := Clip_Default_Precis;
  62.         lfQuality        := Default_Quality;
  63.         lfPitchAndFamily := Variable_Pitch OR ff_Swiss;
  64.         StrCopy(@lfFaceName, 'Helv');
  65.       END;
  66.       NewFont := CreateFontIndirect(ALogFont);
  67.       OldFont := SelectObject(EinDC, NewFont);
  68.       x := Random(R.Right);
  69.       y := Random(R.Bottom);
  70.       StrCopy(MyString, 'Windows, saustark !');
  71.       SetTextColor(EinDC,
  72.             RGB(Random(256), Random(256), Random(256)));
  73.       SetBkColor(EinDC,
  74.             RGB(Random(256), Random(256), Random(256)));
  75.       TextOut(EinDC, x, y, MyString, StrLen(MyString));
  76.       SelectObject(EinDC, OldFont) ;
  77.       ReleaseDC(hWindow, EinDC);
  78.       DeleteObject(NewFont);
  79.     END;
  80.   END;
  81.  
  82. (* ------------------------------------------------------ *)
  83. (*                   Ende von Listing 4                   *)
  84.  
  85.   PROCEDURE tGDIFenster.WMRButtonDown(VAR Msg : tMessage);
  86.   BEGIN
  87.     InvalidateRect(hWindow, NIL, TRUE);
  88.   END;
  89.  
  90. BEGIN
  91.   MyApp.Init('MyApp');
  92.   MyApp.Run;
  93.   MyApp.Done;
  94. END.
  95. (* ------------------------------------------------------ *)
  96. (*                Ende von LITTGDI4.PAS                   *)
  97.  
  98.  
  99.