home *** CD-ROM | disk | FTP | other *** search
/ Mastering Visual Basic 5 / MasteringVisualBasic5.iso / olympus / ik32_15t / delphi2.shr / UPBDISK.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1996-08-01  |  7.8 KB  |  219 lines
  1. {Custom Disk Control - for PicBuf's - PB_DiskControl32V1 is 'Formname'. For correct
  2. Operation the Control must be Displayed using the ShowModal Method:-
  3.  
  4. If PB_DiskControl32V1.ShowModal = MrOK then
  5. begin
  6. ReturnedName := PB_DiskControl32V1.FileName;  Filename stores the users selection 
  7. end;
  8.  
  9. This Causes the Control to be Displayed, and when the user selects the OK button the
  10. code within the Begin - End Block is Executed. Cancel button Simply Closes the form.
  11.  
  12. Please Note that the 'Load' and 'Save' Combo Options are not used in this Demo. The
  13. Image 'Preview' function is enabled. All filenames and Settings of the options
  14. are written to a INI file on your disk, whenever the form is closed. The INI
  15. file can be found in your \windows directory, and will carry the name of this
  16. demo example - Print.INI.
  17.  
  18. CopyRight Belmont Imaging 1996.
  19.  
  20. Demo Program by:- Andrew Hutchison 100022,1047@Compuserve.com
  21.  
  22. All rights reserved.  No part of this program may be photocopied, reproduced,
  23. translated to another programming  language or transported to any computer system
  24. without the prior written consent of Belmont Imaging.
  25.  
  26. This Demo is provided for use by Media Architects in there Delphi Demo's only.
  27. The unit must not be re-used without the permission of Media Architects or Belmont
  28. Imaging. Copyright Belmont Imaging 1996. It is supplied AS-IS. Use at your
  29. own risk.}
  30.  
  31. unit UPBDISK;
  32.  
  33. interface
  34.  
  35. uses
  36.   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  37.   FileCtrl, Grids, Outline, DirOutln, StdCtrls, Buttons, ExtCtrls,
  38.   OleCtrls, ImageKnife32, ComCtrls, Spin, INIfiles,OLEAUTO;
  39.  
  40. type
  41.   TPB_DiskControl32V1 = class(TForm)
  42.     PB_File_List: TFileListBox;
  43.     PB_Selected_Extension: TFilterComboBox;
  44.     PB_Selected_Drive: TDriveComboBox;
  45.     PB_File_Name: TEdit;
  46.     PB_Directory_list: TDirectoryListBox;
  47.     PB_Directory_Label: TLabel;
  48.     PB_Filename_Label: TLabel;
  49.     PB_Dir_Label: TLabel;
  50.     PB_Disk_OK_Icon: TBitBtn;
  51.     PB_Disk_Cancel_Icon: TBitBtn;
  52.     PB_Preview_Panel: TPanel;
  53.     PB_Preview_Image: TPicbuf;
  54.     PB_Preview: TCheckBox;
  55.     PB_JPG_Options: TGroupBox;
  56.     PB_JPG_VALUE: TSpinEdit;
  57.     PB_Write_Options: TComboBox;
  58.     PB_Fractel_Options: TGroupBox;
  59.     PB_FIF_Height: TSpinEdit;
  60.     PB_FIF_Width: TSpinEdit;
  61.     PB_FIF_Options: TComboBox;
  62.     PB_FIF_Scale: TComboBox;
  63.     PB_Bevel_Frame: TBevel;
  64.     PB_Commonpalette: TCheckBox;
  65.     procedure PB_Disk_Cancel_IconClick(Sender: TObject);
  66.     procedure PB_Disk_OK_IconClick(Sender: TObject);
  67.     procedure PB_File_ListClick(Sender: TObject);
  68.     procedure PB_PreviewClick(Sender: TObject);
  69.     procedure FormClose(Sender: TObject; var Action: TCloseAction);
  70.     procedure FormCreate(Sender: TObject);
  71.     procedure PB_Preview_ImageChange(Sender: TObject);
  72.   private
  73.     { Private declarations }
  74.   public
  75.     { Public declarations }
  76.  
  77.   FileName:String;{Make Filename Avaialable to Any Unit}
  78.  
  79.   end;
  80.  
  81. var
  82. PB_DiskControl32V1: TPB_DiskControl32V1;
  83.  
  84. {Does file name a have valid Picbuf file extension}
  85. function ValidPicbufFile(FileName:String):Boolean;
  86.  
  87. implementation
  88.  
  89. {$R *.DFM}
  90.  
  91. {-------------------------------------------------------------------------------}
  92. {Cancel Button}
  93. procedure TPB_DiskControl32V1.PB_Disk_Cancel_IconClick(Sender: TObject);
  94. begin
  95. {Set Filename to FileList Directory and File Box Text}
  96. FileName := PB_File_List.Directory;
  97. if Length(Filename) > 3 then
  98. Filename := Filename  + '\';
  99. FileName := FileName + PB_File_Name.Text;
  100. ModalResult := mrCancel;{Modal Result}
  101. end;
  102.  
  103. {-------------------------------------------------------------------------------}
  104. {OK Button}
  105. procedure TPB_DiskControl32V1.PB_Disk_OK_IconClick(Sender: TObject);
  106. begin
  107. {Set Filename to FileList Directory and File Box Text}
  108. FileName := PB_File_List.Directory;
  109. if Length(Filename) > 3 then
  110. Filename := Filename  + '\';
  111. FileName := FileName + PB_File_Name.Text;
  112. ModalResult := mrOK;{Modal Result}
  113. end;
  114.  
  115. {-------------------------------------------------------------------------------}
  116. {Preview Image - Option Button}
  117. procedure TPB_DiskControl32V1.PB_File_ListClick(Sender: TObject);
  118. Var
  119. Temp : String;
  120. Valid_File: Boolean;
  121. begin
  122. try
  123. if not PB_Preview.Checked then Exit;{If not Checked Skip}
  124. if PB_File_List.Filename <> '' then{Is there a FileName}
  125. begin
  126. if ValidPicbufFile(PB_File_List.Filename) then {UUtil - Checks for Valid Extension}
  127. begin 
  128. PB_Preview_Image.Filename:=(PB_file_list.filename);{Set Picbuf FileName}
  129. PB_Preview_Image.Load;{Load Image Method}
  130. end;
  131. end;
  132. except
  133. end;
  134. end;
  135.  
  136. {-------------------------------------------------------------------------------}
  137. {Clear buffer if Preview NOT required}
  138. procedure TPB_DiskControl32V1.PB_PreviewClick(Sender: TObject);
  139. begin
  140. if not PB_Preview.Checked then
  141. PB_Preview_Image.Clear{Empty Buffer}
  142. else
  143. PB_DiskControl32V1.PB_File_ListClick(Sender);
  144. end;
  145.  
  146. {-------------------------------------------------------------------------------}
  147. {On Exit Clear Image and Save Options to INI file}
  148. procedure TPB_DiskControl32V1.FormClose(Sender: TObject;var Action: TCloseAction);
  149. begin
  150. With Tinifile.Create(changefileext(extractfilename(Application.Exename),'.INI')) do
  151. try
  152. {'Section', Variable Name, Value to store }
  153. WriteInteger('FileOptions','Jpgcomp',PB_JPG_VALUE.Value);
  154. WriteInteger('FileOptions','ProgWrite',PB_Write_Options.Itemindex);
  155. WriteInteger('FileOptions','FifOption',PB_FIF_Options.ItemIndex);
  156. WriteInteger('FileOptions','FifScale',PB_FIF_Scale.ItemIndex);
  157. WriteInteger('FileOptions','FifHeight',PB_FIF_Height.Value);
  158. WriteInteger('FileOptions','FifWidth',PB_FIF_Width.Value);
  159. WriteBool('FileOptions','Preview',PB_Preview.Checked);
  160. WriteBool('FileOptions','Common',PB_Commonpalette.Checked);
  161. WriteString('FileOptions','LastFileLoaded',PB_Diskcontrol32v1.FileName);
  162. finally
  163. free;
  164. end;
  165. PB_Preview_Image.Clear;
  166. Application.Processmessages;
  167. end;
  168.  
  169. {-------------------------------------------------------------------------------}
  170. {Read Values from .INI file and apply to controls - when Created}
  171. procedure TPB_DiskControl32V1.FormCreate(Sender: TObject);
  172. begin
  173. With Tinifile.Create(changefileext(extractfilename(Application.Exename),'.INI')) do
  174. try
  175. {'Section', Variable Name, Default Value}
  176. PB_JPG_VALUE.Value:=ReadInteger('FileOptions','Jpgcomp',100);
  177. PB_Write_Options.Itemindex := ReadInteger('FileOptions','ProgWrite',0);
  178. PB_FIF_Options.ItemIndex := ReadInteger('FileOptions','FifOption',0);
  179. PB_FIF_Scale.ItemIndex:= ReadInteger('FileOptions','FifScale',0);
  180. PB_FIF_Height.Value:= ReadInteger('FileOptions','FifHeight',200);
  181. PB_FIF_Width.Value:= ReadInteger('FileOptions','FifWidth',200);
  182. PB_Preview.Checked:=ReadBool('FileOptions','Preview',True);
  183. PB_Commonpalette.Checked:=ReadBool('FileOptions','Common',False);
  184. {Set FileName and Control and Main Menu Item to Last File Name}
  185. PB_Diskcontrol32v1.FileName := ReadString('FileOptions','LastFileLoaded','C:\*.*');
  186. PB_File_List.Filename := ReadString('FileOptions','LastFileLoaded','C:\*.*');
  187. finally
  188. free;
  189. end;
  190. end;
  191.  
  192. {}
  193. procedure TPB_DiskControl32V1.PB_Preview_ImageChange(Sender: TObject);
  194. begin
  195. PB_Preview_Image.Hint:=PB_Preview_Image.InfoImage;
  196. end;
  197.  
  198. {-------------------------------------------------------------------------------}
  199. {Does file name a have valid Picbuf file extension}
  200. function ValidPicbufFile(FileName:String):Boolean;
  201. Var
  202. Temp:String;
  203. begin
  204. Result:=False;{Default to NO}
  205. Temp := UpperCase(Filename);{Convert FileName to Upper Case}
  206. if Pos('.TGA', Temp ) > 0 then Result:= True;
  207. if Pos('.BMP', Temp ) > 0 then Result:= True;
  208. if Pos('.DIB', Temp ) > 0 then Result:= True;
  209. if Pos('.PCX', Temp ) > 0 then Result:= True;
  210. if Pos('.JPG', Temp ) > 0 then Result:= True;
  211. if Pos('.FIF', Temp ) > 0 then Result:= True;
  212. if Pos('.PNG', Temp ) > 0 then Result:= True;
  213. if Pos('.GIF', Temp ) > 0 then Result:= True;
  214. if Pos('.TIF', Temp ) > 0 then Result:= True;
  215. if Pos('.MSP', Temp ) > 0 then Result:= True;
  216. end;
  217.  
  218. end.
  219.