home *** CD-ROM | disk | FTP | other *** search
/ Prima Shareware 3 / DuCom_Prima-Shareware-3_cd1.bin / PROGRAMO / PASCAL / PERCENT / TESTIT.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1991-11-07  |  7.7 KB  |  242 lines
  1. {$R Testit.RES}
  2. program TestIt;
  3.   Uses CtlDLLImport, Strings, WinTypes, WinProcs, WObjectB;
  4.  
  5. const
  6.   ID_VERSION      = 101;
  7.   ID_CTLTYPES     = 102;
  8.   ID_TITLE        = 103;
  9.   ID_CTLTYPESLIST = 104;
  10.  
  11.   Tab             = chr(9);
  12.  
  13.   type
  14.     PInfoDialog   = ^InfoDialog;
  15.     PTestItWindow = ^TestItWindow;
  16.  
  17.     InfoDialog   = object (TDialog)
  18.                      Version ,
  19.                      NoTypes ,
  20.                      szTitle :  PStatic;
  21.                      TypeList:  PListBox;
  22.  
  23.                      constructor Init(AParent:  PWindowsObject;
  24.                                       AName  :  PChar);
  25.                      destructor  Done;                    virtual;
  26.                      procedure SetupWindow;                virtual;
  27.                    end;
  28.  
  29.     TestItApp    = object (TApplication)
  30.                      procedure InitMainWindow;  virtual;
  31.                    end;
  32.  
  33.     TestItWindow = object (TDlgWindow)
  34.                      PctCtrl :  HWnd;
  35.                      ExitBtn ,
  36.                      FlagBtn ,
  37.                      InfoBtn ,
  38.                      DecPBtn ,
  39.                      IncPBtn ,
  40.                      StyleBtn:  PButton;
  41.  
  42.                      destructor  Done;                    virtual;
  43.                      constructor Init(AParent:  PWindowsObject;
  44.                                       AName  :  PChar);
  45.                      procedure SetupWindow;                virtual;
  46.                      procedure ExitButton  (var Msg:  TMessage);    virtual id_First + 103;
  47.                      procedure FlagButton  (var Msg:  TMessage);    virtual id_First + 101;
  48.                      procedure InfoButton  (var Msg:  TMessage);    virtual id_First + 100;
  49.                      procedure DecPButton  (var Msg:  TMessage);    virtual id_First + 105;
  50.                      procedure IncPButton  (var Msg:  TMessage);    virtual id_First + 104;
  51.                      procedure StyleButton (var Msg:  TMessage);    virtual id_First + 102;
  52.                    end;
  53.  
  54.   var
  55.     hInfo ,
  56.     hStyle:  THandle;
  57.     Test  :  TestItApp;
  58.  
  59.   constructor InfoDialog.Init(AParent:  PWindowsObject; AName:  PChar);
  60.     begin    { InfoDialog.Init }
  61.       TDialog.Init(AParent, AName);
  62.       Version  := New(PStatic , InitResource(@self, ID_VERSION , 5));
  63.       NoTypes  := New(PStatic , InitResource(@self, ID_CTLTYPES, 5));
  64.       szTitle  := New(PStatic , InitResource(@self, ID_TITLE   , ctlTitle));
  65.       TypeList := New(PListBox, InitResource(@self, ID_CTLTYPESLIST))
  66.     end        { InfoDialog.Init };
  67.  
  68.   destructor InfoDialog.Done;
  69.     begin    { InfoDialog.Done }
  70.       dispose(Version , Done);
  71.       dispose(NoTypes , Done);
  72.       dispose(szTitle , Done);
  73.       dispose(TypeList, Done);
  74.       TDialog.Done
  75.     end        { InfoDialog.Done };
  76.  
  77.   procedure InfoDialog.SetupWindow;
  78.     var
  79.       i   :  integer;
  80.       Info:  PCtlInfo;
  81.       s   :  string[80];
  82.       t   :  array [0 .. 10] of char;
  83.       p   :  array [0 .. 80] of char;
  84.  
  85.     begin    { InfoDialog.SetupWindow }
  86.       TDialog.SetupWindow;
  87.       Info := GlobalLock(hInfo);
  88.       Str(Info^.wVersion:1, s);      StrPCopy(p, s);
  89.       Version^.SetText(p);
  90.       Str(Info^.wCtlTypes:1, s);     StrPCopy(p, s);
  91.       NoTypes^.SetText(p);
  92.       szTitle^.SetText(Info^.szTitle);
  93.       for i := 0 to CtlTypes - 1 do
  94.         begin
  95.           Str(i:2, s);
  96.           StrPCopy(p, s);
  97.           StrCat(p, Tab);
  98.           Str(Info^.ctType[i].wWidth:1, s);
  99.           StrPCopy(t, s);
  100.           StrCat(p, t);
  101.           StrCat(p, Tab);
  102.           Str(Info^.ctType[i].wHeight:1, s);
  103.           StrPCopy(t, s);
  104.           StrCat(p, t);
  105.           StrCat(p, Tab);
  106.           Str(Info^.ctType[i].dwStyle:1, s);
  107.           StrPCopy(t, s);
  108.           StrCat(p, t);
  109.           TypeList^.AddString(p)
  110.         end;
  111.       GlobalUnlock(hInfo)
  112.     end        { InfoDialog.SetupWindow };
  113.  
  114.   procedure TestItApp.InitMainWindow;
  115.     begin    { TestItApp.InitMainWindow }
  116.       MainWindow := New(PTestItWindow, Init(nil, 'TestIt'))
  117.     end        { TestItApp.InitMainWindow };
  118.  
  119.   destructor TestItWindow.Done;
  120.     begin    { TestItWindow.Done }
  121.       dispose(ExitBtn , Done);
  122.       dispose(FlagBtn , Done);
  123.       dispose(InfoBtn , Done);
  124.       dispose(DecPBtn , Done);
  125.       dispose(IncPBtn , Done);
  126.       dispose(StyleBtn, Done);
  127.       DestroyWindow(PctCtrl);
  128.       GlobalFree(hInfo);
  129.       GlobalFree(hStyle);
  130.       TDlgWindow.Done
  131.     end        { TestItWindow.Done };
  132.  
  133.   constructor TestItWindow.Init(AParent:  PWindowsObject;
  134.                                 AName  :  PChar);
  135.     var
  136.       Info :  PCtlInfo;
  137.       Style:  PCtlStyle;
  138.  
  139.     begin    { TestItWindow.Init }
  140.       TDlgWindow.Init(AParent, AName);
  141.       ExitBtn  := New(PButton, InitResource(@Self, 103));
  142.       FlagBtn  := New(PButton, InitResource(@Self, 101));
  143.       InfoBtn  := New(PButton, InitResource(@Self, 100));
  144.       DecPBtn  := New(PButton, InitResource(@Self, 105));
  145.       IncPBtn  := New(PButton, InitResource(@Self, 104));
  146.       StyleBtn := New(PButton, InitResource(@Self, 102));
  147.  
  148.       hInfo  := PercentCtrlInfo;
  149.       hStyle := GlobalAlloc(gmem_Moveable, sizeof(TCtlStyle));
  150.       if hInfo <> 0
  151.        then
  152.         begin
  153.          Info := GlobalLock(hInfo);
  154.          if Info <> nil
  155.           then
  156.            if hStyle <> 0
  157.             then
  158.              begin
  159.               Style := GlobalLock(hStyle);
  160.               if Style <> nil
  161.                then
  162.                 with Style^ do
  163.                   begin
  164.                     wX      := 0;
  165.                     wY      := 0;
  166.                     wCx     := Info^.ctType[0].wWidth;
  167.                     wCy     := Info^.ctType[0].wHeight;
  168.                     wId     := 100;
  169.                     dwStyle := Info^.ctType[0].dwStyle;
  170.                     StrCopy(szClass, Info^.szClass);
  171.                     StrCopy(szTitle, Info^.szTitle);
  172.                     GlobalUnlock(hStyle)
  173.                   end
  174.              end;
  175.          GlobalUnlock(hInfo)
  176.         end
  177.     end        { TestItWindow.Init };
  178.  
  179.   procedure TestItWindow.SetupWindow;
  180.     var
  181.       Rect:  TRect;
  182.  
  183.     begin    { TestItWindow.SetupWindow }
  184.       TDlgWindow.SetupWindow;
  185.       GetClientRect(HWindow, Rect);
  186.       PctCtrl := GetItemHandle(106)
  187.     end        { TestItWindow.SetupWindow };
  188.  
  189.   procedure TestItWindow.ExitButton(var Msg:  TMessage);
  190.     begin    { TestItWindow.ExitButton }
  191.       SendMessage(HWindow, wm_Close, 0, 0)
  192.     end        { TestItWindow.ExitButton };
  193.  
  194.   procedure TestItWindow.FlagButton(var Msg:  TMessage);
  195.     var
  196.       w:  word;
  197.       p:  PCtlStyle;
  198.       t:  packed array [0 .. 256] of char;
  199.  
  200.     begin    { TestItWindow.FlagButton }
  201.       FillChar(t, sizeof(t), #0);
  202.       p := GlobalLock(hStyle);
  203.       w := PercentCtrlFlags(p^.dwStyle, t, 256);
  204.       MessageBox(HWindow, t, 'Control Flags', mb_OK)
  205.     end        { TestItWindow.FlagButton };
  206.  
  207.   procedure TestItWindow.InfoButton(var Msg:  TMessage);
  208.     var
  209.       Info:  PInfoDialog;
  210.  
  211.  
  212.     begin     { TestItWindow.InfoButton }
  213.       Info := New(PInfoDialog, Init(@self, 'CtlInfo'));
  214.       if Info <> nil
  215.        then Application^.ExecDialog(Info)
  216.     end        { TestItWindow.InfoButton };
  217.  
  218.   procedure TestItWindow.DecPButton(var Msg:  TMessage);
  219.     begin    { TestItWindow.DecPButton }
  220.       SendMessage(PctCtrl, pcm_AddPercent, word(-10), 0)
  221.     end        { TestItWindow.DecPButton };
  222.  
  223.   procedure TestItWindow.IncPButton(var Msg:  TMessage);
  224.     begin    { TestItWindow.IncPButton }
  225.       SendMessage(PctCtrl, pcm_AddPercent, 10, 0)
  226.     end        { TestItWindow.IncPButton };
  227.  
  228.   procedure TestItWindow.StyleButton(var Msg:  TMessage);
  229.     var
  230.       b:  LongBool;
  231.  
  232.     begin    { TestItWindow.StyleButton }
  233.       b := FALSE;
  234.       if hStyle <> 0
  235.        then b := PercentCtrlStyle(HWindow, hStyle, nil, nil)
  236.     end        { TestItWindow.StyleButton };
  237.  
  238.   begin        { Main }
  239.     Test.Init('TestIt');
  240.     Test.Run;
  241.     Test.Done
  242.   end        { Main }.