Çeşitli Delphi Kodları

Programdan windows wallpaper'i degistirme islemi

procedure TForm1.ChangeWallPaper(const FileName: string);
begin
SystemParametersInfoA(SPI_SETDESKWALLPAPER, 0,
PChar(FileName), SPIF_UPDATEINIFILE);
end;


*****************
Eliptik form olusturulmasi

procedure TForm1.FormCreate(Sender: TObject);
var
region: HRgn;
begin
{ koselerden 25 pixel keser }
region:=CreateRoundRectRgn(1, 1, 484, 312, 25, 25);
SetWindowRgn(handle, region, true);
end;


******************
Programdan bir internet adresini yeni ve istenilen ozelliklerde bir pencerede acmak

uses
comobj;
procedure TFmMain.GotoUrl(SUrl: string; Width, Height: Integer; ToolBar: Boolean);
const
csOLEObjName = 'InternetExplorer.Application';
var
IE : Variant;
WinHanlde : HWnd;
begin
if( VarIsEmpty( IE ) )then
begin
IE := CreateOleObject( csOLEObjName );
IE.Visible := true;
IE.Toolbar := Toolbar;
if Width > 0 then IE.Width := Width;
if Height > 0 then IE.Height := Height;
IE.Navigate( sURL );
end else
begin
WinHanlde := FindWIndow( 'IEFrame', nil );
if( 0 <> WinHanlde )then
begin
IE.Navigate( sURL );
SetForegroundWindow( WinHanlde );
end else
begin
ShowMessage('Internet Explorer acilamadi');
end;
end;
end;

// kullanimi:

{adresi yukseklik ve genislik belirtmeden acar }
GotoUrl('http://www.delphiturk.com', 0, 0, True);
{adresi yukseklik ve genislik belirterek toolbar
olmayan bir pencerede acar }
GotoUrl('http://www.delphiturk.com', 400, 400, False);


************************
Programdan dosya kopyalama islemi


procedure FileCopy(const SourceFileName, TargetFileName: string );
var
S, T: TFileStream;
begin
S := TFileStream.Create(sourcefilename, fmOpenRead );
try
T := TFileStream.Create(targetfilename, fmOpenWrite or fmCreate);
try
T.CopyFrom(S, S.Size ) ;
finally
T.Free;
end;
finally
S.Free;
end;
end;


******************************
Herhangi bir Wincontrol' veya tüm ekran nasil bitmap olarak alinir ?


function GetDcAsBitmap(DC: HDC; Bitmap: TBitmap; W, H: Cardinal): Boolean;
var
hdcCompatible: HDC;
hbmScreen: HBitmap;
begin
Result := False;
if DC = 0 then Exit;
hdcCompatible := CreateCompatibleDC(DC);
hbmScreen := CreateCompatibleBitmap(DC, W, H);
if (hbmScreen = 0) then Exit;
if (SelectObject(hdcCompatible, hbmScreen)=0) then Exit;
if not(BitBlt(hdcCompatible, 0,0, W, H, DC, 0,0, SRCCOPY)) then
Exit;
Bitmap.Handle := HbmScreen;
Bitmap.Dormant;
Result := True;
end;

function GetScreenAsBitmap(Bitmap: TBitmap): Boolean;
var ScreenDC: HDC;
begin
ScreenDC := CreateDC('DISPLAY', nil, nil, nil);
Result := GetDCAsBitmap(ScreenDC, Bitmap,
GetDeviceCaps(ScreenDC, HORZRES),
GetDeviceCaps(ScreenDC, VERTRES)
);
end;

function GetWindowAsBitmap(const WindowName: string;
Bitmap: TBitmap): Boolean;
var Wnd: HWnd;
Rect: TRect;
begin
Wnd := FindWindow(nil, PChar(WindowName));
GetWindowRect(Wnd, Rect);
Result := GetDCAsBitmap(GetWindowDC(Wnd), Bitmap,
Rect.Right - Rect.Left, Rect.Bottom - Rect.Top);
end;

function GetWindowAsBitmap(Wnd: HWnd; Bitmap: TBitmap): Boolean;
var
Rect: TRect;
begin
GetWindowRect(Wnd, Rect);
Result := GetDCAsBitmap(GetWindowDC(Wnd), Bitmap,
Rect.Right - Rect.Left, Rect.Bottom - Rect.Top);
end;

// Kullanimi:
{Button1 yüzeyini resim olarak al}
GetWindowAsBitmap(Button1.Handle, Image1.Picture.Bitmap);
{Tüm ekrani resim olarak al}
GetScreenAsBitmap(Image1.Picture.Bitmap);

*****************************