sidiq's

Membuat Animasi Sederhana

2012-01-11T23:38:00.001+07:00

Animasi 2D mau bagaimana bentuknya pada dasarnya sama saja yaitu menampilkan gambar-gambar secara bergiliran. Untuk membuat animasi pada game 2D pada umumnya, sedikitnya ada tiga class yang terlibat. Ketiga class tersebut adalah:

Class yang merepresentasikan citra/image yang akan dianimasikan. Biasanya disebut sprite. Dalam hal ini adalah TSprite.
Container untuk menampung sprite objects. Container ini juga berperan sebagai sprite manager. Pada contoh code diberi nama TSpriteContainer.
Class yang melakukan animasi. Bisa disebut sprite engine. Pada contoh code disebut TSpriteEngine.

Berikut adalah contoh code yang menampilkan teknik untuk melakukan animasi sederhana. Kelihatannya ribet yah. Mungkin iya karena code berikut adalah implementasi sederhana dari sebuah sprite engine untuk game 2D. Walaupun sederhana, mestinya sih sudah cukup untuk menjelaskan konsep animasi dan memperlihatkan bagaimana animasi berjalan tanpa flicker (bug paling menyebalkan dalam animasi). Contoh berikut terdiri atas dua unit, yaitu Sprite.pas dan Main.pas. Unit Sprite berisi empat buah class, yaitu:

TUtils yang berisi method untuk yang bersifat utilisasi dan dipakai bersama-sama oleh semua class.
TSprite yang merupakan class yang berisi informasi image yang akan digambar.
TSpriteContainer yang berfungsi sebagai sprite container dan sprite manager.
TSpriteEngine yang berfungsi melakukan animasi. Berisi sebuah method, yaitu OpenMouth.

Gambar-gambar yang akan di-raster di-load dan ditampung pada TSpriteContainer. Misalkan keempat file gambar tersebut bernama pac-1.bmp, pac-2.bmp, pac-3.bmp, pac-4.bmp, dan bg.bmp. Semuanya disimpan dalam directory “img\” yang path-nya relative terhadap .exe file.

File Sprite.pas:

unit Sprite;
 
interface
 
uses Windows, Graphics, Classes;
 
const
  BACKGROUND_PATH = 'img\bg.bmp';
 
type
  TUtils = class
  public
    class procedure ReleaseItems(AList: TList);
  end;
 
  TSprite = class
  private
    FName: string;
    FImage: TGraphic;
    FTop: Integer;
    FLeft: Integer;
    FWidth: Integer;
    FHeight: Integer;
  public
    constructor Create(AImgPath: string);
    destructor Destroy; override;
 
    property Name: string read FName write FName;
    property Image: TGraphic read FImage;
    property Top: Integer read FTop write FTop;
    property Left: Integer read FLeft write FLeft;
    property Width: Integer read FWidth write FWidth;
    property Height: Integer read FHeight write FHeigth;
  end;
 
  TSpriteContainer = class
  private
    FSprites: TList;
  public
    constructor Create;
    destructor Destroy; override;
    function Add(ASprite: TSprite): Integer;
    function Remove(ASprite: TSprite): Integer;
    function GetSprite(ASpriteName: string): TSprite;
    procedure Clear;
 
    property Sprites: TList read FSprites;
  end;
 
  TSpriteEngine = class
  private
    FContainer: TSpriteContainer;
    FScreen: TCanvas;
    FBackground: TGraphic;
  public
    constructor Create(AContainer: TSpriteContainer);
    destructor Destroy; override;
    procedure OpenMouth(ADuration: Integer);
 
    property Container: TSpriteContainer read FContainer;
    property Screen: TCanvas read FScreen write FScreen;
  end;
 
implementation
 
{TUtils}
 
class procedure TUtils.ReleaseItems(AList: TList);
begin
  while AList.Count &gt; 0 do
  begin
    Dispose(AList.First);
    AList.Delete(0);
  end;
  AList.Capacity := 0;
end;
 
{TSprite}
 
