home *** CD-ROM | disk | FTP | other *** search
/ Delphi 2.0 - Programmer's Utilities Power Pack / Delphi 2.0 Programmer's Utilities Power Pack.iso / e_to_l / imlib201 / ublob.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1996-09-15  |  15.5 KB  |  532 lines
  1. {Part of Imagelib VCL/DLL Library.
  2.  
  3. Written by Jan Dekkers and Kevin Adams}
  4.  
  5. unit Ublob;
  6.  
  7. interface
  8.  
  9. uses
  10.   SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
  11.   Forms, Dialogs, DB, DBTables, tdbmulti, StdCtrls, ExtCtrls, DBCtrls,
  12.   Gauges, Mask, Buttons, Clipbrd, Spin, U_p_size, Printers, Ufullscr, UAbout;
  13.  
  14. type
  15.   TForm1 = class(TForm)
  16.     Table1              : TTable;
  17.     DataSource1         : TDataSource;
  18.     DBNavigator1        : TDBNavigator;
  19.     TDBMultiImage1      : TDBMultiImage;
  20.     Gauge1              : TGauge;
  21.     AutodisplayCheckBox : TCheckBox;
  22.     DBEdit1             : TDBEdit;
  23.     StretchCheckBox     : TCheckBox;
  24.     BitBtn1: TBitBtn;
  25.     OpenDialog1: TOpenDialog;
  26.     SaveDialog1: TSaveDialog;
  27.     BitBtn2: TBitBtn;
  28.     GroupBox1: TGroupBox;
  29.     RadioButton1: TRadioButton;
  30.     RadioButton2: TRadioButton;
  31.     RadioButton3: TRadioButton;
  32.     CenterCheckBox: TCheckBox;
  33.     BitBtn4: TBitBtn;
  34.     BitBtn5: TBitBtn;
  35.     Timer1: TTimer;
  36.     BitBtn6: TBitBtn;
  37.     Edit1: TEdit;
  38.     BitBtn3: TBitBtn;
  39.     OpenDialog2: TOpenDialog;
  40.     Edit2: TEdit;
  41.     Edit3: TEdit;
  42.     Edit4: TEdit;
  43.     Edit5: TEdit;
  44.     Edit6: TEdit;
  45.     Label1: TLabel;
  46.     Label2: TLabel;
  47.     Label3: TLabel;
  48.     Label4: TLabel;
  49.     Label5: TLabel;
  50.     Label6: TLabel;
  51.     Edit7: TEdit;
  52.     Label7: TLabel;
  53.     Edit8: TEdit;
  54.     GroupBox2: TGroupBox;
  55.     RadioButton4: TRadioButton;
  56.     RadioButton5: TRadioButton;
  57.     BitBtn7: TBitBtn;
  58.     BitBtn8: TBitBtn;
  59.     SaveDialog2: TSaveDialog;
  60.     GroupBox3: TGroupBox;
  61.     SpinEdit1: TSpinEdit;
  62.     SpinEdit2: TSpinEdit;
  63.     Label8: TLabel;
  64.     Label9: TLabel;
  65.     BitBtn9: TBitBtn;
  66.     BitBtn10: TBitBtn;
  67.     PrintDialog1: TPrintDialog;
  68.     BitBtn11: TBitBtn;
  69.     BitBtn12: TBitBtn;
  70.     procedure FormCreate(Sender: TObject);
  71.     procedure AutodisplayCheckBoxClick(Sender: TObject);
  72.     procedure StretchCheckBoxClick(Sender: TObject);
  73.     procedure DataSource1DataChange(Sender: TObject; Field: TField);
  74.     procedure BitBtn1Click(Sender: TObject);
  75.     procedure BitBtn2Click(Sender: TObject);
  76.     procedure ResolutionClick(Sender: TObject);
  77.     procedure CenterCheckBoxClick(Sender: TObject);
  78.     procedure BitBtn4Click(Sender: TObject);
  79.     procedure BitBtn5Click(Sender: TObject);
  80.     procedure Timer1Timer(Sender: TObject);
  81.     procedure BitBtn6Click(Sender: TObject);
  82.     procedure BitBtn3Click(Sender: TObject);
  83.     procedure RadioButton4Click(Sender: TObject);
  84.     procedure BitBtn7Click(Sender: TObject);
  85.     procedure BitBtn8Click(Sender: TObject);
  86.     procedure SpinEdit2Change(Sender: TObject);
  87.     procedure SpinEdit1Change(Sender: TObject);
  88.     procedure BitBtn10Click(Sender: TObject);
  89.     procedure BitBtn9Click(Sender: TObject);
  90.     procedure BitBtn11Click(Sender: TObject);
  91.     procedure BitBtn12Click(Sender: TObject);
  92.   private
  93.     { Private declarations }
  94.     procedure PrintBitmap(Bitmap: TBitmap; X, Y: Integer);
  95.   public
  96.     { Public declarations }
  97.   end;
  98.  
  99. var
  100.   Form1: TForm1;
  101.  
  102. implementation
  103.  
  104. procedure CallMe(i : integer); export; {CallBack Function MUST be exported}
  105. begin
  106.  {Update the gauge}
  107.  Form1.Gauge1.Progress:=i;
  108.  {Be nice to other hard and software}
  109.  Application.ProcessMessages;
  110. end;
  111.  
  112. function JustPathname(PathName : string) : string;
  113.     {-Return just the drive:directory portion of a pathname}
  114.   var
  115.     I : Word;
  116.   const
  117.      DosDelimSet : set of Char = ['\', ':', #0];
  118.   begin
  119.     I := Succ(Word(Length(PathName)));
  120.     repeat
  121.       Dec(I);
  122.     until (PathName[I] in DosDelimSet) or (I = 0);
  123.  
  124.     if I = 0 then
  125.       {Had no drive or directory name}
  126.       JustPathname[0] := #0
  127.     else if I = 1 then
  128.       {Either the root directory of default drive or invalid pathname}
  129.       JustPathname := PathName[1]
  130.     else if (PathName[I] = '\') then begin
  131.       if PathName[Pred(I)] = ':' then
  132.         {Root directory of a drive, leave trailing backslash}
  133.         JustPathname := Copy(PathName, 1, I)
  134.       else
  135.         {Subdirectory, remove the trailing backslash}
  136.         JustPathname := Copy(PathName, 1, Pred(I));
  137.     end else
  138.       {Either the default directory of a drive or invalid pathname}
  139.       JustPathname := Copy(PathName, 1, I);
  140.   end;
  141.  
  142. {$R *.DFM}
  143. procedure TForm1.FormCreate(Sender: TObject);
  144. begin
  145.  {Assign a callback function to the VCL/DLL}
  146.  TDBMultiImageCallBack:=CallMe;
  147.  {Is Autodisplay Initial on or off}
  148.  TDBMultiImage1.AutoDisPlay:=AutodisplayCheckBox.Checked;
  149.  {If the image data is changed save the blob to a jpeg or Bmp blob}
  150.  TDBMultiImage1.UpdateBlobAsJpeg:=RadioButton4.Checked;
  151.  
  152.  {set the values of teh spin edit controls to the values of the vcl}
  153.  SpinEdit2.Value:=TDBMultiImage1.JPegSaveSmooth;
  154.  SpinEdit1.Value:=TDBMultiImage1.JPegSaveQuality;
  155.  (*
  156.  {Show the database open dialogbox}
  157.  BitBtn3Click(Sender);
  158.  *)
  159. end;
  160.  
  161.  
  162. procedure TForm1.AutodisplayCheckBoxClick(Sender: TObject);
  163. begin
  164.   {Toggle Autodisplay}
  165.   TDBMultiImage1.AutoDisPlay:=AutodisplayCheckBox.Checked;
  166.  
  167.   {Let users know to double click when autodisplay is off}
  168.   TDBMultiImage1.ShowHint:= not AutodisplayCheckBox.Checked;
  169.  
  170.   {reset the gauge to 0}
  171.   Gauge1.Progress:=0;
  172. end;
  173.  
  174.  
  175. procedure TForm1.StretchCheckBoxClick(Sender: TObject);
  176. begin
  177.  {Stretch DBImage}
  178.  TDBMultiImage1.Stretch:=StretchCheckBox.Checked;
  179.  
  180.  {reset the gauge to 0}
  181.   Gauge1.Progress:=0;
  182. end;
  183.  
  184. procedure TForm1.CenterCheckBoxClick(Sender: TObject);
  185. begin
  186.  {Center DBImage}
  187.  TDBMultiImage1.Center:=CenterCheckBox.Checked;
  188.  
  189.  {reset the gauge to 0}
  190.  Gauge1.Progress:=0;
  191. end;
  192.  
  193.  
  194. procedure TForm1.DataSource1DataChange(Sender: TObject; Field: TField);
  195. begin
  196.  {Reset the Gauge}
  197.   Gauge1.Progress:=0;
  198.  
  199.  {If TDBMultiImage1.autodisplay = false then get the blob info
  200.   manually else the vcl will do it automatically}
  201.   If not TDBMultiImage1.autodisplay then TDBMultiImage1.GetInfoAndType;
  202.  
  203.  {Show the user the blob info}
  204.   Edit1.text:='This blob image is a '+TDBMultiImage1.BFiletype;
  205.   Edit2.text:=IntToStr(TDBMultiImage1.Bwidth);
  206.   Edit3.text:=IntToStr(TDBMultiImage1.BHeight);
  207.   Edit4.text:=IntToStr(TDBMultiImage1.Bbitspixel);
  208.   Edit5.text:=IntToStr(TDBMultiImage1.Bplanes);
  209.   Edit6.text:=IntToStr(TDBMultiImage1.Bnumcolors);
  210.   Edit7.text:=TDBMultiImage1.Bcompression;
  211.   Edit8.text:=IntToStr(TDBMultiImage1.BSize);
  212. end;
  213.  
  214. procedure TForm1.BitBtn1Click(Sender: TObject);
  215. begin
  216.  {load a image file in the current blob}
  217.  
  218.  If OpenDialog1.Execute Then begin
  219.    {Place table in edit mode}
  220.    Table1.Edit;
  221.    {Load the image from file into the blob}
  222.    TDBMultiImage1.LoadFromFile(OpenDialog1.FileName);
  223.    {Post the blob}
  224.    Table1.Post;
  225.    {reset the gauge to 0}
  226.    Gauge1.Progress:=0;
  227.  end;
  228. end;
  229.  
  230. procedure TForm1.BitBtn2Click(Sender: TObject);
  231. var temp : string;
  232. begin
  233.  {Save the current blob to a jpeg, pcx, gif or Bmp  file.  The SaveToFile
  234.  will save it as stored in the blob. (no conversion is done here)
  235.  Use SaveToFileAsBMP or SaveToFileAsJpeg to Convert to one another}
  236.  
  237.  {get the extension (filetype) of the stored blob}
  238.  {GetInfoAndType returns the extension of the blob stored}
  239.  if not table1.active then exit;
  240.  temp:=TDBMultiImage1.GetInfoAndType;
  241.  
  242.  if temp = 'GIF' then begin
  243.  {set SaveDialog filter to display gif's only}
  244.   SaveDialog1.filter:='GIF files|*.GIF';
  245.  
  246.   {set SaveDialog Default extension}
  247.   SaveDialog1.DefaultExt:='GIF';
  248.  end else
  249.  
  250.  if temp = 'PCX' then begin
  251.  {set SaveDialog filter to display pcx's only}
  252.   SaveDialog1.filter:='PCX files|*.PCX';
  253.  
  254.   {set SaveDialog Default extension}
  255.   SaveDialog1.DefaultExt:='PCX';
  256.  end else
  257.  
  258.  if temp = 'JPG' then begin
  259.  {set SaveDialog filter to display jpeg's only}
  260.   SaveDialog1.filter:='Jpeg files|*.JPG';
  261.  
  262.   {set SaveDialog Default extension}
  263.   SaveDialog1.DefaultExt:='JPG';
  264.  end else
  265.  
  266.  if temp = 'BMP' then begin
  267.  {set SaveDialog filter to display bmp's only}
  268.   SaveDialog1.filter:='BMP files|*.BMP';
  269.   {set SaveDialog Default extension}
  270.   SaveDialog1.DefaultExt:='BMP';
  271.  end;
  272.  
  273.  {save it to file as stored in blob}
  274.  If SaveDialog1.Execute Then
  275.    TDBMultiImage1.SaveToFile(SaveDialog1.FileName);
  276.  {reset the gauge to 0}
  277.  Gauge1.Progress:=0;
  278. end;
  279.  
  280.  
  281. procedure TForm1.ResolutionClick(Sender: TObject);
  282. begin
  283.  {Set resolution and dither the image}
  284.  if RadioButton1.Checked then begin
  285.  {Set resolution to 16 colors}
  286.   TDBMultiImage1.JpegResolution:=4;
  287.   {Set dither 1 pass ordered}
  288.   TDBMultiImage1.JpegDither:=2;
  289.  end else
  290.  
  291.  if RadioButton2.Checked then begin
  292.  {Set resolution to 256 colors}
  293.   TDBMultiImage1.JpegResolution:=8;
  294.  {Set dither 2 pass FS}
  295.   TDBMultiImage1.JpegDither:=4;
  296.  end else
  297.  
  298.  if RadioButton3.Checked then begin
  299.   {Set resolution to true color}
  300.   TDBMultiImage1.JpegResolution:=24;
  301.   {Set No dither (True color images don't have a palette)}
  302.   TDBMultiImage1.JpegDither:=0;
  303.  end;
  304.  
  305.  {Reload the image }
  306.  Table1.Refresh;
  307.  
  308.  {reset the gauge to 0}
  309.  Gauge1.Progress:=0;
  310. end;
  311.  
  312.  
  313. procedure TForm1.BitBtn4Click(Sender: TObject);
  314. begin
  315.   {Check to see if image is there}
  316.   if TDBMultiImage1.Picture.Bitmap <> nil then
  317.    {Copy the image to the clipboard}
  318.     TDBMultiImage1.CopyToClipboard;
  319.    {reset the gauge to 0}
  320.    Gauge1.Progress:=0;
  321. end;
  322.  
  323. procedure TForm1.BitBtn5Click(Sender: TObject);
  324. {Paste image from clipboard}
  325. begin
  326.    {does the clipboard has the right format?}
  327.    if Clipboard.HasFormat(CF_PICTURE) then
  328.    {Yep it does. Paste image from clipboard}
  329.    TDBMultiImage1.PastefromClipboard;
  330.  
  331.    {reset the gauge to 0}
  332.    Gauge1.Progress:=0;
  333. end;
  334.  
  335. procedure TForm1.Timer1Timer(Sender: TObject);
  336. begin
  337.   {En/Disable Paste Button if clipboard has format}
  338.   BitBtn5.Enabled:=Clipboard.HasFormat(CF_PICTURE);
  339.   {Enable/disable certain buttons}
  340.   {Button is only then enabled if table is active}
  341.   BitBtn1.Enabled:=Table1.Active;
  342.   {Button is only then enabled if table is active}
  343.   BitBtn2.Enabled:=Table1.Active;
  344.   {Button is only then enabled if table is active}
  345.   BitBtn4.Enabled:=Table1.Active;
  346.   {Button is only then enabled if table is active}
  347.   BitBtn6.Enabled:=Table1.Active;
  348.   {Button is only then enabled if table is active}
  349.   BitBtn7.Enabled:=Table1.Active;
  350.   {Button is only then enabled if table is active}
  351.   BitBtn8.Enabled:=Table1.Active;
  352.   {Button is only then enabled if table is active}
  353.   BitBtn9.Enabled:=Table1.Active;
  354.   {Button is only then enabled if table is active}
  355.   BitBtn10.Enabled:=Table1.Active;
  356.   {Button is only then enabled if table is active}
  357.   BitBtn11.Enabled:=Table1.Active;
  358.   {Box is only then visible if table is active and blob is a jpeg }
  359.   GroupBox1.Visible:=Table1.Active and (TDBMultiImage1.BFiletype = 'JPEG');
  360.   {Box is only then visible if table is active and field is in edit state}
  361.   GroupBox2.Visible:=Table1.Active and (DataSource1.State in [dsEdit, dsInsert]);
  362.   {Box is only then visible if table is active and field is in edit state and update is in jpeg mode}
  363.   GroupBox3.Visible:=Table1.Active and RadioButton4.Checked and (DataSource1.State in [dsEdit, dsInsert]);
  364. end;
  365.  
  366. procedure TForm1.BitBtn6Click(Sender: TObject);
  367. begin
  368.  {Append a record and store an image file into the blob}
  369.  If OpenDialog1.Execute Then begin
  370.    {Place table in edit mode}
  371.    Table1.Append;
  372.    {Load the image from file into the blob}
  373.    TDBMultiImage1.LoadFromFile(OpenDialog1.FileName);
  374.    {Post the blob}
  375.    Table1.Post;
  376.    {reset the gauge to 0}
  377.    Gauge1.Progress:=0;
  378.  end;
  379.  
  380. end;
  381.  
  382. procedure TForm1.BitBtn3Click(Sender: TObject);
  383. begin
  384. {open the table}
  385.       If OpenDialog2.execute then begin
  386.         Table1.Active:=False;
  387.         Table1.DataBaseName:=JustPathname(OpenDialog2.FileName);
  388.         Table1.TableName:=OpenDialog2.FileName;
  389.         Table1.Active:=True;
  390.       end;
  391. end;
  392.  
  393. procedure TForm1.RadioButton4Click(Sender: TObject);
  394. begin
  395.  {If the image data is changed save the blob to a jpeg or Bmp blob}
  396.  TDBMultiImage1.UpdateBlobAsJpeg:=RadioButton4.Checked;
  397.  
  398.  {Hide or show the jpeg update/save options}
  399.  GroupBox3.Visible:=RadioButton4.Checked;
  400. end;
  401.  
  402.  
  403. procedure TForm1.BitBtn7Click(Sender: TObject);
  404.  {save or convert the blob to a BMP file}
  405.  {make sure that the blob is displayed before saving to file}
  406. begin
  407.   {set SaveDialog filter to display bmp's only}
  408.   SaveDialog2.filter:='BMP files|*.BMP';
  409.  
  410.   {set SaveDialog Default extension}
  411.   SaveDialog2.DefaultExt:='BMP';
  412.  
  413.   if SaveDialog2.Execute then
  414.   {Save it}
  415.   TDBMultiImage1.SaveToFileAsBMP(SaveDialog2.Filename);
  416.  
  417.   {reset the gauge to 0}
  418.   Gauge1.Progress:=0;
  419. end;
  420.  
  421.  
  422. procedure TForm1.BitBtn8Click(Sender: TObject);
  423.  {save or convert the blob to a Jpeg file}
  424.  {make sure that the blob is displayed before saving to file}
  425. begin
  426.   {set SaveDialog filter to display jpeg's only}
  427.   SaveDialog2.filter:='Jpeg files|*.JPG';
  428.  
  429.   {set SaveDialog Default extension}
  430.   SaveDialog2.DefaultExt:='JPG';
  431.  
  432.   if SaveDialog2.Execute then
  433.   {Save it}
  434.   TDBMultiImage1.SaveToFileAsJpeg(SaveDialog2.Filename);
  435.  
  436.   {reset the gauge to 0}
  437.   Gauge1.Progress:=0;
  438. end;
  439.  
  440.  
  441. procedure TForm1.SpinEdit2Change(Sender: TObject);
  442. begin
  443.   {Set the smooth of the jpeg to save or upate a blob}
  444.   TDBMultiImage1.JPegSaveSmooth:=SpinEdit2.Value;
  445. end;
  446.  
  447. procedure TForm1.SpinEdit1Change(Sender: TObject);
  448. begin
  449.   {Set the quality of the jpeg to save or upate a blob}
  450.   TDBMultiImage1.JPegSaveQuality:=SpinEdit1.Value;
  451. end;
  452.  
  453. procedure TForm1.BitBtn10Click(Sender: TObject);
  454. begin
  455.  {Initialize the height spinedit of the printsize dialog box}
  456.  Printersize.HeigthSpinEdit.Value:=TDBMultiImage1.BHeight;
  457.  {Initialize the width spinedit of the printsize dialog box}
  458.  Printersize.WidthSpinEdit.Value:=TDBMultiImage1.BWidth;
  459.  {reset the original size radio button}
  460.  RadioButton1.Checked:=True;
  461.  {Show it}
  462.  Printersize.ShowModal;
  463.  {Hide it if done}
  464.  Printersize.hide;
  465. end;
  466.  
  467. procedure TForm1.BitBtn9Click(Sender: TObject);
  468. begin
  469.   if PrintDialog1.execute then begin
  470.    {Sent the doc to the printer}
  471.    Printer.Begindoc;
  472.    {Print the TDBMultiImage bitmap}
  473.    PrintBitmap(TDBMultiImage1.Picture.Bitmap,0,0);
  474.    {End the printjob and close the bitmap}
  475.    Printer.Enddoc;
  476.   end;
  477. end;
  478.  
  479. procedure TForm1.PrintBitmap(Bitmap: TBitmap; X, Y: Integer);
  480.   var
  481.     Info: PBitmapInfo;
  482.     InfoSize: Integer;
  483.     Image: Pointer;
  484.     ImageSize: Longint;
  485.   begin
  486.     {Print using borland's how to print a bitmap example code}
  487.     with Bitmap do
  488.     begin
  489.       GetDIBSizes(Handle, InfoSize, ImageSize);
  490.       Info := MemAlloc(InfoSize);
  491.       try
  492.         Image := MemAlloc(ImageSize);
  493.         try
  494.           GetDIB(Handle, Palette, Info^, Image^);
  495.           with Info^.bmiHeader do begin
  496.              if (Printersize.HeigthSpinEdit.Value >1) and (Printersize.WidthSpinEdit.Value >1) then
  497.               StretchDIBits(Printer.Canvas.Handle, X, Y, Printersize.WidthSpinEdit.Value,
  498.               Printersize.HeigthSpinEdit.Value, 0, 0, biWidth, biHeight, Image, Info^,
  499.               DIB_RGB_COLORS, SRCCOPY)
  500.              else
  501.               StretchDIBits(Printer.Canvas.Handle, X, Y, Width,
  502.               Height, 0, 0, biWidth, biHeight, Image, Info^,
  503.               DIB_RGB_COLORS, SRCCOPY);
  504.           end;
  505.         finally
  506.           FreeMem(Image, ImageSize);
  507.         end;
  508.       finally
  509.         FreeMem(Info, InfoSize);
  510.       end;
  511.     end;
  512.   end;
  513.  
  514. procedure TForm1.BitBtn11Click(Sender: TObject);
  515. begin
  516.   {copy DB Blob image to fullscreen image}
  517.   FullSlide.MultiImage1.Picture.Graphic:=TDBMultiImage1.Picture.Graphic;
  518.   {show the image fulscreen}
  519.   FullSlide.showmodal;
  520. end;
  521.  
  522. procedure TForm1.BitBtn12Click(Sender: TObject);
  523. {about box}
  524. begin
  525. {Copy the image to the image of he about box}
  526.  AboutBox.Image1.Picture.Graphic:=TDBMultiImage1.Picture.Graphic;
  527. {show the about box}
  528.  AboutBox.showmodal;
  529. end;
  530.  
  531. end.
  532.