home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / pascal / library / windows / om / om.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1992-04-08  |  34.0 KB  |  1,168 lines
  1. {OttoMenu 3.0 - Program Copyright (C) Doug Overmyer 12/17/91}
  2. {Begun 12/2/91} {Rel 3.5} {tabs = 2}
  3. program OttoMenu;
  4.  
  5. {$S-}{$R om.RES}{$R-}{$X+}{$V-}
  6. uses WinTypes,WinProcs,Strings,WObjects,WinDos,StdDlgs,WFPlus,Buttons,
  7.     SclpText,WIN31,ShellAPI,Bitmap,CommDlg;
  8. const
  9.     id_BMP       = 99;
  10.   id_RGB       = 100;
  11.     id_ButOffset = 120;
  12.      id_But0    = 200;     {Base value of Icon buttons   }
  13.   id_But1    = 201;     {User defined button 1 iconbar}
  14.   id_But2    = 202;     {      "             2 iconbar}
  15.   id_But3    = 203;     {      "             3 iconbar}
  16.   id_But4    = 204;     {      "             3 iconbar}
  17.   id_But5    = 205;     {      "             5 iconbar}
  18.   id_But6    = 206;     {User defined button 6 iconbar}
  19.   id_But7    = 207;     {      "             7 iconbar}
  20.   id_But8    = 208;     {      "             8 iconbar}
  21.   id_But9    = 209;     {      "             9 iconbar}
  22.   id_But10   = 210;     {      "            10 iconbar}
  23.   id_But11   = 211;     {      "            11        }
  24.   id_But12   = 212;     {                   12        }
  25.   id_But13   = 213;     {                   13        }
  26.   id_But14   = 214;     {                   14        }
  27.   id_But15   = 215;     {                   15        }
  28.   id_But21   = 221;     {page 1 icon}
  29.   id_But22   = 222;     {page 2 icon}
  30.   id_But23   = 223;     {page 3 icon}
  31.   id_But24   = 224;     {page 4 icon}
  32.   id_Gb1     = 300;     {group box for radio buttons}
  33.   id_GB2     = 200;     {group box for page icons}
  34.   id_St1     = 401;     {Static text 1         icon bar}
  35.   id_St2     = 402;     {Static text 2         icon bar}
  36.   id_Pict    = 501;
  37.   id_D1      = 550;
  38.   id_D1RB1   = 551;
  39.   id_D1RB2   = 552;
  40.   id_D2OK    = 601;     {OK button in Dlg2     }
  41.   id_D2Browse= 650;     {Dlg2 Browse button}
  42.   id_D2EC1   = 603;     {Edit Control 1 in Dlg2 item #}
  43.   id_D2EC2   = 605;     {             2         Name}
  44.   id_D2EC3   = 607;     {             3         file}
  45.   id_D2EC4   = 609;     {             4         Start directory}
  46.   id_D2EC5   = 617;     {             5         parameters}
  47.   id_D2EC6   = 621;     {             6         start size}
  48.   id_D3LB1   = 701;
  49.   idm_About  = 801;     {menu id for OM_About menu}
  50. {************************  Types    ************************}
  51. type
  52. TOMApplication = object(TApplication)
  53.   SplashRect: TRect;
  54.   constructor Init(AName:PChar);
  55.   procedure InitMainWindow;virtual;
  56.   procedure Redraw;
  57. end;
  58.  
  59. ItemRec = record
  60. ItemNum,PgmName,PgmFile,Dir,Params,Cmdshow:Array[0..69] of Char;
  61. end;
  62.  
  63. PPgmItem = ^TPgmItem;
  64. TPgmItem = object(TObject)
  65.     PgmName:PChar;
  66.   PgmFile:PChar;
  67.   Dir:PChar;
  68.   Params:PChar;
  69.   CmdShow:PChar;
  70.   constructor Init(NewPgmName,NewPgmFile,NewDir,NewParams,NewCmdShow:PChar);
  71.   destructor Done;virtual;
  72. end;
  73.  
  74. POMCol = ^TOMCol;
  75. TOMCol = object(TCollection)
  76.     TheItems:PCollection;
  77.     constructor Init(ALimit,ADelta:Integer);
  78.   destructor Done;virtual;
  79.   function At(Indx:Integer):PPgmItem;virtual;
  80.   procedure ReadItems(Start,Finish:Integer);virtual;
  81.     procedure ItemGet(var PgmItem:ItemRec);virtual;
  82.     procedure ItemSet(PgmItem:ItemRec);virtual;
  83.   function GetCount:Integer;virtual;
  84.   function IsValidIndx(Indx:Integer):Boolean;
  85. end;
  86.  
  87. POMDlg2 = ^TOMDlg2;
  88. TOMDlg2 = object(TDialog)              {Item setup dialog}
  89.     EC1,EC2,EC3,EC4,EC5,EC6:PEdit;
  90.   constructor Init(AParent:PWindowsObject;AName:PChar);
  91.   procedure IDD2OK(var Msg:TMessage); virtual id_First+id_D2OK;
  92.   procedure IDBrowse(var Msg:TMessage);virtual id_First+id_D2Browse;
  93. end;
  94.  
  95. POMDlg3 = ^TOMDlg3;
  96. TOMDlg3 = object(TDialog)              {Run dialog}
  97.     procedure SetupWindow; virtual;
  98. end;
  99.  
  100. POMAboutDlg = ^TOMAboutDlg;
  101. TOMAboutDlg = object(TDialog)
  102.     Logo:HBitmap;
  103.   Brush:HBrush;
  104.   constructor Init(AParent:PWindowsObject;AName:PChar;ALogo:HBitmap;ABrush:HBrush);
  105.     procedure WMCtlColor(var Msg:TMessage);virtual wm_First+wm_CtlColor;
  106. end;
  107.  
  108. POMRButton = ^TOMRButton;
  109. TOMRButton = object(TRadioButton)
  110.     procedure WMRButtonDown(var Msg:TMessage);virtual wm_First+wm_RButtonDown;
  111. end;
  112.  
  113. POMGroupBox = ^TOMGroupBox;
  114. TOMGroupBox = object(TGroupBox)
  115.     procedure SetupWindow;virtual;
  116.   function CanClose:Boolean;virtual;
  117.   procedure WMDropFiles(var Msg:TMessage);virtual wm_First+wm_DropFiles;
  118. end;
  119.  
  120. POMStatic = ^TOMStatic;
  121. TOMStatic = object(TSText)
  122.     procedure WMRButtonDown(var Msg:TMessage);virtual wm_First+wm_RButtonDown;
  123. end;
  124.  
  125. type
  126. POMWindow = ^TOMWindow;
  127. TOMWindow = object(TWindow)
  128.   BN1:Array[0..10] of PDDButton;  {icon bar button pointers}
  129.   BN2:Array[0..5] of PODButton;
  130.   BNR:Array[0..5] of PIcon; {page icons}
  131.   GB1:POMGroupBox;
  132.   GB2:PIconGroup;
  133.   RB:Array[0..20] of POMRButton; {radio button pointers id's 301-320}
  134.   ST1:POMStatic;
  135.   Apps:POMCol;
  136.   BkgndBr:HBrush;
  137.   Logo,Pict:HBitmap;
  138.   PictRect:TRect;
  139.   PageNum,Max_Pages,AutoMin:Integer;
  140.   Helv:HFont;
  141.   D2TfB:ItemRec;
  142.   Bitmap:PTBMP;
  143.   StatDisp:Char;
  144.     constructor Init(AParent:PWindowsObject;ATitle:PChar);
  145.   destructor Done;virtual;
  146.   procedure SetupWindow;virtual;
  147.   function GetClassName:PChar;virtual;
  148.   procedure SetRBText;virtual;
  149.   procedure Paint(PaintDC:HDC;var PaintInfo:TPaintStruct);virtual;
  150.   procedure SetStaticText;
  151.   procedure    WMDrawItem(var Msg:TMessage);virtual wm_First + wm_DrawItem;
  152.     procedure IDBut11(var Msg:TMessage);virtual id_First+id_But11; { }
  153.   procedure IDBut12(var Msg:TMessage);virtual id_First+id_But12; { }
  154.   procedure    IDBut13(var Msg:TMessage);virtual id_First+id_But13; { }
  155.   procedure IDBut14(var Msg:TMessage);virtual id_First+id_But14; { }
  156.   procedure IDBut15(var Msg:TMessage);virtual id_First+id_But15; {Free Icon}
  157.   procedure DefChildProc(var Msg:TMessage);virtual;
  158.   procedure WinExecc(var Msg:TMessage);virtual;
  159.   procedure    WMSysCommand(var Msg:TMessage);virtual wm_First+wm_SysCommand;
  160.   procedure SetItemValues(PgmItem:ItemRec);virtual;
  161.     procedure WMCtlColor(var Msg:TMessage);virtual wm_First+wm_CtlColor;
  162.   procedure RunIt;virtual;
  163.   procedure UMDropFiles(var Msg:TMessage);virtual wm_User+wm_Dropfiles;
  164.     procedure UMRButtonDown(var Msg:TMessage);virtual wm_User+wm_RButtonDown;
  165.     procedure LoadBMP(BMPName:PChar);
  166.   function CtrlToIndx(Id:Integer):Integer;virtual;
  167.   procedure WMRButtonDown(var Msg:TMessage);virtual wm_First+wm_RButtonDown;
  168.   procedure SetStatProp(var Msg:TMessage);virtual;
  169.   procedure SetButProp(var Msg:TMessage);virtual;
  170.   procedure SetBMPProp(var Msg:TMessage);virtual;
  171.   procedure SetRGBProp(var Msg:TMessage);virtual;
  172.   procedure WMDropFiles(var Msg:TMessage);virtual wm_First+wm_DropFiles;
  173.   procedure GetPictRect;virtual;
  174.   procedure CreateBrush(BkgndColor:PChar);virtual;
  175.   procedure WMNCRButtonDown(Msg:TMessage);virtual wm_First+wm_NCRButtonDown;
  176. end;
  177.  
  178. {***********************  Methods    *******************************}
  179. constructor TOMApplication.Init(AName: PChar);
  180. var
  181.   DC, MemDC: HDC;
  182.   OldBitMap, BitMap: HBitMap;
  183.   BM: TBitMap;
  184. begin
  185.   DC := CreateDC('Display', Nil, Nil, Nil);
  186.   BitMap := LoadBitMap(HInstance, 'OM_Logo');
  187.   MemDC := CreateCompatibleDC(DC);
  188.   OldBitMap := SelectObject(MemDC, BitMap);
  189.   GetObject(BitMap, SizeOf(BM), @BM);
  190.   with SplashRect do
  191.   begin
  192.     Left := 200;
  193.     Top := 150;
  194.     Right := Left + BM.bmWidth;
  195.     Bottom := Top + BM.bmHeight;
  196.     BitBlt(DC, Left, Top, BM.bmWidth, BM.bmHeight, MemDC, 0, 0, SRCCopy);
  197.   end;
  198.   DeleteObject(SelectObject(MemDC, OldBitMap));
  199.   DeleteDC(MemDC);
  200.   DeleteDC(DC);
  201.   TApplication.Init(AName);
  202. end;
  203.  
  204. procedure TOMApplication.InitMainWindow;
  205. begin
  206.     MainWindow := New(POMWindow,Init(nil,'OttoMenu'));
  207. end;
  208.  
  209. procedure TOMApplication.Redraw;
  210. begin
  211.     InvalidateRect(0,@SplashRect,True);
  212. end;
  213. {**********************  TOMWindow  *******************************}
  214. constructor TOMWindow.Init(AParent:PWindowsObject;ATitle:PChar);
  215. Const
  216.     BMP:Array[0..25] of PChar = ('','','','','','','','','','','',
  217.   'OM_B1','OM_B2','OM_B3', 'OM_B4', 'OM_B5',
  218.   '','','','','',
  219.   'OM_B21', 'OM_B22','OM_B23','OM_B24','');
  220. {bitmaps OM_B1 to OM_B5 are 34 x 34 16 color resources}
  221. var
  222.   TheBmp:HBitmap;
  223.   Buf:Array[0..69] of Char;
  224.   Indx:Integer;
  225.   TheItem:PPgmItem;
  226. begin
  227.     Logo := 0;Pict := 0;
  228.     TWindow.Init(AParent,ATitle);
  229.   Apps := New(POMCol,Init(101,20));
  230.   PageNum := 1;
  231.   Max_Pages := 5;
  232.   Apps^.ReadItems(0,100);
  233.   Attr.Menu := 0; {LoadMenu(HInstance,'OM_Menu');}
  234.   Attr.X := 20; Attr.Y := 25; Attr.W := 595; Attr.H := 325;
  235.   Attr.Style := ws_Overlapped or ws_SysMenu or ws_MinimizeBox;
  236.   For Indx := 0 to 10 do BN1[Indx] := nil;
  237.   For Indx := 0 to 5 do BN2[Indx] := nil;
  238.   For Indx := 0 to 4 do BNR[Indx] := nil;
  239.   For Indx := 0 to 20 do RB[Indx] := nil;
  240.   For Indx := 1 to 10 do
  241.       begin
  242.     TheItem := Apps^.At(Indx+80);
  243.       BN1[Indx]:=New(PDDButton,Init(@Self,id_GB2+Indx,'',Pred(Indx)*35,0,35,35,False,TheItem^.PgmFile));
  244.       end;
  245.     For Indx := 1 to 5 do
  246.       BN2[Indx]:=New(PODButton,Init(@Self,id_GB2+10+Indx,'',Pred(Indx)*35,35,35,35,False,BMP[Indx+10]));
  247.   GB2 := New(PIconGroup,Init(@Self,id_Gb2,'',0,35,34,34));
  248.   For Indx := 1 to Pred(Max_Pages) do
  249.         BNR[Indx] := New(PIcon,Init(@Self,Indx+220,'',0,35,34,34,GB2,BMP[Indx+20]));
  250.   St1 := New(POMStatic,Init(@Self,id_St1,'',355,5,235,25,sr_Recessed,
  251.               dt_Center or dt_VCenter or dt_SingleLine));
  252.   GB1 := New(POMGroupBox,Init(@Self,id_Gb1,'Applications',200,50,350,230));
  253.   For Indx := 1 to 10 do
  254.       RB[Indx]:=New(POMRButton,Init(@Self,(id_GB1+Indx),'',215,(75+Pred(Indx)*20),160,20,GB1));
  255.   For Indx := 11 to 20 do
  256.       RB[Indx]:=New(POMRButton,Init(@Self,(id_GB1+Indx),'',385,(75+(Indx-11)*20),160,20,GB1));
  257.  
  258.     GetPrivateProfileString('OM','BkgndColor','12632256',Buf,SizeOf(Buf),'OM.INI');
  259.   BkgndBr := 0;
  260.   CreateBrush(Buf);
  261.   StrCopy(Buf,'');
  262.     GetPrivateProfileString('OM','PgmFile99','OMLOGO.BMP',Buf,SizeOf(Buf),'OM.INI');
  263.     AutoMin :=Min(2,GetPrivateProfileInt('OM','AutoMin',0,'OM.INI'));
  264.   Bitmap:= New(PTBMP,Init('xx'));
  265.   if StrLen(Buf) <> 0 then
  266.       Bitmap^.LoadBitmapFile(buf);
  267.   Pict := Bitmap^.BitmapHandle;
  268.   Logo := LoadBitmap(HInstance,'OM_Logo');
  269.   if Pict = 0 then
  270.       Pict := Logo;
  271.   BNR[1]^.State := 1;
  272.   GB2^.SelectionChanged(id_But21);
  273.     GetPrivateProfileString('OM','StatDisp','M',Buf,SizeOf(Buf),'OM.INI');
  274.   StatDisp := Buf[0];
  275. end;
  276.  
  277. function TOMWindow.GetClassName:Pchar;
  278. begin
  279.     GetClassName := 'OMWindow';
  280. end;
  281.  
  282. procedure TOMWindow.SetupWindow;
  283. var
  284.     SysMenu:hMenu;
  285.   Indx:Word;
  286.   CR:TRect;
  287.   NewTop:Integer;
  288.   LogFont:TLogFont;
  289.   Msg:TMessage;
  290.   PictMetrics:TBitmap;
  291. begin
  292.     TWindow.SetupWindow;
  293.     SetClassWord(HWindow,GCW_HIcon,LoadIcon(HInstance,'OM_Icon'));
  294.   SetClassWord(HWindow,GCW_HBrBackGround,BkgndBr);
  295.   Sysmenu := GetSystemMenu(hWindow,false);
  296.   AppendMenu(SysMenu,MF_Separator,0,nil);
  297.   AppendMenu(Sysmenu,0,idm_About,'About...');
  298.   GetClientRect(HWindow,CR);
  299.   NewTop := CR.Bottom-Cr.Top-34;
  300.   for Indx := 1  to 4 do
  301.       if BNR[Indx] <> nil then
  302.         begin
  303.         MoveWindow(BNR[Indx]^.HWindow,34*Pred(Indx),NewTop,34,34,False);
  304.       MoveWindow(GB2^.HWindow,0,NewTOP,34*(Indx),34,False);
  305.       end;
  306.   GetObject(GetStockObject(System_Font),sizeof(LogFont),@LogFont);
  307.   StrCopy(LogFont.lfFaceName,'Helv');
  308.     LogFont.lfHeight := round(LogFont.lfHeight * 2 / 3);
  309.   LogFont.lfWidth := 0;
  310.   LogFont.lfPitchAndFamily := 0;
  311.   Helv := CreateFontIndirect(LogFont);
  312.   GetPictRect;
  313.     SetStaticText;
  314.   SetRBText;
  315.   DragAcceptFiles(HWindow,TRUE);
  316. end;
  317.  
  318. function GetHeapSpaces(Module:THandle):LongInt;far;external 'Kernel';
  319.  
  320. procedure TOMWindow.SetStaticText;
  321. var
  322.   Buf:Array[0..55] of Char;
  323.   Mem :Record
  324.       GlobalFreeMem,User,GDI:LongInt;
  325.   end;
  326.   Res:Record
  327.       HRes,VRes,NColors:Integer;
  328.   end;
  329.   PageNumBuf:Array[0..25] of Char;
  330.   lr:LongRec;
  331.   Info:LongInt;
  332.   nBitsPixel,nPlanes,nSizePalette:Integer;
  333.   DC:HDc;
  334. begin
  335. if StatDisp = 'M' then
  336.     begin
  337.     LongInt(LR) := GetHeapSpaces(GetModuleHandle('User'));
  338.   Mem.User := Round((LR.Lo  / LR.Hi)*100);
  339.     LongInt(LR) := GetHeapSpaces(GetModuleHandle('GDI'));
  340.   Mem.GDI := Round((LR.Lo / LR.Hi)*100) ;
  341.     Mem.GlobalFreeMem := Round(GetFreeSpace(0) / 1024);
  342.   wvsprintf(Buf,'GMem:%luK  User:%lu%%  GDI:%li%%',Mem);
  343.   end
  344. else
  345.     begin
  346.   Res.HRes := GetSystemMetrics(sm_CXScreen);
  347.   Res.VRes := GetSystemMetrics(sm_CYScreen);
  348.   DC := GetDC(HWindow);
  349.   nPlanes := GetDeviceCaps(DC,Planes);
  350.   nBitsPixel := GetDeviceCaps(DC,BitsPixel);
  351.   nSizePalette := GetDeviceCaps(DC,SizePalette);
  352.   if (RC_Palette AND GetDeviceCaps(DC,RASTERCAPS)) > 0 then
  353.       Res.NColors := nSizePalette
  354.   else
  355.          Res.NColors := (nPlanes * nBitsPixel) shl 2 ;
  356.   ReleaseDC(HWindow,DC);
  357.   wvsprintf(Buf,'HRes:%i  VRes:%i  #Colors:%i',Res);
  358.     end;
  359.     St1^.SetFont(Helv);
  360.   St1^.SetText(Buf);
  361.  
  362.   Str(PageNum,PageNumBuf);
  363.   StrCat(StrCopy(Buf,'Page: '),PageNumBuf);
  364.   SetWindowText(GB1^.HWindow,Buf);
  365. end;
  366.  
  367. procedure TOMWindow.SetRBText;
  368. var
  369.     Offset:Integer;
  370.     ChildWin:PRadioButton;
  371.   Indx:Integer;
  372.   Item:PPgmItem;
  373. begin
  374.     Offset := Pred(PageNum)*20;
  375.     For Indx := Offset+1 to Offset+20 do
  376.       begin
  377.     Item := Apps^.At(Indx);
  378.     SetWindowText(RB[Indx-OffSet]^.HWindow,Item^.PgmName);
  379.       end;
  380. end;
  381.  
  382. destructor TOMWindow.Done;
  383. begin
  384.     Dispose(Bitmap,Done);
  385.     DeleteObject(Helv);
  386.   Apps^.Done;
  387.   if Logo <> 0 then DeleteObject(Logo);
  388.     If HPrevInst = 0 then
  389.         DeleteObject(BkgndBr);
  390.   DragAcceptFiles(HWindow,FALSE);
  391.   TWindow.Done;
  392. end;
  393.  
  394. procedure TOMWindow.Paint(PaintDC:HDC;var PaintInfo:TPaintStruct);
  395. const
  396.     X1=190; Y1=48; X2=560; Y2=290;
  397. var
  398.     ThePen,OldPen:HPen;
  399.   TheBrush,OldBrush:HBrush;
  400.   MemDC:hDC;
  401. begin
  402.     TheBrush := GetStockObject(LtGray_Brush);
  403.     ThePen := CreatePen(ps_Solid,1,$00000000);
  404.   OldPen := SelectObject(PaintDC,ThePen);
  405.   OldBrush := SelectObject(PaintDC,TheBrush);
  406.   Rectangle(PaintDC,0,0,600,35);
  407.   SelectObject(PaintDC,OldBrush);
  408.   SelectObject(PaintDC,OldPen);
  409.   DeleteObject(ThePen);
  410.   DeleteObject(TheBrush);
  411.   SRectangle(PaintDC,X1,Y1,X2,Y2,2,sr_Recessed);
  412.     Bitmap^.Draw(PaintDC,PictRect,False);
  413. end;
  414.  
  415. procedure    TOMWindow.WMDrawItem(var Msg:TMessage);
  416. var
  417.     PDIS : ^TDrawItemStruct;
  418. begin
  419.     PDIS := Pointer(Msg.lParam);
  420.     case PDIS^.CtlType of
  421.         odt_Button:
  422.         case PDIS^.CtlID of
  423.             id_But1..id_But10:Bn1[PDIS^.CtlID-200]^.DrawItem(Msg);
  424.             id_But11..id_But15:Bn2[PDIS^.CtlID-210]^.DrawItem(Msg);
  425.             id_But21..id_But24:BnR[PDIS^.CtlID-220]^.DrawItem(Msg);
  426.         end;
  427.     end;
  428. end;
  429.  
  430. procedure TOMWindow.IDBut11(var Msg:TMessage);
  431. var
  432.     Item:PPgmItem;
  433. begin
  434.     Item := Apps^.At(91);
  435.     if (Item^.Dir <> NIL) then
  436.           SetCurdir(Item^.Dir);
  437.   if (Item^.PgmFile <> nil) then
  438.       WinExec(Item^.PgmFile,sw_Normal)
  439.   else
  440.         WinExec('command.com',sw_Normal);
  441. end;
  442.  
  443. procedure TOMWindow.IDBut12(var Msg:TMessage);
  444. begin
  445.     Runit;
  446. end;
  447.  
  448. procedure TOMWindow.IDBut13(var Msg:TMessage);
  449. var
  450.     Dlg3:POMDlg3;
  451. begin
  452.     Dlg3 := New(POMDlg3,Init(@Self,'Om_Dlg3'));
  453.     Application^.ExecDialog(Dlg3);
  454. end;
  455.  
  456. procedure TOMWindow.IDBut14(var Msg:TMessage);
  457. begin
  458.     SetStaticText;
  459. end;
  460.  
  461. procedure TOMWindow.IDBut15(var Msg:TMessage);
  462. begin
  463.   ExitWindows(0,0);
  464. end;
  465.  
  466. procedure TOMWindow.DefChildProc(var Msg:TMessage);
  467. var
  468.     ID:Integer;
  469. begin
  470.   case Msg.WParam of
  471.       id_But1..id_But10:
  472.       WinExecc(Msg);
  473.     Succ(id_GB1)..id_GB1+20:
  474.       WinExecc(Msg);
  475.     id_But21..id_But24:
  476.             begin
  477.             PageNum := Msg.wParam-220;
  478.           SetRBText;
  479.           SetStaticText;
  480.             end;
  481.     else
  482.         TWindow.DefChildProc(Msg);
  483.     end;
  484. end;
  485.  
  486. procedure TOMWindow.WinExecc(var Msg:TMessage);
  487. var
  488.     Indx:Integer;
  489.     Item:PPgmItem;
  490.   Buf:Array[0..100] of Char;
  491.   Errval:Integer;
  492.   nCmdShow,CmdShow:Integer;
  493. begin
  494.     Indx := CtrlToIndx(Msg.wParam);
  495.     Item := Apps^.At(Indx);
  496.   if (Item^.PgmFile = NIL) then
  497.       begin
  498.       if (Msg.wParam > id_Gb1) then
  499.           RB[Msg.WParam-id_GB1]^.Toggle;
  500.     TWindow.DefChildProc(Msg);
  501.     Exit;
  502.     end;
  503.   StrCopy(Buf,Item^.PgmFile);
  504.   if (Item^.Params <> NIL) then
  505.           StrCat(StrCat(Buf,' '),Item^.Params);
  506.   if (Item^.Cmdshow <> NIL) then
  507.       case Item^.CmdShow[0] of
  508.         'N','n':Cmdshow := sw_Normal;
  509.       'M','m':CmdShow := sw_Maximize;
  510.       'I','i':CmdShow := sw_Minimize;
  511.         else
  512.           CmdShow := sw_Normal;
  513.     end
  514.   else
  515.       CmdShow := sw_Normal;
  516.     if (Item^.Dir <> NIL) then
  517.       SetCurdir(Item^.Dir);
  518.   WinExec(Buf,CmdShow);
  519.   if Msg.wParam > id_GB1 then
  520.         RB[Msg.WParam-id_GB1]^.Toggle;
  521.   If AutoMin = 1 then
  522.       ShowWindow(HWindow,sw_Minimize);
  523. end;
  524.  
  525. procedure    TOMWindow.WMSysCommand(var Msg:TMessage);
  526. begin
  527.     case Msg.Wparam of
  528.         idm_About:
  529.              application^.ExecDialog(New(POMAboutDlg,Init(@Self,'OM_About',Logo,BkgndBr)));
  530.        else
  531.            DefWndProc(Msg);
  532.        end;
  533. end;
  534.  
  535. procedure TOMWindow.SetItemValues(PgmItem:ItemRec);
  536. begin
  537.     Apps^.ItemSet(PgmItem);
  538.   SetRBText;
  539. end;
  540.  
  541. procedure TOMWindow.WMCTLCOLOR(var Msg: TMessage);
  542. begin
  543.   case Msg.LParamHi of
  544.     ctlcolor_Btn:
  545.       begin
  546.       SetBkMode(Msg.WParam, Transparent);
  547.       Msg.Result := GetStockObject(ltGray_Brush);
  548.       end;
  549.   else
  550.     DefWndProc(Msg);
  551.   end;
  552. end;
  553.  
  554. procedure TOMWindow.Runit;
  555. const
  556.   szFilter:Array[0..8] of Char ='*.*'#0'*.*'#0#0;
  557. var
  558.   Path,Name,Ext,OldDir:Array[0..fsPathName] of Char;
  559.     szDirName:Array[0..256] of Char;
  560.   szFile,szFileTitle:Array[0..256] of Char;
  561.   OFN:TOpenFileName;
  562. begin
  563.     StrCopy(szFile,'');
  564.   OFN.lStructSize := sizeof(TOpenFileName);
  565.   OFN.hWndOwner := HWindow;
  566.   OFN.lpStrFilter := @szFilter;
  567.   OFN.lpStrCustomFilter := nil;
  568.   OFN.nMaxCustFilter := 0;
  569.   OFN.nFilterIndex := LongInt(1);
  570.   OFN.lpStrFile := szFile;
  571.   OFN.nMaxFile := sizeof(szFile);
  572.   OFN.lpstrfileTitle := szFileTitle;
  573.   OFN.nMaxFileTitle := sizeof(szFileTitle);
  574.   OFN.lpstrInitialDir := NIL;
  575.   OFN.lpStrTitle := 'Run A Program';
  576.   OFN.flags := 0;
  577.   OFN.nFileOffset := 0;
  578.   OFN.nFileExtension := 0;
  579.   OFN.lpstrDefext := nil;
  580.   If GetOpenFileName(OFN) then
  581.       begin
  582.     filesplit(szFile,Path,Name,Ext);
  583.     SetCurDir(Path);
  584.       WinExec(Name,sw_Normal);
  585.     SetCurdir(OldDir);
  586.       If AutoMin = 1 then
  587.           ShowWindow(HWindow,sw_Minimize);
  588.     end;
  589. end;
  590.  
  591. procedure TOMWindow.UMDropFiles(var Msg:TMessage);
  592. var
  593.     FileNamePtr:PChar;
  594.   CtrlID:Integer;
  595.     Buf1:Array[0..30] of Char;
  596.   Indx:Integer;
  597.     PgmItem:ItemRec;
  598.   Dir,Name,Ext:Array[0..fsPathName] of Char;
  599. begin
  600.     FileNamePtr := Pointer(Msg.lParam);
  601.   FileSplit(FileNamePtr,Dir,Name,Ext);
  602.   AnsiLower(Name);
  603.   Name[0] := UpCase(Name[0]);
  604.     StrCopy(PgmItem.PgmName,Name);
  605.   StrCopy(PgmItem.PgmFile,FileNamePtr);
  606.   CtrlID :=Msg.wParam;
  607.   If CtrlID = id_Pict then
  608.       Indx := id_BMP
  609.   else
  610.         Indx := CtrlToIndx(Msg.wParam);
  611.   Str(Indx:2,PgmItem.ItemNum);
  612.   StrCopy(PgmItem.Dir,'');
  613.   StrCopy(PgmItem.Params,'');
  614.   StrCopy(PgmItem.CmdShow,'N');
  615.   SetItemValues(PgmItem);
  616. end;
  617.  
  618. procedure TOMWindow.UMRButtonDown(var Msg:TMessage);
  619. begin
  620.   if Msg.wParam = id_St1 then
  621.       SetStatProp(Msg)
  622.   else if (Msg.wParam > id_But11) and (Msg.wParam < Succ(id_But15)) then
  623.   else if (Msg.wParam = id_RGB) then
  624.       SetRGBProp(Msg)
  625.   else if (Msg.wParam = id_Pict) then
  626.       SetBMPProp(Msg)
  627.   else if (Msg.wParam > id_GB2) and (Msg.wParam < id_GB1+100) then
  628.       SetButProp(Msg)
  629.   else
  630.       DefWndProc(Msg);
  631. end;
  632.  
  633. function TOMWindow.CtrlToIndx(ID:Integer):Integer;
  634. begin
  635.     if ID > id_GB1 then
  636.         CtrlToIndx := ID - id_GB1 + (20*Pred(PageNum))
  637.   else
  638.         CtrlToIndx := ID - id_GB2 + 80;
  639. end;
  640.  
  641. procedure TOMWindow.WMRButtonDown(var Msg:TMessage);
  642. var
  643.     MousePt:TPoint;
  644. begin
  645.     MousePt := MakePoint(Msg.lParam);
  646.      if PtInRect(PictRect,MousePt)  then
  647.       SendMessage(HWindow,wm_User+wm_RButtonDown,id_Pict,Msg.lParam)
  648.   else
  649.       SendMessage(HWindow,wm_User+wm_RButtonDown,id_RGB,Msg.lParam);
  650.     DefWndProc(Msg);
  651. end;
  652.  
  653. procedure TOMWindow.SetStatProp(var Msg:TMessage);
  654. begin
  655.     if StatDisp = 'M' then
  656.     StatDisp := 'R'
  657.   else
  658.         StatDisp := 'M';
  659.   WritePrivateProfileString('OM','StatDisp',@StatDisp,'OM.INI');
  660.   SetStaticText;
  661. end;
  662.  
  663. procedure TOMWindow.SetButProp(var Msg:TMessage);
  664. var
  665.   Dlg2:POMDlg2;
  666. begin
  667.   FillChar(D2TfB,sizeof(D2TfB),$0);
  668.     Dlg2 := New(POMDlg2,Init(@Self,'Om_Dlg2'));
  669.   Str(CtrlToIndx(Msg.wParam),D2TfB.ItemNum);
  670.   Dlg2^.TransferBuffer := @D2TfB;
  671.   Apps^.ItemGet(D2TfB);
  672.     if StrLen(D2TfB.Cmdshow) = 0 then
  673.       StrCopy(D2TfB.Cmdshow,'N');
  674.   if (Application^.ExecDialog(Dlg2) = 1) then
  675.       begin
  676.     SetItemValues(D2TfB);
  677.       if (Msg.wParam > id_But0) and (Msg.wParam < id_But11) then
  678.           BN1[Msg.wParam - id_But0]^.ChangeBMP(D2TfB.PgmFile);
  679.       end;
  680. end;
  681.  
  682. procedure TOMWindow.SetBMPProp(var Msg:TMessage);
  683. var
  684.   Dlg2:POMDlg2;
  685. begin
  686.   FillChar(D2TfB,sizeof(D2TfB),$0);
  687.     Dlg2 := New(POMDlg2,Init(@Self,'Om_Dlg2'));
  688.   StrCopy(D2TfB.ItemNum,'99');
  689.   Dlg2^.TransferBuffer := @D2TfB;
  690.   Apps^.ItemGet(D2TfB);
  691.   StrCopy(D2TfB.Cmdshow,'N');
  692.   if (Application^.ExecDialog(Dlg2) = 1) then
  693.       begin
  694.     SetItemValues(D2TfB);
  695.       if  (StrLen(D2TfB.PgmFile) <> 0) then
  696.           LoadBMP(D2TfB.PgmFile);
  697.       end;
  698. end;
  699.  
  700. procedure TOMWindow.SetRGBProp(var Msg:TMessage);
  701. var
  702.     Chsclr:TChooseColor;
  703.   Color:LongInt;
  704.   ColorArray:Array[0..15] of LongInt;
  705.   Indx:Integer;
  706.   BkColor:Array[0..12] of Char;
  707.   Buf:Array[0..15] of Char;
  708.   Errornum:Integer;
  709. begin
  710.       begin
  711.       for Indx := 0 to 15 do ColorArray[Indx] := LongInt(RGB(255,255,255));
  712.         GetPrivateProfileString('OM','BkgndColor','12632256',Buf,SizeOf(Buf),'OM.INI');
  713.     Val(Buf,Color,Errornum);
  714.       ChsClr.lStructsize:= sizeof(TChooseColor);
  715.       ChsClr.hWndOwner := HWindow;
  716.       ChsClr.hInstance := HInstance;
  717.       ChsClr.rgbResult := Color;
  718.        ChsClr.lpcustcolors := pLongInt(@ColorArray);
  719.       ChsClr.lcustdata := 0;
  720.       ChsClr.Flags :=  cc_RGBInit;
  721.       ChsClr.lptemplateName := PChar(nil);
  722.         if Choosecolor(ChsClr) then
  723.         begin
  724.         Str(ChsClr.rgbResult,BkColor);
  725.         WritePrivateProfileString('OM','BkgndColor',BkColor,'OM.INI');
  726.       CreateBrush(BkColor);
  727.       end;
  728.     end;
  729. end;
  730.  
  731. procedure TOMWindow.WMDropFiles(var Msg:TMessage);
  732. var
  733.     DropItem:hDrop;
  734.   FileNameBuf:Array[0..fsPathName] of Char;
  735.   GFileName:PChar;
  736.   Loc:TPoint;
  737. begin
  738.     DropItem := Msg.wParam;
  739.   DragQueryFile(DropItem,0,FileNameBuf,sizeof(FileNameBuf));
  740.   DragQueryPoint(DropItem,Loc);
  741.   DragFinish(DropItem);
  742.      if PtInRect(PictRect,Loc) then
  743.        begin
  744.       GFileName :=StrNew(FileNameBuf);
  745.       SendMessage(HWindow,wm_User+wm_DropFiles,id_Pict,LongInt(GFileName));
  746.     StrDispose(GFileName);
  747.     LoadBMP(FileNameBuf);
  748.       end;
  749. end;
  750.  
  751. procedure TOMWindow.LoadBMP(BMPName:PChar);
  752. begin
  753.     Dispose(BitMap,Done);
  754.   Bitmap:= New(PTBMP,Init('xx'));
  755.   Bitmap^.LoadBitmapFile(BMPName);
  756.   Pict := Bitmap^.BitmapHandle;
  757.   GetPictRect;
  758.   InvalidateRect(HWindow,nil,True);
  759.   UpdateWindow(HWindow);
  760. end;
  761.  
  762. procedure TOMWindow.GetPictRect;
  763. var
  764.     CR:TRect;
  765.   PictMetrics:TBitmap;
  766. begin
  767.     GetClientRect(HWindow,CR);
  768.   GetObject(Pict,SizeOf(PictMetrics),@PictMetrics);
  769.   PictRect.Left := Max((190 - PictMetrics.bmWidth) div 2 , 5);
  770.   PictRect.Top := Max((CR.Bottom-CR.Top-105 - PictMetrics.bmHeight) div 2 , 0)+75;
  771.   PictRect.Right := Min(PictRect.Left +PictMetrics.bmWidth,185);
  772.   PictRect.Bottom := Min(PictRect.Top +PictMetrics.bmHeight,CR.Bottom-40);
  773. end;
  774.  
  775. procedure TOMWindow.CreateBrush(BkgndColor:PChar);
  776. var
  777.     DC,MemDC:HDC;
  778.   NewBmp,Bmp,OldBmp:HBitmap;
  779.   NewBrush,OldBrush,MonoBrush:HBrush;
  780.   nBkgndColor:TColorRef;
  781.   ErrCode:Integer;
  782. begin
  783.     if BkgndBr > 0 then
  784.       DeleteObject(BkgndBr);
  785.   Val(BkgndColor,nBkgndColor,ErrCode);
  786.   Bmp :=LoadBitmap(HInstance,'OM_Br');
  787.   MonoBrush :=CreatePatternBrush(Bmp);
  788.     DC := GetDC(HWindow);
  789.   NewBMP := CreateCompatibleBitmap(DC,8,8);
  790.   MemDC := CreateCompatibleDC(DC);
  791.   SetTextColor(MemDC,nBkgndColor);
  792.   OldBrush := SelectObject(MemDC,MonoBrush);
  793.   OldBmp := SelectObject(MemDC,NewBmp);
  794.     PatBlt(MemDC,0,0,8,8,PatCopy); 
  795.   SelectObject(MemDC,OldBmp);
  796.   SelectObject(MemDC,OldBrush);
  797.   DeleteObject(MonoBrush);
  798.   BkgndBr := CreatePatternBrush(NewBMP);
  799.   DeleteObject(Bmp);
  800.   DeleteObject(NewBmp);
  801.   DeleteDC(MemDC);
  802.   ReleaseDC(HWindow,DC);
  803.   SetClassWord(HWindow,GCW_HBrBackGround,BkgndBr);
  804.   InvalidateRect(HWindow,nil,True);
  805. end;
  806.  
  807. procedure TOMWindow.WMNCRButtonDown(Msg:TMessage);
  808. var
  809.     TheDialog:PDialog;
  810.     RadioRec :Record
  811.       RB1,RB2:Bool;
  812.   end;
  813.   RBut1,RBut2:PRadioButton;
  814. begin
  815.     TheDialog :=New(PDialog,Init(@Self,'OM_DLG1'));
  816.   New(RBut1,InitResource(TheDialog,id_D1RB1));
  817.   New(RBut2,InitResource(TheDialog,id_D1RB2));
  818.   RadioRec.RB1 := False;
  819.   RadioRec.RB2 := True;
  820.   TheDialog^.TransferBuffer := @RadioRec;
  821.   Application^.ExecDialog(TheDialog);
  822.   If RadioRec.RB1 then
  823.       begin
  824.     AutoMin := 1;
  825.     WritePrivateProfileString('OM','AutoMin','1','OM.INI')
  826.     end
  827.   else
  828.       begin
  829.     AutoMin := 0;
  830.     WritePrivateProfileString('OM','AutoMin','0','OM.INI');
  831.     end;
  832. end;
  833. {***********************  TOMDlg2  ******************************}
  834. constructor TOMDlg2.Init(AParent:PWindowsObject;AName:PChar);
  835. begin
  836.     TDialog.Init(AParent,AName);
  837.   New(EC1,InitResource(@Self,id_D2Ec1,70));
  838.   New(EC2,InitResource(@Self,id_D2Ec2,70));
  839.   New(EC3,InitResource(@Self,id_D2Ec3,70));
  840.   New(EC4,InitResource(@Self,id_D2Ec4,70));
  841.   New(EC5,InitResource(@Self,id_D2Ec5,70));
  842.   New(EC6,InitResource(@Self,id_D2Ec6,70));
  843. end;
  844.  
  845. procedure TOMDlg2.IDD2OK(var Msg:TMessage);
  846. begin
  847.     TransferData(tf_GetData);
  848.   EndDlg(1);
  849. end;
  850.  
  851. procedure TOMDlg2.IDBrowse(var Msg:TMessage);
  852. const
  853.   szFilter:Array[0..8] of Char ='*.*'#0'*.*'#0#0;
  854. var
  855.   pBuf:PChar;
  856.   Dir,Name,Ext:Array[0..fsPathName] of Char;
  857.     szDirName:Array[0..256] of Char;
  858.   szFile,szFileTitle:Array[0..256] of Char;
  859.   OFN:TOpenFileName;
  860.   Ptr:PChar;
  861. begin
  862.     Ptr := @szFilter;
  863.     StrCopy(szFile,'');
  864.   OFN.lStructSize := sizeof(TOpenFileName);
  865.   OFN.hWndOwner := HWindow;
  866.   OFN.lpStrFilter := Ptr;
  867.   OFN.lpStrCustomFilter := nil;
  868.   OFN.nMaxCustFilter := 0;
  869.   OFN.nFilterIndex := LongInt(1);
  870.   OFN.lpStrFile := szFile;
  871.   OFN.nMaxFile := sizeof(szFile);
  872.   OFN.lpstrfileTitle := szFileTitle;
  873.   OFN.nMaxFileTitle := sizeof(szFileTitle);
  874.   OFN.lpstrInitialDir := NIL;
  875.   OFN.lpStrTitle := 'Select Program';
  876.   OFN.flags := OFN_Pathmustexist or OFN_Filemustexist;
  877.   OFN.nFileOffset := 0;
  878.   OFN.nFileExtension := 0;
  879.   OFN.lpstrDefext := nil;
  880.   If GetOpenFileName(OFN) then
  881.       begin
  882.     FileSplit(szFile,Dir,Name,Ext);
  883.     StrLower(Name);
  884.     Name[0] := UpCase(Name[0]);
  885.     pBuf := Name;
  886.     EC2^.SetText(pBuf);
  887.     pBuf := szFile;
  888.       EC3^.SetText(pBuf);
  889.     SetFocus(GetItemHandle(id_D2Ec4));
  890.     end;
  891. end;
  892. {***********************  TOMDlg3  ******************************}
  893. procedure TOMDlg3.SetupWindow;
  894. var
  895. ArgList : record
  896.     StrPtr : PChar;
  897.   Free:PChar;
  898.   Size:LongInt;
  899.   PctFree:LongInt;
  900. end;
  901.     szFree:Array[0..5] of Char;
  902.   rFree:Real;
  903.   szDr:Array[0..2] of Char;
  904.   szOutput : Array[0..80] of Char;
  905.   hListBox:hWnd;
  906. begin
  907.     TDialog.SetupWindow;
  908.     hListBox :=GetItemHandle(Id_D3Lb1);
  909.     SendMessage(hListBox,wm_SetFont,GetStockObject(OEM_Fixed_Font),0);
  910.     DosError := 0; StrCopy(szOutput,'');
  911.   WVSPrintf(szOutput,'Dr  MBf  MBt %%Free',ArgList);
  912.   SendMessage(hListBox,lb_AddString,0,LongInt(@szOutput));
  913.  
  914.   StrCopy(szDr,'C:');
  915.   while DosError = 0 do
  916.        begin
  917.     SetCurDir(szDr);
  918.       if DosError = 0 then
  919.           begin
  920.         rFree := (DiskFree(0) / 1024 / 1024);
  921.         Str(rFree:4:1,szFree);
  922.         ArgList.Free := @szFree;
  923.         ArgList.Size := Round( DiskSize(0) / 1024 /1024) ;
  924.         ArgList.PctFree := Round(DiskFree(0) / (DiskSize(0) / 100 )) ;
  925.         ArgList.StrPtr := @szDr;
  926.         WVSPrintf(szOutput,'%s %s  %3li  %3li',ArgList);
  927.         SendMessage(hListBox,lb_AddString,0,LongInt(@szOutput));
  928.         end;
  929.         Inc(szDr[0]);
  930.     end;
  931. end;
  932. {********************  TOMAbout     **************************}
  933. constructor TOMAboutDlg.Init(AParent:PWindowsObject;
  934.             AName:PChar;ALogo:HBitmap;ABrush:HBrush);
  935. begin
  936.     TDialog.Init(AParent,AName);
  937.   Logo := ALogo;
  938.   Brush := ABrush;
  939. end;
  940.  
  941. procedure TOMAboutDlg.WMCTLCOLOR(var Msg: TMessage);
  942. const
  943.   as_AboutSt1 =   126;  {about dlg static text   }
  944.   as_AboutSt2 =   128;  {about dlg static blank static to draw upon}
  945. var
  946.     HSt1,HSt2:HWnd;
  947.   MemDC:hDC;
  948.   OldBitmap:HBitmap;
  949.   CR:TRect;
  950.   X,Y,W,H:Integer;
  951.   LogoMetrics:TBitmap;
  952. begin
  953.   case Msg.LParamHi of
  954.     ctlColor_Static:
  955.       begin
  956.         If (as_AboutSt1 = GetDlgCtrlID(Msg.lParamLo)) then
  957.             SetTextColor(Msg.WParam, RGB(0,0,255))
  958.         else  if (as_AboutSt2 = GetDlgCtrlID(Msg.lParamLo)) then
  959.             begin
  960.           MemDC := CreateCompatibleDC(Msg.WParam);
  961.           OldBitmap := SelectObject(MemDC,Logo);
  962.           GetClientRect(Msg.lParamLo,CR);
  963.           W:= CR.Right-CR.Left;H:= CR.Bottom-CR.Top;
  964.           GetObject(Logo,SizeOf(LogoMetrics),@LogoMetrics);
  965.           X := Max((W - LogoMetrics.bmWidth) div 2 , 0);
  966.           Y := Max((H - LogoMetrics.bmHeight) div 2 , 0);
  967.           BitBlt(Msg.WParam,X,Y,W,H,MemDc,0,0,SrcCopy);
  968.           SelectObject(MemDC,OldBitmap);
  969.           DeleteDC(MemDc);
  970.           end;
  971.         SetBkMode(Msg.WParam, transparent);
  972.         Msg.Result := GetStockObject(Null_Brush);
  973.       end;
  974.     ctlcolor_Dlg:
  975.       begin
  976.         SetBkMode(Msg.WParam, Transparent);
  977.         Msg.Result := GetStockObject(ltGray_Brush);
  978.       end;
  979.   else
  980.     DefWndProc(Msg);
  981.   end;
  982. end;
  983. {************************  TPrgItem    *****************************}
  984. constructor TPgmItem.Init(NewPgmName,NewPgmFile,NewDir,NewParams:PChar;NewCmdShow:Pchar);
  985. begin
  986.     PgmName := StrNew(NewPgmName);
  987.   PgmFile := StrNew(NewPgmFile);
  988.   Dir := StrNew(NewDir);
  989.   Params := StrNew(NewParams);
  990.   CmdShow := StrNew(NewCmdShow);
  991. end;
  992.  
  993. destructor TPgmItem.Done;
  994. begin
  995.     StrDispose(PgmName);
  996.   StrDispose(PgmFile);
  997.   StrDispose(Dir);
  998.   StrDispose(Params);
  999.   StrDispose(CmdShow);
  1000. end;
  1001. {************************  TOMCol    *****************************}
  1002. constructor TOMCol.Init(ALimit,ADelta:Integer);
  1003. begin
  1004.     TheItems := New(PCollection,Init(ALimit,ADelta));
  1005. end;
  1006.  
  1007. destructor TOMCol.Done;
  1008. begin
  1009.     Dispose(TheItems,Done);
  1010. end;
  1011.  
  1012. function TOMCol.At(Indx:Integer):PPgmItem;
  1013. begin
  1014.     At := TheItems^.At(Indx);
  1015. end;
  1016.  
  1017. procedure TOMCol.ReadItems(Start,Finish:Integer);
  1018. var
  1019.     Buf1:Array[0..30] of Char;
  1020.   Indx:Integer;
  1021.   IndxStr:Array[0..5] of Char;
  1022.   Found:Boolean;
  1023.   Key:Array[0..20] of Char;
  1024.   PgmName,PgmFile,Dir,Params:Array[0..50] of Char;
  1025.   CmdShow:Array[0..5] of Char;
  1026. begin
  1027.   for Indx := Start to Finish do
  1028.       begin
  1029.     StrCopy(PgmFile,'');Strcopy(Dir,'');StrCopy(Params,'');StrCopy(CmdShow,'');
  1030.     Str(Indx,IndxStr);
  1031.     StrCat(StrCopy(Key,'PgmName'),IndxStr);
  1032.         GetPrivateProfileString('OM',Key,'',PgmName,SizeOf(PgmName),'OM.INI');
  1033.     if PgmName[0] <> #0 then
  1034.         begin
  1035.         StrCat(StrCopy(Key,'PgmFile'),IndxStr);
  1036.             GetPrivateProfileString('OM',Key,'',PgmFile,SizeOf(PgmFile),'OM.INI');
  1037.         StrCat(StrCopy(Key,'Dir'),IndxStr);
  1038.             GetPrivateProfileString('OM',Key,'',Dir,SizeOf(dir),'OM.INI');
  1039.         StrCat(StrCopy(Key,'Params'),IndxStr);
  1040.             GetPrivateProfileString('OM',Key,'',Params,SizeOf(Params),'OM.INI');
  1041.         StrCat(StrCopy(Key,'CmdShow'),IndxStr);
  1042.             GetPrivateProfileString('OM',Key,'',Cmdshow,SizeOf(CmdShow),'OM.INI');
  1043.         end;
  1044.     TheItems^.AtInsert(Indx,New(PPgmItem,Init(PgmName,PgmFile,Dir,Params,Cmdshow)));
  1045.     end;
  1046. end;
  1047.  
  1048. procedure TOMCol.ItemGet(var PgmItem:ItemRec);
  1049. var
  1050.   Indx:Integer;
  1051.   IndxStr:Array[0..5] of Char;
  1052.   ErrCode:Integer;
  1053.   TheItem:PPgmItem;
  1054. begin
  1055.     Val(PgmItem.ItemNum,Indx,ErrCode);
  1056.   if (ErrCode <> 0) or (NOT(IsValidIndx(Indx))) then
  1057.       Exit;
  1058.   begin
  1059.   TheItem := TheItems^.At(Indx);
  1060.   If TheItem^.PgmName <> nil then
  1061.       StrCopy(PgmItem.PgmName,TheItem^.PgmName);
  1062.   If TheItem^.PgmFile <> nil then
  1063.       StrCopy(PgmItem.PgmFile,TheItem^.PgmFile);
  1064.   If TheItem^.Dir <> nil then
  1065.       StrCopy(PgmItem.Dir,TheItem^.Dir);
  1066.   If TheItem^.Params <> nil then
  1067.       StrCopy(PgmItem.Params,TheItem^.Params);
  1068.   If TheItem^.Cmdshow <> nil then
  1069.       StrCopy(PgmItem.CmdShow,TheItem^.Cmdshow);
  1070.     end;
  1071. end;
  1072.  
  1073. procedure TOMCol.ItemSet(PgmItem:ItemRec);
  1074. var
  1075.     Buf1:Array[0..30] of Char;
  1076.   Indx:Integer;
  1077.   IndxStr:Array[0..5] of Char;
  1078.   Found:Boolean;
  1079.   Key:Array[0..20] of Char;
  1080.   Errval:Integer;
  1081. begin
  1082.     Val(PgmItem.ItemNum,Indx,Errval);
  1083.   If IsValidIndx(Indx) then
  1084.       begin
  1085.       StrCopy(IndxStr,PgmItem.ItemNum) ;
  1086.     StrCat(StrCopy(Key,'PgmName'),IndxStr);
  1087.         WritePrivateProfileString('OM',Key,PgmItem.PgmName,'OM.INI');
  1088.     StrCat(StrCopy(Key,'PgmFile'),IndxStr);
  1089.         WritePrivateProfileString('OM',Key,PgmItem.PgmFile,'OM.INI');
  1090.     StrCat(StrCopy(Key,'Dir'),IndxStr);
  1091.         WritePrivateProfileString('OM',Key,PgmItem.Dir,'OM.INI');
  1092.     StrCat(StrCopy(Key,'Params'),IndxStr);
  1093.         WritePrivateProfileString('OM',Key,PgmItem.Params,'OM.INI');
  1094.     StrCat(StrCopy(Key,'CmdShow'),IndxStr);
  1095.         WritePrivateProfileString('OM',Key,PgmItem.CmdShow,'OM.INI');
  1096.     TheItems^.AtFree(Indx);
  1097.     TheItems^.AtInsert(Indx,New(PPgmItem,Init(PgmItem.PgmName,PgmItem.PgmFile,
  1098.         PgmItem.Dir,PgmItem.Params,PgmItem.Cmdshow)));
  1099.     end;
  1100. end;
  1101.  
  1102. function TOMCol.GetCount:Integer;
  1103. begin
  1104.     GetCount := TheItems^.Count;
  1105. end;
  1106.  
  1107. function TOMCol.IsValidIndx(Indx:Integer):Boolean;
  1108. begin
  1109.     IsValidIndx :=((Indx >= 0) and (Indx < TheItems^.Count));
  1110. end;
  1111. {************************  TOMRButton    *****************************}
  1112. procedure TOMRButton.WMRButtonDown(var Msg:TMessage);
  1113. begin
  1114.   SendMessage(Parent^.HWindow,wm_User+wm_RButtonDown,GetID,0);
  1115. end;
  1116. {***************************************************************************}
  1117. procedure TOMGroupBox.SetupWindow;
  1118. begin
  1119.     TGroupBox.SetupWindow;
  1120.   DragAcceptFiles(HWindow,TRUE);
  1121. end;
  1122.  
  1123. function TOMGroupBox.CanClose:Boolean;
  1124. begin
  1125.     DragAcceptFiles(HWindow,FALSE);
  1126.     CanClose := TGroupBox.CanClose;
  1127. end;
  1128.  
  1129. procedure TOMGroupBox.WMDropFiles(var Msg:TMessage);
  1130. var
  1131.     DropItem:hDrop;
  1132.   FileNameBuf:Array[0..fsPathName] of Char;
  1133.   NewIcon:hIcon;
  1134.   MemDC,DC:HDC;
  1135.   OldBmp,NewBmp:HBitmap;
  1136.   OldBrush:HBrush;
  1137.   GFileName:PChar;
  1138.   CtrlID:Integer;
  1139.   Loc,SLoc:TPoint;
  1140.   ChildWin:HWnd;
  1141. begin
  1142.     DropItem := Msg.wParam;
  1143.   DragQueryFile(DropItem,0,FileNameBuf,sizeof(FileNameBuf));
  1144.   GFileName :=StrNew(FileNameBuf);
  1145.   DragQueryPoint(DropItem,Loc);
  1146.   DragFinish(DropItem);
  1147.   SLoc := Loc;
  1148.   ClienttoScreen(HWindow,SLoc);
  1149.   ChildWin := WindowFromPoint(SLoc);
  1150.   CtrlID := GetDlgCtrlID(ChildWin);
  1151.   SendMessage(Parent^.HWindow,wm_User+wm_DropFiles,CtrlID,LongInt(GFileName));
  1152.   StrDispose(GFileName);
  1153. end;
  1154. {************************  TOMStatic    *****************************}
  1155. procedure TOMStatic.WMRButtonDown(var Msg:TMessage);
  1156. begin
  1157.   SendMessage(Parent^.HWindow,wm_User+wm_RButtonDown,GetID,0);
  1158. end;
  1159. {***********************  MainLine  ********************************}
  1160. var
  1161.     OMApp : TOMApplication;
  1162. begin
  1163.     OMApp.Init('OttoMenu');
  1164.   OMApp.Redraw;
  1165.     OMApp.Run;
  1166.     OMApp.Done;
  1167. end.
  1168.