home *** CD-ROM | disk | FTP | other *** search
- {OttoMenu 3.0 - Program Copyright (C) Doug Overmyer 12/17/91}
- {Begun 12/2/91} {Rel 3.0} {tabs = 2}
- program OttoMenu;
-
- {$S-}{$R om.RES}{$R-}{$X+}{$V-}
- uses WinTypes,WinProcs,Strings,WObjects,WinDos,StdDlgs,
- WFPlus,Buttons,SclpText;
- const
- id_But1 = 201; {User defined button 1 iconbar}
- id_But2 = 202; { " 2 iconbar}
- id_But3 = 203; { " 3 iconbar}
- id_But4 = 204; { " 3 iconbar}
- id_But5 = 205; { " 5 iconbar}
- id_But6 = 206; {User defined button 6 iconbar}
- id_But7 = 207; { " 7 iconbar}
- id_But8 = 208; { " 8 iconbar}
- id_But9 = 209; { " 9 iconbar}
- id_But10 = 210; { " 10 iconbar}
- id_But11 = 211;
- id_But12 = 212;
- id_But13 = 213;
- id_But14 = 214;
- id_But15 = 215;
- id_But21 = 221; {page 1 icon}
- id_But22 = 222; {page 2 icon}
- id_But23 = 223; {page 3 icon}
- id_But24 = 224; {page 4 icon}
- id_Gb1 = 300; {group box for radio buttons}
- id_GB2 = 200; {group box for page icons}
- id_D1Lb1 = 351; {List box element in Dlg1}
- id_St1 = 401; {Static text 1 icon bar}
- id_St2 = 402; {Static text 2 icon bar}
- id_D2OK = 601; {OK button in Dlg2 }
- id_D2Browse= 650; {Dlg2 Browse button}
- id_D2EC1 = 603; {Edit Control 1 in Dlg2 item #}
- id_D2EC2 = 605; { 2 Name}
- id_D2EC3 = 607; { 3 file}
- id_D2EC4 = 609; { 4 Start directory}
- id_D2EC5 = 617; { 5 parameters}
- id_D2EC6 = 621; { 6 start size}
- id_D3LB1 = 701;
-
- idm_About = 801; {menu id for OM_About menu}
- idm_MenuChange = 803;
- idm_Run =802;
- {************************ Types ************************}
- type
- TOMApplication = object(TApplication)
- procedure InitMainWindow;virtual;
- end;
-
- type
- ItemRec = record
- ItemNum,PgmName,PgmFile,Dir,Params,Cmdshow:Array[0..69] of Char;
- end;
-
- type
- PPgmItem = ^TPgmItem;
- TPgmItem = object(TObject)
- PgmName:PChar;
- PgmFile:PChar;
- Dir:PChar;
- Params:PChar;
- CmdShow:PChar;
- constructor Init(NewPgmName,NewPgmFile,NewDir,NewParams,NewCmdShow:PChar);
- destructor Done;virtual;
- end;
-
- POMDlg2 = ^TOMDlg2;
- TOMDlg2 = object(TDialog) {Item setup dialog}
- AnItem:ItemRec;
- procedure WMInitDialog(var Msg:TMessage);virtual wm_First+wm_InitDialog;
- procedure IDD2OK(var Msg:TMessage); virtual id_First+id_D2OK;
- procedure IDD2EC1(var Msg:TMessage);virtual id_First+id_D2EC1;
- procedure IDD2EC2(var Msg:TMessage);virtual id_First+id_D2EC2;
- procedure IDD2EC3(var Msg:TMessage);virtual id_First+id_D2EC3;
- procedure IDD2EC4(var Msg:TMessage);virtual id_First+id_D2EC4;
- procedure IDD2EC5(var Msg:TMessage);virtual id_First+id_D2EC5;
- procedure IDD2EC6(var Msg:TMessage);virtual id_First+id_D2EC6;
- procedure LoadFields;
- procedure IDBrowse(var Msg:TMessage);virtual id_First+id_D2Browse;
- end;
-
- POMDlg3 = ^TOMDlg3;
- TOMDlg3 = object(TDialog) {Item setup dialog}
- procedure SetupWindow; virtual;
- end;
-
-
- POMAboutDlg = ^TOMAboutDlg;
- TOMAboutDlg = object(TDialog)
- CurBrush:HBrush;
- Is_Timer:Boolean;
- procedure WMCtlColor(var Msg:TMessage);virtual wm_First+wm_CtlColor;
- procedure SetupWindow;virtual;
- procedure WMTimer(var Msg:TMessage);virtual wm_First+wm_Timer;
- function CanClose:Boolean;virtual;
- end;
-
- type {MainWindow of Application}
- POMWindow = ^TOMWindow;
- TOMWindow = object(TWindow)
- TheIcon:HIcon;
- BN:Array[0..15] of PODButton; {icon bar button pointers}
- BNR:Array[0..5] of PODRButton;
- Gb1:PGroupBox;
- GB2:PODGroupBox;
- RB:Array[0..20] of PRadioButton; {radio button pointers id's 301-320}
- St1,St2:PSText;
- Apps:PCollection;
- Br1,Br2:HBrush;
- Logo:HBitmap;
- PageNum,Max_Pages,AutoMin:Integer;
- hUser,hGDI:THandle;
- Helv:HFont;
- Dlg3:POMDlg3;
- constructor Init(AParent:PWindowsObject;ATitle:PChar);
- destructor Done;virtual;
- procedure SetupWindow;virtual;
- procedure SetRBText;virtual;
- procedure Paint(PaintDC:HDC;var PaintInfo:TPaintStruct);virtual;
- procedure SetStaticText;
- procedure WMDrawItem(var Msg:TMessage);virtual wm_First + wm_DrawItem;
- procedure IDBut1(var Msg:TMessage);virtual id_First+id_But1; { }
- procedure IDBut2(var Msg:TMessage);virtual id_First+id_But2; { }
- procedure IDBut3(var Msg:TMessage);virtual id_First+id_But3; { }
- procedure IDBut4(var Msg:TMessage);virtual id_First+id_But4; { }
- procedure IDBut5(var Msg:TMessage);virtual id_First+id_But5; { }
- procedure IDBut6(var Msg:TMessage);virtual id_First+id_But6; { }
- procedure IDBut7(var Msg:TMessage);virtual id_First+id_But7; { }
- procedure IDBut8(var Msg:TMessage);virtual id_First+id_But8; { }
- procedure IDBut9(var Msg:TMessage);virtual id_First+id_But9; { }
- procedure IDBut10(var Msg:TMessage);virtual id_First+id_But10; { }
- procedure IDBut11(var Msg:TMessage);virtual id_First+id_But11; { }
- procedure IDBut12(var Msg:TMessage);virtual id_First+id_But12; { }
- procedure IDBut13(var Msg:TMessage);virtual id_First+id_But13; { }
- procedure IDBut14(var Msg:TMessage);virtual id_First+id_But14; { }
- procedure IDBut21(var Msg:TMessage);virtual id_First+id_But21; {Page1}
- procedure IDBut22(var Msg:TMessage);virtual id_First+id_But22; {Page2}
- procedure IDBut23(var Msg:TMessage);virtual id_First+id_But23; {Page3}
- procedure IDBut24(var Msg:TMessage);virtual id_First+id_But24; {Page4}
- procedure IDBut15(var Msg:TMessage);virtual id_First+id_But15; {Free Icon}
- procedure DefChildProc(var Msg:TMessage);virtual;
- procedure WinExecc(var Msg:TMessage);virtual;
- procedure WMSysCommand(var Msg:TMessage);virtual wm_First+wm_SysCommand;
- procedure GetItemValues(var AnItem:ItemRec);virtual;
- procedure SetItemValues(AnItem:ItemRec);virtual;
- procedure GetItems;virtual;
- procedure WMCtlColor(var Msg:TMessage);virtual wm_First+wm_CtlColor;
- procedure RunIt;virtual;
- end;
- {*********************** Globals ******************************}
- var
- MainWin:POMWindow;
- {*********************** Methods *******************************}
- procedure TOMApplication.InitMainWindow;
- begin
- MainWindow := New(POMWindow,Init(nil,'OttoMenu'));
- MainWin := POMWindow(MainWindow);
- end;
- {********************** TOMWindow *******************************}
- constructor TOMWindow.Init(AParent:PWindowsObject;ATitle:PChar);
- Const
- BMP:Array[0..25] of PChar = ('','OM_B4','OM_B1','OM_B9','OM_B8','OM_B10',
- 'OM_B7','OM_B3','OM_B11','OM_B12','OM_B13',
- 'OM_B2','OM_B14','OM_B15', 'OM_B6', 'OM_B5',
- '','','','','',
- 'OM_B21', 'OM_B22','OM_B23','OM_B24','');
- var
- TheBmp:HBitmap;
- Buf:Array[0..25] of Char;
- Indx:Integer;
- begin
- TWindow.Init(AParent,ATitle);
- Attr.Menu := 0; {LoadMenu(HInstance,'OM_Menu');}
- Attr.X := 20; Attr.Y := 25; Attr.W := 595; Attr.H := 325;
- Attr.Style := ws_Overlapped or ws_SysMenu or ws_MinimizeBox;
- Max_Pages :=Min(4,GetPrivateProfileInt('OM','MaxPages',4,'OM.INI'));
- For Indx := 0 to 11 do BN[Indx] := nil;
- For Indx := 0 to 4 do BNR[Indx] := nil;
- For Indx := 0 to 20 do RB[Indx] := nil;
- For Indx := 1 to 10 do
- BN[Indx]:=New(PODButton,Init(@Self,200+Indx,'',(Indx-1)*34,0,34,34,False,BMP[Indx]));
- For Indx := 11 to 15 do
- BN[Indx]:=New(PODButton,Init(@Self,200+Indx,'',(Indx-11)*34+0,35,34,34,False,BMP[Indx]));
- Gb2 := New(PODGroupBox,Init(@Self,id_Gb2,'',0,35,34,34));
- GB2^.Attr.Style := GB2^.Attr.Style and not ws_Visible;
- For Indx := 1 to Max_Pages do
- BNR[Indx] := New(PODRButton,Init(@Self,Indx+220,'',0,35,34,34,GB2,BMP[Indx+20]));
- St1 := New(PSText,Init(@Self,id_St1,'',345,5,245,25,sr_Recessed,
- dt_Center or dt_VCenter or dt_SingleLine));
- GB1 := New(PGroupBox,Init(@Self,id_Gb1,'Applications',200,50,350,230));
- For Indx := 1 to 10 do
- RB[Indx]:=New(PRadioButton,Init(@Self,(300+Indx),'',215,(75+(Indx-1)*20),160,20,GB1));
- For Indx := 11 to 20 do
- RB[Indx]:=New(PRadioButton,Init(@Self,(300+Indx),'',385,(75+(Indx-11)*20),160,20,GB1));
- Apps := New(PCollection,Init(81,20));
- PageNum := 1;
- TheBmp :=LoadBitmap(HInstance,'OM_Br1');
- Br1 :=CreatePatternBrush(TheBmp);
- DeleteObject(TheBmp);
- theBmp :=LoadBitmap(HInstance,'OM_Br2');
- Br2 :=CreatePatternBrush(TheBmp);
- DeleteObject(theBmp);
- GetPrivateProfileString('OM','CPU','Otto',Buf,SizeOf(Buf),'OM.INI');
- AutoMin :=Min(2,GetPrivateProfileInt('OM','AutoMin',0,'OM.INI'));
- if StrIComp(Buf,'ECO')= 0 then
- Logo :=LoadBitmap(HInstance,'OM_Logo')
- else if StrIComp(Buf,'MIS') = 0 then
- Logo :=LoadBitmap(HInstance,'OM_Logo2')
- else
- Logo :=LoadBitmap(HInstance,'OM_Logo3');
- BNR[1]^.State := 1;
- GB2^.SelectionChanged(id_But21);
- end;
-
- procedure TOMWindow.SetupWindow;
- var
- SysMenu:hMenu;
- Indx:Word;
- CR:TRect;
- NewTop:Integer;
- LogFont:TLogFont;
- DC:hDC;
- LogPixY:Integer;
- Msg:TMessage;
- begin
- TWindow.SetupWindow;
- SetClassWord(HWindow,GCW_HIcon,LoadIcon(HInstance,'OM_Icon'));
- SetClassWord(HWindow,GCW_HBrBackGround,Br1);
- Sysmenu := GetSystemMenu(hWindow,false);
- AppendMenu(SysMenu,MF_Separator,0,nil);
- AppendMenu(Sysmenu,0,idm_Run,'Run...');
- AppendMenu(Sysmenu,0,idm_MenuChange,'Menu Maintenance...');
- AppendMenu(Sysmenu,0,idm_About,'About...');
- GetClientRect(HWindow,CR);
- NewTop := CR.Bottom-Cr.Top-34;
- for Indx := 1 to 4 do
- if BNR[Indx] <> nil then
- begin
- MoveWindow(BNR[Indx]^.HWindow,34*(Indx-1),NewTop,34,34,False);
- MoveWindow(GB2^.HWindow,0,NewTOP,34*(Indx),34,False);
- end;
- hUser := LoadLibrary('User.exe');
- FreeLibrary(hUser);
- hGDI := LoadLibrary('GDI.exe');
- FreeLibrary(hGDI);
-
- DC := GetDC(HWindow);
- LogPixY :=GetDeviceCaps(DC,LogPixelsY);
- ReleaseDC(HWindow,DC);
-
- GetObject(GetStockObject(System_Font),sizeof(LogFont),@LogFont);
- StrCopy(LogFont.lfFaceName,'Helv');
- LogFont.lfHeight := round(LogFont.lfHeight * 2 / 3);
- LogFont.lfWidth := 0;
- LogFont.lfPitchAndFamily := 0;
- Helv := CreateFontIndirect(LogFont);
-
- SetStaticText;
- GetItems;
- SetRBText;
- end;
-
- procedure TOMWindow.SetStaticText;
- var
- Buf:Array[0..55] of Char;
- Mem :Record
- GlobalFreeMem,User,GDI:LongInt;
- end;
- PageNumBuf:Array[0..25] of Char;
- LogFont:TLogFont;
- NewFont,OldFont:HFont;
- begin
- Mem.User :=Round((65536 - GlobalSize(hUser)) / 1024);
- Mem.GDI := Round((65536 -GlobalSize(hGDI)) / 1024);
- Mem.GlobalFreeMem := Round(GetFreeSpace(0) / 1024);
- wvsprintf(Buf,'GMem:%luK USeg:%luK GDISeg:%liK',Mem);
-
- St1^.SetFont(Helv);
- St1^.SetText(Buf);
- Str(PageNum,PageNumBuf);
- StrCat(StrCopy(Buf,'Page: '),PageNumBuf);
- SetWindowText(GB1^.HWindow,Buf);
- end;
-
- procedure TOMWindow.GetItems;
- var
- Buf1:Array[0..30] of Char;
- Indx:Integer;
- IndxStr:Array[0..5] of Char;
- Found:Boolean;
- Key:Array[0..20] of Char;
- PgmName,PgmFile,Dir,Params:Array[0..50] of Char;
- CmdShow:Array[0..5] of Char;
- begin
- for Indx := 0 to 20*Max_Pages do
- begin
- StrCopy(PgmFile,'');Strcopy(Dir,'');StrCopy(Params,'');StrCopy(CmdShow,'');
- Str(Indx,IndxStr);
- StrCat(StrCopy(Key,'PgmName'),IndxStr);
- GetPrivateProfileString('OM',Key,'',PgmName,SizeOf(PgmName),'OM.INI');
- if PgmName[0] <> #0 then
- begin
- StrCat(StrCopy(Key,'PgmFile'),IndxStr);
- GetPrivateProfileString('OM',Key,'',PgmFile,SizeOf(PgmFile),'OM.INI');
- StrCat(StrCopy(Key,'Dir'),IndxStr);
- GetPrivateProfileString('OM',Key,'',Dir,SizeOf(dir),'OM.INI');
- StrCat(StrCopy(Key,'Params'),IndxStr);
- GetPrivateProfileString('OM',Key,'',Params,SizeOf(Params),'OM.INI');
- StrCat(StrCopy(Key,'CmdShow'),IndxStr);
- GetPrivateProfileString('OM',Key,'',Cmdshow,SizeOf(CmdShow),'OM.INI');
- end;
- Apps^.AtInsert(Indx,New(PPgmItem,Init(PgmName,PgmFile,Dir,Params,Cmdshow)));
- end;
- end;
-
- procedure TOMWindow.SetRBText;
- var
- Offset:Integer;
- ChildWin:PRadioButton;
- Indx:Integer;
- Item:PPgmItem;
- begin
- Offset := (PageNum-1)*20;
- For Indx := Offset+1 to Offset+20 do
- begin
- Item := Apps^.At(Indx);
- SetWindowText(RB[Indx-OffSet]^.HWindow,Item^.PgmName);
- end;
- end;
-
- destructor TOMWindow.Done;
- begin
- DeleteObject(Helv);
- Dispose(Apps,Done);
- DeleteObject(Logo);
- If HPrevInst = 0 then
- begin
- DeleteObject(Br1);
- DeleteObject(Br2);
- end;
- TWindow.Done;
- end;
-
- procedure TOMWindow.Paint(PaintDC:HDC;var PaintInfo:TPaintStruct);
- var
- ThePen:HPen;
- TheBrush :HBrush;
- OldBrush :HBrush;
- OldPen:HPen;
- MemDC:hDC;
- OldBitmap:HBitmap;
- CR:TRect;
- X1,Y1,X2,Y2:Integer;
- Pen1:HPen;
- Pen2:HPen;
- begin
- X1:=190;Y1:=48;X2:=560;Y2:=290;
- TheBrush := GetStockObject(LtGray_Brush);
- ThePen := CreatePen(ps_Solid,1,$00000000);
- OldPen := SelectObject(PaintDC,ThePen);
- OldBrush := SelectObject(PaintDC,TheBrush);
- Rectangle(PaintDC,0,0,1024,35);
- SelectObject(PaintDC,OldBrush);
- SelectObject(PaintDC,OldPen);
- DeleteObject(ThePen);
- DeleteObject(TheBrush);
- SRectangle(PaintDC,X1,Y1,X2,Y2,2,sr_Recessed);
- MemDC := CreateCompatibleDC(PaintDC);
- OldBitmap := SelectObject(MemDC,Logo);
- BitBlt(PaintDC,25,100,125,125,MemDc,0,0,SrcCopy);
- SelectObject(MemDC,OldBitmap);
- DeleteDC(MemDc);
- end;
-
- procedure TOMWindow.WMDrawItem(var Msg:TMessage);
- var
- PDIS : ^TDrawItemStruct;
- begin
- PDIS := Pointer(Msg.lParam);
- case PDIS^.CtlType of
- odt_Button:
- case PDIS^.CtlID of
- id_But1..id_But15:Bn[PDIS^.CtlID-200]^.DrawItem(Msg);
- id_But21..id_But24:BnR[PDIS^.CtlID-220]^.DrawItem(Msg);
- end;
- end;
- end;
-
- procedure TOMWindow.IDBut1(var Msg:TMessage);
- begin
- WinExec('progman.exe',sw_Normal);
- end;
-
- procedure TOMWindow.IDBut2(var Msg:TMessage);
- begin
- WinExec('winfile.exe',sw_Normal);
- end;
-
- procedure TOMWindow.IDBut3(var Msg:TMessage);
- begin
- WinExec('clipbrd.exe',sw_Normal);
- end;
-
- procedure TOMWindow.IDBut4(var Msg:TMessage);
- begin
- WinExec('control.exe',sw_Normal);
- end;
-
- procedure TOMWindow.IDBut5(var Msg:TMessage);
- begin
- winExec('printman.exe',sw_Normal);
- end;
-
- procedure TOMWindow.IDBut6(var Msg:TMessage);
- begin
- WinExec('pifedit.exe',sw_Normal);
- end;
-
- procedure TOMWindow.IDBut7(var Msg:TMessage);
- begin
- WinExec('notepad.exe',sw_Normal);
- end;
-
- procedure TOMWindow.IDBut8(var Msg:TMessage);
- begin
- WinExec('pbrush.exe',sw_Normal);
- end;
-
- procedure TOMWindow.IDBut9(var Msg:TMessage);
- begin
- WinExec('sysedit.exe',sw_Normal);
- end;
-
- procedure TOMWindow.IDBut10(var Msg:TMessage);
- begin
- WinExec('setup.exe',sw_Normal);
- end;
-
- procedure TOMWindow.IDBut11(var Msg:TMessage);
- var
- Item:PPgmItem;
- begin
- Item := Apps^.At(0);
- if (Item^.Dir <> NIL) then
- SetCurdir(Item^.Dir);
- if (Item^.PgmFile <> nil) then
- WinExec(Item^.PgmFile,sw_Normal)
- else
- WinExec('command.com',sw_Normal);
- end;
-
- procedure TOMWindow.IDBut12(var Msg:TMessage);
- begin
- Dlg3 := New(POMDlg3,Init(@Self,'Om_Dlg3'));
- Application^.ExecDialog(Dlg3);
- end;
-
- procedure TOMWindow.IDBut13(var Msg:TMessage);
- begin
- SetStaticText;
- end;
-
- procedure TOMWindow.IDBut14(var Msg:TMessage);
- begin
- CloseWindow;
- end;
-
- procedure TOMWindow.IDBut15(var Msg:TMessage);
- begin
- ExitWindows(0,0);
- end;
-
- procedure TOMWindow.IDBut21(var Msg:TMessage);
- begin
- PageNum := 1;
- SetRBText;
- SetStaticText;
- end;
- procedure TOMWindow.IDBut22(var Msg:TMessage);
- begin
- PageNum := Min(2,Max_Pages);
- SetRBText;
- SetStaticText;
- end;
- procedure TOMWindow.IDBut23(var Msg:TMessage);
- begin
- PageNum := Min(3,Max_pages);
- SetRBText;
- SetStaticText;
- end;
- procedure TOMWindow.IDBut24(var Msg:TMessage);
- begin
- PageNum := Min(4,Max_Pages);
- SetRBText;
- SetStaticText;
- end;
-
-
-
- procedure TOMWindow.DefChildProc(var Msg:TMessage);
- var
- ID:Integer;
- begin
- ID := Msg.WParam-300 + 20*(PageNum-1);
- If (Msg.WParam > id_GB1) and
- (Msg.WParam < (id_GB1+21)) and
- (ID < Apps^.Count) then
- WinExecc(Msg)
- else
- TWindow.DefChildProc(Msg);
- end;
-
- procedure TOMWindow.WinExecc(var Msg:TMessage);
- var
- ID:Integer;
- Item:PPgmItem;
- Buf:Array[0..100] of Char;
- Errval:Integer;
- nCmdShow,CmdShow:Integer;
- begin
- ID := Msg.WParam-300 + 20*(PageNum-1);
- Item := Apps^.At(ID);
- if (Item^.PgmFile = NIL) then
- begin
- RB[Msg.WParam-300]^.Toggle;
- TWindow.DefChildProc(Msg);
- Exit;
- end;
-
- StrCopy(Buf,Item^.PgmFile);
- if (Item^.Params <> NIL) then
- StrCat(StrCat(Buf,' '),Item^.Params);
- if (Item^.Cmdshow <> NIL) then
- case Item^.CmdShow[0] of
- 'N','n':Cmdshow := sw_Normal;
- 'M','m':CmdShow := sw_Maximize;
- 'I','i':CmdShow := sw_Minimize;
- else
- CmdShow := sw_Normal;
- end;
- if (Item^.Dir <> NIL) then
- SetCurdir(Item^.Dir);
- WinExec(Buf,CmdShow);
- RB[Msg.WParam-300]^.Toggle;
- If AutoMin = 1 then
- ShowWindow(HWindow,sw_Minimize);
- end;
-
- procedure TOMWindow.WMSysCommand(var Msg:TMessage);
- begin
- case Msg.Wparam of
- idm_About:
- Application^.ExecDialog(New(POMAboutDlg,Init(@Self,'OM_About')));
- idm_MenuChange:
- Application^.ExecDialog(New(POMDlg2,Init(@Self,'Om_Dlg2')));
- idm_Run:
- Runit;
- else
- DefWndProc(Msg);
- end;
- end;
-
- procedure TOMWindow.GetItemValues(var AnItem:ItemRec);
- var
- Buf1:Array[0..30] of Char;
- Indx:Integer;
- IndxStr:Array[0..5] of Char;
- Key:Array[0..20] of Char;
- ErrCode:Integer;
- TheItem:PPgmItem;
- begin
- Val(AnItem.ItemNum,Indx,ErrCode);
- if ErrCode <> 0 then
- Exit;
- If Indx > Max_Pages*20 then
- Exit;
- begin
- TheItem := Apps^.At(Indx);
- If TheItem^.PgmName <> nil then
- StrCopy(AnItem.PgmName,TheItem^.PgmName);
- If TheItem^.PgmFile <> nil then
- StrCopy(AnItem.PgmFile,TheItem^.PgmFile);
- If TheItem^.Dir <> nil then
- StrCopy(AnItem.Dir,TheItem^.Dir);
- If TheItem^.Params <> nil then
- StrCopy(AnItem.Params,TheItem^.Params);
- If TheItem^.Cmdshow <> nil then
- StrCopy(AnItem.CmdShow,TheItem^.Cmdshow);
- end;
- end;
-
- procedure TOMWindow.SetItemValues(AnItem:ItemRec);
- var
- Buf1:Array[0..30] of Char;
- Indx:Integer;
- IndxStr:Array[0..5] of Char;
- Found:Boolean;
- Key:Array[0..20] of Char;
- Errval:Integer;
- begin
- Val(AnItem.ItemNum,Indx,Errval);
- If Indx <= 20*Max_Pages then
- begin
- StrCopy(IndxStr,AnItem.ItemNum) ;
- StrCat(StrCopy(Key,'PgmName'),IndxStr);
- WritePrivateProfileString('OM',Key,AnItem.PgmName,'OM.INI');
- StrCat(StrCopy(Key,'PgmFile'),IndxStr);
- WritePrivateProfileString('OM',Key,AnItem.PgmFile,'OM.INI');
- StrCat(StrCopy(Key,'Dir'),IndxStr);
- WritePrivateProfileString('OM',Key,AnItem.Dir,'OM.INI');
- StrCat(StrCopy(Key,'Params'),IndxStr);
- WritePrivateProfileString('OM',Key,AnItem.Params,'OM.INI');
- StrCat(StrCopy(Key,'CmdShow'),IndxStr);
- WritePrivateProfileString('OM',Key,AnItem.CmdShow,'OM.INI');
- Apps^.AtFree(Indx);
- Apps^.AtInsert(Indx,New(PPgmItem,Init(AnItem.PgmName,AnItem.PgmFile,
- AnItem.Dir,AnItem.Params,AnItem.Cmdshow)));
- SetRBText;
- end;
- end;
-
- procedure TOMWindow.WMCTLCOLOR(var Msg: TMessage);
- const
- as_AboutSt1 = 126; {about dlg static text }
- as_AboutSt2 = 128; {about dlg static blank static to draw upon}
- var
- HSt1,HSt2:HWnd;
- MemDC:hDC;
- OldBitmap:HBitmap;
- CR:TRect;
- X,Y,W,H:Integer;
- LogoMetrics:TBitmap;
- begin
- case Msg.LParamHi of
- ctlcolor_Btn:
- begin
- SetBkMode(Msg.WParam, Transparent);
- Msg.Result := GetStockObject(ltGray_Brush);
- end;
- else
- DefWndProc(Msg);
- end;
- end;
-
- procedure TOMWindow.Runit;
- var
- Dlg1 :PFileDialog;
- App:Array[0..69] of Char;
- Path,Dir,Ext:Array[0..79] of Char;
- OldDir:Array[0..79] of Char;
- begin
- StrCopy(App,'*.*');
- Dlg1 := new(PfileDialog,Init(@Self,PChar(sd_FileOpen),@App));
- Dlg1^.Caption := 'Select Program';
- GetCurDir(Olddir,0);
- If Application^.ExecDialog(Dlg1) = id_OK then
- begin
- filesplit(App,Path,Dir,Ext);
- SetCurDir(Path);
- WinExec(App,sw_Normal);
- SetCurdir(OldDir);
- If AutoMin = 1 then
- ShowWindow(HWindow,sw_Minimize);
- end;
- end;
-
- {*********************** TOMDlg2 ******************************}
- procedure TOMDlg2.WMInitDialog(var Msg:TMessage);
- begin
- StrCopy(AnItem.ItemNum,'');
- StrCopy(AnItem.PgmName,'');
- StrCopy(AnItem.PgmFile,'');
- StrCopy(AnItem.Dir,'');
- Strcopy(AnItem.Params,'');
- StrCopy(AnItem.CmdShow,'');
- end;
-
- procedure TOMDlg2.IDD2OK(var Msg:TMessage);
- begin
- MainWin^.SetItemValues(AnItem);
- EndDlg(1);
- end;
-
- procedure TOMDlg2.IDD2EC1(var Msg:TMessage);
- var
- Buf:Array[0..69] of Char;
- Ptr : PChar;
- ErrCode:Integer;
- Margin:Real;
- return:Integer;
- begin
- case Msg.lParamHi of
- en_KillFocus:
- begin
- Ptr := Buf;
- Return := SendDlgItemMsg(id_D2EC1,wm_GetText,word(69),LongInt(Ptr));
- StrCopy(AnItem.ItemNum,Ptr);
- LoadFields;
- end;
- end;
- end;
-
- procedure TOMDlg2.IDD2EC2(var Msg:TMessage);
- var
- Buf:Array[0..69] of Char;
- Ptr : PChar;
- return:Integer;
- begin
- case Msg.lParamHi of
- en_KillFocus:
- begin
- Ptr := Buf;
- Return := SendDlgItemMsg(id_D2EC2,wm_GetText,word(69),LongInt(Ptr));
- StrCopy(AnItem.PgmName,Ptr);
- end;
- end;
- end ;
-
- procedure TOMDlg2.IDD2EC3(var Msg:TMessage);
- var
- Buf:Array[0..69] of Char;
- Ptr : PChar;
- return:Integer;
- begin
- case Msg.lParamHi of
- en_KillFocus:
- begin
- Ptr := Buf;
- Return := SendDlgItemMsg(id_D2EC3,wm_GetText,word(69),LongInt(Ptr));
- StrCopy(AnItem.PgmFile,Ptr);
- end;
- end;
- end;
-
- procedure TOMDlg2.IDD2EC4(var Msg:TMessage);
- var
- Buf:Array[0..69] of Char;
- Ptr : PChar;
- return:Integer;
- begin
- case Msg.lParamHi of
- en_KillFocus:
- begin
- Ptr := Buf;
- Return := SendDlgItemMsg(id_D2EC4,wm_GetText,word(69),LongInt(Ptr));
- StrCopy(AnItem.Dir,Ptr);
- end;
- end;
- end;
-
- procedure TOMDlg2.IDD2EC5(var Msg:TMessage);
- var
- Buf:Array[0..69] of Char;
- Ptr : PChar;
- return:Integer;
- begin
- case Msg.lParamHi of
- en_KillFocus:
- begin
- Ptr := Buf;
- Return := SendDlgItemMsg(id_D2EC5,wm_GetText,word(69),LongInt(Ptr));
- StrCopy(AnItem.Params,Ptr);
- end;
- end;
- end;
-
- procedure TOMDlg2.IDD2EC6(var Msg:TMessage);
- var
- Buf:Array[0..69] of Char;
- Ptr : PChar;
- return:Integer;
- begin
- case Msg.lParamHi of
- en_KillFocus:
- begin
- Ptr := Buf;
- Return := SendDlgItemMsg(id_D2EC6,wm_GetText,word(69),LongInt(Ptr));
- StrCopy(AnItem.CmdShow,Ptr);
- end;
- end;
- end;
-
- procedure TOMDlg2.LoadFields;
- var
- pBuf:Pchar;
- begin
- MainWin^.GetItemValues(AnItem);
- pBuf := AnItem.PgmName;
- SendDlgItemMsg(id_D2Ec2,wm_SetText,0,LongInt(pBuf));
- pBuf := AnItem.PgmFile;
- SendDlgItemMsg(id_D2Ec3,wm_SetText,0,LongInt(pBuf));
- pBuf := AnItem.Dir;
- SendDlgItemMsg(id_D2Ec4,wm_SetText,0,LongInt(pBuf));
- pBuf := AnItem.Params;
- SendDlgItemMsg(id_D2Ec5,wm_SetText,0,LongInt(pBuf));
- pBuf := AnItem.CmdShow;
- SendDlgItemMsg(id_D2Ec6,wm_SetText,0,LongInt(pBuf));
- EnableWindow(GetItemHandle(id_D2Browse),True);
- end;
-
- procedure TOMDlg2.IDBrowse(var Msg:TMessage);
- var
- Dlg1 :PFileDialog;
- App:Array[0..69] of Char;
- pBuf:PChar;
- Dir,Name,Ext:Array[0..69] of Char;
- begin
- StrCopy(App,'*.*');
- Dlg1 := new(PfileDialog,Init(@Self,PChar(sd_FileOpen),@App));
- Dlg1^.Caption := 'Select Program';
- If Application^.ExecDialog(Dlg1) = id_OK then
- begin
- FileSplit(App,Dir,Name,Ext);
- Name[0] := UpCase(Name[0]);
- pBuf := Name;
- SendDlgItemMsg(id_D2Ec2,wm_SetText,0,LongInt(pBuf));
- StrCopy(AnItem.PgmName,pBuf);
- pBuf := App;
- SendDlgItemMsg(id_D2Ec3,wm_SetText,0,LongInt(pBuf));
- StrCopy(AnItem.PgmFile,pBuf);
- SetFocus(GetItemHandle(id_D2Ec4));
- end;
- end;
-
- procedure TOMDlg3.SetupWindow;
- var
- Dr:Char;
- ArgList : record
- StrPtr : PChar;
- Free:PChar;
- Size:LongInt;
- PctFree:LongInt;
- end;
- szFree:Array[0..5] of Char;
- rFree:Real;
- szDr:Array[0..2] of Char;
- szOutput : Array[0..80] of Char;
- begin
- SendMessage(MainWin^.Dlg3^.GetItemHandle(Id_D3Lb1),wm_SetFont,GetStockObject(OEM_Fixed_Font),0);
- DosError := 0; StrCopy(szOutput,'');
- WVSPrintf(szOutput,'Dr MBf MBt %%Free',ArgList);
- SendMessage(MainWin^.Dlg3^.GetItemHandle(Id_D3Lb1),lb_AddString,0,LongInt(@szOutput));
-
- Dr := 'C';
- szDr[0] := Dr; szDr[1] := #0;
- while DosError = 0 do
- begin
- SetCurDir(StrCat(szDr,':'));
- if DosError = 0 then
- begin
- rFree := (DiskFree(0) / 1024 / 1024);
- Str(rFree:4:1,szFree);
- ArgList.Free := @szFree;
- ArgList.Size := Round( DiskSize(0) / 1024 /1024) ;
- ArgList.PctFree := Round(DiskFree(0) / (DiskSize(0) / 100 )) ;
- ArgList.StrPtr := @szDr;
- WVSPrintf(szOutput,'%s %s %3li %3li',ArgList);
- SendMessage(MainWin^.Dlg3^.GetItemHandle(Id_D3Lb1),lb_AddString,0,LongInt(@szOutput));
- end;
- Inc(Dr);
- szDr[0] := Dr;
- szDr[1] := #0;
- end;
- end;
- {******************** TOMAbout **************************}
- procedure TOMAboutDlg.WMCTLCOLOR(var Msg: TMessage);
- const
- as_AboutSt1 = 126; {about dlg static text }
- as_AboutSt2 = 128; {about dlg static blank static to draw upon}
- var
- HSt1,HSt2:HWnd;
- MemDC:hDC;
- OldBitmap:HBitmap;
- CR:TRect;
- X,Y,W,H:Integer;
- LogoMetrics:TBitmap;
- begin
- case Msg.LParamHi of
- ctlColor_Static:
- begin
- If (as_AboutSt1 = GetDlgCtrlID(Msg.lParamLo)) then
- SetTextColor(Msg.WParam, RGB(0,0,255))
- else if (as_AboutSt2 = GetDlgCtrlID(Msg.lParamLO)) then
- begin
- MemDC := CreateCompatibleDC(Msg.WParam);
- OldBitmap := SelectObject(MemDC,MainWin^.Logo);
- GetClientRect(Msg.lParamLo,CR);
- W:= CR.Right-CR.Left;H:= CR.Bottom-CR.Top;
- GetObject(MainWin^.Logo,SizeOf(LogoMetrics),@LogoMetrics);
- X := Max((W - LogoMetrics.bmWidth) div 2 , 0);
- Y := Max((H - LogoMetrics.bmHeight) div 2 , 0);
- BitBlt(Msg.WParam,X,Y,W,H,MemDc,0,0,SrcCopy);
- SelectObject(MemDC,OldBitmap);
- DeleteDC(MemDc);
- end;
- SetBkMode(Msg.WParam, transparent);
- Msg.Result := GetStockObject(Null_Brush);
- end;
- ctlcolor_Dlg:
- begin
- SetBkMode(Msg.WParam, Transparent);
- If CurBrush = MainWin^.Br1 then
- CurBrush := MainWin^.Br2
- else
- CurBrush := MainWin^.Br1;
- Msg.Result := CurBrush;
- end;
- else
- DefWndProc(Msg);
- end;
- end;
-
- procedure TOMAboutDlg.SetupWindow;
- var
- SysMenu:HMenu;
- begin
- TDialog.SetupWindow;
- SetTimer(HWindow,2,5000,nil);
- Is_Timer := True;
- end;
-
- procedure TOMAboutDlg.WMTimer(var Msg:TMessage);
- begin
- KillTimer(HWindow,2);
- Is_Timer := False;
- InvalidateRect(HWindow,nil,True);
- end;
-
- function TOMAboutDlg.CanClose:Boolean;
- begin
- CanClose := True;
- end;
-
- {************************ TPrgItem *****************************}
- constructor TPgmItem.Init(NewPgmName,NewPgmFile,NewDir,NewParams:PChar;NewCmdShow:Pchar);
- begin
- PgmName := StrNew(NewPgmName);
- PgmFile := StrNew(NewPgmFile);
- Dir := StrNew(NewDir);
- Params := StrNew(NewParams);
- CmdShow := StrNew(NewCmdShow);
- end;
-
- destructor TPgmItem.Done;
- begin
- StrDispose(PgmName);
- StrDispose(PgmFile);
- StrDispose(Dir);
- StrDispose(Params);
- StrDispose(CmdShow);
- end;
-
- {*********************** MainLine ********************************}
- var
- OMApp : TOMApplication;
- begin
- OMApp.Init('OttoMenu');
- OMApp.Run;
- OMApp.Done;
- end.
-