home *** CD-ROM | disk | FTP | other *** search
/ Delphi Developer's Kit 1996 / Delphi Developer's Kit 1996.iso / power / source8 / ublob.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1995-12-22  |  18.0 KB  |  570 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 2.2. Changed the callback to a function instead of a
  7. procedure to let the user cancel out. Added:
  8.  
  9. scrolling text images
  10. Cut, Copy and Paste to/from the clipboard
  11. Printing bitmaps}
  12.  
  13. unit Ublob;
  14.  
  15. interface
  16.  
  17. uses
  18.   SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
  19.   Forms, Dialogs, DB, DBTables, TDBmulti, StdCtrls, ExtCtrls, DBCtrls,
  20.   Gauges, Mask, Buttons, Clipbrd, Spin, U_p_size, Printers, Ufullscr, UAbout;
  21.  
  22. type
  23.   TForm1 = class(TForm)
  24.     Table1              : TTable;
  25.     DataSource1         : TDataSource;
  26.     DBNavigator1        : TDBNavigator;
  27.     Gauge1              : TGauge;
  28.     AutodisplayCheckBox : TCheckBox;
  29.     DBEdit1             : TDBEdit;
  30.     StretchCheckBox     : TCheckBox;
  31.     BitBtn1: TBitBtn;
  32.     OpenDialog1: TOpenDialog;
  33.     SaveDialog1: TSaveDialog;
  34.     BitBtn2: TBitBtn;
  35.     GroupBox1: TGroupBox;
  36.     RadioButton1: TRadioButton;
  37.     RadioButton2: TRadioButton;
  38.     RadioButton3: TRadioButton;
  39.     CenterCheckBox: TCheckBox;
  40.     BitBtn4: TBitBtn;
  41.     BitBtn5: TBitBtn;
  42.     Timer1: TTimer;
  43.     BitBtn6: TBitBtn;
  44.     Edit1: TEdit;
  45.     BitBtn3: TBitBtn;
  46.     OpenDialog2: TOpenDialog;
  47.     Edit2: TEdit;
  48.     Edit3: TEdit;
  49.     Edit4: TEdit;
  50.     Edit5: TEdit;
  51.     Edit6: TEdit;
  52.     Label1: TLabel;
  53.     Label2: TLabel;
  54.     Label3: TLabel;
  55.     Label4: TLabel;
  56.     Label5: TLabel;
  57.     Label6: TLabel;
  58.     Edit7: TEdit;
  59.     Label7: TLabel;
  60.     Edit8: TEdit;
  61.     GroupBox2: TGroupBox;
  62.     RadioButton4: TRadioButton;
  63.     RadioButton5: TRadioButton;
  64.     BitBtn7: TBitBtn;
  65.     BitBtn8: TBitBtn;
  66.     SaveDialog2: TSaveDialog;
  67.     GroupBox3: TGroupBox;
  68.     SpinEdit1: TSpinEdit;
  69.     SpinEdit2: TSpinEdit;
  70.     Label8: TLabel;
  71.     Label9: TLabel;
  72.     BitBtn9: TBitBtn;
  73.     PrintDialog1: TPrintDialog;
  74.     BitBtn11: TBitBtn;
  75.     BitBtn12: TBitBtn;
  76.     BitBtn13: TBitBtn;
  77.     DBMultiImage1: TDBMultiImage;
  78.     procedure FormCreate(Sender: TObject);
  79.     procedure AutodisplayCheckBoxClick(Sender: TObject);
  80.     procedure StretchCheckBoxClick(Sender: TObject);
  81.     procedure DataSource1DataChange(Sender: TObject; Field: TField);
  82.     procedure BitBtn1Click(Sender: TObject);
  83.     procedure BitBtn2Click(Sender: TObject);
  84.     procedure ResolutionClick(Sender: TObject);
  85.     procedure CenterCheckBoxClick(Sender: TObject);
  86.     procedure BitBtn4Click(Sender: TObject);
  87.     procedure BitBtn5Click(Sender: TObject);
  88.     procedure Timer1Timer(Sender: TObject);
  89.     procedure BitBtn6Click(Sender: TObject);
  90.     procedure BitBtn3Click(Sender: TObject);
  91.     procedure RadioButton4Click(Sender: TObject);
  92.     procedure BitBtn7Click(Sender: TObject);
  93.     procedure BitBtn8Click(Sender: TObject);
  94.     procedure SpinEdit2Change(Sender: TObject);
  95.     procedure SpinEdit1Change(Sender: TObject);
  96.     procedure BitBtn9Click(Sender: TObject);
  97.     procedure BitBtn11Click(Sender: TObject);
  98.     procedure BitBtn12Click(Sender: TObject);
  99.     procedure BitBtn13Click(Sender: TObject);
  100.   private
  101.     { Private declarations }
  102.     Procedure Trigger(Sender : TObject; Var Done : Boolean);
  103.   public
  104.     { Public declarations }
  105.   end;
  106.  
  107. var
  108.   Form1: TForm1;
  109.  
  110. implementation
  111.  
  112. {Changed in version 2.2 from a procedure to a function. To cancel return
  113. a 0 else return a 1}
  114. Function CallMe(i : integer) : integer; export;
  115. {Callback function from the dll, EXPORT IS REQUIRED}
  116. begin
  117.  if Application.Terminated then begin
  118.    {User wants to terminate the program. Pass a 0 to the dll}
  119.    Result:=0;
  120.   end else begin
  121.   {Be nice to others <g>}
  122.    Application.ProcessMessages;
  123.    {process a Gauge}
  124.    Form1.Gauge1.Progress:=i;
  125.    {tell the dll that everything is OK}
  126.    Result:=1;
  127.    end;
  128. end;
  129. {---------------------------------------------------------------------}
  130.  
  131.  
  132. function JustPathname(PathName : string) : string;
  133.     {-Return just the drive:directory portion of a pathname}
  134.   var
  135.     I : Word;
  136.   const
  137.      DosDelimSet : set of Char = ['\', ':', #0];
  138.   begin
  139.     I := Succ(Word(Length(PathName)));
  140.     repeat
  141.       Dec(I);
  142.     until (PathName[I] in DosDelimSet) or (I = 0);
  143.  
  144.     if I = 0 then
  145.       {Had no drive or directory name}
  146.       JustPathname[0] := #0
  147.     else if I = 1 then
  148.       {Either the root directory of default drive or invalid pathname}
  149.       JustPathname := PathName[1]
  150.     else if (PathName[I] = '\') then begin
  151.       if PathName[Pred(I)] = ':' then
  152.         {Root directory of a drive, leave trailing backslash}
  153.         JustPathname := Copy(PathName, 1, I)
  154.       else
  155.         {Subdirectory, remove the trailing backslash}
  156.         JustPathname := Copy(PathName, 1, Pred(I));
  157.     end else
  158.       {Either the default directory of a drive or invalid pathname}
  159.       JustPathname := Copy(PathName, 1, I);
  160.   end;
  161. {---------------------------------------------------------------------}
  162.  
  163. {$R *.DFM}
  164. procedure TForm1.FormCreate(Sender: TObject);
  165. begin
  166.  {Assign a callback function to the VCL/DLL}
  167.  TDBMultiImageCallBack:=CallMe;
  168.  {Is Autodisplay Initial on or off}
  169.  DBMultiImage1.AutoDisPlay:=AutodisplayCheckBox.Checked;
  170.  {If the image data is changed save the blob to a jpeg or Bmp blob}
  171.  DBMultiImage1.UpdateBlobAsJpeg:=RadioButton4.Checked;
  172.  
  173.  {set the values of teh spin edit controls to the values of the vcl}
  174.  SpinEdit2.Value:=DBMultiImage1.JPegSaveSmooth;
  175.  SpinEdit1.Value:=DBMultiImage1.JPegSaveQuality;
  176.  
  177.  If FileExists(ExtractFilePath(Application.ExeName)+'JPSTAMP.DBF') then begin
  178.    {if the table exists open it on creation}
  179.    Table1.DataBaseName:=JustPathName(Application.ExeName);
  180.    Table1.TableName:='JPSTAMP.DBF';
  181.    Table1.Active:=True;
  182.    Table1.Last;
  183.  end;
  184.  
  185.  
  186.  {IMPORTANT
  187.  This is the moving engine for all the messages. Since an applcation
  188.  can have only one OnIdle Trigger, this trigger needs to be subdivided
  189.  by all your moving and animated objects. In this particular case the
  190.  function is called TRIGGER but you can name it as you want as long
  191.  you have a procedure named the same.}
  192.  
  193.   Application.OnIdle:=Trigger;
  194. end;
  195. {---------------------------------------------------------------------}
  196.  
  197. Procedure TForm1.Trigger(Sender : TObject; Var Done : Boolean);
  198. begin
  199.  {IMPORTANT}
  200.  {This function is called when your app is idle. Subdivide the
  201.   trigger event to your TDBMultiImage objects who may need one.
  202.   If no Message is active it will not take up significant time}
  203.  
  204.   DBMultiImage1.Trigger;
  205.  {DBMultiImage2.Trigger;
  206.   DBMultiImage3.Trigger;}
  207. end;
  208. {---------------------------------------------------------------------}
  209.  
  210. procedure TForm1.AutodisplayCheckBoxClick(Sender: TObject);
  211. begin
  212.   {Toggle Autodisplay}
  213.   DBMultiImage1.AutoDisPlay:=AutodisplayCheckBox.Checked;
  214.  
  215.   {Let users know to double click when autodisplay is off}
  216.   DBMultiImage1.ShowHint:= not AutodisplayCheckBox.Checked;
  217.  
  218.   {reset the gauge to 0}
  219.   Gauge1.Progress:=0;
  220. end;
  221. {---------------------------------------------------------------------}
  222.  
  223. procedure TForm1.StretchCheckBoxClick(Sender: TObject);
  224. begin
  225.  {Stretch DBImage}
  226.  DBMultiImage1.Stretch:=StretchCheckBox.Checked;
  227.  
  228.  {reset the gauge to 0}
  229.   Gauge1.Progress:=0;
  230. end;
  231. {---------------------------------------------------------------------}
  232.  
  233. procedure TForm1.CenterCheckBoxClick(Sender: TObject);
  234. begin
  235.  {Center DBImage}
  236.  DBMultiImage1.Center:=CenterCheckBox.Checked;
  237.  
  238.  {reset the gauge to 0}
  239.  Gauge1.Progress:=0;
  240. end;
  241. {---------------------------------------------------------------------}
  242.  
  243. procedure TForm1.DataSource1DataChange(Sender: TObject; Field: TField);
  244. begin
  245.  {Reset the Gauge}
  246.   Gauge1.Progress:=0;
  247.  
  248.  {If DBMultiImage1.autodisplay = false then get the blob info
  249.   manually else the vcl will do it automatically}
  250.   If not DBMultiImage1.autodisplay then DBMultiImage1.GetInfoAndType;
  251.  
  252.  {Show the user the blob info}
  253.   Edit1.text:='This blob image is a '+DBMultiImage1.BFiletype;
  254.   Edit2.text:=IntToStr(DBMultiImage1.Bwidth);
  255.   Edit3.text:=IntToStr(DBMultiImage1.BHeight);
  256.   Edit4.text:=IntToStr(DBMultiImage1.Bbitspixel);
  257.   Edit5.text:=IntToStr(DBMultiImage1.Bplanes);
  258.   Edit6.text:=IntToStr(DBMultiImage1.Bnumcolors);
  259.   Edit7.text:=DBMultiImage1.Bcompression;
  260.   Edit8.text:=IntToStr(DBMultiImage1.BSize)+ ' bytes';
  261. end;
  262. {---------------------------------------------------------------------}
  263.  
  264. procedure TForm1.BitBtn1Click(Sender: TObject);
  265. begin
  266.  {load a image file in the current blob}
  267.  
  268.  If OpenDialog1.Execute Then begin
  269.    {Place table in edit mode}
  270.    Table1.Edit;
  271.    {Load the image from file into the blob}
  272.    DBMultiImage1.LoadFromFile(OpenDialog1.FileName);
  273.    {Post the blob}
  274.    Table1.Post;
  275.    {reset the gauge to 0}
  276.    Gauge1.Progress:=0;
  277.  end;
  278. end;
  279. {---------------------------------------------------------------------}
  280.  
  281. procedure TForm1.BitBtn2Click(Sender: TObject);
  282. var temp : string;
  283. begin
  284.  {Save the current blob to a jpeg, pcx, gif or Bmp  file.  The SaveToFile
  285.  will save it as stored in the blob. (no conversion is done here)
  286.  Use SaveToFileAsBMP or SaveToFileAsJpeg to Convert to one another}
  287.  
  288.  {get the extension (filetype) of the stored blob}
  289.  {GetInfoAndType returns the extension of the blob stored}
  290.  if not table1.active then exit;
  291.  temp:=DBMultiImage1.GetInfoAndType;
  292.  
  293.  if temp = 'GIF' then begin
  294.  {set SaveDialog filter to display gif's only}
  295.   SaveDialog1.filter:='GIF files|*.GIF';
  296.  
  297.   {set SaveDialog Default extension}
  298.   SaveDialog1.DefaultExt:='GIF';
  299.  end else
  300.  
  301.  if temp = 'PCX' then begin
  302.  {set SaveDialog filter to display pcx's only}
  303.   SaveDialog1.filter:='PCX files|*.PCX';
  304.  
  305.   {set SaveDialog Default extension}
  306.   SaveDialog1.DefaultExt:='PCX';
  307.  end else
  308.  
  309.  if temp = 'JPG' then begin
  310.  {set SaveDialog filter to display jpeg's only}
  311.   SaveDialog1.filter:='Jpeg files|*.JPG';
  312.  
  313.   {set SaveDialog Default extension}
  314.   SaveDialog1.DefaultExt:='JPG';
  315.  end else
  316.  
  317.  if temp = 'BMP' then begin
  318.  {set SaveDialog filter to display bmp's only}
  319.   SaveDialog1.filter:='BMP files|*.BMP';
  320.   {set SaveDialog Default extension}
  321.   SaveDialog1.DefaultExt:='BMP';
  322.  end;
  323.  
  324.  {save it to file as stored in blob}
  325.  If SaveDialog1.Execute Then
  326.    DBMultiImage1.SaveToFile(SaveDialog1.FileName);
  327.  {reset the gauge to 0}
  328.  Gauge1.Progress:=0;
  329. end;
  330. {---------------------------------------------------------------------}
  331.  
  332.  
  333. procedure TForm1.ResolutionClick(Sender: TObject);
  334. begin
  335.  {Set resolution and dither the image}
  336.  if RadioButton1.Checked then begin
  337.  {Set resolution to 16 colors}
  338.   DBMultiImage1.JpegResolution:=4;
  339.   {Set dither 1 pass ordered}
  340.   DBMultiImage1.JpegDither:=2;
  341.  end else
  342.  
  343.  if RadioButton2.Checked then begin
  344.  {Set resolution to 256 colors}
  345.   DBMultiImage1.JpegResolution:=8;
  346.  {Set dither 2 pass FS}
  347.   DBMultiImage1.JpegDither:=4;
  348.  end else
  349.  
  350.  if RadioButton3.Checked then begin
  351.   {Set resolution to true color}
  352.   DBMultiImage1.JpegResolution:=24;
  353.   {Set No dither (True color images don't have a palette)}
  354.   DBMultiImage1.JpegDither:=0;
  355.  end;
  356.  
  357.  {Reload the image }
  358.  Table1.Refresh;
  359.  
  360.  {reset the gauge to 0}
  361.  Gauge1.Progress:=0;
  362. end;
  363. {---------------------------------------------------------------------}
  364.  
  365.  
  366. procedure TForm1.BitBtn4Click(Sender: TObject);
  367. begin
  368.   {Check to see if image is there}
  369.   if DBMultiImage1.Picture.Bitmap <> nil then
  370.    {Copy the image to the clipboard}
  371.     DBMultiImage1.CopyToClipboard;
  372.    {reset the gauge to 0}
  373.    Gauge1.Progress:=0;
  374. end;
  375. {---------------------------------------------------------------------}
  376.  
  377. procedure TForm1.BitBtn5Click(Sender: TObject);
  378. {Paste image from clipboard}
  379. begin
  380.    {does the clipboard has the right format?}
  381.    if Clipboard.HasFormat(CF_PICTURE) then
  382.    {Yep it does. Paste image from clipboard}
  383.    DBMultiImage1.PastefromClipboard;
  384.  
  385.    {reset the gauge to 0}
  386.    Gauge1.Progress:=0;
  387. end;
  388. {---------------------------------------------------------------------}
  389.  
  390. procedure TForm1.Timer1Timer(Sender: TObject);
  391. begin
  392.   {En/Disable Paste Button if clipboard has format}
  393.   BitBtn5.Enabled:=Clipboard.HasFormat(CF_PICTURE);
  394.   {Enable/disable certain buttons}
  395.   {Button is only then enabled if table is active}
  396.   BitBtn1.Enabled:=Table1.Active;
  397.   {Button is only then enabled if table is active}
  398.   BitBtn2.Enabled:=Table1.Active;
  399.   {Button is only then enabled if table is active}
  400.   BitBtn4.Enabled:=Table1.Active;
  401.   {Button is only then enabled if table is active}
  402.   BitBtn6.Enabled:=Table1.Active;
  403.   {Button is only then enabled if table is active}
  404.   BitBtn7.Enabled:=Table1.Active;
  405.   {Button is only then enabled if table is active}
  406.   BitBtn8.Enabled:=Table1.Active;
  407.   {Button is only then enabled if table is active}
  408.   BitBtn9.Enabled:=Table1.Active;
  409.   {Button is only then enabled if table is active}
  410.   BitBtn11.Enabled:=Table1.Active;
  411.   {Button is only then enabled if table is active}
  412.   BitBtn13.Enabled:=Table1.Active;
  413.   {Box is only then visible if table is active and blob is a jpeg }
  414.   GroupBox1.Visible:=Table1.Active and (DBMultiImage1.BFiletype = 'JPEG');
  415.   {Box is only then visible if table is active and field is in edit state}
  416.   GroupBox2.Visible:=Table1.Active and (DataSource1.State in [dsEdit, dsInsert]);
  417.   {Box is only then visible if table is active and field is in edit state and update is in jpeg mode}
  418.   GroupBox3.Visible:=Table1.Active and RadioButton4.Checked and (DataSource1.State in [dsEdit, dsInsert]);
  419. end;
  420. {---------------------------------------------------------------------}
  421.  
  422. procedure TForm1.BitBtn6Click(Sender: TObject);
  423. begin
  424.  {Append a record and store an image file into the blob}
  425.  If OpenDialog1.Execute Then begin
  426.    {Place table in edit mode}
  427.    Table1.Append;
  428.    {Load the image from file into the blob}
  429.    DBMultiImage1.LoadFromFile(OpenDialog1.FileName);
  430.    {Post the blob}
  431.    Table1.Post;
  432.    {reset the gauge to 0}
  433.    Gauge1.Progress:=0;
  434.  end;
  435. end;
  436. {---------------------------------------------------------------------}
  437.  
  438. procedure TForm1.BitBtn3Click(Sender: TObject);
  439. begin
  440. {open the table}
  441.       If OpenDialog2.execute then begin
  442.         Table1.Active:=False;
  443.         Table1.DataBaseName:=JustPathname(OpenDialog2.FileName);
  444.         Table1.TableName:=OpenDialog2.FileName;
  445.         Table1.Active:=True;
  446.       end;
  447. end;
  448. {---------------------------------------------------------------------}
  449.  
  450. procedure TForm1.RadioButton4Click(Sender: TObject);
  451. begin
  452.  {If the image data is changed save the blob to a jpeg or Bmp blob}
  453.  DBMultiImage1.UpdateBlobAsJpeg:=RadioButton4.Checked;
  454.  
  455.  {Hide or show the jpeg update/save options}
  456.  GroupBox3.Visible:=RadioButton4.Checked;
  457. end;
  458. {---------------------------------------------------------------------}
  459.  
  460. procedure TForm1.BitBtn7Click(Sender: TObject);
  461.  {save or convert the blob to a BMP file}
  462.  {make sure that the blob is displayed before saving to file}
  463. begin
  464.   {set SaveDialog filter to display bmp's only}
  465.   SaveDialog2.filter:='BMP files|*.BMP';
  466.  
  467.   {set SaveDialog Default extension}
  468.   SaveDialog2.DefaultExt:='BMP';
  469.  
  470.   if SaveDialog2.Execute then
  471.   {Save it}
  472.   DBMultiImage1.SaveToFileAsBMP(SaveDialog2.Filename);
  473.  
  474.   {reset the gauge to 0}
  475.   Gauge1.Progress:=0;
  476. end;
  477. {---------------------------------------------------------------------}
  478.  
  479. procedure TForm1.BitBtn8Click(Sender: TObject);
  480.  {save or convert the blob to a Jpeg file}
  481.  {make sure that the blob is displayed before saving to file}
  482. begin
  483.   {set SaveDialog filter to display jpeg's only}
  484.   SaveDialog2.filter:='Jpeg files|*.JPG';
  485.  
  486.   {set SaveDialog Default extension}
  487.   SaveDialog2.DefaultExt:='JPG';
  488.  
  489.   if SaveDialog2.Execute then
  490.   {Save it}
  491.   DBMultiImage1.SaveToFileAsJpeg(SaveDialog2.Filename);
  492.  
  493.   {reset the gauge to 0}
  494.   Gauge1.Progress:=0;
  495. end;
  496. {---------------------------------------------------------------------}
  497.  
  498. procedure TForm1.SpinEdit2Change(Sender: TObject);
  499. begin
  500.   {Set the smooth of the jpeg to save or upate a blob}
  501.   DBMultiImage1.JPegSaveSmooth:=SpinEdit2.Value;
  502. end;
  503. {---------------------------------------------------------------------}
  504.  
  505. procedure TForm1.SpinEdit1Change(Sender: TObject);
  506. begin
  507.   {Set the quality of the jpeg to save or upate a blob}
  508.   DBMultiImage1.JPegSaveQuality:=SpinEdit1.Value;
  509. end;
  510. {---------------------------------------------------------------------}
  511.  
  512. procedure TForm1.BitBtn9Click(Sender: TObject);
  513. begin
  514.   if PrintDialog1.execute then begin
  515.   {Initialize the height spinedit of the printsize dialog box}
  516.    Printersize.HeigthSpinEdit.Value:=DBMultiImage1.Picture.Height;
  517.    {Initialize the width spinedit of the printsize dialog box}
  518.    Printersize.WidthSpinEdit.Value:=DBMultiImage1.Picture.Width;
  519.    {Show it}
  520.    Printersize.ShowModal;
  521.    if Printersize.Modalresult = mrok then
  522.  
  523.     {print TMultiImage}
  524.      DBMultiImage1.PrintMultiImage(0,0,Printersize.WidthSpinEdit.Value,Printersize.HeigthSpinEdit.Value);
  525.  
  526.    {Hide it if done}
  527.    Printersize.hide;
  528.   end;
  529. end;
  530. {---------------------------------------------------------------------}
  531.  
  532. procedure TForm1.BitBtn11Click(Sender: TObject);
  533. begin
  534.   {copy DB Blob image to fullscreen image}
  535.   FullSlide.MultiImage1.Picture.Graphic:=DBMultiImage1.Picture.Graphic;
  536.   {show the image fulscreen}
  537.   FullSlide.showmodal;
  538. end;
  539. {---------------------------------------------------------------------}
  540.  
  541. procedure TForm1.BitBtn12Click(Sender: TObject);
  542. {about box}
  543. begin
  544. {Copy the image to the image of he about box}
  545.  AboutBox.Image1.Picture.Graphic:=DBMultiImage1.Picture.Graphic;
  546. {show the about box}
  547.  AboutBox.showmodal;
  548. end;
  549. {---------------------------------------------------------------------}
  550.  
  551. procedure TForm1.BitBtn13Click(Sender: TObject);
  552. begin
  553.     {Place the Database in append mode}
  554.     Table1.Append;
  555.     {Create a New Message}
  556.     If DBMultiImage1.CreateMessage then
  557.     {Post or cancel that thing}
  558.       Table1.Post
  559.     else
  560.       Table1.Cancel;
  561. end;
  562.  
  563. {---------------------------------------------------------------------}
  564. {Scrolling messages are a new Blob Format.
  565. Undocumented in this release. For examples how to
  566. use look at the project BLOBMM which can be
  567. found in BlobDemo.Zip}
  568. {---------------------------------------------------------------------}
  569. end.
  570.