home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / PASCAL / TVTOOL.ZIP / TVDIALOG.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1992-10-08  |  25.7 KB  |  271 lines
  1. {*
  2. *
  3. *   Copyright (c) 1992 by Richard W. Hansen
  4. *
  5. *   This source code will compile.
  6. *   Unpacked source is available to registered users.
  7. *
  8. *}
  9. UNIT TvDialog;{$X+}{$V-}{$I TVDEFS.INC}INTERFACE USES Dos,TvColl,TvConst,TvString,TvType,TvViews,{$IFDEF TVSCROLL}TvScroll,
  10. {$ENDIF}App,Dialogs,Drivers,Memory,MsgBox,Objects,StdDlg,Views;CONST C3DButton=#37#41#38#39#40#42;
  11. C3DDialog=CDialog+#72#73#74#75#76#77#78#79#80#81#82#83#84#85#86#87;C3DOutline=#43#44;C3DListViewer=#48#48#49#50#51;
  12. BarChar:Char='▒';BarFillChar:Char='█';ButtonSelect:FrameArray='╔╗╚╝║║══';ButtonNormal1:FrameArray='┌┐└┘││──';
  13. ButtonNormal2:FrameArray='┌╖╘╝│║─═';ButtonPress:FrameArray='┌┐└┘││──';BorderNormal:FrameArray='╔╗╚╝║║══';
  14. Buttons:Array[0..3]of String[8]=('~Y~es','~N~o','O~K~','~C~ancel');Commands:Array[0..3]of Word=(cmYes,cmNo,cmOK,cmCancel);
  15. Titles:Array[0..3]of String[11]=('Warning','Error','Information','Confirm');mfMessageLine=$1000;mfPauseButton=$2000;
  16. mfPauseCancel=mfPauseButton+mfCancelButton;mfOKPauseCancel=mfOKCancel+mfPauseButton;TYPE PSearchRec=^TSearchRec;
  17. DriveLetters='A'..'Z';DriveSet=Set of DriveLetters;TYPE PRunDialog=^TRunDialog;TRunDialog=Object(TDialog)Msg:PStaticText;
  18. RunState:Word;pfFlags:Word;BtnRow:Byte;SButton:PButton;CButton:PButton;Constructor Init(var Bounds:TRect;ATitle:TTitleStr;
  19. AMessage:String;AOptions:Word;ButtonRow:Byte);Function Execute:Word;Virtual;Procedure HandleEvent(var Event:TEvent);Virtual;
  20. Procedure Process;Virtual;Procedure ChangeMessage(AMessage:String);end;PPercentDialog=^TPercentDialog;
  21. TPercentDialog=Object(TRunDialog)Total:LongInt;Count:LongInt;Step:Word;Pct:PStaticText;Bar:PStaticText;
  22. Constructor Init(ATitle:TTitleStr;AMessage:String;ATotal:LongInt;AOptions:Word );Procedure Increment;
  23. Procedure IncrementBy(AStep:Word);end;PPrintDialog=^TPrintDialog;TPrintDialog=Object(TRunDialog)
  24. Constructor Init(ATitle:TTitleStr;AMessage:String;AOptions:Word );end;PMessageDialog=^TMessageDialog;
  25. TMessageDialog=Object(TDialog)SList:TUnsortedStringCollection;DOptions:Word;Constructor Init(AOptions:Word);
  26. Procedure AddMessage(St:String);Function Process:Word;Destructor Done;Virtual;end;{$IFDEF NEW_FILE_DIALOG}
  27. PNewFileCollection=^TNewFileCollection;TNewFileCollection=object(TFileCollection)
  28. Function Compare(Key1,Key2:Pointer):Integer;Virtual;end;PNewFileList=^TNewFileList;TNewFileList=object(TFileList)
  29. Constructor Init(var Bounds:TRect;AWildCard:PathStr;AScrollBar:PScrollBar);Procedure HandleEvent(var Event:TEvent);Virtual;
  30. Procedure FocusItem(Item:Integer);Virtual;Procedure ReadDirectory(AWildCard:PathStr);Virtual;end;PDriveList=^TDriveList;
  31. TDriveList=object(TNewFileList)Constructor Init(var Bounds:TRect;AScrollBar:PScrollBar);
  32. Procedure GetDrives(var Drives:DriveSet);Procedure ReadDirectory(AWildCard:PathStr);Virtual;
  33. Function GetKey(var S:String):Pointer;Virtual;end;PNewFileInputLine=^TNewFileInputLine;
  34. TNewFileInputLine=object(TFileInputLine)Procedure HandleEvent(var Event:TEvent);Virtual;end;
  35. PNewFileInfoPane=^TNewFileInfoPane;TNewFileInfoPane=object(TFileInfoPane)Procedure Draw;Virtual;end;
  36. PDirectoryInfoPane=^TDirectoryInfoPane;TDirectoryInfoPane=object(TView)Constructor Init(var Bounds:TRect);
  37. Function GetPalette:PPalette;Virtual;Procedure HandleEvent(var Event:TEvent);Virtual;Procedure Draw;Virtual;end;
  38. PNewFileDialog=^TNewFileDialog;TNewFileDialog=object(TFileDialog)DriveList:PDriveList;Constructor Init(AWildCard:TWildStr;
  39. ATitle:String;InputName:String;AOptions:Word;HistoryId:Byte);end;{$ENDIF}PLinkedInputLine=^TLinkedInputLine;
  40. TLinkedInputLine=Object(TInputLine)LinkEvent:Word;Constructor Init(var Bounds:TRect;AMaxLen:Integer;EventCode:Word);
  41. Procedure HandleEvent(var Event:TEvent);Virtual;end;PLinkedListBox=^TLinkedListBox;TLinkedListBox=object(TListBox)
  42. LinkEvent:Word;Constructor Init(var Bounds:TRect;ANumCols:Word;AScrollBar:PScrollBar;EventCode:Word);
  43. Procedure FocusItem(Item:Integer);virtual;end;P3DButton=^T3DButton;T3DButton=Object(TButton)Down:Boolean;
  44. Constructor Init(var Bounds:TRect;ATitle:TTitleStr;ACommand:Word;AFlags:Word);Procedure Draw;Virtual;
  45. Procedure HandleEvent(var Event:TEvent);Virtual;Procedure DrawTitle(ATitle:TTitleStr;Color:Word;Row:Word);
  46. Function GetPalette:PPalette;Virtual;Procedure GetFrame(var F:FrameArray);Virtual;end;PToolButton=^TToolButton;
  47. TToolButton=Object(T3DButton)Procedure GetFrame(var F:FrameArray);Virtual;end;P3DDialog=^T3DDialog;T3DDialog=Object(TDialog)
  48. Procedure InitFrame;Virtual;Function GetPalette:PPalette;Virtual;end;P3DOutline=^T3DOutline;T3DOutline=Object(TView)
  49. Constructor Init(var Bounds:TRect);Procedure Draw;Virtual;Function GetPalette:PPalette;Virtual;
  50. Procedure GetFrame(var F:FrameArray);Virtual;end;PToolBar=^TToolBar;TToolBar=Object(T3DDialog)IsVertical:Boolean;LastX:Word;
  51. LastY:Word;Constructor Init(var Bounds:TRect;Vertical:Boolean);Procedure AddTool(ATitle:TTitleStr;ACommand:Word);
  52. Procedure SizeLimits(var Min,Max:TPoint);Virtual;Procedure InitFrame;Virtual;end;P3DListViewer=^T3DListViewer;
  53. T3DListViewer=Object(TView)Function GetPalette:PPalette;Virtual;end;IMPLEMENTATION 
  54. Function T3DListViewer.GetPalette:PPalette;Const P:String[Length(C3DListViewer)]=C3DListViewer;begin GetPalette:=@P;end;
  55. Constructor T3DOutline.Init(var Bounds:TRect);var R:TRect;begin R:=Bounds;R.Grow(1,1);TView.Init(R);end;
  56. Function T3DOutline.GetPalette:PPalette;Const P:String[Length(C3DOutline)]=C3DOutline;begin GetPalette:=@P;end;
  57. Procedure T3DOutline.GetFrame(var F:FrameArray);begin F:=BorderNormal;end;Procedure T3DOutline.Draw;var Chars:FrameArray;
  58. CBorder:Word;X:Word;Y:Word;B:TDrawBuffer;begin GetFrame(Chars);CBorder:=GetColor($0102);X:=Size.X-1;
  59. MoveChar(B,Chars[7],WordRec(CBorder).Lo,Size.X);WordRec(B[X]).Hi:=WordRec(CBorder).Hi;WordRec(B[0]).Lo:=Byte(Chars[1]);
  60. WordRec(B[X]).Lo:=Byte(Chars[2]);WriteLine(0,0,Size.X,1,B);MoveChar(B,Chars[8],WordRec(CBorder).Hi,Size.X);
  61. WordRec(B[0]).Hi:=WordRec(CBorder).Lo;WordRec(B[0]).Lo:=Byte(Chars[3]);WordRec(B[X]).Lo:=Byte(Chars[4]);
  62. WriteLine(0,Size.Y-1,Size.X,1,B);for Y:=1 to Size.Y-2 do begin WriteChar(0,Y,Chars[5],2,1);WriteChar(X,Y,Chars[6],1,1);end;
  63. end;Procedure T3DDialog.InitFrame;var R:TRect;begin GetExtent(R);Frame:=New(P3DFrame,Init(R));end;
  64. Function T3DDialog.GetPalette:PPalette;Const P:String[Length(C3DDialog)]=C3DDialog;begin GetPalette:=@P;end;
  65. Constructor TToolBar.Init(var Bounds:TRect;Vertical:Boolean);var R:TRect;P:PView;begin TDialog.Init(Bounds,'');
  66. IsVertical:=Vertical;SetState(sfShadow,False);Options:=Options and not ofTileable and not ofSelectable or ofFirstClick;
  67. Flags:=Flags and not wfClose;GetExtent(R);if(Frame<>nil)then begin LastX:=1;LastY:=1;R.Grow(-1,-1);end else begin LastX:=0;
  68. LastY:=0;end;P:=New(PView,Init(R));P^.SetState(sfDisabled,True);P^.Options:=P^.Options and not ofSelectable;
  69. P^.GrowMode:=P^.GrowMode or gfGrowHiX OR gfGrowHiY;Insert(P);end;Procedure TToolBar.AddTool(ATitle:TTitleStr;ACommand:Word);
  70. var R:TRect;B:TRect;Len:Word;Cols:Word;Rows:Word;MPos:Word;DX:Word;DY:Word;Width:Word;Height:Word;Btn:PToolButton;begin
  71. MPos:=Pos(^M,ATitle);if(MPos=0)then begin Rows:=3;Cols:=CStrLen(ATitle);end else begin Rows:=4;
  72. Cols:=CStrLen(Copy(ATitle,1,MPos-1));Len:=CStrLen(Copy(ATitle,MPos+1,Length(ATitle)));if(Len>Cols)then Cols:=Len;end;
  73. Cols:=Cols+2;R.A.X:=LastX;R.A.Y:=LastY;R.B.X:=R.A.X+Cols;R.B.Y:=R.A.Y+Rows;Width:=Size.X;Height:=Size.Y;if(Frame<>nil)then
  74. begin Dec(Width);Dec(Height);end;if(R.B.Y>Height)then DY:=R.B.Y-Height else DY:=0;if(R.B.X>Width)then DX:=R.B.X-Width else
  75. DX:=0;GetBounds(B);if(DY<>0)then begin B.B.Y:=B.B.Y+DY;if(B.B.Y>Desktop^.Size.Y)then EXIT;end;if(DX<>0)then begin
  76. B.B.X:=B.B.X+DX;if(B.B.X>Desktop^.Size.X)then EXIT;end;if(DX<>0)or(DY<>0)then if(State and sfVisible<>0)then ChangeBounds(B)
  77. else SetBounds(B);Btn:=New(PToolButton,Init(R,ATitle,ACommand,0));Insert(Btn);if IsVertical then LastY:=R.B.Y else
  78. LastX:=R.B.X;end;Procedure TToolBar.SizeLimits(var Min,Max:TPoint);begin Min:=Size;Max:=Size;end;
  79. Procedure TToolBar.InitFrame;begin Frame:=nil;end;Constructor T3DButton.Init(var Bounds:TRect;ATitle:TTitleStr;ACommand:Word;
  80. AFlags:Word);begin TButton.Init(Bounds,ATitle,ACommand,AFlags);Down:=False;end;Procedure T3DButton.Draw;var Chars:FrameArray;
  81. Y:Word;X:Word;CBorder:Word;CText:Word;B:TDrawBuffer;begin GetFrame(Chars);if(State and sfDisabled<>0)then
  82. CText:=GetColor($0404)else if(State and sfSelected=0)and AmDefault then CText:=GetColor($0506)else CText:=GetColor($0503);
  83. if Down then CBorder:=GetColor($0201)else CBorder:=GetColor($0102);X:=Size.X-1;
  84. MoveChar(B,Chars[7],WordRec(CBorder).Hi,Size.X);WordRec(B[X]).Hi:=WordRec(CBorder).Lo;WordRec(B[0]).Lo:=Byte(Chars[1]);
  85. WordRec(B[X]).Lo:=Byte(Chars[2]);WriteLine(0,0,Size.X,1,B);MoveChar(B,Chars[8],WordRec(CBorder).Lo,Size.X);
  86. WordRec(B[0]).Hi:=WordRec(CBorder).Hi;WordRec(B[0]).Lo:=Byte(Chars[3]);WordRec(B[X]).Lo:=Byte(Chars[4]);
  87. WriteLine(0,Size.Y-1,Size.X,1,B);MoveChar(B,' ',WordRec(CBorder).Hi,Size.X);WordRec(B[0]).Lo:=Byte(Chars[5]);
  88. WordRec(B[X]).Lo:=Byte(Chars[6]);WordRec(B[X]).Hi:=WordRec(CBorder).Lo;for Y:=1 to Size.Y-2 do WriteLine(0,Y,Size.X,1,B);
  89. X:=Pos(^M,Title^);if(X=0)then Y:=Size.Y div 2 else Y:=(Size.Y-1)div 2;if(X=0)then DrawTitle(Title^,CText,Y)else begin
  90. DrawTitle(Copy(Title^,1,X-1),CText,Y);DrawTitle(Copy(Title^,X+1,Length(Title^)),CText,Y+1);end;end;
  91. Procedure T3DButton.DrawTitle(ATitle:TTitleStr;Color:Word;Row:Word);var X:Word;L:Word;B:TDrawBuffer;begin L:=Size.X-2;
  92. if(Flags and bfLeftJust<>0)then X:=0 else X:=(L-CStrLen(ATitle))div 2;MoveChar(B,' ',WordRec(Color).Lo,L);
  93. MoveCStr(B[X],ATitle,Color);WriteLine(1,Row,L,1,B);end;Procedure T3DButton.HandleEvent(var Event:TEvent);var R:TRect;
  94. P:TPoint;begin GetExtent(R);if(Event.What=evMouseDown)then begin MakeLocal(Event.Where,P);if not R.Contains(P)then
  95. ClearEvent(Event);TView.HandleEvent(Event);if(Event.What=evMouseDown)then begin Down:=False;Repeat MakeLocal(Event.Where,P);
  96. if(Down<>R.Contains(P))then begin Down:=not Down;Draw;end;Until not MouseEvent(Event,evMouseMove);if Down then begin
  97. Down:=False;Press;Draw;end;ClearEvent(Event);end;end;TButton.HandleEvent(Event);end;Function T3DButton.GetPalette:PPalette;
  98. Const P:String[Length(C3DButton)]=C3DButton;begin GetPalette:=@P;end;Procedure T3DButton.GetFrame(var F:FrameArray);begin
  99. if Down then F:=ButtonPress else if(State and sfSelected<>0)then F:=ButtonSelect else F:=ButtonNormal1;end;
  100. Procedure TToolButton.GetFrame(var F:FrameArray);begin if Down then F:=ButtonPress else F:=ButtonNormal1;end;
  101. Constructor TLinkedListBox.Init(var Bounds:TRect;ANumCols:Word;AScrollBar:PScrollBar;EventCode:Word);begin
  102. TListBox.Init(Bounds,ANumCols,AScrollBar);LinkEvent:=EventCode;end;Procedure TLinkedListBox.FocusItem(Item:Integer);begin
  103. TListBox.FocusItem(Item);Message(Owner,evBroadcast,LinkEvent,List^.At(Item));end;
  104. Constructor TLinkedInputLine.Init(var Bounds:TRect;AMaxLen:Integer;EventCode:Word);begin TInputLine.Init(Bounds,AMaxLen);
  105. LinkEvent:=EventCode;EventMask:=EventMask or evBroadcast;end;Procedure TLinkedInputLine.HandleEvent(var Event:TEvent);begin
  106. TInputLine.HandleEvent(Event);if(Event.What=evBroadcast)and(Event.Command=LinkEvent)and (State and sfSelected=0)then begin
  107. Data^:=PString(Event.InfoPtr)^;DrawView;end;end;Constructor TRunDialog.Init(var Bounds:TRect;ATitle:TTitleStr;
  108. AMessage:String;AOptions:Word;ButtonRow:Byte);var R:TRect;begin TDialog.Init(Bounds,ATitle);pfFlags:=AOptions;
  109. Flags:=Flags AND NOT wfClose;BtnRow:=ButtonRow;RunState:=0;if((pfFlags AND mfMessageLine)<>0)then begin R.Assign(2,1,42,2);
  110. Msg:=New(PStaticText,Init(R,AMessage));Insert(Msg);end;if((pfFlags AND mfOKCancel)=mfOKCancel)then begin
  111. R.Assign(11,BtnRow,20,BtnRow+2);SButton:=New(PButton,Init(R,'Start',cmStartJob,bfDefault));Insert(SButton);
  112. R.Assign(24,BtnRow,34,BtnRow+2);CButton:=New(PButton,Init(R,'Cancel',cmCancelJob,bfNormal));Insert(CButton);end 
  113. else if((pfFlags AND mfOKButton)<>0)then begin R.Assign(17,BtnRow,26,BtnRow+2);
  114. SButton:=New(PButton,Init(R,'Start',cmStartJob,bfDefault));Insert(SButton);CButton:=nil;end 
  115. else if((pfFlags AND mfCancelButton)<>0)then begin R.Assign(16,BtnRow,26,BtnRow+2);
  116. CButton:=New(PButton,Init(R,'Cancel',cmCancelJob,bfDefault));Insert(CButton);SButton:=nil;end;SelectNext(False);end;
  117. Function TRunDialog.Execute:Word;var Event:TEvent;begin if((pfFlags AND mfOKButton)=0)then RunState:=cmStartJob;Repeat
  118. GetEvent(Event);HandleEvent(Event);Process;Until(RunState>cmContinueJob);Execute:=RunState;end;
  119. Procedure TRunDialog.HandleEvent(var Event:TEvent);var R:TRect;Procedure DisposeButton(Button:PButton);begin
  120. if(Button<>nil)then begin Delete(Button);Dispose(Button,Done);end;end;begin TWindow.HandleEvent(Event);Case Event.What of
  121. evKeyDown:Case Event.KeyCode of kbEsc:begin Event.What:=evCommand;Event.Command:=cmCancelJob;Event.InfoPtr:=nil;
  122. PutEvent(Event);ClearEvent(Event);end;kbEnter:begin Event.What:=evBroadcast;Event.Command:=cmDefault;Event.InfoPtr:=nil;
  123. PutEvent(Event);ClearEvent(Event);end;end;evCommand:Case Event.Command of cmCancelJob,cmJobComplete,
  124. cmPauseJob,cmContinueJob,cmStartJob:begin Case Event.Command of cmContinueJob,cmStartJob:begin Lock;DisposeButton(SButton);
  125. DisposeButton(CButton);if((pfFlags AND mfPauseCancel)=mfPauseCancel)then begin R.Assign(11,BtnRow,20,BtnRow+2);
  126. SButton:=New(PButton,Init(R,'Pause',cmPauseJob,bfDefault));SButton^.State:=SButton^.State or sfActive;Insert(SButton);
  127. R.Assign(24,BtnRow,34,BtnRow+2);CButton:=New(PButton,Init(R,'Cancel',cmCancelJob,bfNormal));Insert(CButton);
  128. CButton^.State:=CButton^.State or sfActive;end else if((pfFlags AND mfPauseButton)<>0)then begin
  129. R.Assign(17,BtnRow,26,BtnRow+2);SButton:=New(PButton,Init(R,'Pause',cmPauseJob,bfDefault));Insert(SButton);CButton:=nil;
  130. SButton^.State:=SButton^.State or sfActive;end else if((pfFlags AND mfCancelButton)<>0)then begin
  131. R.Assign(16,BtnRow,26,BtnRow+2);CButton:=New(PButton,Init(R,'Cancel',cmCancelJob,bfDefault));Insert(CButton);SButton:=nil;
  132. CButton^.State:=CButton^.State or sfActive;end;SelectNext(False);DrawView;Unlock;end;cmPauseJob:begin Lock;
  133. DisposeButton(SButton);DisposeButton(CButton);if((pfFlags AND mfPauseCancel)=mfPauseCancel)then begin
  134. R.Assign(10,BtnRow,22,BtnRow+2);SButton:=New(PButton,Init(R,'Continue',cmContinueJob,bfDefault));Insert(SButton);
  135. R.Assign(25,BtnRow,35,BtnRow+2);CButton:=New(PButton,Init(R,'Cancel',cmCancelJob,bfNormal));Insert(CButton);
  136. SButton^.State:=SButton^.State or sfActive;CButton^.State:=CButton^.State or sfActive;end else begin
  137. R.Assign(15,BtnRow,27,BtnRow+2);SButton:=New(PButton,Init(R,'Continue',cmContinueJob,bfDefault));Insert(SButton);
  138. CButton:=nil;SButton^.State:=SButton^.State or sfActive;end;SelectNext(False);DrawView;Unlock;end;end;
  139. RunState:=Event.Command;ClearEvent(Event);end;end;end;end;Procedure TRunDialog.Process;begin end;
  140. Procedure TRunDialog.ChangeMessage(AMessage:String);begin if(Msg<>nil)then begin DisposeStr(Msg^.Text);
  141. Msg^.Text:=NewStr(AMessage);Msg^.DrawView;end;end;Constructor TPercentDialog.Init(ATitle:TTitleStr;AMessage:String;
  142. ATotal:LongInt;AOptions:Word );var R:TRect;begin R.Assign(0,0,44,10);TRunDialog.Init(R,ATitle,AMessage,AOptions,7);
  143. Options:=Options OR ofCentered;Total:=ATotal;Step:=Total DIV 25;if(Total MOD 25<>0)then Inc(Step);R.Assign(9,3,36,4);
  144. Insert(New(PStaticText,Init(R,'┌─────────────────────────┐')));R.Assign(9,4,36,5);
  145. Insert(New(PStaticText,Init(R,'│                         │')));R.Assign(9,5,36,6);
  146. Insert(New(PStaticText,Init(R,'└─────────────────────────┘')));R.Assign(20,2,25,3);Pct:=New(PStaticText,Init(R,'0%  '));
  147. Insert(Pct);R.Assign(10,4,35,5);Bar:=New(PStaticText,Init(R,Chars(25,BarChar)));Insert(Bar);end;
  148. Procedure TPercentDialog.Increment;begin IncrementBy(1);end;Procedure TPercentDialog.IncrementBy(AStep:Word);var Percent:Real;
  149. X:Word;N:String[3];begin if(Count<Total)then begin Count:=Count+AStep;if(Count>=Total)then begin
  150. FillChar(Bar^.Text^[1],25,BarFillChar);Bar^.DrawView;Pct^.Text^:='100%';Pct^.DrawView;end else if((Count MOD Step)=0)then
  151. begin Percent:=(Count/Total)*100;X:=Round(Percent/4);FillChar(Bar^.Text^[1],X,BarFillChar);Bar^.DrawView;Str(Percent:3:0,N);
  152. Pct^.Text^:=N+'%';Pct^.DrawView;end;end;end;Constructor TPrintDialog.Init(ATitle:TTitleStr;AMessage:String;AOptions:Word );
  153. var R:TRect;begin R.Assign(0,0,44,7);TRunDialog.Init(R,ATitle,AMessage,AOptions,4);Options:=Options OR ofCentered;end;
  154. {$IFDEF NEW_FILE_DIALOG}Function TNewFileCollection.Compare(Key1,Key2:Pointer):Integer;begin
  155. if PSearchRec(Key1)^.Name=PSearchRec(Key2)^.Name then Compare:=0 else if PSearchRec(Key1)^.Name='..'then Compare:=-1
  156. else if PSearchRec(Key2)^.Name='..'then Compare:=1 else if(PSearchRec(Key1)^.Attr and VolumeID<>0)and
  157. (PSearchRec(Key2)^.Attr and VolumeID=0)then Compare:=1 else if(PSearchRec(Key2)^.Attr and VolumeID<>0)and
  158. (PSearchRec(Key1)^.Attr and VolumeID=0)then Compare:=-1 else if PSearchRec(Key1)^.Name>PSearchRec(Key2)^.Name then Compare:=1
  159. else Compare:=-1;end;Constructor TNewFileList.Init(var Bounds:TRect;AWildCard:PathStr;AScrollBar:PScrollBar);begin
  160. TSortedListBox.Init(Bounds,1,AScrollBar);end;Procedure TNewFileList.HandleEvent(var Event:TEvent);var E:TEvent;begin
  161. if(Event.What=evBroadcast)and(Event.Command=cmReceivedFocus)and (Event.InfoPtr=@Self)then begin FocusItem(Focused)end else
  162. begin if(Event.What=evMouseDown)and(Event.Double)then Message(Owner,evBroadcast,cmRecordHistory,nil);
  163. TFileList.HandleEvent(Event);end;end;Procedure TNewFileList.FocusItem(Item:Integer);begin if(List^.Count>0)then
  164. TFileList.FocusItem(Item);end;Procedure TNewFileList.ReadDirectory(AWildCard:PathStr);var S:SearchRec;P:PSearchRec;
  165. Event:TEvent;FileList:PNewFileCollection;Dir:DirStr;Name:NameStr;Ext:ExtStr;begin
  166. PNewFileDialog(Owner)^.DriveList^.ReadDirectory(AWildCard);AWildCard:=FExpand(AWildCard);FSplit(AWildCard,Dir,Name,Ext);
  167. FileList:=New(PNewFileCollection,Init(5,5));FindFirst(AWildCard,ReadOnly+Archive,S);P:=@P;while(P<>nil)and(DosError=0)do begin
  168. if(S.Attr and Directory=0)then begin P:=MemAlloc(SizeOf(P^));if(P<>nil)then begin Move(S.Attr,P^,SizeOf(P^));
  169. FileList^.Insert(P);end;end;FindNext(S);end;if(P=nil)then MessageBox('Too many files.',nil,mfOkButton+mfWarning);
  170. NewList(FileList);if(List^.Count>0)then begin Event.What:=evBroadcast;Event.Command:=cmFileFocused;
  171. Event.InfoPtr:=List^.At(0);Owner^.HandleEvent(Event);end;end;Constructor TDriveList.Init(var Bounds:TRect;
  172. AScrollBar:PScrollBar);begin TSortedListBox.Init(Bounds,1,AScrollBar);end;
  173. Procedure TDriveList.GetDrives(var Drives:DriveSet);var DriveMap:LongInt;begin
  174.     ASM
  175.         mov   ah,19h                  
  176.         int   21h
  177.         push  ax
  178.  
  179.         mov   bx,1                    
  180.         xor   cx,cx
  181.         xor   dl,dl
  182.         mov   word ptr [DriveMap], 0
  183.         mov   word ptr [DriveMap+2], 0
  184.  
  185.     @1: mov   ah,0Eh                  
  186.         int   21h
  187.         mov   ah,19h
  188.         int   21h
  189.         cmp   al,dl
  190.         jne   @2
  191.         or    word ptr [DriveMap],bx
  192.         or    word ptr [DriveMap+2],cx
  193.  
  194.     @2: shl   bx,1
  195.         rcl   cx,1
  196.         inc   dl
  197.         cmp   dl,26
  198.         jb    @1
  199.  
  200.         mov   ah,0Eh                  
  201.         pop   dx
  202.         int   21h
  203.  
  204.         shl   word ptr [DriveMap],1   
  205.         rcl   word ptr [DriveMap+2],1
  206. end;Drives:=DriveSet(DriveMap);end;Function TDriveList.GetKey(var S:String):Pointer;const SR:TSearchRec=();
  207. Procedure UpStr(var S:String);var I:Byte;begin for I:=1 to Length(S)do S[I]:=UpCase(S[I]);end;begin SR.Attr:=Directory;
  208. SR.Name:=S;UpStr(SR.Name);GetKey:=@SR;end;Procedure TDriveList.ReadDirectory(AWildCard:PathStr);var C:Char;Drives:DriveSet;
  209. S:SearchRec;P:PSearchRec;FileList:PNewFileCollection;Dir:DirStr;Name:NameStr;Ext:ExtStr;begin P:=@P;
  210. FileList:=New(PNewFileCollection,Init(5,5));AWildCard:=FExpand(AWildCard);FSplit(AWildCard,Dir,Name,Ext);
  211. AWildCard:=Dir+'*.*';FindFirst(AWildCard,Directory,S);while(P<>nil)and(DosError=0)do begin
  212. if(S.Attr and Directory<>0)and(S.Name[1]<>'.')then begin P:=MemAlloc(SizeOf(P^));if(P<>nil)then begin
  213. Move(S.Attr,P^,SizeOf(P^));FileList^.Insert(PObject(P));end;end;FindNext(S);end;if Length(Dir)>4 then begin
  214. P:=MemAlloc(SizeOf(P^));if(P<>nil)then begin FindFirst(AWildCard,Directory,S);FindNext(S);if(DosError=0)and(S.Name='..')then
  215. begin Move(S.Attr,P^,SizeOf(P^))end else begin P^.Name:='..';P^.Size:=0;P^.Time:=$210000;P^.Attr:=Directory;end;
  216. FileList^.Insert(PObject(P));end;end;GetDrives(Drives);for C:='A'to'Z'do if(C in Drives)then begin P:=MemAlloc(SizeOf(P^));
  217. if(P<>nil)then begin P^.Name:=C+':';P^.Size:=0;P^.Time:=$210000;P^.Attr:=Directory OR VolumeID;
  218. FileList^.AtInsert(FileList^.Count,PObject(P));end;end;if(P=nil)then
  219. MessageBox('Too many directories.',nil,mfOkButton+mfWarning);NewList(FileList);end;Procedure TNewFileInfoPane.Draw;var
  220. Color:Word;Params:array[0..7]of LongInt;Time:DateTime;D:String[5];FmtId:String[60];Str:String[60];B:TDrawBuffer;const
  221. sDirectoryLine='%-12s  %-9s  %02d/%02d/%4d  %02d:%02d%cm';sFileLine='%-12s  %-9d  %02d/%02d/%4d  %02d:%02d%cm';begin 
  222. Color:=GetColor($01);MoveChar(B,' ',Color,Size.X);Params[0]:=LongInt(@S.Name);if((S.Attr and Directory)<>0)then begin
  223. FmtId:=sDirectoryLine;D:='<Dir>';Params[1]:=LongInt(@D);end else begin FmtId:=sFileLine;Params[1]:=S.Size;end;
  224. UnpackTime(S.Time,Time);Params[2]:=Time.Month;Params[3]:=Time.Day;Params[4]:=Time.Year;if(Time.Hour>=12)then
  225. Params[7]:=Byte('p')else Params[7]:=Byte('a');Time.Hour:=Time.Hour mod 12;if(Time.Hour=0)then Time.Hour:=12;
  226. Params[5]:=Time.Hour;Params[6]:=Time.Min;FormatStr(Str,FmtId,Params);MoveStr(B[1],Str,Color);WriteLine(0,0,Size.X,1,B);end;
  227. Constructor TDirectoryInfoPane.Init(var Bounds:TRect);begin TView.Init(Bounds);EventMask:=EventMask or evBroadcast;end;
  228. Function TDirectoryInfoPane.GetPalette:PPalette;const P:String[Length(CInfoPane)]=CInfoPane;begin GetPalette:=@P;end;
  229. Procedure TDirectoryInfoPane.HandleEvent(var Event:TEvent);begin TView.HandleEvent(Event);
  230. if(Event.What=evBroadcast)and(Event.Command=cmFileFocused)then DrawView;end;Procedure TDirectoryInfoPane.Draw;var
  231. B:TDrawBuffer;Color:Word;Path:PathStr;begin Path:=FExpand(PNewFileDialog(Owner)^.Directory^);Color:=GetColor($01);
  232. MoveChar(B,' ',Color,Size.X);MoveStr(B[1],Path,Color);WriteLine(0,0,Size.X,1,B);end;
  233. Procedure TNewFileInputLine.HandleEvent(var Event:TEvent);begin TInputLine.HandleEvent(Event);
  234. if(Event.What=evBroadcast)and(Event.Command=cmFileFocused)and (State and sfSelected=0)then begin
  235. if(PSearchRec(Event.InfoPtr)^.Attr and Directory<>0)then Data^:=PSearchRec(Event.InfoPtr)^.Name+'\'+
  236. PFileDialog(Owner)^.WildCard else Data^:=FExpand(PNewFileDialog(Owner)^.Directory^)+PSearchRec(Event.InfoPtr)^.Name;DrawView;
  237. end;end;Constructor TNewFileDialog.Init(AWildCard:TWildStr;ATitle:String;InputName:String;AOptions:Word;HistoryId:Byte);var
  238. Control:PView;R:TRect;S:String;Opt:Word;ACurDir:PathStr;begin R.Assign(0,0,49,18);TDialog.Init(R,ATitle);
  239. Options:=Options or ofCentered;WildCard:=AWildCard;R.Assign(2,2,31,3);FileName:=New(PNewFileInputLine,Init(R,79));
  240. FileName^.Data^:=WildCard;Insert(FileName);R.Assign(2,1,3+CStrLen(InputName),2);
  241. Control:=New(PLabel,Init(R,InputName,FileName));Insert(Control);R.Assign(31,2,34,3);
  242. Control:=New(PHistory,Init(R,FileName,HistoryId));Insert(Control);R.Assign(16,6,17,16);Control:=New(PScrollBar,Init(R));
  243. Insert(Control);R.Assign(2,6,16,16);FileList:=New(PNewFileList,Init(R,WildCard,PScrollBar(Control)));Insert(FileList);
  244. R.Assign(2,5,8,6);Control:=New(PLabel,Init(R,'~F~iles',FileList));Insert(Control);R.Assign(32,6,33,16);
  245. Control:=New(PScrollBar,Init(R));Insert(Control);R.Assign(18,6,32,16);DriveList:=New(PDriveList,Init(R,PScrollBar(Control)));
  246. Insert(DriveList);R.Assign(18,5,30,6);Control:=New(PLabel,Init(R,'~D~irectories',DriveList));Insert(Control);
  247. R.Assign(35,2,46,4);Opt:=bfDefault;if AOptions and fdOpenButton<>0 then begin
  248. Insert(New(PButton,Init(R,'~O~pen',cmFileOpen,Opt)));Opt:=bfNormal;Inc(R.A.Y,3);Inc(R.B.Y,3);end;
  249. if AOptions and fdOkButton<>0 then begin Insert(New(PButton,Init(R,'O~K~',cmFileOpen,Opt)));Opt:=bfNormal;
  250. Inc(R.A.Y,3);Inc(R.B.Y,3);end;if AOptions and fdReplaceButton<>0 then begin
  251. Insert(New(PButton,Init(R,'~R~eplace',cmFileReplace,Opt)));Opt:=bfNormal;Inc(R.A.Y,3);Inc(R.B.Y,3);end;
  252. if AOptions and fdClearButton<>0 then begin Insert(New(PButton,Init(R,'~C~lear',cmFileClear,Opt)));Opt:=bfNormal;
  253. Inc(R.A.Y,3);Inc(R.B.Y,3);end;Insert(New(PButton,Init(R,'Cancel',cmCancel,bfNormal)));Inc(R.A.Y,3);Inc(R.B.Y,3);
  254. if AOptions and fdHelpButton<>0 then begin Insert(New(PButton,Init(R,'Help',cmHelp,bfNormal)));Inc(R.A.Y,3);Inc(R.B.Y,3);end;
  255. R.Assign(2,4,31,5);Control:=New(PDirectoryInfoPane,Init(R));Insert(Control);R.Assign(3,3,12,4);
  256. Control:=New(PStaticText,Init(R,'Directory'));Insert(Control);R.Assign(2,Size.Y-2,Size.X-2,Size.Y-1);
  257. Control:=New(PNewFileInfoPane,Init(R));Insert(Control);SelectNext(False);if((AOptions and fdNoLoadDir)=0)then ReadDirectory;
  258. end;{$ENDIF}Constructor TMessageDialog.Init(AOptions:Word);var R:TRect;S:String[13];begin R.Assign(0,0,4,4);
  259. TDialog.Init(R,Titles[AOptions AND$3]);Options:=Options+ofCentered;DOptions:=AOptions;Desktop^.GetExtent(R);
  260. SList.Init(R.B.Y-5,0);end;Procedure TMessageDialog.AddMessage(St:String);var P:PString;begin GetMem(P,Length(St)+1);
  261. if(P<>nil)then begin P^:=St;SList.Insert(P);end;end;Function TMessageDialog.Process:Word;var P:Pointer;X,Y:Byte;I:Byte;
  262. Count:Byte;Rem:Integer;Spc:Integer;R:TRect;begin Desktop^.GetExtent(R);X:=0;for i:=0 to SList.Count-1 do begin P:=SList.At(i);
  263. if(Byte(P^)>R.B.X)then Byte(P^):=R.B.X;if(Byte(P^)>X)then X:=Byte(P^);end;Count:=0;for i:=0 to 3 do
  264. if(DOptions AND($0100 shl i)<>0)then Inc(Count);if((Count*11+1)>X)then X:=Count*11+1;X:=X+2;Y:=SList.Count+2;
  265. if(ButtonCount>0)then Y:=Y+3;R.Assign(0,0,X,Y);ChangeBounds(R);if(Count>0)then begin Rem:=Size.X-(Count*9);
  266. Spc:=Rem DIV(Count+1);X:=Spc+(Rem MOD Count)shr 1;for i:=0 to 3 do if(DOptions AND($0100 shl i)<>0)then begin
  267. R.Assign(X,Size.Y-3,X+10,Size.Y-1);Insert(New(PButton,Init(R,Buttons[i],Commands[i],bfNormal)));Inc(X,Spc+8);end;
  268. SelectNext(False);end;for i:=0 to SList.Count-1 do begin R.Assign(1,i+1,Size.X-1,i+2);
  269. Insert(New(PStaticText,Init(R,PString(SList.At(i))^)));end;Process:=DeskTop^.ExecView(@Self);end;
  270. Destructor TMessageDialog.Done;begin SList.Done;end;END.
  271.