constructor TSprite.Create(AImgPath: string);
begin
  FImage := TBitmap.Create;
  FImage.LoadFromFile(AImgPath);
 
  Fwidth := FImage.Width;
  FHeigth := FImage.Height;
  FTop := 0;
  FLeft := 0;
end;
 
destructor TSprite.Destroy;
begin
  FImage.Free;
  inherited;
end;
 
{TSpriteContainer}
 
constructor TSpriteContainer.Create;
begin
  FSprites := TList.Create;
end;
 
destructor TSpriteContainer.Destroy;
begin
  FSprites.Free;
  inherited;
end;
 
function TSpriteContainer.Add(ASprite: TSprite): Integer;
begin
  Result := FSprites.Add(ASprite);
end;
 
function TSpriteContainer.Remove(ASprite: TSprite): Integer;
begin
  Result := Fsprites.Remove(ASprite);
end;
 
function TSpriteContainer.GetSprite(ASpriteName: string): TSprite;
var
  i: Integer;
  sprite: TSprite;
begin
  Result := nil;
  for i := 0 to FSprites.Count-1 do
  begin
    sprite := FSprites.Items[i];
    if sprite.Name = ASpriteName then
    begin
      Result := sprite;
      Exit;
    end;
  end;
end;
 
procedure TSpriteContainer.Clear;
begin
  TUtils.ReleaseItems(FSprites);
end;
 
{TSpriteEngine}
 
constructor TSpriteEngine.Create(AContainer: TSpriteCOntainer);
begin
  FContainer := AContainer;
  FBackground := TBitmap.Create;
  FBackground.LoadFromFile(BACKGROUND_PATH);
end;
 
destructor TSpriteEngine.Destroy;
begin
  FBackground.Free;
  inherited;
end;
 
procedure TSpriteEngine.OpenMouth(APosition: TPoint;
  ADuration: integer);
var
  startTick, deltaTick: Cardinal
  frameDuration: Cardinal;
  spriteIndex: Integer;
  buffer: TBitmap;
