resim ekleme ve okuma
-
- Üye
- Mesajlar: 386
- Kayıt: 02 Tem 2007 09:43
resim ekleme ve okuma
değerli arkadaşlar;
veri tabanından veri okurken yada veri tabanına veri aktarırken ben aşağıdaki yöntemi kullanıyorum.
CXCOMBOBOX5.Text :=DM.ADSTBLSTOKGRUBU.AsString;
DM.ADSTBLSTOKGRUBU.AsString := CXCOMBOBOX5.Text;
yukarıdaki kod sistemini veri tabanından resim verisi okurken yada resmi kaydederken nasıl kullanabilirim. resmi cximage ye alabiliyorum ancak kaydetme ve okuma işlemini yukarıdaki kod sisteminde olduğu gibi yapamadım.
delphi 7, advantage veri tabanı ve cximage kullanıyorum.
kolay gelsin,
veri tabanından veri okurken yada veri tabanına veri aktarırken ben aşağıdaki yöntemi kullanıyorum.
CXCOMBOBOX5.Text :=DM.ADSTBLSTOKGRUBU.AsString;
DM.ADSTBLSTOKGRUBU.AsString := CXCOMBOBOX5.Text;
yukarıdaki kod sistemini veri tabanından resim verisi okurken yada resmi kaydederken nasıl kullanabilirim. resmi cximage ye alabiliyorum ancak kaydetme ve okuma işlemini yukarıdaki kod sisteminde olduğu gibi yapamadım.
delphi 7, advantage veri tabanı ve cximage kullanıyorum.
kolay gelsin,
İsteyen, yapabildiğinden daha fazlasını yapar.
Re: resim ekleme ve okuma
image i parametre olarak aktarabilirsin.
2 hafta önce banada lazım olmuştu. sql serverdaki tabloya resmi blob alana kaydettim ancak kodlar işyerinde yarın musait olursam kodları yollarım. createblobparameter yada createblob.. gibi bişiler vardı tam çıkaramadım şimdi...
2 hafta önce banada lazım olmuştu. sql serverdaki tabloya resmi blob alana kaydettim ancak kodlar işyerinde yarın musait olursam kodları yollarım. createblobparameter yada createblob.. gibi bişiler vardı tam çıkaramadım şimdi...
bazen yükselmek için önce dibi görmek gerekir...
forumda soru sormadan önce bakılmalı bence
daha fazlası için...
yürümeyi öğrenmeden koşmaya çalışanlar için, tökezleyip düşmek kaçınılmazdır...
forumda soru sormadan önce bakılmalı bence
daha fazlası için...
yürümeyi öğrenmeden koşmaya çalışanlar için, tökezleyip düşmek kaçınılmazdır...
-
- Üye
- Mesajlar: 386
- Kayıt: 02 Tem 2007 09:43
Re: resim ekleme ve okuma
yardımlarınız için şimdiden teşekkür ederim. kodu bekliyorum.
İsteyen, yapabildiğinden daha fazlasını yapar.
Re: resim ekleme ve okuma
Kod: Tümünü seç
var
ResimStream :TMemoryStream;
ResimStream := TMemoryStream.Create;
ResimStream.CopyFrom(ResimData, ResimData.Size);
//ResimAQ.Close;
ResimAQ.SQL.text := '';
ResimAQ.SQL.Add('INSERT INTO _TBLPENETRASYONRESIM (GUID_FISNO,RESIM_DATA) VALUES(''' + GUID_FISNO + ''',:RESIM_DATA) ');
with ResimAQ.Parameters.AddParameter do
begin
DataType := ftBlob;
Direction := pdInput;
LoadFromStream(ResimStream, ftBlob);
end;
ResimAQ.Connection := ResimAC;
ResimAQ.ExecSQL;
ResimData kullandığımız bileşen üzerinden tanımlı stream tipli değişken. sen filestream kullanarak resmi alabilirsin.
bazen yükselmek için önce dibi görmek gerekir...
forumda soru sormadan önce bakılmalı bence
daha fazlası için...
yürümeyi öğrenmeden koşmaya çalışanlar için, tökezleyip düşmek kaçınılmazdır...
forumda soru sormadan önce bakılmalı bence
daha fazlası için...
yürümeyi öğrenmeden koşmaya çalışanlar için, tökezleyip düşmek kaçınılmazdır...
-
- Üye
- Mesajlar: 122
- Kayıt: 31 Tem 2010 06:38
Re: resim ekleme ve okuma
kolay gelsin umarım cevap gelir :=)
ben de bir soru sorayım dedim anlıyacagım dilden olursa sevinirim.
şimdi bir muhasebe programı var reklam olmasın isim vemiyecegim
bu programda stok kartı var ürün ekliyorsun resim ekliyorsun stok kartında sorun yok
databaseye Firebird Maestro ile bağlanınca resim_yolu boş bir veri yok ama programda görünüyor sorunsuz neden dertlendim derseniz asp sayfa yapıyorum resim yolunu gösteriyorum resimi bulamıyor çünki boş resmi dbden asp yolla nasıl çekerim yardımcı olabilirmisiniz.
ben de bir soru sorayım dedim anlıyacagım dilden olursa sevinirim.
şimdi bir muhasebe programı var reklam olmasın isim vemiyecegim
bu programda stok kartı var ürün ekliyorsun resim ekliyorsun stok kartında sorun yok
databaseye Firebird Maestro ile bağlanınca resim_yolu boş bir veri yok ama programda görünüyor sorunsuz neden dertlendim derseniz asp sayfa yapıyorum resim yolunu gösteriyorum resimi bulamıyor çünki boş resmi dbden asp yolla nasıl çekerim yardımcı olabilirmisiniz.
Re: resim ekleme ve okuma
belkide kullanılmayan bir alandır. veri tabanında blob alanları kontrol ediniz.
-
- Üye
- Mesajlar: 122
- Kayıt: 31 Tem 2010 06:38
Re: resim ekleme ve okuma
blob dedigini anlıyamadım ama kullanılmıyan bir alansa ben programda nasıl ekledigim resimi görebiliyorum transfer diye bir olay var orada yer falan belirtirken diyorki resimleri db ye yazar ama neresine yazdıgını bir türlü bulamadım ki ona resimi ekle tekrar siteye ekle çok ama çok uzun bir bir 20000 kalem mal var aşayukarı db de şu anda okadar degil ama çok yakın bir zamanda geçme ihtimali birle var..
-
- Üye
- Mesajlar: 122
- Kayıt: 31 Tem 2010 06:38
Re: resim ekleme ve okuma
program adı vereyim bari olmıyacak başka türlü sanırım :=)
şimdi arkadaşlar wolvox kullanıyoruz buna asp olarak bir site entegre etmeye çelışıyorum ve bitti sayılır muhasebe programında stok kartını açıyorum resim ekle diyor reim yolunu gösteriyorum ve gayet başarılı bir şekilde gösteriyor klasöre falan yazmıyor db nin içine direk yazıyormuş db yi alt üst ettim bulamadım nerede oldugunu db de stok kartılarını açıyorum orada resim yolu tablosu var onu açıyoum içi bom boş bir şey yok ama stok kartını açınca resim var programda bu işi nasıl çözerim yardımlarınıza ihtiyacım var şimdiden teşekkürler..
şimdi arkadaşlar wolvox kullanıyoruz buna asp olarak bir site entegre etmeye çelışıyorum ve bitti sayılır muhasebe programında stok kartını açıyorum resim ekle diyor reim yolunu gösteriyorum ve gayet başarılı bir şekilde gösteriyor klasöre falan yazmıyor db nin içine direk yazıyormuş db yi alt üst ettim bulamadım nerede oldugunu db de stok kartılarını açıyorum orada resim yolu tablosu var onu açıyoum içi bom boş bir şey yok ama stok kartını açınca resim var programda bu işi nasıl çözerim yardımlarınıza ihtiyacım var şimdiden teşekkürler..
Re: resim ekleme ve okuma
Merhaba,
A*soft sisteminde ikinci bir veritabanı daha var; ona baktınız mı?
A*soft sisteminde ikinci bir veritabanı daha var; ona baktınız mı?
-
- Üye
- Mesajlar: 122
- Kayıt: 31 Tem 2010 06:38
Re: resim ekleme ve okuma
bakmadım onada bakayım :=) belki de ondadır o şirket diye bir db diye onu kaydeye almamıştım :=)))
umarım işe yarar şimdiden teşekkür ederim işe yaramassa yazarım gene :=)
umarım işe yarar şimdiden teşekkür ederim işe yaramassa yazarım gene :=)
-
- Üye
- Mesajlar: 122
- Kayıt: 31 Tem 2010 06:38
Re: resim ekleme ve okuma
evet haklıymışşın ayrı bir db de tutuyor resmi şimdi söyle bir sorun var bunada yardımcı olabilirsen sevinirim db ayrı mesele yok bağlantı kurarız da
stok kartının db id yok blkodu var id yerine geçen blkodu örnek
7289 ama resim dosyasında blkodu 15 oldu bağkodu diye bir yervar orası onunla irtibata geçiyor fakat ordada şu yazıyor
wo_stlogo_17289 burada asp de wo_stlogo_1 alma dan nasıl bağlantı kurduracagım..
stok kartının db id yok blkodu var id yerine geçen blkodu örnek
7289 ama resim dosyasında blkodu 15 oldu bağkodu diye bir yervar orası onunla irtibata geçiyor fakat ordada şu yazıyor
wo_stlogo_17289 burada asp de wo_stlogo_1 alma dan nasıl bağlantı kurduracagım..
-
- Üye
- Mesajlar: 122
- Kayıt: 31 Tem 2010 06:38
Re: resim ekleme ve okuma
akınsoft wolvox kullanıyorum db si firebird ben asp ile netten bağlanıyorum dosya.fdb db adı
CREATE TABLE DOSYA (
BLKODU DOUBLE PRECISION NOT NULL,
BAGKODU VARCHAR(30) CHARACTER SET WIN1254 COLLATE WIN1254,
DOSYAADI VARCHAR(75) CHARACTER SET WIN1254 COLLATE PXW_TURK,
ACIKLAMA VARCHAR(100) CHARACTER SET WIN1254 COLLATE PXW_TURK,
FILEDATA BLOB,
OZELKODU VARCHAR(30) CHARACTER SET WIN1254 COLLATE PXW_TURK);
ALTER TABLE DOSYA ADD PRIMARY KEY (BLKODU);
CREATE INDEX DOSYA_BAGKODU ON DOSYA(BAGKODU);
resimler dosya adında sadece dosyanın adı var ama başka bir şekilde resimler görünmüyor dll kodları bunlar bu dosyayı ben nasıl sitede göstere bilirim şimdiden herkese teşekkürler..
CREATE TABLE DOSYA (
BLKODU DOUBLE PRECISION NOT NULL,
BAGKODU VARCHAR(30) CHARACTER SET WIN1254 COLLATE WIN1254,
DOSYAADI VARCHAR(75) CHARACTER SET WIN1254 COLLATE PXW_TURK,
ACIKLAMA VARCHAR(100) CHARACTER SET WIN1254 COLLATE PXW_TURK,
FILEDATA BLOB,
OZELKODU VARCHAR(30) CHARACTER SET WIN1254 COLLATE PXW_TURK);
ALTER TABLE DOSYA ADD PRIMARY KEY (BLKODU);
CREATE INDEX DOSYA_BAGKODU ON DOSYA(BAGKODU);
resimler dosya adında sadece dosyanın adı var ama başka bir şekilde resimler görünmüyor dll kodları bunlar bu dosyayı ben nasıl sitede göstere bilirim şimdiden herkese teşekkürler..
-
- Üye
- Mesajlar: 386
- Kayıt: 02 Tem 2007 09:43
Re: resim ekleme ve okuma
merhaba;
unicorn64 kardeşim, resimlerle ilgili formda araştırma yapıyordum. 2008 yılında sorduğum bir sorumu gördüm. kodu beklediğimi yazmışım. üzerinden çok zaman geçmiş.
incelik gösterip kodu yazmışsınız.
fark ettim de teşekkür etmeyi unutmuşum. kabul ederseniz şimdi teşekkür etmek istiyorum.
kolay gelsin
unicorn64 kardeşim, resimlerle ilgili formda araştırma yapıyordum. 2008 yılında sorduğum bir sorumu gördüm. kodu beklediğimi yazmışım. üzerinden çok zaman geçmiş.
incelik gösterip kodu yazmışsınız.
fark ettim de teşekkür etmeyi unutmuşum. kabul ederseniz şimdi teşekkür etmek istiyorum.
kolay gelsin
İsteyen, yapabildiğinden daha fazlasını yapar.
- ender_arslanturk
- Kıdemli Üye
- Mesajlar: 709
- Kayıt: 18 Şub 2005 03:38
- Konum: İstanbul
Re: resim ekleme ve okuma
Resim olarak kayıt etme yerine datasını kayıt edebilirsiniz..
Veri tabanına kayıt ederken :
Veri tabanından resmin datasını alırken :
İstifadenize..
Kod: Tümünü seç
unit ads_GraphicStrings;
{Copyright(c)2000 Advanced Delphi Systems
Richard Maley
Advanced Delphi Systems
12613 Maidens Bower Drive
Potomac, MD 20854 USA
phone 301-840-1554
maley@advdelphisys.com
The code herein can be used or modified by anyone. Please retain references
to Richard Maley at Advanced Delphi Systems. If you make improvements to the
code please send your improvements to maley@advdelphisys.com so that the
entire Delphi community can benefit. All comments are welcome.
}
(*
Description: ads_GraphicStrings
This unit contains functions for converting
graphic images to and from strings. The string
format is the same as that which is used by dfm
files.
*)
interface
Uses Graphics, Controls;
Function BitmapToString_ads(Bitmap: TBitmap): String;
Function StringToBitmap_ads(Bitmap: TBitmap; BitmapString: String): Boolean;
Function PictureToString_ads(Picture: TPicture): String;
Function StringToPicture_ads(Picture: TPicture; PictureString: String): Boolean;
Function GlyphToString_ads(Glyph: TBitmap): String;
Function StringToGlyph_ads(Glyph: TBitmap; GlyphString: String): Boolean;
Function StringToIcon_ads(Icon: TIcon; IconString: String): Boolean;
Function ImageListToString_ads(ImageList: TImageList): String;
Function StringToImageList_ads(Var ImageList: TImageList; ImageListString: String): Boolean;
implementation
Uses
Classes,
SysUtils,
Dialogs,
ads_Exception;
Var
UnitName : String;
ProcName : String;
Type
TIcon_ads = Class(TComponent)
private
FIcon: TIcon;
procedure SetIcon(const Value: TIcon);
public
Constructor Create(AOwner: TComponent); Override;
Destructor Destroy; Override;
published
property Icon : TIcon read FIcon write SetIcon;
End;
constructor TIcon_ads.Create(AOwner: TComponent);
begin
ProcName := 'TIcon_ads.Create'; Try
inherited;
FIcon := TIcon.Create();
Except On E : Exception Do RaiseError(UnitName,ProcName,E); End;
end;
destructor TIcon_ads.Destroy;
begin
ProcName := 'TIcon_ads.Destroy'; Try
Try FIcon.Free; Except End;
inherited;
Except On E : Exception Do RaiseError(UnitName,ProcName,E); End;
end;
procedure TIcon_ads.SetIcon(const Value: TIcon);
begin
ProcName := 'TIcon_ads.SetIcon'; Try
If FIcon <> Value Then FIcon := Value;
Except On E : Exception Do RaiseError(UnitName,ProcName,E); End;
end;
Type
TBitmap_ads = Class(TComponent)
private
FBitmap: TBitmap;
procedure SetBitmap(const Value: TBitmap);
public
Constructor Create(AOwner: TComponent); Override;
Destructor Destroy; Override;
published
property Bitmap : TBitmap read FBitmap write SetBitmap;
End;
constructor TBitmap_ads.Create(AOwner: TComponent);
begin
ProcName := 'TBitmap_ads.Create'; Try
inherited;
FBitmap := TBitmap.Create();
Except On E : Exception Do RaiseError(UnitName,ProcName,E); End;
end;
destructor TBitmap_ads.Destroy;
begin
ProcName := 'TBitmap_ads.Destroy'; Try
Try FBitmap.Free; Except End;
inherited;
Except On E : Exception Do RaiseError(UnitName,ProcName,E); End;
end;
procedure TBitmap_ads.SetBitmap(const Value: TBitmap);
begin
ProcName := 'TBitmap_ads.SetBitmap'; Try
If FBitmap <> Value Then FBitmap := Value;
Except On E : Exception Do RaiseError(UnitName,ProcName,E); End;
end;
Type
TPicture_ads = Class(TComponent)
private
FPicture: TPicture;
procedure SetPicture(const Value: TPicture);
public
Constructor Create(AOwner: TComponent); Override;
Destructor Destroy; Override;
published
property Picture : TPicture read FPicture write SetPicture;
End;
constructor TPicture_ads.Create(AOwner: TComponent);
begin
ProcName := 'TPicture_ads.Create'; Try
inherited;
FPicture := TPicture.Create();
Except On E : Exception Do RaiseError(UnitName,ProcName,E); End;
end;
destructor TPicture_ads.Destroy;
begin
ProcName := 'TPicture_ads.Destroy'; Try
Try FPicture.Free; Except End;
inherited;
Except On E : Exception Do RaiseError(UnitName,ProcName,E); End;
end;
procedure TPicture_ads.SetPicture(const Value: TPicture);
begin
ProcName := 'TPicture_ads.SetPicture'; Try
If FPicture <> Value Then FPicture := Value;
Except On E : Exception Do RaiseError(UnitName,ProcName,E); End;
end;
function ComponentToString(Component: TComponent): string;
var
BinStream:TMemoryStream;
StrStream: TStringStream;
s: string;
begin
ProcName := 'ComponentToString'; Try
BinStream := TMemoryStream.Create;
try
StrStream := TStringStream.Create(s);
try
BinStream.WriteComponent(Component);
BinStream.Seek(0, soFromBeginning);
ObjectBinaryToText(BinStream, StrStream);
StrStream.Seek(0, soFromBeginning);
Result:= StrStream.DataString;
finally
StrStream.Free;
end;
finally
BinStream.Free
end;
Except On E : Exception Do RaiseError(UnitName,ProcName,E); End;
end;
function StringToComponent(Value: string): TComponent;
var
StrStream:TStringStream;
BinStream: TMemoryStream;
begin
Result := nil;
ProcName := 'StringToComponent'; Try
StrStream := TStringStream.Create(Value);
try
BinStream := TMemoryStream.Create;
try
ObjectTextToBinary(StrStream, BinStream);
BinStream.Seek(0, soFromBeginning);
Result := BinStream.ReadComponent(nil);
finally
BinStream.Free;
end;
finally
StrStream.Free;
end;
Except On E : Exception Do RaiseError(UnitName,ProcName,E); End;
end;
Function BitmapToString_ads(Bitmap: TBitmap): String;
Var
Bitmap_ads : TBitmap_ads;
Begin
ProcName := 'BitmapToString_ads'; Try
Bitmap_ads := TBitmap_ads.Create(nil);
Try
Bitmap_ads.Bitmap.Assign(Bitmap);
Result := ComponentToString(Bitmap_ads);
Finally
Bitmap_ads.Free;
End;
Except On E : Exception Do RaiseError(UnitName,ProcName,E); End;
End;
Function StringToBitmap_ads(Bitmap: TBitmap; BitmapString: String): Boolean;
Var
Bitmap_ads : TBitmap_ads;
Image : TBitmap;
Begin
Result := True;
ProcName := 'StringToBitmap_ads'; Try
Try
Bitmap_ads := TBitmap_ads.Create(nil);
Image := TBitmap.Create();
Try
Bitmap_ads := TBitmap_ads(StringToComponent(BitmapString));
Image.Assign(Bitmap_ads.Bitmap);
Bitmap.Assign(Image);
Finally
Bitmap_ads.Free;
Image.Free;
End;
Except
Result := False;
End;
Except On E : Exception Do RaiseError(UnitName,ProcName,E); End;
End;
Function PictureToString_ads(Picture: TPicture): String;
Var
Picture_ads : TPicture_ads;
Begin
ProcName := 'PictureToString_ads';
Try
Picture_ads := TPicture_ads.Create(nil);
Try
Picture_ads.Picture.Assign(Picture);
Result := ComponentToString(Picture_ads);
Finally
Picture_ads.Free;
End;
Except
On E : Exception Do
RaiseError(UnitName,ProcName,E);
End;
End;
Function StringToPicture_ads(Picture: TPicture; PictureString: String): Boolean;
Var
Picture_ads : TPicture_ads;
Image : TPicture;
Begin
Result := True;
ProcName := 'StringToPicture_ads';
Try
Try
Picture_ads := TPicture_ads.Create(nil);
Image := TPicture.Create();
Try
Picture_ads := TPicture_ads(StringToComponent(PictureString));
Image.Assign(Picture_ads.Picture);
Picture.Assign(Image);
Finally
Picture_ads.Free;
Image.Free;
End;
Except
Result := False;
End;
Except
On E : Exception Do
RaiseError(UnitName,ProcName,E);
End;
End;
Function GlyphToString_ads(Glyph: TBitmap): String;
Begin
ProcName := 'GlyphToString_ads'; Try
Result := BitmapToString_ads(Glyph);
Except On E : Exception Do RaiseError(UnitName,ProcName,E); End;
End;
Function StringToGlyph_ads(Glyph: TBitmap; GlyphString: String): Boolean;
Begin
Result := False;
ProcName := 'StringToGlyph_ads'; Try
Result := StringToBitmap_ads(Glyph,GlyphString);
Except On E : Exception Do RaiseError(UnitName,ProcName,E); End;
End;
Function StringToIcon_ads(Icon: TIcon; IconString: String): Boolean;
Var
Icon_ads : TIcon_ads;
Image : TIcon;
Begin
Result := True;
ProcName := 'StringToIcon_ads'; Try
Try
Icon_ads := TIcon_ads.Create(nil);
Image := TIcon.Create();
Try
Icon_ads := TIcon_ads(StringToComponent(IconString));
Image.Assign(Icon_ads.Icon);
Icon.Assign(Image);
Finally
Icon_ads.Free;
Image.Free;
End;
Except
Result := False;
End;
Except On E : Exception Do RaiseError(UnitName,ProcName,E); End;
End;
Type
TImageList_ads = Class(TComponent)
private
FImageList: TImageList;
procedure SetImageList(const Value: TImageList);
public
Constructor Create(AOwner: TComponent); Override;
Destructor Destroy; Override;
published
property ImageList : TImageList read FImageList write SetImageList;
End;
constructor TImageList_ads.Create(AOwner: TComponent);
begin
ProcName := 'TImageList_ads.Create'; Try
inherited;
FImageList := TImageList.Create(nil);
Except On E : Exception Do RaiseError(UnitName,ProcName,E); End;
end;
destructor TImageList_ads.Destroy;
begin
ProcName := 'TImageList_ads.Destroy'; Try
Try FImageList.Free; Except End;
inherited;
Except On E : Exception Do RaiseError(UnitName,ProcName,E); End;
end;
procedure TImageList_ads.SetImageList(const Value: TImageList);
begin
ProcName := 'TImageList_ads.SetImageList'; Try
If FImageList <> Value Then FImageList := Value;
Except On E : Exception Do RaiseError(UnitName,ProcName,E); End;
end;
Function ImageListToString_ads(ImageList: TImageList): String;
Var
ImageList_ads : TImageList_ads;
Begin
ProcName := 'ImageListToString_ads'; Try
ImageList_ads := TImageList_ads.Create(nil);
Try
ImageList_ads.ImageList.Assign(ImageList);
Result := ComponentToString(ImageList_ads);
Finally
ImageList_ads.Free;
End;
Except On E : Exception Do RaiseError(UnitName,ProcName,E); End;
End;
Function StringToImageList_ads(Var ImageList: TImageList; ImageListString: String): Boolean;
Var
ImageList_ads : TImageList_ads;
Image : TImageList;
Begin
Result := True;
ProcName := 'StringToImageList_ads'; Try
Try
ImageList_ads := TImageList_ads.Create(nil);
Image := TImageList.Create(nil);
Try
ImageList_ads := TImageList_ads(StringToComponent(ImageListString));
//Image.Assign(ImageList_ads.ImageList);
//ImageList.Assign(Image);
//ImageList := ImageList_ads.ImageList;
//ImageList.Assign(ImageList_ads.ImageList);
ImageList := TImageList(StringToComponent(ImageListString));
Finally
ImageList_ads.Free;
Image.Free;
End;
Except
Result := False;
End;
Except On E : Exception Do RaiseError(UnitName,ProcName,E); End;
End;
Initialization
UnitName := 'ads_GraphicStrings';
ProcName := 'Unknown';
RegisterClasses([TBitmap_ads,TPicture_ads,TIcon_ads,TImageList_ads, TImageList]);
end.
Veri tabanına kayıt ederken :
Kod: Tümünü seç
Query.Append;
try QueryMemoAlan.Value:=PictureToString_ads(Image1.Picture); except end;
Query.Post;
Kod: Tümünü seç
Image1.Visible:=False;
Image1.Picture:=Nil;
If Trim(TasarimlarFon.Value)<>'' Then
StringToPicture_ads(Image1.Picture, Trim(Query1Memo.Value));
Image1.Visible:=True;
-
- Üye
- Mesajlar: 386
- Kayıt: 02 Tem 2007 09:43
Re: resim ekleme ve okuma
merhaba;
vermiş olduğunuz kodlar üzerinde bu aralar çalışma imkanı buldum. yaptığım denemelerde ads_Exception unitinde hata mesajı alıyordum. yaptığım araştırmalarda uniti delphi ile alakalı sitelerin birinde buldum şimdi hangisinde bulduğumu hatırlamıyorum. ihtiyaç duyanlar için yayınlayayım dedim.
herkese teşekkür ederim.
vermiş olduğunuz kodlar üzerinde bu aralar çalışma imkanı buldum. yaptığım denemelerde ads_Exception unitinde hata mesajı alıyordum. yaptığım araştırmalarda uniti delphi ile alakalı sitelerin birinde buldum şimdi hangisinde bulduğumu hatırlamıyorum. ihtiyaç duyanlar için yayınlayayım dedim.
herkese teşekkür ederim.
Kod: Tümünü seç
unit ads_Exception;
interface
Uses SysUtils, Classes, Windows, FileCtrl;
{
This unit is devoted to exception handling.
If the RaiseError procedure is used throughout an application all
ambiguity is removed as to when and where errors are
occurring. This procedure can record exactly when, where
and the specific error. All errors can be logged for
future reference. Size limits can be set on the log
file and how often the file is written thereby freeing up
memory resources. The log orders the data newest to oldest
so that the newest errors appear at the beginning.
}
{!~
RaiseError
This procedure is a centralized error handler.
If this procedure is used throughout an application all
ambiguity is removed as to when and where errors are
occurring. This procedure can record exactly when, where
and the specific error. All errors can be logged for
future reference. Size limits can be set on the log
file and how often the file is written thereby freeing up
memory resources. The log orders the data newest to oldest
so that the newest errors appear at the beginning.
To use this procedure add ads_Exception to a units uses
clause and call RaiseError in functions and procedures where
you desire error handling.
Example:
unit MyCodeUnit;
interface
Uses
ads_Exception;
procedure MyProc;
Implementation
const UnitName = MyCodeUnit;
procedure MyProc;
Var
ProcName : String;
Begin
ProcName := MyProc'; Try
.
.
.
Except On E : Exception Do RaiseError(UnitName,ProcName,E); End;
End;
End.
This procedure handles:
cleanup prior to handling an error (RaiseErrorInit),
graceful processing of errors (RaiseErrorHandle),
logging errors to file (LogErrors True/False),
raising errors (RaiseErrors True/False),
post error actions (RaiseErrorLast)
Set the following variables to control the behavior
of the error handling. The values shown below are the
defaults.
LogErrors := True;
RaiseErrors := False;
ErrorLogSizeLimit := 1000000;
SaveToFileEveryNErrors := 20;
ErrorLogFileName := Copy(ParamStr(0),1,Length(ParamStr(0))-4)+'_err_'+UserIDFromWindows+'.txt';
}
Procedure RaiseError(UnitName,ProcName:String;E : Exception);
Var
{!~
LogErrors
Errors are recorded to file, i.e., lofgged based on
the LogErrors boolean variable. If True errors are
written to file, if false error messages are not
logged. LogErrors can be used in any
combination with RasiseErrors to control presentation
and recording of errors.
RaiseErrors LogErrors See Error Log Error
TRUE TRUE YES YES
TRUE FALSE YES NO
FALSE TRUE NO YES
FALSE FALSE NO NO }
LogErrors : Boolean;
{!~
RaiseErrors
Errors are presented to users or suppressed based on
the RaiseErrors boolean variable. If True errors are
presented to users, if false error messages are
suppressed. RasiseErrors can be used in any
combination with LogErrors to control presentation
and recording of errors.
RaiseErrors LogErrors See Error Log Error
TRUE TRUE YES YES
TRUE FALSE YES NO
FALSE TRUE NO YES
FALSE FALSE NO NO }
RaiseErrors : Boolean;
{!~
ErrorLogFileName
If LogErrors is set to True then all unhandled errors
are logged to a file. The log file path and name are
set by ErrorLogFileName. The default value for
ErrorLogFileName is
ExecutableName+'_err_'+UserIDFromWindows+'.txt'.
This default naming allows for an executable to be run
from the network and each user has his own error log.
The filename can be changed at runtime.}
ErrorLogFileName : String;
{!~
RaiseErrorInit
This procedure is run first in the RaiseError procedure.
This procedure provides an opportunity to do cleanup
before processing an error. An example of cleanup
would be correcting the mouse cursor.
}
RaiseErrorInit : Procedure;
{!~
RaiseErrorHandle
This procedure is run after RaiseErrorInit in the RaiseError
procedure.
If the RaiseErrorHandle function returns True meaning that
the error has been successfully handled, then the error is
not raised or logged, otherwise flow continues in the
RaiseError procedure to log and raise the error as appropriate.
The RaiseErrorHandle procedure is a place to handle errors.
Procedures can be assigned to RaiseErrorHandle on the fly
like: RaiseErrorHandle := MyErrorHandler;
To disable a current setting for RaiseErrorHandle set this
variable to nil.
}
RaiseErrorHandle : Function(UnitName,ProcName:String;E : Exception): Boolean;
{!~
RaiseErrorLast
This procedure is run last in the RaiseError procedure.
}
RaiseErrorLast : Procedure;
{!~
ErrorLogSizeLimit
This variable establishes the upper limit on the size of the
log file. If LogErrors = True then errors are recorded in
ErrorLogFileName. If the size of the log file reaches
the value set by ErrorLogSizeLimit then the file is reduced
in size until it reaches the size limit. Error messages
are deleted from the oldest to the newest. The default
value for ErrorLogSizeLimit is 1000000. Please remember
this variable is of type Int64 not Integer. There is a
difference.
}
ErrorLogSizeLimit : Int64;
{!~
SaveToFileEveryNErrors
This variable establishes how frequently the error data
in memory is written to file. The default is 20, meaning
that after 20 errors the log in memory is written to file
and then the memory log is cleared. This allows the
maximum amount of memory to be available to the application
and solves a problem where a user keeps an application open
all day and the log keeps on getting bigger and bigger
thereby draining memory resources.
Setting SaveToFileEveryNErrors to 20 ensures that never
will the memory log be any bigger than 20 errors.}
SaveToFileEveryNErrors : Integer;
implementation
Const UnitName = 'ads_Exception';
Var
ErrorLog : TStringList;
ProcName : String;
Function UserIDFromWindows: string;
Var
UserName : string;
UserNameLen : Dword;
Begin
UserNameLen := 255;
SetLength(userName, UserNameLen);
If GetUserName(PChar(UserName), UserNameLen) Then
Result := Copy(UserName,1,UserNameLen - 1)
Else
Result := 'Unknown';
End;
function GetFileSize(const FileName: string): LongInt;
Var
SearchRec: TSearchRec;
sgPath : String;
inRetval : Integer;
begin
sgPath := ExpandFileName(FileName);
Try
inRetval := FindFirst(ExpandFileName(FileName), faAnyFile, SearchRec);
If inRetval = 0 Then
Result := SearchRec.Size
Else Result := -1;
Finally
SysUtils.FindClose(SearchRec);
End;
end;
{!~
TrimErrorLog
This routine controls the saving and sizing of the error log.
}
Procedure TrimErrorLog(lst : TStringList);
Var
inCounter : Integer;
ProcName : String;
boBreak : Boolean;
begin
ProcName := 'TrimErrorLog'; Try
boBreak := False;
inCounter := 1;
lst.SaveToFile(ErrorLogFileName);
While True Do
Begin
If FileExists(ErrorLogFileName) Then
Begin
If GetFileSize(ErrorLogFileName) > ErrorLogSizeLimit Then
Begin
lst.Delete(lst.Count-1);
lst.SaveToFile(ErrorLogFileName);
End
Else
Begin
boBreak := True;
End;
End
Else
Begin
Break;
End;
inc(inCounter);
If boBreak Then Break;
If inCounter > 1000 Then Break;
If lst.Count < 10 Then Break;
End;
Except On E : Exception Do RaiseError(UnitName,ProcName,E); End;
End;
{!~
SaveErrorLog
This routine controls the saving and sizing of the error log.
}
Procedure SaveErrorLog;
Var
lst : TStringList;
inCounter : Integer;
ProcName : String;
sgPath : String;
begin
ProcName := 'SaveErrorLog'; Try
lst := TStringList.create();
Try
sgPath := ExtractFilePath(ErrorLogFileName);
If Not DirectoryExists(sgPath) Then ForceDirectories(sgPath);
lst.Clear;
If FileExists(ErrorLogFileName) Then
lst.LoadFromFile(ErrorLogFileName);
ErrorLog.SetText(PChar(ErrorLog.Text+lst.Text));
ErrorLog.Sorted := True;
ErrorLog.Sorted := False;
lst.Clear;
For inCounter := (ErrorLog.Count - 1) DownTo 0 Do
Begin
lst.Add(ErrorLog[inCounter]);
End;
TrimErrorLog(lst);
Finally
lst.Free;
End;
Except On E : Exception Do RaiseError(UnitName,ProcName,E); End;
End;
{!~
RaiseError
This procedure is a centralized error handler.
If this procedure is used throughout an application all
ambiguity is removed as to when and where errors are
occurring. This procedure can record exactly when, where
and the specific error. All errors can be logged for
future reference. Size limits can be set on the log
file and how often the file is written thereby freeing up
memory resources. The log orders the data newest to oldest
so that the newest errors appear at the beginning.
To use this procedure add ads_Exception to a units uses
clause and call RaiseError in functions and procedures where
you desire error handling.
Example:
unit MyCodeUnit;
interface
Uses
ads_Exception;
procedure MyProc;
Implementation
const UnitName = MyCodeUnit;
procedure MyProc;
Var
ProcName : String;
Begin
ProcName := MyProc'; Try
.
.
.
Except On E : Exception Do RaiseError(UnitName,ProcName,E); End;
End;
End.
This procedure handles:
cleanup prior to handling an error (RaiseErrorInit),
graceful processing of errors (RaiseErrorHandle),
logging errors to file (LogErrors True/False),
raising errors (RaiseErrors True/False),
post error actions (RaiseErrorLast)
Set the following variables to control the behavior
of the error handling. The values shown below are the
defaults.
LogErrors := True;
RaiseErrors := False;
ErrorLogSizeLimit := 1000000;
SaveToFileEveryNErrors := 20;
ErrorLogFileName := Copy(ParamStr(0),1,Length(ParamStr(0))-4)+'_err_'+UserIDFromWindows+'.txt';
}
Procedure RaiseError(UnitName,ProcName:String;E : Exception);
Var
sgErr : String;
boHandled : Boolean;
Begin
If Assigned(RaiseErrorInit) Then RaiseErrorInit;
If Assigned(RaiseErrorHandle) Then
Begin
boHandled := RaiseErrorHandle(UnitName,ProcName,E);
If boHandled Then Exit;
End;
If LogErrors Then
Begin
sgErr := E.Message;
sgErr := StringReplace(sgErr,#13,'',[rfReplaceall]);
sgErr := StringReplace(sgErr,#10,'',[rfReplaceall]);
ErrorLog.Add(FormatDateTime('yyyymmddhhnnss',now())+' '+UnitName+'.'+Procname+' error: '+sgErr);
If ErrorLog.Count > SaveToFileEveryNErrors Then
Begin
SaveErrorLog;
ErrorLog.Clear;
End;
End;
If RaiseErrors Then Raise Exception.Create(UnitName+'.'+Procname+' error: '+sgErr);
If Assigned(RaiseErrorLast) Then RaiseErrorLast;
End;
Initialization
ProcName := 'Initialization'; Try
LogErrors := True;
RaiseErrors := False;
ErrorLogSizeLimit := 1000000;
SaveToFileEveryNErrors := 20;
ErrorLogFileName := Copy(ParamStr(0),1,Length(ParamStr(0))-4)+'_err_'+UserIDFromWindows+'.txt';
ErrorLog := TstringList.Create();
Except On E : Exception Do RaiseError(UnitName,ProcName,E); End;
Finalization
ProcName := 'Finalization'; Try
If LogErrors Then SaveErrorLog;
ErrorLog .Free; ErrorLog := nil;
Except On E : Exception Do RaiseError(UnitName,ProcName,E); End;
End.
İsteyen, yapabildiğinden daha fazlasını yapar.