Форум: "Базы";
Текущий архив: 2002.03.28;
Скачать: [xml.tar.bz2];

Вниз

Помогите!   Найти похожие ветки 

← →
Набережных С.   (2002-03-02 20:14) [1]

Не очень понятен вопрос, но может быть это поможет?
unit Unit1;

interface

uses
Windows, Messages, SysUtils, Classes,
Graphics, Controls, Forms, Dialogs,
Db, ADODB, ExtDlgs, ExtCtrls, StdCtrls;

type
TForm1 = class(TForm)
Button1: TButton;
Button2: TButton;
Button3: TButton;
OPD: TOpenPictureDialog;
ADOTable1: TADOTable;
ADOTable1BlobField: TBlobField;
Image1: TImage;
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure Button3Click(Sender: TObject);
private
{ Private declarations }
FList:TStringList;
public
{ Public declarations }
end;

var
Form1: TForm1;

implementation

{$R *.DFM}

uses Jpeg;

procedure WriteBlob(Source: TStrings; Field: TBlobField);
var
B,T:TStream;
n,m:integer;
Img:TJPEGImage;
begin
B:=Field.DataSet.CreateBlobStream(Field,bmWrite);
try
B.Size:=0;
n:=Source.Count;
B.Write(n,SizeOf(n));
T:=TMemoryStream.Create;
try
n:=0;
while n < Source.Count do
begin
TObject(Img):=Source.Objects[n];
Img.SaveToStream(T);
T.Position:=0;
m:=T.Size;
B.Write(m,SizeOf(m));
B.CopyFrom(T,m);
T.Size:=0;
Inc(n);
end;
finally
T.Free;
end;
finally
B.Free;
end;
end;

procedure ReadBlob(Target: TStrings; Field: TBlobField);
var
B,T:TStream;
n,m:integer;
Img:TJPEGImage;
begin
B:=Field.DataSet.CreateBlobStream(Field,bmRead);
try
if B.Size < SizeOf(n) then Exit;
B.Position:=0;
B.Read(n,SizeOf(n));
if n > 0 then Target.Capacity:=n;
T:=TMemoryStream.Create;
try
while n > 0 do
begin
B.Read(m,SizeOf(m));
T.CopyFrom(B,m);
Img:=TJPEGImage.Create;
Target.AddObject("",Img);
T.Position:=0;
Img.LoadFromStream(T);
T.Size:=0;
Dec(n);
end;
finally
T.Free;
end;
finally
B.Free;
end;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
Img:TJPEGImage;
begin
if FList <> nil then
while FList.Count > 0 do
begin
FList.Objects[FList.Count-1].Free;
FList.Delete(FList.Count-1);
end
else
FList:=TStringList.Create;
Img:=TJPEGImage.Create;
OPD.Execute;
Img.LoadFromFile(OPD.FileName);
FList.AddObject("",Img);
Img:=TJPEGImage.Create;
OPD.Execute;
Img.LoadFromFile(OPD.FileName);
FList.AddObject("",Img);
Img:=TJPEGImage.Create;
OPD.Execute;
Img.LoadFromFile(OPD.FileName);
FList.AddObject("",Img);
ADOTable1.Open;
ADOTable1.Edit;
WriteBlob(FList,ADOTable1BlobField);
ADOTable1.Post;
ADOTable1.Close;
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
if FList <> nil then
while FList.Count > 0 do
begin
FList.Objects[FList.Count-1].Free;
FList.Delete(FList.Count-1);
end
else
FList:=TStringList.Create;
ADOTable1.Open;
ReadBlob(FList,ADOTable1BlobField);
ADOTable1.Close;
end;

procedure TForm1.Button3Click(Sender: TObject);
const
n:integer = 0;
var
img:TJPEGImage;
begin
if FList.Count = 0 then exit
else if n >= FList.Count then n:=0;
Image1.Picture.Graphic:=nil;
TObject(img):=FList.Objects[n];
Image1.Picture.Assign(img);
Inc(n);
end;

end.


---

Страницы: 1 вся ветка

Форум: "Базы";
Текущий архив: 2002.03.28;
Скачать: [xml.tar.bz2];

Наверх

Память: 0.45 MB
Время: 0.006 c