begin
  startTick := GetTickCount;
  spriteIndex := 0;
  desltaTick := 0;
  frameDuration := ADuration div FContainer.Sprites.Count;
 
  buffer := TBitmap.Create;
  buffer.Width := FBackground.Width;
  buffer.Height := FBackground.Height;
 
  while (deltaTick

Unit Main.pas terdiri dari sebuah form yang berisi sebuah control bertipe TPainBox yang berfungsi sebagai screen, dan sebuah tombol bertipe TButton. Penggalan Main.pas adalah sebagai berikut:

unit Main;
 
interface
 
uses Windows, ..., ExtCtrls, Sprite;
 
const
  IMAGES_NUMBER = 4;
  PLAYING_DURATION = 200;
  LOOP_DELAY = 100;
  X = 200;
  Y = 100;
 
type
  TformMain = class(TForm)
    PaintBox: TPaintBox;
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
  private
    ...
    procedure LoadAllImages(AContainer: TSpriteContainer);
    ...
 
  end;
 
implementation
 
{ TformMain }
 
constructor TformMain.Create(AOwner: TComponent);
begin
  inherited;
  FContainer := TSpriteContainer.Create;
  { Load semua image yang akan di-raster, Kemas menjadi object
    bertipe TSprite, kemudian simpan di dalam container menjadi
    data yang siap raster }
  LoadAllImages(FContainer);
 
  FSpriteEngine := TSpriteEngine.Create(FContainer);
  FSpriteEngine.Screen := PaintBox.Canvas;
end;
 
...
 
procedure LoadAllImages(AContainer: TSpriteCOntainer);
var
  i: Integer;
  sprite: TSprite;
  spriteName: string;
begin
  for i := 0 to IMAGES_NUMBER-1 do
  begin
    spriteName := 'pac-' + IntToStr(i+1) + '.bmp';
 
    sprite := TSprite.Create('img\' + spriteName);
    sprite.Name := spriteName;
    AContainer.Add(sprite);
  end;
end;
 
procedure TFormMain.Button1Click(Sender: TObject);
begin
  while True do
  begin
    FSpriteEngine.OpenMouth(Point(X, Y), PLAYING_DURATION);
    Sleep(LOOP_DELAY);
  end;
end;
 
end.

Gambar-gambar yang akan dianimasikan adalah:

Yang perlu diingat, code di atas hanyalah prototipe dari sprite engine sebuah dimensi dua yang memperlihatkan bagaimana memanipulasi sprite sehingga bisa menjadi gambar yang bergerak (animasi). Semoga bermanfaat dan silakan dimodifikasi sesuai dengan kebutuhan.

sumber : blogriza.com

conection ms.access dengan oleDB

2011-02-05T22:30:00.002+07:00

procedure Tdm.DataModuleCreate(Sender: TObject);
const
CONNECTION_STRING = 'Provider=Microsoft.Jet.OLEDB.4.0;Data Source=%s;Jet OLEDB:Database Password=password;';
DATABASE_FILE = 'database.mdb';
var
path: string;
begin
path := ExtractFilePath(Application.ExeName);
path := path + DATABASE_FILE;

connection.ConnectionString := Format(CONNECTION_STRING, [path]);
end;

Mengontrol Ms.Excel melalui delphi

2010-02-16T16:34:00.001+07:00

uses
ComObj;

var
ExcelApp: OleVariant;

implementation

procedure TForm1.Button1Click(Sender: TObject);
const
// SheetType
xlChart = -4109;
xlWorksheet = -4167;
// WBATemplate
xlWBATWorksheet = -4167;
xlWBATChart = -4109;
// Page Setup
xlPortrait = 1;
xlLandscape = 2;
xlPaperA4 = 9;
// Format Cells
xlBottom = -4107;
xlLeft = -4131;
xlRight = -4152;
xlTop = -4160;
// Text Alignment
xlHAlignCenter = -4108;
xlVAlignCenter = -4108;
// Cell Borders
xlThick = 4;
xlThin = 2;
var
ColumnRange: OleVariant;

// Function to get the number of Rows in a Certain column

function GetLastLine(AColumn: Integer): Integer;
const
xlUp = 3;
begin
Result := ExcelApp.Range[Char(96 + AColumn) + IntToStr(65536)].end[xlUp].Rows.Row;
end;

begin
{ Start Excel }

// By using GetActiveOleObject, you use an instance of Word that's already running,
// if there is one.
try
ExcelApp := GetActiveOleObject('Excel.Application');
except
try
// If no instance of Word is running, try to Create a new Excel Object
ExcelApp := CreateOleObject('Excel.Application');
except
ShowMessage('Cannot start Excel/Excel not installed ?');
Exit;
end;
end;

// Add a new Workbook, Neue Arbeitsmappe öffnen
ExcelApp.Workbooks.Add(xlWBatWorkSheet);

// Open a Workbook, Arbeitsmappe öffnen
ExcelApp.Workbooks.Open('c:\YourFileName.xls');

// Rename the active Sheet
ExcelApp.ActiveSheet.Name := 'This is Sheet 1';

// Rename
ExcelApp.Workbooks[1].WorkSheets[1].Name := 'This is Sheet 1';

// Insert some Text in some Cells[Row,Col]
ExcelApp.Cells[1, 1].Value := 'SwissDelphiCenter.ch';
ExcelApp.Cells[2, 1].Value := 'http://www.swissdelphicenter.ch';
ExcelApp.Cells[3, 1].Value := FormatDateTime('dd-mmm-yyyy', Now);

// Setting a row of data with one call
ExcelApp.Range['A2', 'D2'].Value := VarArrayOf([1, 10, 100, 1000]);

// Setting a formula
ExcelApp.Range['A11', 'A11'].Formula := '=Sum(A1:A10)';

// Change Cell Alignement
ExcelApp.Cells[2, 1].HorizontalAlignment := xlright;

// Change the Column Width.
ColumnRange := ExcelApp.Workbooks[1].WorkSheets[1].Columns;
ColumnRange.Columns[1].ColumnWidth := 20;
ColumnRange.Columns[2].ColumnWidth := 40;

// Change Rowheight / Zeilenhöhe ändern:
ExcelApp.Rows[1].RowHeight := 15.75;

// Merge cells, Zellen verbinden:
ExcelApp.Range['B3:D3'].Mergecells := True;

// Apply borders to cells, Zellen umrahmen:
ExcelApp.Range['A14:M14'].Borders.Weight := xlThick; // Think line/ Dicke Linie
ExcelApp.Range['A14:M14'].Borders.Weight := xlThin; // Thin line Dünne Linie

// Set Bold Font in cells, Fettdruck in den Zellen

ExcelApp.Range['B16:M26'].Font.Bold := True;

// Set Font Size, Schriftgröße setzen
ExcelApp.Range['B16:M26'].Font.Size := 12;

//right-aligned Text, rechtsbündige Textausrichtung
ExcelApp.Cells[9, 6].HorizontalAlignment := xlright;

// horizontal-aligned text, horizontale Zentrierung
ExcelApp.Range['B14:M26'].HorizontalAlignment := xlHAlignCenter;

// left-aligned Text, vertikale Zentrierung
ExcelApp.Range['B14:M26'].VerticallyAlignment := xlVAlignCenter;

{ Page Setup }

ExcelApp.ActiveSheet.PageSetup.Orientation := xlLandscape;

// Left, Right Margin (Seitenränder)
ExcelApp.ActiveSheet.PageSetup.LeftMargin := 35;
ExcelApp.ActiveSheet.PageSetup.RightMargin := -15;

// Set Footer Margin
ExcelApp.ActiveSheet.PageSetup.FooterMargin := ExcelApp.InchesToPoints(0);

// Fit to X page(s) wide by Y tall
ExcelApp.ActiveSheet.PageSetup.FitToPagesWide := 1; // Y
ExcelApp.ActiveSheet.PageSetup.FitToPagesTall := 3; // Y

// Zoom
ExcelApp.ActiveSheet.PageSetup.Zoom := 95;

// Set Paper Size:
ExcelApp.PageSetup.PaperSize := xlPaperA4;

// Show/Hide Gridlines:
ExcelApp.ActiveWindow.DisplayGridlines := False;

// Set Black & White
ExcelApp.ActiveSheet.PageSetup.BlackAndWhite := False;

// footers
ExcelApp.ActiveSheet.PageSetup.RightFooter := 'Right Footer / Rechte Fußzeile';
ExcelApp.ActiveSheet.PageSetup.LeftFooter := 'Left Footer / Linke Fußzeile';

// Show Excel Version:
ShowMessage(Format('Excel Version %s: ', [ExcelApp.Version]));

// Show Excel:
ExcelApp.Visible := True;

// Save the Workbook
ExcelApp.SaveAs('c:\filename.xls');

// Save the active Workbook:
ExcelApp.ActiveWorkBook.SaveAs('c:\filename.xls');

end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
// Quit Excel
if not VarIsEmpty(ExcelApp) then
begin
ExcelApp.DisplayAlerts := False; // Discard unsaved files....
ExcelApp.Quit;
end;
end;

sumber : tips explorer 2007.

Mengirim email Melalui Ms.Outlook di delphi

2010-02-16T16:29:00.005+07:00

const
olMailItem = 0;
var
Outlook: OLEVariant;
MailItem: Variant;
begin
try
Outlook:=GetActiveOleObject('Outlook.Application');
except
Outlook:=CreateOleObject('Outlook.Application');
end;
MailItem := Outlook.CreateItem(olMailItem);
with MailItem do begin
Recipients.Add('delphi.guide@about.com');
Subject := 'Subject: Outlook Mail From Delphi';
Body := 'Welcome to my homepage: http://delphi.about.com';
Attachments.Add('C:\Windows\Win.ini');
Send;
end;
Outlook := Unassigned;
end;

sumber : Tips Explorer 2007

Function untuk mendapatkan nilai terbilang

2010-01-11T14:00:00.006+07:00

function TForm1.terbilang(x: Int64): string;
const abil : array[0..11] of string[10]=('','satu','dua','tiga', 'empat','lima','enam','tujuh','delapan','sembilan', 'sepuluh','sebelas');
begin
if (x < 12) then Result := ' ' + abil[x] else if (x < 20) then Result := Terbilang(x-10) + ' belas'
else
if (x < 100) then Result := Terbilang(x div 10) + ' puluh' + Terbilang(x mod 10)
else
if (x < 200) then Result := ' seratus' + Terbilang(x-100)
else
if (x < 1000) then Result := Terbilang(x div 100) + ' ratus' + Terbilang(x mod 100)
else
if (x < 2000) then Result := ' seribu' + Terbilang(x-1000)
else
if (x < 1000000) then Result := Terbilang(x div 1000) + ' ribu' + Terbilang(x mod 1000)
else
if (x < 1000000000) then Result := Terbilang(x div 1000000) + ' juta' + Terbilang(x mod 1000000)
else
if (x < 1000000000000) then Result := Terbilang(x div 1000000000) + ' milyar'+ Terbilang(x mod 1000000000);
end;

keterangan..:
untuk variabel diatas menggunakan int64 agar jumlah angka yang di konversi bisa mencapai milyar,, jika menggunakan integer biasa maka hanya bisa digunakan sampai level juta

Penggunaan Function substring() di Query SQL

2009-10-12T12:38:00.003+07:00

Penggunaan Function substring() di Query SQL

Pada artikel ini, akan dibahas bagaimana mengambil substring dalam suatu string dari data menggunakan statement SQL. Untuk mempermudah pembahasan, kita akan mengambil studi kasus tentang data mahasiswa.

Misalkan Anda diberikan data mahasiswa dalam tabel berikut ini.

NIM        NAMA MAHASISWA
M0197001   Dwi Amalia Fitriani
M0197002   Faza Fauzan Khosiyarrohman
M0198002   Nada Hasanah
M0199003   Rosihan Ari Yuana
M0199005   Ismail Hasan
M0199006   Yusron Rizqi
M0297003   Yohana Dwi Ariyanto
M0298004   Subari
M0298005   Rusmini

Kemudian Anda ingin menjawab pertanyaan berikut ini:

Siapa saja mahasiswa yang berangkatan 97?
Berapa jumlah mahasiswa yang merupakan angkatan 99?
Tampilkan jumlah mahasiswa untuk setiap angkatan.
Tampilkan jumlah mahasiswa dari jurusan yang berkode M01 (dengan asumsi bahwa M0X menunjukkan kode Jurusan)
Tampilkan jumlah mahasiswa untuk setiap jurusan (M01 dan M02)

Kalau Anda perhatikan data di atas, tidak tercantum field ANGKATAN. Haruskah field tersebut ada? Ternyata tidak harus. Untuk mendapatkan angkatan mahasiswa, Anda cukup mengambil informasi dari NIM mahasiswanya. Bagaimana caranya?

Tahun angkatan mahasiswa dapat dilihat pada bagian NIM, yaitu mulai pada karakter ke 4 s/d 5, sebagai contoh NIM M0197001 memiliki tahun angkatan 97. Dengan menggunakan function substring() pada SQL, Anda dapat memperoleh tahun angkatan mahasiswa tersebut.

Sekarang kita akan menjawab soal No 1.

Statement SQL untuk menjawab soal ini adalah:

SELECT * FROM mhs WHERE substring(NIM, 4, 2) = '97';

Maksud dari perintah substring(NIM, 4, 2) pada query di atas adalah mencari karakter 4 dan 5 dari field NIM yang sama dengan ‘97′. Maksud parameter 2 pada function tersebut menunjukkan jumlah karakter yang akan dicek (mulai dari karakter ke 4).

Selanjutnya akan kita bahas soal No. 2

Statement untuk query ini adalah:

SELECT count(*) FROM mhs WHERE substring(NIM, 4, 2) = '99';

Saya kira penjelasan dari query ini hampir sama dengan No. 1

Untuk No. 3, statement SQL nya adalah:

SELECT substring(NIM, 4, 2) as Angkatan, Count(*)
FROM mhs
GROUP BY Angkatan;

Pada soal No. 1 dan 2, function substring() terletak di bagian WHERE, sedangkan pada soal No. 3 ini, substring() terletak di klausa SELECT. Hal ini tidak ada masalah. Karena kita akan menampilkan tahun angkatan, maka berikan substring(NIM, 4, 2) di bagian SELECT. Selanjutnya tahun angkatan ini kita buat alias untuk melakukan grouping ketika melakukan perhitungan jumlah mahasiswa setiap angkatan.

Sedangkan untuk soal No. 4, statement SQL nya adalah:

SELECT count(*) FROM mhs WHERE substring(NIM, 1, 3) = 'M01';

Mengapa menggunakan substring(NIM, 1, 3)? Ya… karena untuk kode jurusan ini memiliki 3 karakter yang diawali mulai dari karakter pertama dari NIM.

Untuk soal terakhir, statement SQL yang Anda buat adalah:

SELECT substring(NIM, 1, 3) as Jurusan, count(*) as Jumlah
FROM mhs
GROUP BY Jurusan

Pembahasan soal No. 5 ini identik dengan No. 3

sumber: http://blog.rosihanari.net

Selamat Hari Raya Idul Fitri 1430 H

2009-09-18T11:24:00.002+07:00

Menghitung Usia Seseorang

2008-10-19T04:12:00.001+07:00

function CalculateAge(Birthday, CurrentDate: TDate): Integer;
var Month, Day, Year, CurrentYear, CurrentMonth, CurrentDay: Word;
begin
DecodeDate(Birthday, Year, Month, Day);
DecodeDate(CurrentDate, CurrentYear, CurrentMonth, CurrentDay);
if (Year = CurrentYear) and (Month = CurrentMonth) and (Day = CurrentDay) then
begin
Result := 0; end else begin Result := CurrentYear - Year; if (Month > CurrentMonth) then
Dec(Result) else begin if Month = CurrentMonth then if (Day > CurrentDay) then Dec(Result);
end;
end;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
Label1.Caption := Format('Your age is %d', [CalculateAge(StrToDate('01.01.1903'), Date)]);
end;

Pengambilan dan Penyimpanan Data Blob

2008-10-11T18:54:00.001+07:00

Untuk sisi aplikasi, ada 2 cara penyimpanan dan pengambilan data BLOB ini. Cara pertama menggunakan persistent field, i.e. kamu buat field2 di dataset kamu menggunakan Fields Editor (double klik dataset kamu aja, pasti tampil), dan cara kedua dengan dynamic field.
Secara umum cara pertama lebih mudah. Berikut kodenya:

(*************************************************************************
Diasumsikan ada ADODataset bernama tblMyFiles yang berisi 3 buah persistent field
bernama tblMyFilesID (utk field bernama 'ID'), tblMyFilesName (utk field bernama 'Name'),
dan tblMyFilesBin (utk field bernama 'Bin')
Field 'ID' cuma buat identity saja (primary key) bertipe int(eger)
Field 'Name' buat nampung nama aslinya file yang disimpan
Field 'Bin' buat nampung isi file
*************************************************************************)

// AFileName harus sudah berisi nama file yang valid yang ingin disimpan di database
Procedure TForm1.StoreMyFile(Const AFileName: String);
Begin
// anggap lah kita mau nambah reccord baru, utk yang lain pake edit
tblMyFiles.Append;
// simpan nama asli file ybs, strip the path portion
tblMyFilesName.Value := ExtractFileName(AFileName);

// simpan isi file nya
tblMyFilesBin.LoadFromFile(AFileName)
// simpan
tblMyFiles.CheckBrowseMode;
End;

// Di sini kita mengambil isi field 'Bin' dari record yang sedang aktif dan
// mengembalikannya sebagai file di direktori 'C:\MyFiles'
Procedure TForm1.GetMyFile;
Begin
tblMyFilesBin.SaveToFile('C:\MyFiles\' + tblMyFilesName.Value);
End;

Cara kedua sedikit ribet, melibatkan penggunakan Stream (TADOBlobStream, atau kombinasi TBlobStream dan TFileStream), hanya bermanfaat jika kamu tidak mau menggunakan metode Persistent Field. Seperti pada kasus penggunaan sebuah dataset secara bersama. Dimana tipe2 field yang akan diambil tidak bisa langsung ditentukan pada saat design-time.

Contoh:
Procedure TForm1.StoreMyFile(Const AFileName: String);
Var
vBlob: TADOBlobStream;
Begin
// anggap lah kita mau nambah reccord baru, utk yang lain pake edit
tblMyFiles.Append;
// simpan nama asli file ybs, strip the path portion
tblMyFiles.FieldByName('Name').Value := AFileName

// simpan isi file nya
vBlob := TADOBlobStream.Create(tblMyFiles.FieldByName('Bin') AS TBlobField, bmWrite);
Try
vBlob.LoadFromFile(AFileName);
Finally
vBlob.Free;
End;

// simpan
tblMyFiles.CheckBrowseMode;
End;

// Di sini kita mengambil isi field 'Bin' dari record yang sedang aktif dan
// mengembalikannya sebagai file di direktori 'C:\MyFiles'
Procedure TForm1.GetMyFile;
Var
vBlob: TADOBlobStream;
Begin
vBlob := TADOBlobStream.Create(tblMyFiles.FieldByName('Bin') AS TBlobField, bmRead);
Try
vBlob.SaveToFile('C:\MyFiles\' + tblMyFiles.FieldByName('Name').AsString);
Finally
vBlob.Free;
End;
End;

Mengkonversikan Stream

2008-10-11T18:50:00.001+07:00

Begin
jika anda sering bermasalah dalam menggunakan stream, berikut ada beberapa rutin yang biasa saya gunakan untuk mengkonversikan stream.

//Stream Convertion

{** File to String **}
function filetostring(afilename:string):string;
var fl:TFileStream;
begin
fl:=TFileStream.Create(afilename,fmOpenRead or fmShareCompat);
SetLength(result,fl.Size);
fl.Read(result[1],fl.Size);
fl.Free;
end;

{** String to File **}
procedure stringtofile(acontent,afilename:string);
var fl:TFileStream;
begin
fl:=TFileStream.Create(afilename,fmOpenWrite or fmCreate);
fl.Write(acontent[1],length(acontent));
fl.Free;
end;

{** Stream to String **}
function stringtofile(adata:TStream):string;
var str:TStringStream;
s:string;
begin
str:=TStringStream.Create(s);
str.CopyFrom(adata,adata.size);
result:=str.datastring;
str.free;
end;

{** String to Stream **}
procedure stringtofile(s:String;adata:TStream);
var str:TStringStream;
begin
str:=TStringStream.Create(s);
adata.CopyFrom(str,str.size);
str.free;
result:=str.datastring;
str.free;
end;

End;

save file dalam network

2008-10-08T10:59:00.001+07:00

No 1. Bisa menggunakan fungsi yang udah ada di SysUtils

function ExtractFileName(const FileName: string): string;

No 2. Salah satunya bisa dengan cara ini (perlu dikembangakan untuk meng copy *.exe) :

procedure TForm.CopyFile(AFileName: string);
var
hnd : THandle;
sTarget: string;
begin
sTarget := '\192.168.0.1\sharedfolder\' + AFileName;
screen.Cursor := crHourGlass;
if not CopyFile(PansiChar(AFileName), PansiChar(sTarget), False) then
begin
MessageDlg('Gagal meng-copy file :' + AFileName, mtError, [mbOK], 0);
Exit;
end;
Screen.Cursor := crDefault;
end;