home *** CD-ROM | disk | FTP | other *** search
/ Delphi Developer's Kit 1996 / Delphi Developer's Kit 1996.iso / power / source8 / mmblob.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1995-12-22  |  13.2 KB  |  414 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.  
  14. unit Mmblob;
  15.  
  16. interface
  17.  
  18. uses WinTypes, WinProcs, Classes, Graphics, Forms, Controls, Buttons,
  19.   StdCtrls, ExtCtrls, MPlayer, DB, DBTables, DBCtrls, Gauges, SysUtils,
  20.   Dialogs, Mask, TDBMulti;
  21.  
  22. type
  23.   TBtnBottomDlg = class(TForm)
  24.     CancelBtn: TBitBtn;
  25.     DBMediaPlayer1: TDBMediaPlayer;
  26.     DataSource1: TDataSource;
  27.     Table1: TTable;
  28.     DBNavigator1: TDBNavigator;
  29.     Gauge1: TGauge;
  30.     OpenDialog1: TOpenDialog;
  31.     BitBtn1: TBitBtn;
  32.     CheckBox1: TCheckBox;
  33.     CheckBox2: TCheckBox;
  34.     OpenDialog2: TOpenDialog;
  35.     BitBtn2: TBitBtn;
  36.     DBMultiMedia1: TDBMultiMedia;
  37.     DBEdit1: TDBEdit;
  38.     DBEdit2: TDBEdit;
  39.     DBMemo1: TDBMemo;
  40.     BitBtn3: TBitBtn;
  41.     CheckBox3: TCheckBox;
  42.     CheckBox4: TCheckBox;
  43.     Label3: TLabel;
  44.     Label5: TLabel;
  45.     Label6: TLabel;
  46.     Label7: TLabel;
  47.     Label4: TLabel;
  48.     Bevel1: TBevel;
  49.     Label8: TLabel;
  50.     Label9: TLabel;
  51.     BitBtn4: TBitBtn;
  52.     ScrollBar1: TScrollBar;
  53.     Panel1: TPanel;
  54.     BitBtn5: TBitBtn;
  55.     Panel2: TPanel;
  56.     BitBtn6: TBitBtn;
  57.     PrintDialog1: TPrintDialog;
  58.     procedure CancelBtnClick(Sender: TObject);
  59.     procedure FormCreate(Sender: TObject);
  60.     procedure BitBtn1Click(Sender: TObject);
  61.     procedure CheckBox1Click(Sender: TObject);
  62.     procedure CheckBox2Click(Sender: TObject);
  63.     procedure BitBtn2Click(Sender: TObject);
  64.     procedure BitBtn3Click(Sender: TObject);
  65.     procedure CheckBox3Click(Sender: TObject);
  66.     procedure CheckBox4Click(Sender: TObject);
  67.     procedure BitBtn4Click(Sender: TObject);
  68.     procedure DataSource1DataChange(Sender: TObject; Field: TField);
  69.     procedure ScrollBar1Change(Sender: TObject);
  70.     procedure BitBtn5Click(Sender: TObject);
  71.     procedure BitBtn6Click(Sender: TObject);
  72.   private
  73.     function JustPathname(PathName : string) : string;
  74.     Procedure Trigger(Sender : TObject; Var Done : Boolean);
  75.     { Private declarations }
  76.   public
  77.     { Public declarations }
  78.   end;
  79.  
  80. var
  81.   BtnBottomDlg: TBtnBottomDlg;
  82.  
  83. implementation
  84.  
  85. {$R *.DFM}
  86. {---------------------------------------------------------------------}
  87.  
  88. procedure TBtnBottomDlg.CancelBtnClick(Sender: TObject);
  89. begin
  90. {close the app}
  91.  close;
  92. end;
  93. {---------------------------------------------------------------------}
  94.  
  95. {Changed in version 2.2 from a procedure to a function. To cancel return
  96. a 0 else return a 1}
  97. Function IwillBeCalled ( i : integer) : integer; export;
  98. {Callback function from the dll, EXPORT IS REQUIRED}
  99. begin
  100.  
  101.   if Application.Terminated then
  102.  
  103.    {User wants to terminate the program. Pass a 0 to the dll}
  104.    Result:=0
  105.  
  106.   else begin
  107.    {Process Progress bar}
  108.    BtnBottomDlg.Gauge1.Progress:=i;
  109.  
  110.    {Live in peace with others}
  111.    Application.ProcessMessages;
  112.  
  113.    {tell the dll that everything is OK}
  114.    Result:=1;
  115.    end;
  116. end;
  117. {---------------------------------------------------------------------}
  118.  
  119.  
  120. procedure TBtnBottomDlg.FormCreate(Sender: TObject);
  121. begin
  122.     {Register the callback Fuction to the VCL}
  123.     TDBMultiMediaCallBack:=IwillBeCalled;
  124.  
  125.     {init label caption with file type}
  126.     Panel1.Caption:=DBMultiMedia1.BFiletype;
  127.  
  128.     {init label caption with file size}
  129.     Panel2.Caption:=IntToStr(DBMultiMedia1.Bsize)+ ' bytes';
  130.  
  131.     {On/Off Play the multimedia automatically}
  132.     DBMultiMedia1.AutoPlayMultiMedia:=CheckBox1.Checked;
  133.  
  134.     {On/Off Hide the DBMediaPlayer Automatically if MM is present}
  135.     DBMultiMedia1.AutoHideMediaPlayer:=CheckBox2.Checked;
  136.  
  137.     {On/Off RePlay the multimedia automatically}
  138.     DBMultiMedia1.AutoRePlayMultiMedia:=CheckBox4.Checked;
  139.  
  140.     {On/Off Display the multimedia automatically}
  141.     DBMultiMedia1.AutoDisplay:=CheckBox3.Checked;
  142.  
  143.     If FileExists(ExtractFilePath(Application.ExeName)+'mmblob.dbf') then begin
  144.        {if the table exists open it on creation}
  145.        Table1.DataBaseName:=JustPathName(Application.ExeName);
  146.        Table1.TableName:='mmblob.dbf';
  147.        Table1.Active:=True;
  148.        {Show or hide the append/replace button, depending on
  149.        the table active stasus}
  150.        BitBtn4.Enabled:=Table1.Active;
  151.        BitBtn3.Enabled:=Table1.Active;
  152.        BitBtn1.Enabled:=Table1.Active;
  153.      end;
  154.  
  155.    {IMPORTANT}
  156.     {This is the moving engine for all the messages. Since an applcation
  157.     can have only one OnIdle Trigger, this trigger needs to be subdivided
  158.     by all your moving and animated objects. In this particular case the
  159.     function is called TRIGGER but you can name it as you want as long
  160.     you have a procedure named the same.}
  161.     Application.OnIdle:=Trigger;
  162.  end;
  163. {---------------------------------------------------------------------}
  164.  
  165. Procedure TBtnBottomDlg.Trigger(Sender : TObject; Var Done : Boolean);
  166. begin
  167.     {IMPORTANT}
  168.    {This function is called when your app is idle. Subdivide the
  169.     trigger event to your TDBMultiMedia objects who may need one.
  170.     If no Message is active it will not take up significant time}
  171.     DBMultiMedia1.Trigger;
  172. end;
  173. {---------------------------------------------------------------------}
  174.  
  175. procedure TBtnBottomDlg.BitBtn1Click(Sender: TObject);
  176. begin
  177.   {fill the OpenDialog filter with the MM extensions as found in the win.ini
  178.    (This means that the appropriate drivers are installed)}
  179.   OpenDialog1.filter:=DBMultiMedia1.GetMultiMediaExtensions;
  180.  
  181.   {Execute the open dialog box}
  182.   if OpenDialog1.Execute then begin
  183.  
  184.     {Place the Database in append mode}
  185.     Table1.Append;
  186.  
  187.     {Load the Multimedia into the Blob}
  188.     DBMultiMedia1.LoadfromFile(OpenDialog1.FileName);
  189.  
  190.     {Post that thing}
  191.     Table1.Post;
  192.   end;
  193. end;
  194. {---------------------------------------------------------------------}
  195.  
  196. procedure TBtnBottomDlg.BitBtn3Click(Sender: TObject);
  197. begin
  198.   {fill the OpenDialog filter with the MM extensions as found in the win.ini
  199.    (This means that the appropriate drivers are installed)}
  200.   OpenDialog1.filter:=DBMultiMedia1.GetMultiMediaExtensions;
  201.  
  202.   {Execute the open dialog box}
  203.   if OpenDialog1.Execute then begin
  204.  
  205.     {Place the Database in edit mode}
  206.     Table1.Edit;
  207.  
  208.     {Load the Multimedia into the Blob}
  209.     DBMultiMedia1.LoadfromFile(OpenDialog1.FileName);
  210.  
  211.     {Post that thing}
  212.     Table1.Post;
  213.   end;
  214. end;
  215. {---------------------------------------------------------------------}
  216.  
  217. procedure TBtnBottomDlg.CheckBox1Click(Sender: TObject);
  218. begin
  219.      {Play the appropriate multimedi when there}
  220.      DBMultiMedia1.AutoPlayMultiMedia:=CheckBox1.Checked;
  221. end;
  222. {---------------------------------------------------------------------}
  223.  
  224. procedure TBtnBottomDlg.CheckBox2Click(Sender: TObject);
  225. begin
  226.     {On/Off Hide the DBMediaPlayer Automatically if MM is present}
  227.      DBMultiMedia1.AutoHideMediaPlayer:=CheckBox2.Checked;
  228.  
  229.     {Suprise <g>}
  230.     if (Panel1.Caption = 'MID') or (Panel1.Caption = 'RMI') or (Panel1.Caption = 'WAV') then
  231.     {hide blob window if no media needs to be display and auto hide is on}
  232.      DBMultiMedia1.Visible:=not CheckBox2.Checked;
  233. end;
  234. {---------------------------------------------------------------------}
  235.  
  236. procedure TBtnBottomDlg.CheckBox3Click(Sender: TObject);
  237. begin
  238.     {On/Off Display the multimedia automatically}
  239.      DBMultiMedia1.AutoDisplay:=CheckBox3.Checked;
  240. end;
  241. {---------------------------------------------------------------------}
  242.  
  243. procedure TBtnBottomDlg.CheckBox4Click(Sender: TObject);
  244. begin
  245.     {On/Off RePlay the multimedia automatically}
  246.     DBMultiMedia1.AutoRePlayMultiMedia:=CheckBox4.Checked;
  247. end;
  248. {---------------------------------------------------------------------}
  249.  
  250. function TBtnBottomDlg.JustPathname(PathName : string) : string;
  251.     {-Return just the drive:directory portion of a pathname}
  252.   var
  253.     I : Word;
  254.   const
  255.      DosDelimSet : set of Char = ['\', ':', #0];
  256.   begin
  257.     I := Succ(Word(Length(PathName)));
  258.     repeat
  259.       Dec(I);
  260.     until (PathName[I] in DosDelimSet) or (I = 0);
  261.  
  262.     if I = 0 then
  263.       {Had no drive or directory name}
  264.       JustPathname[0] := #0
  265.     else if I = 1 then
  266.       {Either the root directory of default drive or invalid pathname}
  267.       JustPathname := PathName[1]
  268.     else if (PathName[I] = '\') then begin
  269.       if PathName[Pred(I)] = ':' then
  270.         {Root directory of a drive, leave trailing backslash}
  271.         JustPathname := Copy(PathName, 1, I)
  272.       else
  273.         {Subdirectory, remove the trailing backslash}
  274.         JustPathname := Copy(PathName, 1, Pred(I));
  275.     end else
  276.       {Either the default directory of a drive or invalid pathname}
  277.       JustPathname := Copy(PathName, 1, I);
  278.   end;
  279. {---------------------------------------------------------------------}
  280.  
  281. procedure TBtnBottomDlg.BitBtn2Click(Sender: TObject);
  282. begin
  283. {open the table}
  284.  try
  285.       If OpenDialog2.execute then begin
  286.         Table1.Active:=False;
  287.         Table1.DataBaseName:=JustPathname(OpenDialog2.FileName);
  288.         Table1.TableName:=OpenDialog2.FileName;
  289.         Table1.Active:=True;
  290.       end;
  291.  finally
  292.         {Show or hide the append/replace button, depending on
  293.         the table active status}
  294.         BitBtn4.Enabled:=Table1.Active;
  295.         BitBtn3.Enabled:=Table1.Active;
  296.         BitBtn1.Enabled:=Table1.Active;
  297.  end;
  298. end;
  299. {---------------------------------------------------------------------}
  300.  
  301. procedure TBtnBottomDlg.BitBtn4Click(Sender: TObject);
  302. begin
  303.     {Place the Database in append mode}
  304.     Table1.Append;
  305.     {Create a New Message}
  306.     If DBMultiMedia1.CreateMessage then
  307.     {Post or cancel that thing}
  308.        Table1.Post
  309.     else
  310.        Table1.Cancel;
  311. end;
  312. {---------------------------------------------------------------------}
  313.  
  314. procedure TBtnBottomDlg.DataSource1DataChange(Sender: TObject;
  315.   Field: TField);
  316.  
  317. var
  318.    temp : string;
  319.  
  320. begin
  321.   {Show or hide the scroll bar}
  322.   ScrollBar1.Visible:=(DBMultiMedia1.BFiletype = 'SCM');
  323.  
  324.   {Syncronize the scrollbar's position}
  325.   ScrollBar1.Position:=DBMultiMedia1.MsgSpeed;
  326.  
  327.    {Set the blob window to visible}
  328.     DBMultiMedia1.Visible:=true;
  329.  
  330.     {Set the Video display rectangle to the rectangle of the blob window}
  331.     DBMediaPlayer1.DisplayRect:=Rect(0,0,DBMultiMedia1.Width,DBMultiMedia1.Height);
  332.  
  333.     {Set the Video display to the the display of the blob window}
  334.     DBMediaPlayer1.Display:=DBMultiMedia1;
  335.  
  336.     {init label caption with file type}
  337.     Panel1.Caption:=DBMultiMedia1.BFiletype;
  338.  
  339.     {init label caption with file size}
  340.     Panel2.Caption:=IntToStr(DBMultiMedia1.Bsize)+ ' bytes';
  341.  
  342.     {Get file type of blob stored}
  343.     temp:=DBMultiMedia1.BFiletype;
  344.  
  345.     {Show print button only when image is there}
  346.     BitBtn6.Enabled:= (DBMultiMedia1.Picture.Graphic <> nil);
  347.  
  348.     {Enable the next line. Just to show of (Play message if blob is a RMI file}
  349.     {if temp = 'RMI' then BitBtn5Click(Sender);}
  350.  
  351.     {Enable the next line. Just to show of (Play message if blob is a MIDI file}
  352.     {if temp = 'MID' then BitBtn5Click(Sender);}
  353.  
  354.     {Suprise <g>}
  355.     if (temp = 'MID') or (temp = 'RMI') or (temp = 'WAV') then
  356.     {hide blob window if no media needs to be display and auto hide is on}
  357.     DBMultiMedia1.Visible:=not CheckBox2.Checked;
  358.  
  359. end;
  360. {---------------------------------------------------------------------}
  361.  
  362. procedure TBtnBottomDlg.ScrollBar1Change(Sender: TObject);
  363. begin
  364.   {Set message speed 1(fast) to 10(slow)}
  365.   DBMultiMedia1.MsgSpeed:=ScrollBar1.Position;
  366. end;
  367. {---------------------------------------------------------------------}
  368.  
  369. procedure TBtnBottomDlg.BitBtn5Click(Sender: TObject);
  370. begin
  371. begin
  372.    {create a message on the fly without actualy storing the message in the blob
  373.    At any time you can play this message}
  374.    {set Message text}
  375.     DBMultiMedia1.MsgText:='Isn''t super to be a Delphi programmer ?? '+
  376.     'Delphi is too Cool and so is every one who''s using VCL''s !! ';
  377.     {set Message font name;  Note you could do this also with a font dialog}
  378.     DBMultiMedia1.MsgFont.Name:='Arial';
  379.    {set Message font size}
  380.     DBMultiMedia1.MsgFont.Size:=-30;
  381.     {set Message font style}
  382.     DBMultiMedia1.MsgFont.Style:=[fsItalic];
  383.     {set Message font color}
  384.     DBMultiMedia1.MsgFont.Color:=clWhite;
  385.     {set Message background. Note you could do this also with a color dialog}
  386.     DBMultiMedia1.MsgBkGrnd:=clTeal;
  387.     {set Message speed from 0 is fast to 10 is slow}
  388.     DBMultiMedia1.MsgSpeed:=0;
  389.     {show the speed control scroll bar}
  390.     ScrollBar1.Visible:=True;
  391.     {Set position according speed}
  392.     ScrollBar1.Position:=DBMultiMedia1.MsgSpeed;
  393.     {inititiate new message}
  394.     DBMultiMedia1.NewMessage;
  395.   end;
  396. end;
  397. {---------------------------------------------------------------------}
  398.  
  399. procedure TBtnBottomDlg.BitBtn6Click(Sender: TObject);
  400. begin
  401. {print image x y width and heigth (if width and heigth are 0 the image
  402. original size is printed)}
  403.  If PrintDialog1.Execute then
  404.   DBMultiMedia1.PrintMultiImage(0,0,0,0);
  405. end;
  406. {---------------------------------------------------------------------}
  407.  
  408. {---------------------------------------------------------------------}
  409.  
  410.  
  411. end.
  412.  
  413. {easy enough ?}
  414.