home *** CD-ROM | disk | FTP | other *** search
/ Simtel MSDOS - Coast to Coast / simteldosarchivecoasttocoast.iso / pcmag / vol12n01.zip / WINTID.ZIP / WINPAS.ZIP / TIDYWINA.PAS next >
Pascal/Delphi Source File  |  1992-11-01  |  4KB  |  125 lines
  1. {$IFDEF VER70}
  2. {$K+}
  3. {$ENDIF}
  4. UNIT TidyWinA;
  5. (**) INTERFACE (**)
  6. USES WinTypes, WinProcs, Strings, Win31, {$IFNDEF VER70} WObjects;
  7. {$ELSE} ODialogs, OWindows, Objects;{$ENDIF}
  8. CONST
  9.   MaxGroups = 40; {Win 3.1 supports a maximum of 40 ProgMan groups}
  10. TYPE
  11.   PHwndArray = ^THWndArray;
  12.   THWndArray = ARRAY[0..MaxGroups] OF HWnd;
  13.  
  14.   PTidyWindowA = ^TTidyWindowA;
  15.   TTidyWindowA = OBJECT(TDlgWindow)
  16.     PMWindow : hWnd;
  17.     THA      : THWndArray;
  18.     Quiet    : Boolean;
  19.     oldCur   : hCursor;
  20.     CONSTRUCTOR Init(AParent : PWindowsObject; AName : PChar);
  21.     PROCEDURE GetGroupHandles;
  22.     PROCEDURE ArrangeAll;
  23.     (**) PRIVATE (**)
  24.     ArrangeCmd : Word;
  25.     PROCEDURE GetAACmd;
  26.   END;
  27.  
  28.   FUNCTION GetGroup(H : hWnd; PHA : PHWndArray) : Boolean; Export;
  29.  
  30. (**) IMPLEMENTATION (**)
  31.   FUNCTION GetGroup(H : hWnd; PHA : PHWndArray) : Boolean;
  32.     {callback function used in saving layout of groups}
  33.   VAR CBuf : ARRAY[0..12] OF Char;
  34.   BEGIN
  35.     GetGroup := TRUE; {continue enumerating}
  36.     GetClassName(H, CBuf, 12);
  37.       {if this is a group window, collect its handle}
  38.     IF (StrComp(CBuf, 'PMGroup') = 0) AND (PHA^[0] < 40) THEN
  39.       BEGIN
  40.         Inc(PHA^[0]);
  41.         PHA^[PHA^[0]] := H;
  42.       END;
  43.   END;
  44.  
  45.   CONSTRUCTOR TTidyWindowA.Init(AParent : PWindowsObject;
  46.     AName : PChar);
  47.   BEGIN
  48.     TDlgWindow.Init(AParent, AName);
  49.     Quiet    := FALSE;
  50.     PMWindow := FindWindow('Progman', NIL);
  51.     GetAACmd;
  52.     IF ArrangeCmd = 0 THEN PMWindow := 0;
  53.   END;
  54.  
  55.   PROCEDURE TTidyWindowA.GetGroupHandles;
  56.   VAR theInst  : TFarProc;
  57.   BEGIN
  58.       {Fill the array with the handles of all the group windows}
  59.     FillChar(THA, SizeOf(THA), 0);
  60. {$IFDEF VER70} {use BP smart callbacks if available}
  61.     EnumChildWindows(pmWindow, @GetGroup, LongInt(@THA));
  62. {$ELSE}
  63.     TheInst := MakeProcInstance(@GetGroup, hInstance);
  64.     EnumChildWindows(pmWindow, theInst, LongInt(@THA));
  65.     FreeProcInstance(theInst);
  66. {$ENDIF}
  67.   END;
  68.  
  69.   PROCEDURE TTidyWindowA.ArrangeAll;
  70.   VAR N   : Word;
  71.  
  72.     PROCEDURE ArrangeOne(H : HWnd);
  73.     BEGIN
  74.       ShowWindow(H, sw_Restore);
  75.       SendMessage(PMWindow, wm_Command, ArrangeCmd, 0);
  76.       ShowWindow(H, sw_ShowMinimized);
  77.     END;
  78.  
  79.   BEGIN
  80.     IF pmWindow = 0 THEN Exit;
  81.     OldCur := SetCursor(LoadCursor(0, idc_Wait));
  82.     SetCapture(hWindow);
  83.     GetGroupHandles;
  84.       {arrange icons in each group window}
  85.     ShowWindow(pmWindow, sw_Hide);
  86.     FOR N := 1 TO THA[0] DO ArrangeOne(THA[N]);
  87.     ShowWindow(pmWindow, sw_Show);
  88.       {arrange icons of group windows themselves}
  89.     SendMessage(PMWindow, wm_Command, ArrangeCmd, 0);
  90.     IF NOT Quiet THEN MessageBeep(mb_IconInformation);
  91.     MessageBox(hWindow, 'All icons arranged', 'WINTIDY',
  92.       mb_OK + mb_IconInformation);
  93.     SetCursor(OldCur);
  94.     ReleaseCapture;
  95.   END;
  96.  
  97.   PROCEDURE TTidyWindowA.GetAACmd;
  98.   CONST bSize = 20;
  99.   VAR
  100.     MainM, SubM : hMenu;
  101.     count, N    : Word;
  102.     mBuff       : ARRAY[0..bSize] OF Char;
  103.   BEGIN
  104.     ArrangeCmd := 0;
  105.     IF PMWindow = 0 THEN Exit;
  106.     MainM := GetMenu(PMWindow);
  107.     Count := GetMenuItemCount(MainM);
  108.     SubM := 0;
  109.     FOR N := 0 to pred(Count) DO
  110.       BEGIN
  111.         GetMenuString(MainM, N, mBuff, bSize, mf_ByPosition);
  112.         IF StrLIComp(mBuff, '&Window', 7) = 0 THEN
  113.           SubM := GetSubMenu(MainM, N)
  114.       END;
  115.     IF SubM = 0 THEN Exit;
  116.     Count := GetMenuItemCount(SubM);
  117.     FOR N := 0 TO pred(Count) DO
  118.       BEGIN
  119.         GetMenuString(SubM, N, mBuff, bSize, mf_ByPosition);
  120.         IF StrLIComp(mBuff, '&Arrange Icons',14) = 0 THEN
  121.           ArrangeCmd := GetMenuItemID(SubM, N);
  122.       END;
  123.   END;
  124. END.
  125.