home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
PC World Komputer 1997 May
/
Pcwk0597.iso
/
delphi
/
imagelib
/
ublob.pa_
/
ublob.pa
Wrap
Text File
|
1995-10-01
|
23KB
|
707 lines
{Part of Imagelib VCL/DLL Library.
Written by Jan Dekkers and Kevin Adams (c) 1995. If you are a non
registered client, you may use or alter this demo only for evaluation
purposes.
Uses ImageLib 3.0
Bug fixes:
Changed callback in version 2.21 to a function with cdecl.
using the C calling convention.
Version 2.2.2 Added property ImageLibPalette which if set to True will
use the ImageLib Way to paint. If false it will paint the Delphi way.
This is a fix of a Stretchdraw Delphi bug which doesn't paint correctly
256 color palettes on 256 color Video cards}
unit Ublob;
interface
uses
SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
Forms, Dialogs, DB, DBTables, StdCtrls, ExtCtrls, DBCtrls, Gauges, Mask,
Buttons, Clipbrd, Spin, U_p_size, Printers, Ufullscr, UAbout,
DLL30, TDMultiP;
type
TBlobForm1 = class(TForm)
Table1 : TTable;
DataSource1 : TDataSource;
DBNavigator1 : TDBNavigator;
Gauge1 : TGauge;
AutodisplayCheckBox : TCheckBox;
DBEdit1 : TDBEdit;
StretchCheckBox : TCheckBox;
BitBtn1: TBitBtn;
OpenDialog1: TOpenDialog;
SaveDialog1: TSaveDialog;
BitBtn2: TBitBtn;
GroupBox1: TGroupBox;
RadioButton1: TRadioButton;
RadioButton2: TRadioButton;
RadioButton3: TRadioButton;
CenterCheckBox: TCheckBox;
BitBtn4: TBitBtn;
BitBtn5: TBitBtn;
Timer1: TTimer;
BitBtn6: TBitBtn;
Edit1: TEdit;
BitBtn3: TBitBtn;
OpenDialog2: TOpenDialog;
Edit2: TEdit;
Edit3: TEdit;
Edit4: TEdit;
Edit5: TEdit;
Edit6: TEdit;
Label1: TLabel;
Label2: TLabel;
Label3: TLabel;
Label4: TLabel;
Label5: TLabel;
Label6: TLabel;
Edit7: TEdit;
Label7: TLabel;
Edit8: TEdit;
GroupBox2: TGroupBox;
RadioButton4: TRadioButton;
RadioButton5: TRadioButton;
BitBtn7: TBitBtn;
BitBtn8: TBitBtn;
SaveDialog2: TSaveDialog;
GroupBox3: TGroupBox;
SpinEdit1: TSpinEdit;
SpinEdit2: TSpinEdit;
Label8: TLabel;
Label9: TLabel;
BitBtn9: TBitBtn;
PrintDialog1: TPrintDialog;
BitBtn11: TBitBtn;
BitBtn12: TBitBtn;
BitBtn13: TBitBtn;
DBMultiImage1: TPDBMultiImage;
RadioButton6: TRadioButton;
RadioButton7: TRadioButton;
RadioButton9: TRadioButton;
BitBtn14: TBitBtn;
BitBtn15: TBitBtn;
BitBtn16: TBitBtn;
BitBtn10: TBitBtn;
procedure FormCreate(Sender: TObject);
procedure AutodisplayCheckBoxClick(Sender: TObject);
procedure StretchCheckBoxClick(Sender: TObject);
procedure DataSource1DataChange(Sender: TObject; Field: TField);
procedure BitBtn1Click(Sender: TObject);
procedure BitBtn2Click(Sender: TObject);
procedure ResolutionClick(Sender: TObject);
procedure CenterCheckBoxClick(Sender: TObject);
procedure BitBtn4Click(Sender: TObject);
procedure BitBtn5Click(Sender: TObject);
procedure Timer1Timer(Sender: TObject);
procedure BitBtn6Click(Sender: TObject);
procedure BitBtn3Click(Sender: TObject);
procedure RadioButton4Click(Sender: TObject);
procedure BitBtn7Click(Sender: TObject);
procedure BitBtn8Click(Sender: TObject);
procedure SpinEdit2Change(Sender: TObject);
procedure SpinEdit1Change(Sender: TObject);
procedure BitBtn9Click(Sender: TObject);
procedure BitBtn11Click(Sender: TObject);
procedure BitBtn12Click(Sender: TObject);
procedure BitBtn13Click(Sender: TObject);
procedure RadioButton5Click(Sender: TObject);
procedure RadioButton6Click(Sender: TObject);
procedure RadioButton7Click(Sender: TObject);
procedure RadioButton9Click(Sender: TObject);
procedure BitBtn14Click(Sender: TObject);
procedure BitBtn15Click(Sender: TObject);
procedure BitBtn16Click(Sender: TObject);
procedure BitBtn10Click(Sender: TObject);
procedure FormDestroy(Sender: TObject);
private
{ Private declarations }
Procedure Trigger(Sender : TObject; Var Done : Boolean);
public
{ Public declarations }
end;
var
BlobForm1: TBlobForm1;
implementation
{IMPORTANT}
{Changed in version 2.21 from a procedure to a function with cdecl.
To cancel return a 0 else return a 1}
Function CallMe(i : integer) : integer; cdecl; export;
{Callback function from the dll, CDECL and EXPORT ARE REQUIRED}
begin
if Application.Terminated then begin
{User wants to terminate the program. Pass a 0 to the dll}
Result:=0;
end else begin
{Be nice to others <g>}
Application.ProcessMessages;
{process a Gauge}
if BlobForm1 <> nil then
BlobForm1.Gauge1.Progress:=i;
{tell the dll that everything is OK}
Result:=1;
end;
end;
{---------------------------------------------------------------------}
function JustPathname(PathName : string) : string;
{-Return just the drive:directory portion of a pathname}
var
I : Word;
const
DosDelimSet : set of Char = ['\', ':', #0];
begin
I := Succ(Word(Length(PathName)));
repeat
Dec(I);
until (PathName[I] in DosDelimSet) or (I = 0);
if I = 0 then
{Had no drive or directory name}
JustPathname[0] := #0
else if I = 1 then
{Either the root directory of default drive or invalid pathname}
JustPathname := PathName[1]
else if (PathName[I] = '\') then begin
if PathName[Pred(I)] = ':' then
{Root directory of a drive, leave trailing backslash}
JustPathname := Copy(PathName, 1, I)
else
{Subdirectory, remove the trailing backslash}
JustPathname := Copy(PathName, 1, Pred(I));
end else
{Either the default directory of a drive or invalid pathname}
JustPathname := Copy(PathName, 1, I);
end;
{---------------------------------------------------------------------}
{$R *.DFM}
procedure TBlobForm1.FormCreate(Sender: TObject);
begin
{Assign a callback function to the VCL/DLL}
TPDBMultiImageCallBack:=CallMe;
{Is Autodisplay Initial on or off}
DBMultiImage1.AutoDisPlay:=AutodisplayCheckBox.Checked;
{If the image data is changed save the blob to a jpeg or Bmp blob}
DBMultiImage1.UpdateAsJpg:=RadioButton4.Checked;
{set the values of teh spin edit controls to the values of the vcl}
SpinEdit2.Value:=DBMultiImage1.JPegSaveSmooth;
SpinEdit1.Value:=DBMultiImage1.JPegSaveQuality;
If FileExists(ExtractFilePath(Application.ExeName)+'JPSTAMP.DBF') then begin
{if the table exists open it on creation}
Table1.DataBaseName:=JustPathName(Application.ExeName);
Table1.TableName:='JPSTAMP.DBF';
Table1.Active:=True;
{Table1.Last;}
end;
{IMPORTANT
This is the moving engine for all the messages. Since an applcation
can have only one OnIdle Trigger, this trigger needs to be subdivided
by all your moving and animated objects. In this particular case the
function is called TRIGGER but you can name it as you want as long
you have a procedure named the same.}
Application.OnIdle:=Trigger;
end;
{---------------------------------------------------------------------}
Procedure TBlobForm1.Trigger(Sender : TObject; Var Done : Boolean);
begin
{IMPORTANT}
{This function is called when your app is idle. Subdivide the
trigger event to your TDBMultiImage objects who may need one.
If no Message is active it will not take up significant time}
DBMultiImage1.Trigger;
end;
{---------------------------------------------------------------------}
procedure TBlobForm1.AutodisplayCheckBoxClick(Sender: TObject);
begin
{Toggle Autodisplay}
DBMultiImage1.AutoDisPlay:=AutodisplayCheckBox.Checked;
{Let users know to double click when autodisplay is off}
DBMultiImage1.ShowHint:= not AutodisplayCheckBox.Checked;
{reset the gauge to 0}
Gauge1.Progress:=0;
end;
{---------------------------------------------------------------------}
procedure TBlobForm1.StretchCheckBoxClick(Sender: TObject);
begin
{Stretch DBImage}
DBMultiImage1.Stretch:=StretchCheckBox.Checked;
{reset the gauge to 0}
Gauge1.Progress:=0;
end;
{---------------------------------------------------------------------}
procedure TBlobForm1.CenterCheckBoxClick(Sender: TObject);
begin
{Center DBImage}
DBMultiImage1.Center:=CenterCheckBox.Checked;
{reset the gauge to 0}
Gauge1.Progress:=0;
end;
{---------------------------------------------------------------------}
procedure TBlobForm1.DataSource1DataChange(Sender: TObject; Field: TField);
begin
{Reset the Gauge}
Gauge1.Progress:=0;
{If DBMultiImage1.autodisplay = false then get the blob info
manually else the vcl will do it automatically}
If not DBMultiImage1.autodisplay then DBMultiImage1.GetInfoAndType;
{Show the user the blob info}
Edit1.text:='This blob image is a '+DBMultiImage1.BFiletype;
Edit2.text:=IntToStr(DBMultiImage1.Bwidth);
Edit3.text:=IntToStr(DBMultiImage1.BHeight);
Edit4.text:=IntToStr(DBMultiImage1.Bbitspixel);
Edit5.text:=IntToStr(DBMultiImage1.Bplanes);
Edit6.text:=IntToStr(DBMultiImage1.Bnumcolors);
Edit7.text:=DBMultiImage1.Bcompression;
Edit8.text:=IntToStr(DBMultiImage1.BSize)+ ' bytes';
end;
{---------------------------------------------------------------------}
procedure TBlobForm1.BitBtn1Click(Sender: TObject);
begin
{load a image file in the current blob}
If OpenDialog1.Execute Then begin
{Place table in edit mode}
Table1.Edit;
{Load the image from file into the blob}
DBMultiImage1.LoadFromFile(OpenDialog1.FileName);
{Post the blob}
Table1.Post;
{reset the gauge to 0}
Gauge1.Progress:=0;
end;
end;
{---------------------------------------------------------------------}
procedure TBlobForm1.BitBtn2Click(Sender: TObject);
var temp : string;
begin
{Save the current blob to a jpeg, pcx, gif or Bmp file. The SaveToFile
will save it as stored in the blob. (no conversion is done here)
Use SaveToFileAsBMP or SaveToFileAsJpeg to Convert to one another}
{get the extension (filetype) of the stored blob}
{GetInfoAndType returns the extension of the blob stored}
if not table1.active then exit;
temp:=DBMultiImage1.GetInfoAndType;
if temp = 'GIF' then begin
{set SaveDialog filter to display gif's only}
SaveDialog1.filter:='GIF files|*.GIF';
{set SaveDialog Default extension}
SaveDialog1.DefaultExt:='GIF';
end else
if temp = 'PCX' then begin
{set SaveDialog filter to display pcx's only}
SaveDialog1.filter:='PCX files|*.PCX';
{set SaveDialog Default extension}
SaveDialog1.DefaultExt:='PCX';
end else
if temp = 'JPG' then begin
{set SaveDialog filter to display jpeg's only}
SaveDialog1.filter:='Jpeg files|*.JPG';
{set SaveDialog Default extension}
SaveDialog1.DefaultExt:='JPG';
end else
if temp = 'BMP' then begin
{set SaveDialog filter to display bmp's only}
SaveDialog1.filter:='BMP files|*.BMP';
{set SaveDialog Default extension}
SaveDialog1.DefaultExt:='BMP';
end;
{save it to file as stored in blob}
If SaveDialog1.Execute Then
DBMultiImage1.SaveToFile(SaveDialog1.FileName);
{reset the gauge to 0}
Gauge1.Progress:=0;
end;
{---------------------------------------------------------------------}
procedure TBlobForm1.ResolutionClick(Sender: TObject);
begin
{Set resolution and dither the image}
if RadioButton1.Checked then begin
{Set resolution to 16 colors}
DBMultiImage1.ImageReadRes:=Color16;
{Set dither }
DBMultiImage1.ImageDither:=True;
end else
if RadioButton2.Checked then begin
{Set resolution to 256 colors}
DBMultiImage1.ImageReadRes:=Color256;
{Set dither }
DBMultiImage1.ImageDither:=True;
end else
if RadioButton3.Checked then begin
{Set resolution to true color}
DBMultiImage1.ImageReadRes:=ColorTrue;
{Set dither }
DBMultiImage1.ImageDither:=True;
end;
{Reload the image }
Table1.Refresh;
{reset the gauge to 0}
Gauge1.Progress:=0;
end;
{---------------------------------------------------------------------}
procedure TBlobForm1.BitBtn4Click(Sender: TObject);
begin
{Check to see if image is there}
if DBMultiImage1.Picture.Bitmap <> nil then
{Copy the image to the clipboard}
DBMultiImage1.CopyToClipboard;
{reset the gauge to 0}
Gauge1.Progress:=0;
end;
{---------------------------------------------------------------------}
procedure TBlobForm1.BitBtn5Click(Sender: TObject);
{Paste image from clipboard}
begin
{does the clipboard has the right format?}
if Clipboard.HasFormat(CF_PICTURE) then
{Yep it does. Paste image from clipboard}
DBMultiImage1.PastefromClipboard;
{reset the gauge to 0}
Gauge1.Progress:=0;
end;
{---------------------------------------------------------------------}
procedure TBlobForm1.Timer1Timer(Sender: TObject);
begin
{En/Disable Paste Button if clipboard has format}
BitBtn5.Enabled:=Clipboard.HasFormat(CF_PICTURE);
{Enable/disable certain buttons}
{Button is only then enabled if table is active}
BitBtn1.Enabled:=Table1.Active;
{Button is only then enabled if table is active}
BitBtn2.Enabled:=Table1.Active;
{Button is only then enabled if table is active}
BitBtn4.Enabled:=Table1.Active;
{Button is only then enabled if table is active}
BitBtn6.Enabled:=Table1.Active;
{Button is only then enabled if table is active}
BitBtn7.Enabled:=Table1.Active;
{Button is only then enabled if table is active}
BitBtn8.Enabled:=Table1.Active;
{Button is only then enabled if table is active}
BitBtn9.Enabled:=Table1.Active;
{Button is only then enabled if table is active}
BitBtn11.Enabled:=Table1.Active;
{Button is only then enabled if table is active}
BitBtn13.Enabled:=Table1.Active;
{Box is only then visible if table is active and field is in edit state}
GroupBox2.Visible:=Table1.Active and (DataSource1.State in [dsEdit, dsInsert]);
{Box is only then visible if table is active and field is in edit state and update is in jpeg mode}
GroupBox3.Visible:=Table1.Active and RadioButton4.Checked and (DataSource1.State in [dsEdit, dsInsert]);
end;
{---------------------------------------------------------------------}
procedure TBlobForm1.BitBtn6Click(Sender: TObject);
begin
{Append a record and store an image file into the blob}
If OpenDialog1.Execute Then begin
{Place table in edit mode}
Table1.Append;
{Load the image from file into the blob}
DBMultiImage1.LoadFromFile(OpenDialog1.FileName);
{Post the blob}
Table1.Post;
{reset the gauge to 0}
Gauge1.Progress:=0;
end;
end;
{---------------------------------------------------------------------}
procedure TBlobForm1.BitBtn3Click(Sender: TObject);
begin
{open the table}
If OpenDialog2.execute then begin
Table1.Active:=False;
Table1.DataBaseName:=JustPathname(OpenDialog2.FileName);
Table1.TableName:=OpenDialog2.FileName;
Table1.Active:=True;
end;
end;
{---------------------------------------------------------------------}
procedure TBlobForm1.RadioButton4Click(Sender: TObject);
begin
{If the image data is changed save the blob to a jpeg blob}
DBMultiImage1.UpdateASJpg:=RadioButton4.Checked;
{Hide or show the jpeg update/save options}
GroupBox3.Visible:=RadioButton4.Checked;
end;
{---------------------------------------------------------------------}
procedure TBlobForm1.BitBtn7Click(Sender: TObject);
{save or convert the blob to a BMP file}
{make sure that the blob is displayed before saving to file}
begin
{set SaveDialog filter to display bmp's only}
SaveDialog2.filter:='BMP files|*.BMP';
{set SaveDialog Default extension}
SaveDialog2.DefaultExt:='BMP';
if SaveDialog2.Execute then
{Save it}
DBMultiImage1.SaveToFileAsBMP(SaveDialog2.Filename);
{reset the gauge to 0}
Gauge1.Progress:=0;
end;
{---------------------------------------------------------------------}
procedure TBlobForm1.BitBtn8Click(Sender: TObject);
{save or convert the blob to a Jpeg file}
{make sure that the blob is displayed before saving to file}
begin
{set SaveDialog filter to display jpeg's only}
SaveDialog2.filter:='Jpeg files|*.JPG';
{set SaveDialog Default extension}
SaveDialog2.DefaultExt:='JPG';
if SaveDialog2.Execute then
{Save it}
DBMultiImage1.SaveToFileAsJpg(SaveDialog2.Filename);
{reset the gauge to 0}
Gauge1.Progress:=0;
end;
{---------------------------------------------------------------------}
procedure TBlobForm1.SpinEdit2Change(Sender: TObject);
begin
{Set the smooth of the jpeg to save or upate a blob}
DBMultiImage1.JPegSaveSmooth:=SpinEdit2.Value;
end;
{---------------------------------------------------------------------}
procedure TBlobForm1.SpinEdit1Change(Sender: TObject);
begin
{Set the quality of the jpeg to save or upate a blob}
DBMultiImage1.JPegSaveQuality:=SpinEdit1.Value;
end;
{---------------------------------------------------------------------}
procedure TBlobForm1.BitBtn9Click(Sender: TObject);
begin
if PrintDialog1.execute then begin
{Initialize the height spinedit of the printsize dialog box}
Printersize.HeigthSpinEdit.Value:=DBMultiImage1.Picture.Height;
{Initialize the width spinedit of the printsize dialog box}
Printersize.WidthSpinEdit.Value:=DBMultiImage1.Picture.Width;
{Show it}
Printersize.ShowModal;
if Printersize.Modalresult = mrok then
{print TMultiImage}
DBMultiImage1.PrintMultiImage(0,0,Printersize.WidthSpinEdit.Value,Printersize.HeigthSpinEdit.Value);
{Hide it if done}
Printersize.hide;
end;
end;
{---------------------------------------------------------------------}
procedure TBlobForm1.BitBtn11Click(Sender: TObject);
begin
{copy DB Blob image to fullscreen image}
FullSlide.MultiImage1.Picture.Graphic:=DBMultiImage1.Picture.Graphic;
{show the image fulscreen}
FullSlide.showmodal;
end;
{---------------------------------------------------------------------}
procedure TBlobForm1.BitBtn12Click(Sender: TObject);
{about box}
begin
{Copy the image to the image of he about box}
AboutBox.Image1.Picture.Graphic:=DBMultiImage1.Picture.Graphic;
{show the about box}
AboutBox.showmodal;
end;
{---------------------------------------------------------------------}
procedure TBlobForm1.BitBtn13Click(Sender: TObject);
begin
{Place the Database in append mode}
Table1.Append;
{Create a New Message}
If DBMultiImage1.CreateMessage then
{Post or cancel that thing}
Table1.Post
else
Table1.Cancel;
end;
{---------------------------------------------------------------------}
procedure TBlobForm1.RadioButton5Click(Sender: TObject);
begin
{If the image data is changed save the blob to Bmp blob}
DBMultiImage1.UpdateASBMP:=RadioButton5.Checked;
{Hide or show the update/save options}
GroupBox3.Visible:=RadioButton4.Checked;
end;
{---------------------------------------------------------------------}
procedure TBlobForm1.RadioButton6Click(Sender: TObject);
begin
{If the image data is changed save the blob to a GIF blob}
DBMultiImage1.UpdateASGif:=RadioButton4.Checked;
{Hide or show the jpeg update/save options}
GroupBox3.Visible:=RadioButton4.Checked;
end;
{---------------------------------------------------------------------}
procedure TBlobForm1.RadioButton7Click(Sender: TObject);
begin
{If the image data is changed save the blob to a PCX blob}
DBMultiImage1.UpdateASPcx:=RadioButton4.Checked;
{Hide or show the jpeg update/save options}
GroupBox3.Visible:=RadioButton4.Checked;
end;
{---------------------------------------------------------------------}
procedure TBlobForm1.RadioButton9Click(Sender: TObject);
begin
{If the image data is changed save the blob to a PNG blob}
DBMultiImage1.UpdateASPng:=RadioButton4.Checked;
{Hide or show the jpeg update/save options}
GroupBox3.Visible:=RadioButton4.Checked;
end;
{---------------------------------------------------------------------}
procedure TBlobForm1.BitBtn14Click(Sender: TObject);
{save or convert the blob to a GIF file}
{make sure that the blob is displayed before saving to file}
begin
{set SaveDialog filter to display bmp's only}
SaveDialog2.filter:='GIF files|*.GIF';
{set SaveDialog Default extension}
SaveDialog2.DefaultExt:='GIF';
if SaveDialog2.Execute then
{Save it}
DBMultiImage1.SaveToFileAsGIF(SaveDialog2.Filename);
{reset the gauge to 0}
Gauge1.Progress:=0;
end;
{---------------------------------------------------------------------}
procedure TBlobForm1.BitBtn15Click(Sender: TObject);
{save or convert the blob to a PCX file}
{make sure that the blob is displayed before saving to file}
begin
{set SaveDialog filter to display bmp's only}
SaveDialog2.filter:='PCX files|*.PCX';
{set SaveDialog Default extension}
SaveDialog2.DefaultExt:='PCX';
if SaveDialog2.Execute then
{Save it}
DBMultiImage1.SaveToFileAsBMP(SaveDialog2.Filename);
{reset the gauge to 0}
Gauge1.Progress:=0;
end;
{---------------------------------------------------------------------}
procedure TBlobForm1.BitBtn16Click(Sender: TObject);
{save or convert the blob to a PNG file}
{make sure that the blob is displayed before saving to file}
begin
{set SaveDialog filter to display bmp's only}
SaveDialog2.filter:='PNG files|*.PNG';
{set SaveDialog Default extension}
SaveDialog2.DefaultExt:='PNG';
if SaveDialog2.Execute then
{Save it}
DBMultiImage1.SaveToFileAsBMP(SaveDialog2.Filename);
{reset the gauge to 0}
Gauge1.Progress:=0;
end;
{---------------------------------------------------------------------}
{---------------------------------------------------------------------}
procedure TBlobForm1.BitBtn10Click(Sender: TObject);
begin
{Place the Database in append mode}
Table1.Append;
{Create a New Credit Message}
If DBMultiImage1.CreateCreditMessage then
{Post or cancel that thing}
Table1.Post
else
Table1.Cancel;
end;
procedure TBlobForm1.FormDestroy(Sender: TObject);
begin
{Unregister the callback function to the VCL/DLL}
TPDBMultiImageCallBack:=Nil;
Application.OnIdle:=Nil;
BlobForm1 := Nil;
end;
end.