1.Agar wallpaper berubah setelah diset, desktop perlu
direfresh.
untuk bisa merefresh desktop
kirim message WM_COMMAND ke desktop

contoh:

procedure SetWallpaper akan mengubah wallpaper dan
merefresh desktop
.kontanta 106597 adalah id untuk menu item dekstop

unit uwallpaper;

interface
procedure SetWallpaper(const filename:string);

implementation
uses windows,messages;

procedure SetWallpaper(const filename:string);
begin
SystemParametersInfo(SPI_SETDESKWALLPAPER, 0,
Pchar(filename),
SPIF_UPDATEINIFILE);
SendMessage(FindWindow('Progman', 'Program
Manager'),
WM_COMMAND, 106597,0);
end;

end.

2.untuk menghasilkan proses update ListBox yang tidak
menyebabkan flicker
lakukan pemanggilan Items.BeginUpdate sebelum mengubah
isi Items dan memanggil
Items.EndUpdate setelah item selelasi dimodifikasi

Listbox1.Items.BeginUpdate;
//lakukan modifikasi item
Listbox1.Items.EndUpdate;

untuk masalah memori yg gak cukup untuk membuat
thumbnail. karena anda
mengcreate instance panel dan image untuk tiap
thumbanail, handle bitmap yang diperlukan
sangat banyak bila thumbnail yang dibuat banyak(
hdanle bitmap adalah resource yg sangat terbatas)
jika anda menemukan eksepsi "Canvas does not allow
drawing" aplikasi
anda telah menghabiskan resource handle bitmap.
Gunakan TIMageList untuk menyimpan thumbnail, karena
imageList menyimpan daftar
image-image dalam satu bitmap yang sangat besar.

saya pernah posting bagaimana menciptakan thumbnail di
milis ini, ok saya posting lagi
mungkin bisa jadi masukan

3.Untuk bisa membuat thumbnail file berformat lain,
tentunya anda harus mengerti bagaimana format
penyimpanan
dokumen gambar yang hendak anda mau buat thumbnailnya.
Konsultasi ke pembuat format file tersebut


Untuk membuat tampilan thumbnail seperti pada Windows
Explorer
kita membutuhkan instance IExtractImage interface
shell folder. LAngkahnya seperti ini:

0. deklarasi IEXtractImage
saya gak tau IExtractImage deklarasinya ada di unit
apa, karena di hellp Windows bawaan Delphi
interface ini gak disebutkan. tapi dari online helpnya
MSDN IExtractIMage kira2x spt ini:

IExtractImage = interface
['{BB2E617C-0920-11d1-9A0B-00C04FC2D6C1}']
function GetLocation(
pszPathBuffer: PWideChar;
cch: cardinal;
var pdwPriority: cardinal;
var prgSize: TSize;
dwRecClrDepth: cardinal;
var pdwFlags: cardinal): HResult; stdcall;
function Extract(
var phBmpThumbnail: HBITMAP): HResult; stdcall;
end;

1.Mendapatkan interface IShellFolder folder yg ingin
dibuat tampilan thumbnailnya.
instance IShellFolder bisa didapatkan dengan
menggunakan
ShGetDesktopFolder (dideklarasikan di shlobj.pas)

Jika kita menggunakan SHGetDestopFolder, instance
IShellFolder
mengacu pada folder desktop yg merupakan root dari
semua folder di windows
untuk mendapatkan IShellFolder dari folder lain kita
menggunakan
method ParseDisplayName milik interface IShellFolder
untuk mendapatkan
PIDL folder yg diinginkan(apa itu PIDL silakan lihat
dihelp Windows).

utk mendapatkan instance IShellFolder folder yang
kita inginkan dari PIDL
kita menggunakan method IShellFolder.BindToObject.
BindToObject akan mengembalikan
interface IShellFolder yang kita butuhkan, simpan
iponiter in misal di variabel
TargetFolder.
setelah ini PIDL folder dapat di-free dengan
interface IMalloc (di deklarasi diactivex.pas).
untuk mendapatkan instance IMalloc kita menggunakan
SHGetMalloc (shlobj.pas)

2.scan seluruh isi folder untuk mendapatkan semua nama
file yg ada di folder
misal dengan FindFirst, FindNext
3.dari TargetFolder kita lakukan ParseDisplayName
untuk tiap-tiap file yang kita temukan
utk mendapatkan PIDL tiap file.
4.Dengan method IShellFolder.GetUIObjectOf dan PIDL
file, kita ambil
instance IExtractImage.
setelah instance IExtractImage diperoleh PIDL bisa
di-free dengan
IMalloc.
5.Ada dua method pada IExtractImage yakni GetLocation
dan Extract.
GetLocation berfungsi untuk mendapatkan deskripsi
file dan juga utk mengeset
bebrapa setting thumbnail, sperti ukuran
width,height yg kita inginkan
kedalaman warna thumbnail

OK kita buat implementasi lengkapnya. supaya bisa
digunakan lagi
kita implementasi sebagai sebuah kelas.

unit uExtractImg;

interface
uses classes,windows,graphics,activex,shlobj,comObj;
type
IExtractImage = interface
['{BB2E617C-0920-11d1-9A0B-00C04FC2D6C1}']
function GetLocation(
pszPathBuffer: PWideChar;
cch: cardinal;
var pdwPriority: cardinal;
var prgSize: TSize;
dwRecClrDepth: cardinal;
var pdwFlags: cardinal): HResult; stdcall;
function Extract(
var phBmpThumbnail: HBITMAP): HResult; stdcall;
end;
TExtractImgEvent=procedure (Sender:TObject;
const Filename:string;
const
Thumbnail:TBitmap) of object;

TBaseExtractImage=class(TObject)
private
FWidth,FHeight:integer;
FOnExtract:TExtractImgEvent;
protected
function GetTargetFolder(const
aFolder:string):IShellFolder;
procedure
DoExtractImg(ImgExtractor:IExtractImage);
procedure ExtractImg(const filename:string;
const
Thumbnail:TBitmap);virtual;
public
procedure Extract;virtual;abstract;
property Width:integer read FWidth write FWidth;
property Height:integer read FHeight write
FHeight;

property OnExtract:TExtractImgEvent read
FOnExtract write FOnExtract;
end;

TExtractImage=class(TBaseExtractImage)
private
FFilename:string;
public
procedure Extract;override;
published
property Filename:string read FFilename write
FFilename;
property OnExtract;
end;

TExtractFolderImage=class(TBaseExtractImage)
private
FFolder:string;
public
procedure Extract;override;
published
property Folder:string read FFolder write FFolder;
property OnExtract;
end;

implementation
uses sysutils;

function TBaseExtractImage.GetTargetFolder(const
aFolder:string):IShellFolder;
var MallocObj:IMalloc;
DesktopFolder,TargetFolder:IShellFolder;
Eaten,attr:cardinal;
itemPIDL:PItemIDList;
awidefolder:widestring;
begin
aWideFolder:=aFolder;
SHGetMalloc(mallocObj);
SHGetDesktopFolder(DesktopFolder);

DesktopFolder.ParseDisplayName(0,nil,PWideChar(aWideFolder),Eaten,
ItemPIDL,attr);
try
DesktopFolder.BindToObject(ItemPIDL,nil,
IShellFolder,TargetFolder);
result:=TargetFolder;
finally
mallocObj.Free(ItemPIDL);
end;
end;

const
IEIFLAG_ASYNC = $001;
IEIFLAG_CACHE = $002;
IEIFLAG_ASPECT = $004;
IEIFLAG_OFFLINE = $008;
IEIFLAG_GLEAM = $010;
IEIFLAG_SCREEN = $020;
IEIFLAG_ORIGSIZE = $040;
IEIFLAG_NOSTAMP = $080;
IEIFLAG_NOBORDER = $100;
IEIFLAG_QUALITY = $200;

procedure
TBaseExtractImage.DoExtractImg(imgExtractor:IExtractImage);
var
Thumbnail: TBitmap;
ThumbnailHandle: HBITMAP;
Buf: array[0..MAX_PATH] of WideChar;
ColorDepth, Priority, Flags: DWORD;
size:TSize;
res:HResult;
begin
priority:=0; //prioritas normal
colorDepth:=32; //kedalaman warna 32 bit
size.cx:=FWidth; //size thumbnail
size.cy:=FHeight;
//tampilkan seperti dilayar dan hanya yg offline
flags:=IEIFLAG_SCREEN or IEIFLAG_OFFLINE;

res:=imgExtractor.GetLocation(@Buf,sizeof(Buf),priority,
size,colorDepth,Flags);
if (res=NOERROR) or (res=E_PENDING) then
begin
ThumbnailHandle:=0;
imgExtractor.Extract(ThumbnailHandle);
if ThumbnailHandle<>0 then
begin
Thumbnail:=TBitmap.Create;
try
Thumbnail.ReleaseHandle;
Thumbnail.Handle:=ThumbnailHandle;
ExtractImg(buf,thumbnail);
finally
Thumbnail.Free;
end;
end;
end;
end;

procedure TBaseExtractImage.ExtractImg;
begin
if Assigned(FOnExtract) then
FOnExtract(self,Filename,Thumbnail);
end;

{TExtractImage}
procedure TExtractImage.Extract;
var TargetFolder:IShellFolder;
attr,eaten:cardinal;
itemPIDL:PItemIDList;
ImgExtractor:IExtractImage;
folder:string;
mallocObj:IMalloc;
afilename:wideString;
begin
folder:=ExtractFilePath(FFilename);
delete(folder,length(folder),1);
TargetFolder:=GetTargetFolder(folder);
if TargetFolder=nil then
exit;
afilename:=ExtractFilename(FFilename);
SHGetMalloc(mallocObj);

TargetFolder.ParseDisplayName(0,nil,PWideChar(aFilename),
eaten,ItemPIDL,attr);
try

TargetFolder.GetUIObjectOf(0,1,itemPIDL,IExtractImage,
nil,ImgExtractor);
finally
mallocObj.Free(itemPIDL);
end;

DoExtractImg(ImgExtractor);
end;

{TExtractFolderImage}
procedure TExtractFolderImage.Extract;
var TargetFolder:IShellFolder;
attr,eaten:cardinal;
itemPIDL:PItemIDList;
ImgExtractor:IExtractImage;
mallocObj:IMalloc;
afilename:widestring;
searchRec:TSearchRec;
begin
TargetFolder:=GetTargetFolder(FFolder);
if TargetFolder=nil then
exit;
if FindFirst(FFolder+'\*.*',faAnyFile,SearchRec)=0
then
begin
SHGetMalloc(mallocObj);
repeat
afilename:=searchRec.Name;
if (searchRec.Name<>'.') and
(searchRec.Name<>'..') then
begin

TargetFolder.ParseDisplayName(0,nil,PWideChar(aFilename),
eaten,ItemPIDL,attr);
try

TargetFolder.GetUIObjectOf(0,1,itemPIDL,IExtractImage,
nil,ImgExtractor);
finally
mallocObj.Free(itemPIDL);
end;
DoExtractImg(ImgExtractor);
end;
until (FindNext(searchRec)<>0);
FindClose(searchRec);
end;
end;

end.

Sengaja kita pecah menjadi bebrapa kelas. terdapat
fungsionalitas yang mirip
pada saat mendapatkan IShellFolder suatu direktori,
shg lebih baik dijadikan satu
yakni menjadi TBaseExtractImage. Tiap kali sebuah file
diekstrak
akan digenerate event OnExtract dimana parameternya
adalah
nama file yang diekstract dan bitmap berisi thumbnail
file.
Lebar dan tinggi thumbnail yg diinginkan diset melalui
properti Width dan Height kelas ini.
kelas TExtractImage mengekstract berdasarkan nama file
yakni melalui property Filename. TExtractFolderImage
mengektrak
semua file yang ada pada suatu folder.

ok berikut ini contoh penggunaannya TExtractImage
drop kontrol TListbox,TLabel,TImage dan sebuah
TButton.
Siapkan event handler OnFormCreate,OnFormDestory untuk

menyiapkan memori TExtractImage.

unit ufrmTest4;

interface

uses
Windows, Messages, SysUtils, Classes, Graphics,
Controls, Forms, Dialogs,
StdCtrls, ExtCtrls,
uExtractImg;

type
TForm4 = class(TForm)
Image1: TImage;
ListBox1: TListBox;
Button1: TButton;
Label1: TLabel;
procedure Button1Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure ListBox1Click(Sender: TObject);
private
extract:TExtractImage;
procedure DoExtract(Sender:TObject;const
filename:string; const thumb:TBitmap);
{ Private declarations }
public
{ Public declarations }
end;

var
Form4: TForm4;

implementation

{$R *.DFM}

procedure TForm4.Button1Click(Sender: TObject);
var searchRec:TSearchRec;
begin
if FindFirst('c:\my documents\*.*',faAnyFile,
searchRec)=0 then
begin
repeat
if (searchRec.Name<>'.') and
(searchRec.Name<>'..') then
Listbox1.Items.Add('c:\my
documents\'+searchRec.Name);
until (Findnext(searchRec)<>0);
FindClose(searchRec);
end;
end;

procedure TForm4.FormCreate(Sender: TObject);
begin
extract:=TExtractImage.Create;
extract.Width:=Image1.Width;
extract.Height:=Image1.Height;
extract.OnExtract:=DoExtract;
end;

procedure TForm4.FormDestroy(Sender: TObject);
begin
extract.Free;
end;

procedure TForm4.ListBox1Click(Sender: TObject);
var i:integer;
begin
if listbox1.items.Count>0 then
begin
for i:=0 to listbox1.items.Count-1 do
begin
if listbox1.Selected[i] then
begin
extract.Filename:=listbox1.items[i];
extract.Extract;
end;
end;
end;
end;
procedure TForm4.DoExtract(Sender:TObject;const
filename:string; const thumb:TBitmap);
begin
label1.Caption:=filename;
image1.picture.Assign(thumb);
end;

end.


contoh untuk mengekstrak thumbnail disuatu folder:

unit ufrmTest5;

interface

uses
Windows, Messages, SysUtils, Classes, Graphics,
Controls, Forms, Dialogs,
StdCtrls, ComCtrls,uEXtractImg, ImgList;

type
TForm5 = class(TForm)
ListView1: TListView;
Button1: TButton;
ImageList1: TImageList;
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure Button1Click(Sender: TObject);
private
extractFolder:TExtractFolderImage;
procedure DoExtractFolder(Sender:TObject;const
filename:string; const thumb:TBitmap);
{ Private declarations }
public
{ Public declarations }
end;

var
Form5: TForm5;

implementation

{$R *.DFM}

procedure TForm5.FormCreate(Sender: TObject);
begin
extractFolder:=TExtractFolderImage.Create;
extractFolder.Width:=ImageList1.Width;
extractFolder.Height:=ImageList1.Height;
extractFolder.OnExtract:=DoExtractFolder;
end;

procedure TForm5.FormDestroy(Sender: TObject);
begin
extractFolder.Free;
end;
procedure TForm5.DoExtractFolder(Sender:TObject;const
filename:string; const thumb:TBitmap);
var aItem:TListItem;
indx:integer;
begin
indx:=imageList1.Add(thumb,nil);
aItem:=ListView1.items.Add;
aItem.Caption:=filename;
aItem.ImageIndex:=indx;
end;

procedure TForm5.Button1Click(Sender: TObject);
begin
extractFolder.Folder:='c:\my documents\my pictures';
extractFolder.Extract;
end;

end.


--- elmufid <elmufid@...> wrote:

> Hi,
>
> Nama saya Elmo, dan saya baru di sini. Saat ini saya
> sedang membuat
> program untuk melihat file gambar. Tapi saya
> memiliki beberapa
> masalah. Berikut beberapa masalah saya:
> 1. Saya tidak bisa membuat gambar saya menjadi
> Wallpaper. Saya sudah
> mencoba menggunakan beberapa perintah, tapi hasilnya
> tetap nihil.
> Sebenarnya wallpaper memang sudah berganti,
> masalahnya wallpaper
> baru bisa terlihat di desktop jika kita restart
> komputer. Saya
> membuat program ini dengan Delphi 6, dan menggunakan
> Windows XP.
> Apakah ada yang bisa membantu saya bagaimana saya
> bisa membuat
> Wallpaper dengan baik dan benar? Berikut saya
> berikan kutipan
> program yang saya buat.
>
>
> procedure TfrmFullScreen.pmCenterClick(Sender:
> TObject);
> var
> strWallpaper:String;
> bufChar:Array[0..255]of Char;
> recWallpaper:TRect;
> bmpWallpaper:TBitmap;
> regWallpaper:TRegistry;
> grWallpaper:TGraphic;
> intWallpaper:Integer;
> begin
> grWallpaper:=imgFullScreen.Picture.Graphic;
> GetWindowsDirectory(@bufChar,SizeOf(bufChar));
> strWallpaper:=bufChar+'\ElmoPVWallpaper.bmp';
> bmpWallpaper:=TBitmap.Create;
> intWallpaper:=(Sender as TMenuItem).Tag;
> if (intWallpaper<>2) then
> begin
>
> bmpWallpaper.Width:=imgFullScreen.Picture.Width;
>
> bmpWallpaper.Height:=imgFullScreen.Picture.Height;
> bmpWallpaper.Canvas.Draw(0,0,grWallpaper);
> end
> else
> begin
> bmpWallpaper.Width:=Screen.DesktopWidth;
> bmpWallpaper.Height:=Screen.DesktopHeight;
>
>
recWallpaper:=Rect(0,0,bmpWallpaper.Width,bmpWallpaper.Height);
>
>
bmpWallpaper.Canvas.StretchDraw(recWallpaper,grWallpaper);
> end;
> bmpWallpaper.SaveToFile(strWallpaper);
> bmpWallpaper.Free;
>
> {Ini saya membuat Wallpaper dengan menggunakan
> perubahan pada
> registry, hasilnya memang lebih baik dibanding
> dengan menggunakan
> perintah dari Windows API (menurut saya), tapi pada
> akhirnya tetap
> sama, Wallpaper tidak bisa berubah sebelum kita
> restart komputer
> kita, dan itu menyebalkan}
>
> regWallpaper:=TRegistry.Create;
> regWallpaper.RootKey:=HKEY_CURRENT_USER;
> regWallpaper.OpenKey('Control Panel',False);
> regWallpaper.OpenKey('Desktop',True);
>
> regWallpaper.WriteString('Wallpaper',strWallpaper);
> case intWallpaper of
> 0:
> regWallpaper.WriteString('WallpaperStyle','0');
> 1:
> regWallpaper.WriteString('WallpaperStyle','1');
> 2:
> regWallpaper.WriteString('WallpaperStyle','2');
> end;
> regWallpaper.Free;
>
> {Ini saya membuat Wallpaper dengan menggunakan
> perintah dari Windows
> API, saya pikir masalah timbul di parameter kedua
> atau ketiga, tapi
> nggak tahu juga sih. FYI, perintah ini saya gunakan
> sebelum saya
> bisa merubah registry, sedang di program ini saya
> tidak
> menggunakannya, sengaja saya tambahkan sebagai bahan
> pembanding
> saja.}
>
> SystemParametersInfo(spi_SetDeskWallPaper,0,Addr
> (BmpFileName),spif_UpdateIniFile +
> spif_SendWinIniChange);
> end;
>
>
> 2. Setelah saya menjalankan program saya, ada
> beberapa masalah yang
> cukup mengganggu, terutama hal yang berhubungan
> dengan Thumbnail.
> Setiap program saya jalankan, dan mendeteksi adanya
> file grafik,
> program saya akan segera membuat thumbnail,
> masalahnya dalam membuat
> thumbnail cukup lama, dan timbul flicker pada setiap
> pergantian file
> list box. Masalah kedua adalah jika dalam suatu
> folder ada banyak
> file, maka selain cukup lama juga akan boros memori,
> sehingga ada
> kemungkinan (kepastian jika RAM kecil) akan
> mengalami out of memory.
> Ada yang bisa bantu agar saya bisa membuat thumbnail
> dengan cepat,
> dan terutama tidak terlalu makan banyak tempat di
> memory. Berikut
> contoh program yang saya buat.
>
>
> (Procedure untuk membuat Panel dan Image dari
> Thumbnail}
>
> procedure
> TfrmPV.BuatImage(intFile:Integer;strFile:String);
> begin
>
> {Masalah flicker timbul setelah saya menambahkan
> perintah untuk
> membuat panel. Sebelumnya saya tidak memakai panel,
> tapi terlihat
> thumbnail yang saya buat terlalu polos. Penambahan
> panel ini juga
> yang membuat program berjalan terlalu lama saat
> menampilkan
> thumbnail}
>
> pnlThumbnail[intFile]:=TPanel.Create(Self);
> pnlThumbnail[intFile].Parent:=sbxPV;
> pnlThumbnail[intFile].Width:=102;
> pnlThumbnail[intFile].Height:=102;
> pnlThumbnail[intFile].Color:=clWindow;
> pnlThumbnail[intFile].Left:=intKiri;
> pnlThumbnail[intFile].Top:=intAtas;
> imgThumbnail[intFile]:=TImage.Create(Self);
>
> imgThumbnail[intFile].Parent:=pnlThumbnail[intFile];
> imgThumbnail[intFile].Align:=alClient;
> imgThumbnail[intFile].Center:=True;
> imgThumbnail[intFile].Proportional:=True;
>
> imgThumbnail[intFile].Picture.LoadFromFile(strFile);
> imgThumbnail[intFile].Cursor:=crHandPoint;
> if imgThumbnail[intFile].Picture.Graphic is
> TJPEGImage then
> imgThumbnail[intFile].IncrementalDisplay:=True;
> imgThumbnail[intFile].Tag:=intFile;
>
>
imgThumbnail[intFile].OnMouseDown:=sbxPV.OnMouseDown;
> end;
>
> {Procedure untuk membuat label dari nama file grafik
> yang ada}
>
> procedure
> TfrmPV.BuatLabel(intFile:Integer;strFile:String);
> var
> intTinggiLabel,intJumlahTinggi:Integer;
> begin
> mThumbnail[intFile]:=TMemo.Create(Self);
> mThumbnail[intFile].Parent:=sbxPV;
> mThumbnail[intFile].Width:=102;
> mThumbnail[intFile].Lines.Add(strFile);
>
> intJumlahTinggi:=mThumbnail[intFile].Lines.Count-1;
> intTinggiLabel:=flbPV.Canvas.TextHeight('PV');
>
>
intTinggiLabel:=intJumlahTinggi*intTinggiLabel+intTinggiLabel;
> mThumbnail[intFile].Height:=intTinggiLabel;
> mThumbnail[intFile].Ctl3D:=False;
> mThumbnail[intFile].Cursor:=crHandPoint;
> mThumbnail[intFile].ReadOnly:=True;
> mThumbnail[intFile].BorderStyle:=bsNone;
> mThumbnail[intFile].WordWrap:=True;
> mThumbnail[intFile].Alignment:=taCenter;
> mThumbnail[intFile].Left:=intKiri;
> mThumbnail[intFile].Top:=intAtas+105;
> mThumbnail[intFile].Tag:=intFile;
>
> mThumbnail[intFile].OnMouseDown:=sbxPV.OnMouseDown;
> end;
>
> {Procedure untuk meng-highlight file yang diklik}
>
>
=== message truncated ===


__________________________________________________
Do You Yahoo!?
Tired of spam? Yahoo! Mail has the best spam protection around
http://mail.yahoo.com