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