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