home *** CD-ROM | disk | FTP | other *** search
/ PC World Komputer 1997 May / Pcwk0597.iso / delphi / imagelib / bimage.pa_ / bimage.pa
Text File  |  1995-10-01  |  10KB  |  351 lines
  1. {Part of Imagelib VCL/DLL Library.
  2. Written by Jan Dekkers and Kevin Adams (c) 1995. If you are a non
  3. registered client, you may use or alter this demo only for evaluation
  4. purposes.
  5.  
  6. Uses ImageLib 3.0
  7.  
  8. scrolling text images
  9. Cut, Copy and Paste to/from the clipboard
  10. Printing bitmaps}
  11.  
  12.  
  13. unit Bimage;
  14.  
  15. interface
  16.  
  17. uses
  18.   SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
  19.   Forms, Dialogs, StdCtrls, FileCtrl, Spin, Buttons, UFullscr,
  20.   Menus, UAbout, Tmultip, Dll30;
  21.  
  22. type
  23.   TConvertForm1 = class(TForm)
  24.     DriveComboBox1: TDriveComboBox;
  25.     DirectoryListBox1: TDirectoryListBox;
  26.     FileListBox1: TFileListBox;
  27.     Convert: TBitBtn;
  28.     QualitySpin: TSpinEdit;
  29.     Smoothspin: TSpinEdit;
  30.     QualityLabel: TLabel;
  31.     SmoothLabel: TLabel;
  32.     GroupBox1: TGroupBox;
  33.     res4: TRadioButton;
  34.     res24: TRadioButton;
  35.     res8: TRadioButton;
  36.     GroupBox2: TGroupBox;
  37.     MainMenu1: TMainMenu;
  38.     N1: TMenuItem;
  39.     E1: TMenuItem;
  40.     A1: TMenuItem;
  41.     ComboBox1: TComboBox;
  42.     Sstretch: TCheckBox;
  43.     GroupBox3: TGroupBox;
  44.     CTOJPEG: TRadioButton;
  45.     CTOBMP: TRadioButton;
  46.     Label1: TLabel;
  47.     FileListBox2: TFileListBox;
  48.     DirectoryListBox2: TDirectoryListBox;
  49.     DriveComboBox2: TDriveComboBox;
  50.     Label2: TLabel;
  51.     Label3: TLabel;
  52.     CheckBox1: TCheckBox;
  53.     CTOGIF: TRadioButton;
  54.     CTOPCX: TRadioButton;
  55.     CTOPNG: TRadioButton;
  56.     MultiImage1: TPMultiImage;
  57.     GroupBox4: TGroupBox;
  58.     Saveres4: TRadioButton;
  59.     Saveres24: TRadioButton;
  60.     Saveres8: TRadioButton;
  61.     CheckBox2: TCheckBox;
  62.     procedure DriveComboBox1Change(Sender: TObject);
  63.     procedure DirectoryListBox1Change(Sender: TObject);
  64.     procedure FileListBox1Change(Sender: TObject);
  65.     procedure SstretchOnOff(Sender: TObject);
  66.     procedure FormCreate(Sender: TObject);
  67.     procedure ResClick(Sender: TObject);
  68.     procedure DitherClick(Sender: TObject);
  69.     procedure MultiImage1Click(Sender: TObject);
  70.     procedure E1Click(Sender: TObject);
  71.     procedure A1Click(Sender: TObject);
  72.     procedure FormClose(Sender: TObject; var Action: TCloseAction);
  73.     procedure ComboBox1Change(Sender: TObject);
  74.     procedure ConvertClick(Sender: TObject);
  75.     procedure DirectoryListBox2Change(Sender: TObject);
  76.     procedure DriveComboBox2Change(Sender: TObject);
  77.     procedure FileListBox2Change(Sender: TObject);
  78.     procedure QualitySpinChange(Sender: TObject);
  79.     procedure SmoothspinChange(Sender: TObject);
  80.     procedure CTOJPEGClick(Sender: TObject);
  81.     procedure SaveRes(Sender: TObject);
  82.     procedure CheckBox2Click(Sender: TObject);
  83.   private
  84.     function NameOnly(PName : string) : string;
  85.   public
  86.     { Public declarations }
  87.   end;
  88.  
  89. var
  90.   ConvertForm1: TConvertForm1;
  91.  
  92. implementation
  93.  
  94. {$R *.DFM}
  95.  
  96. {update the drive of DirectoryListBox1 with the drive of DriveComboBox1}
  97. procedure TConvertForm1.DriveComboBox1Change(Sender: TObject);
  98. begin
  99.      DirectoryListBox1.Drive := DriveComboBox1.Drive;
  100. end;
  101.  
  102. {update the directory of FileListBox1 with the directory of FileListBox1}
  103. procedure TConvertForm1.DirectoryListBox1Change(Sender: TObject);
  104. begin
  105.      FileListBox1.Directory := DirectoryListBox1.Directory;
  106. end;
  107.  
  108. {Display the image of the FileListBox1.filename}
  109. procedure TConvertForm1.FileListBox1Change(Sender: TObject);
  110. begin
  111.  {set hourglass cursor}
  112.   screen.cursor:=crHourGlass;
  113.  try
  114.  {display an image using the vcl}
  115.   MultiImage1.imagename:=FileListBox1.filename;
  116.  finally
  117.   {set default cursor}
  118.   screen.cursor:=crDefault;
  119.  end;
  120. end;
  121.  
  122. procedure TConvertForm1.FileListBox2Change(Sender: TObject);
  123. begin
  124.  {set hourglass cursor}
  125.   screen.cursor:=crHourGlass;
  126.  try
  127.  {display an image using the vcl}
  128.   MultiImage1.imagename:=FileListBox2.filename;
  129.  finally
  130.   {set default cursor}
  131.   screen.cursor:=crDefault;
  132.  end;
  133. end;
  134.  
  135. {set strech mode}
  136. procedure TConvertForm1.SstretchOnOff(Sender: TObject);
  137. begin
  138.   MultiImage1.stretch:=Sstretch.Checked;
  139. end;
  140.  
  141.  
  142. {what we do on create}
  143. procedure TConvertForm1.FormCreate(Sender: TObject);
  144. begin
  145.     {set the value of the QualitySpin to the value of JPegSaveQuality}
  146.     QualitySpin.value:=MultiImage1.JPegSaveQuality;
  147.  
  148.     {set the value of the Smoothspin to the value of JPegSaveSmooh}
  149.     Smoothspin.value:=MultiImage1.JPegSaveSmooth;
  150.  
  151. end;
  152.  
  153. {Set the resolution to either 16, 256 or true color in the vcl}
  154. procedure TConvertForm1.ResClick(Sender: TObject);
  155. begin
  156.  {set Display resolution to 4 bit 16 color}
  157.  if res4.checked  then MultiImage1.ImageReadRes:=Color16;
  158.  
  159.  {set Display resolution to 8 bit 256 color}
  160.  if res8.checked  then MultiImage1.ImageReadRes:=Color256;
  161.  
  162.  {set Display resolution to 24 bit true color}
  163.  if res24.checked then MultiImage1.ImageReadRes:=ColorTrue;
  164. end;
  165.  
  166. procedure TConvertForm1.DitherClick(Sender: TObject);
  167. begin
  168.   {set the Display dither }
  169.   MultiImage1.ImageDither:=CheckBox1.checked;
  170. end;
  171.  
  172.  
  173. {show fullscreen}
  174. procedure TConvertForm1.MultiImage1Click(Sender: TObject);
  175. begin
  176.   {copy image to fullscreen image}
  177.   FullSlide.MultiImage1.Picture.Graphic:=MultiImage1.Picture.Graphic;
  178.   {show the image fulscreen}
  179.   FullSlide.showmodal;
  180. end;
  181.  
  182. {exit the program}
  183. procedure TConvertForm1.E1Click(Sender: TObject);
  184. begin
  185.  close;
  186. end;
  187.  
  188. {about box}
  189. procedure TConvertForm1.A1Click(Sender: TObject);
  190. begin
  191. {Copy the image to the image of he about box}
  192.  AboutBox.Image1.Picture.Graphic:=MultiImage1.Picture.Graphic;
  193. {show the about box}
  194.  AboutBox.showmodal;
  195. end;
  196.  
  197. {what to do on exit}
  198. procedure TConvertForm1.FormClose(Sender: TObject; var Action: TCloseAction);
  199. begin
  200. {}
  201. end;
  202.  
  203. procedure TConvertForm1.ComboBox1Change(Sender: TObject);
  204. begin
  205.  FileListBox1.Mask:=ComboBox1.text;
  206.  FileListBox1.Update;
  207. end;
  208.  
  209.  
  210. {return filename only. no path, no extension}
  211. function TConvertForm1.NameOnly(PName : string) : string;
  212.  var
  213.    DtP : Byte;
  214.  
  215.  function JName(PName : string) : string;
  216.   var
  217.     I : Word;
  218.   const
  219.     DDSet : set of Char = ['\', ':', #0];
  220.   begin
  221.     I := Succ(Word(Length(PName)));
  222.     repeat
  223.       Dec(I);
  224.     until (PName[I] in DDSet) or (I = 0);
  225.     JName := Copy(PName, Succ(I), 64);
  226.   end;
  227.  
  228.   begin
  229.     PName := JName(PName);
  230.     DtP := Pos('.', PName);
  231.     if DtP > 0 then
  232.       PName := Copy(PName, 1, DtP-1);
  233.     NameOnly := PName;
  234.   end;
  235.  
  236.  
  237.  
  238. {The actual conversion}
  239. procedure TConvertForm1.ConvertClick(Sender: TObject);
  240. var i          : integer;
  241.     pTempExt   : string[4];
  242.     pExtension : string[4];
  243.     pName      : string[13];
  244.     pPath      : string[100];
  245.     toTemp      : string;
  246.     frTemp      : string;
  247. begin
  248.  Label3.CapTion:='';
  249.  
  250.  if CTOJPEG.Checked then
  251.     pTempExt:='.JPG';
  252.  if CTOBMP.Checked then
  253.     pTempExt:='.BMP';
  254.  if CTOGIF.Checked then
  255.     pTempExt:='.GIF';
  256.  if CTOPCX.Checked then
  257.     pTempExt:='.PCX';
  258.  if CTOPNG.Checked then
  259.     pTempExt:='.PNG';
  260.  
  261.  for i:=0 to FileListBox1.items.count-1 do begin
  262.      if FileListBox1.Selected[i] then begin
  263.  
  264.        pExtension:=UpperCase(ExtractFileExt(FileListBox1.Items.Strings[i]));
  265.        pName:=UpperCase(NameOnly(FileListBox1.Items.Strings[i]));
  266.        pPath:=UpperCase(DirectoryListBox2.Directory);
  267.  
  268.        toTemp:=pPath+'\'+pName+pTempExt;
  269.        frTemp:=UpperCase(DirectoryListBox1.Directory+'\'+FileListBox1.Items.Strings[i]);
  270.        {set hourglass cursor}
  271.         screen.cursor:=crHourGlass;
  272. try
  273.        if CTOJPEG.Checked then begin
  274.         MultiImage1.imagename:=frTemp;
  275.         MultiImage1.SaveAsJpg(toTemp)
  276.        end else
  277.        if CTOBMP.Checked then begin
  278.         MultiImage1.imagename:=frTemp;
  279.         MultiImage1.SaveAsBMP(toTemp)
  280.        end else
  281.        if CTOGIF.Checked then begin
  282.         MultiImage1.imagename:=frTemp;
  283.         MultiImage1.SaveAsGIF(toTemp)
  284.        end else
  285.        if CTOPCX.Checked then begin
  286.         MultiImage1.imagename:=frTemp;
  287.         MultiImage1.SaveAsPCX(toTemp)
  288.        end else
  289.        if CTOPNG.Checked then begin
  290.         MultiImage1.imagename:=frTemp;
  291.         MultiImage1.SaveAsPNG(toTemp)
  292.        end;
  293. finally
  294.       {set default cursor}
  295.       screen.cursor:=crDefault;
  296.       FileListBox2.UpDate;
  297.       FileListBox1.UpDate;
  298. end;
  299.       end;
  300.       Label3.CapTion:='DONE';
  301.  end;
  302. end;
  303.  
  304. procedure TConvertForm1.DirectoryListBox2Change(Sender: TObject);
  305. begin
  306.   FileListBox2.Directory := DirectoryListBox2.Directory;
  307. end;
  308.  
  309. procedure TConvertForm1.DriveComboBox2Change(Sender: TObject);
  310. begin
  311.   DirectoryListBox2.Drive := DriveComboBox2.Drive;
  312. end;
  313.  
  314. procedure TConvertForm1.QualitySpinChange(Sender: TObject);
  315. begin
  316.   MultiImage1.JpegSaveQuality:=QualitySpin.Value;
  317. end;
  318.  
  319. procedure TConvertForm1.SmoothspinChange(Sender: TObject);
  320. begin
  321.   MultiImage1.JpegSaveSmooth:=Smoothspin.Value;
  322. end;
  323.  
  324. procedure TConvertForm1.CTOJPEGClick(Sender: TObject);
  325. begin
  326.   QualityLabel.Visible:=CTOJPEG.Checked;
  327.   SmoothLabel.Visible:=CTOJPEG.Checked;
  328.   QualitySpin.Visible:=CTOJPEG.Checked;
  329.   Smoothspin.Visible:=CTOJPEG.Checked;
  330.   CheckBox2.Visible:=CTOPNG.Checked;
  331. end;
  332.  
  333. procedure TConvertForm1.SaveRes(Sender: TObject);
  334. begin
  335.  {set Save resolution to 4 bit 16 color}
  336.  if Saveres4.checked  then MultiImage1.ImageWriteRes:=Color16;
  337.  
  338.  {set Save resolution to 8 bit 256 color}
  339.  if Saveres8.checked  then MultiImage1.ImageWriteRes:=Color256;
  340.  
  341.  {set Save resolution to 24 bit true color}
  342.  if Saveres24.checked then MultiImage1.ImageWriteRes:=ColorTrue;
  343. end;
  344.  
  345. procedure TConvertForm1.CheckBox2Click(Sender: TObject);
  346. begin
  347.    MultiImage1.PNGInterLaced:=CheckBox2.Checked;
  348. end;
  349.  
  350. end.
  351.