Rakamları yazıya dönüştürme, Şekilli formlar, dosya arama
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);
*****************************
Form baslik yerine tüm yüzeyden nasil sürüklenir ?
{ Asagidaki kodun form üzerindeki tüm bilesenlerin
onmousedown event handler'ina konulmasi gerekir }
procedure TForm1.FormMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
ReleaseCapture;
Form1.perform(WM_SYSCOMMAND, $F012, 0);
end;
****************************
Klasör ve alt klasörlerde dosya aramak ve bulunanlari bir listeye atmak
{
Form1'in üzerindeki Memo1'e bulunan dosyalari ekler.
Not: Kod recursion kullanmakta. Cok fazla (Binlerce)
dosya bulundugunda Stack Overflow hatasi verebilir
}
procedure TForm1.FindFiles(StartDir, FileMask: string);
var
SR: TSearchRec;
DirList: TStringList;
IsFound: Boolean;
i: integer;
begin
if StartDir[length(StartDir)] <> '\' then
StartDir := StartDir + '\';
IsFound :=
FindFirst(StartDir+FileMask, faAnyFile-faDirectory, SR) = 0;
while IsFound do begin
Memo1.Lines.Add(StartDir + SR.Name);
IsFound := FindNext(SR) = 0;
end;
FindClose(SR);
DirList := TStringList.Create;
IsFound := FindFirst(StartDir+'*.*', faAnyFile, SR) = 0;
while IsFound do begin
if ((SR.Attr and faDirectory) <> 0) and
(SR.Name[1] <> '.') then
DirList.Add(StartDir + SR.Name);
IsFound := FindNext(SR) = 0;
end;
FindClose(SR);
for i := 0 to DirList.Count-1 do
FindFiles(DirList
, FileMask);
DirList.Free;
end;
// Kullanimi:
FindFiles('C:\windows\', '*.txt');
***************************
Bir klasörün toplam boyutu nasil alinir ?
function GetDirectorySize(const ADirectory: string): Integer;
var
Dir: TSearchRec;
Ret: integer;
Path: string;
begin
Result := 0;
Path := ExtractFilePath(ADirectory);
Ret := Sysutils.FindFirst(ADirectory, faAnyFile, Dir);
if Ret <> NO_ERROR then
exit;
try
while ret=NO_ERROR do
begin
inc(Result, Dir.Size);
if (Dir.Attr in [faDirectory]) and (Dir.Name[1] <> '.') then
Inc(Result, GetDirectorySize(Path + Dir.Name + '\*.*'));
Ret := Sysutils.FindNext(Dir);
end;
finally
Sysutils.FindClose(Dir);
end;
end;
//Kullanimi:
procedure TForm1.Button1Click(Sender: TObject);
begin
label1.caption := Format('Boyut: %d bytes', [GetDirectorySize('C:\Windows')]);
end;
*************************
Verilen bir kredi karti numarasi'nin gecerli olup olmadiginin kontrolü
{-------------------------------------------------
Credit card validator
Returns:
0 : Card is invalid or unknown
1 : Card is a valid AmEx
2 : Card is a valid Visa
3 : Card is a valid MasterCard
-------------------------------------------------}
function Vc(c: string): integer;
var
card: string[21];
Vcard: array[0..21] of byte absolute card;
Xcard: integer;
Cstr: string[21];
y, x: integer;
begin
Cstr := ";
fillchar(Vcard, 22, #0);
card := c;
for x := 1 to 20 do
if (Vcard
Cstr := Cstr + chr(Vcard
card := ";
card := Cstr;
Xcard := 0;
if not odd(length(card)) then
for x := (length(card) - 1) downto 1 do
begin
if odd(x) then
y := ((Vcard
else
y := (Vcard
if (y >= 10) then
y := ((y - 10) + 1);
Xcard := (Xcard + y)
end
else
for x := (length(card) - 1) downto 1 do
begin
if odd(x) then
y := (Vcard
else
y := ((Vcard
if (y >= 10) then
y := ((y - 10) + 1);
Xcard := (Xcard + y)
end;
x := (10 - (Xcard mod 10));
if (x = 10) then
x := 0;
if (x = (Vcard[length(card)] - 48)) then
Vc := ord(Cstr[1])-ord('2')
else
Vc := 0
end;
****************************
Delphide Digital Saat Yapimi
procedure TForm1.Timer1Timer(Sender: TObject);
var
DateTime : TDateTime;
str : string;
begin
DateTime := Time;
str := TimeToStr(DateTime);
Label1.Caption := str;
end;
*****************************
Sayiyi Turkce olarak yazan kod (159 = Yuzellidokuz vb.)
Katirilyona kadar olan sayilari
destekler.
}
const
BIRLER: array[0..9] of string=(", 'Bir', 'Iki', 'Üc', 'Dört', 'Bes', 'Alti',
'Yedi', 'Sekiz', 'Dokuz');
ONLAR : array[0..9] of string=(", 'On', 'Yirmi', 'Otuz', 'Kirk', 'Elli', 'Altmis',
'Yetmis', 'Seksen', 'Doksan');
DIGER : array[0..5] of string=(", 'Bin', 'Milyon', 'Milyar', 'Trilyon', 'Katrilyon');
function SmallNum(N: Integer): string;
var
string[3];
begin
Result := ";
S := IntToStr(N);
if (Length(S)=1) then
S := '00' + S
else if (Length(S)=2) then
S := '0' + S;
if S[1]<>'0' then
if S[1]<>'1' then
Result := BIRLER[StrToInt(S[1])] + 'Yüz'
else
Result := 'Yüz';
Result := Result + ONLAR[StrToInt(S[2])];
Result := Result + BIRLER[StrToInt(S[3])];
end;
function NumStr(Num: Currency): string;
var
i, j, n, Nm: Integer;
S, Sn: string;
begin
S := FormatFloat('0', Num);
Sn := ";
if Num = 0 then
Sn := 'Sifir'
else if Length(S) < 4 then
Sn := SmallNum(Round(Num))
else
begin
I := 1;
J := Length(S) mod 3;
if J=0 then
begin
J := 3;
N := Length(S) div 3 - 1;
end
else
N := Length(S) div 3;
while i<Length(S) do
begin
Nm := StrToInt(Copy(S, I, J));
if (Nm=1) and (N=1) then
begin
Nm := 0;
Sn := Sn + SmallNum(Nm) + Diger[N];
end;
if Nm<>0 then
Sn := Sn + SmallNum(Nm) + Diger[N];
I := I + J;
J := 3;
N := N - 1;
end;
end;
Result := Sn;
end;
// Kullanimi:
procedure TForm1.Button1Click(Sender: TObject);
begin
Label1.Caption := NumStr(StrToCurr(Edit1.Text));
end;
******************************
Bir StringGrid colonu icine dgerin saga kaydirilarak yazilmasi
function sagaDaya(s: string;col: integer): string;
var
bosluk: string;
en: integer;
begin
bosluk := ' ';
en := StringGrid1.ColWidths[col] -
StringGrid1.Canvas.TextWidth(s);
while (en - 5) > SG1.Canvas.TextWidth(bosluk) do
bosluk := bosluk + ' ';
sagaDaya := bosluk + s;
end;
*******************************
DBGrid verilerini (TQUERY) Excel sayfasina aktarma
{Bu kod ornegi herhangi bir table'dan
Ad ve Soyad verilerini ceken TQuery verilerini,
Excelde yeni bir calisma sayfasi
acip icine yazar.}
{uses satirina comobj unitini ekleyin}
procedure TForm1.Button1Click(Sender: TObject);
var
v,sayfa:variant;{v excel prg, sayfa calisma sayfasi}
say,i:integer;
begin
query1.open;
say:=query1.recordcount;//query kayit sayisi
v:=createoleobject('excel.application');//exceli yarat
v.workbooks.add;//yeni calisma kitabini ekle
sayfa:=v.workbooks[1].worksheets[1];{Birinci calisma sayfasini sayfa degiskenine ata}
query1.first;
for i:=1 to say do
begin
sayfa.cells[i,1]:=query1ad.text;
sayfa.cells[i,2]:=query1soyad.text;
query1.next;
end;
v.visible:=true;//Exceli acip verileri goster
end;
***************************************
Bilinmeyen bir sql ile ne zaman Query1.Open, ne zaman Query1.ExecSql ?
{
Kullanicinin Gerek select, gerekse Update, Insert vb
komutlarini hatasiz calistirmak icin kullaniniz.
}
procedure TForm1.Button1Click(Sender: TObject);
begin
Query1.Close;
Query1.Sql.Text :=Memo1.Lines.Text;
try
Query1.Open;
except
on E: Exception do
if not (E is ENoResultSet) then // eger bunun disinda hata varsa
raise;
end;
end;
***********************
FORMLAR ICIN HOS BIR CAPTION EFEKTI
FORMUNUZA BIR TIMER NESNESI EKLEYIN. TIMER'IN INTERVAL DEGERINI 100 YA DA DAHA ASAGI BIR DEGER YAPIP ONTIMER
OLAYINI ASAGIDAKI GIBI DUZENLEYIN!
EGER BASLIGINIZA BOSLUK KARAKTERLERINI EKLERSENIZ DAHA HOS
OLUR : 'BASLIK ' GIBI}
procedure TForm1.Timer1Timer(Sender: TObject);
begin
CAPTION:=COPY(CAPTION,2,LENGTH(CAPTION)-1)+CAPTION[1];
end;
*************************
Databes'den StringGrid'e Aktarma
procedure TForm1.BitBtn1Click(Sender: TObject);
var
i,row:integer;
begin
Table1.OPEN;
Table1.First;
row := 0;
StringGrid1.RowCount:=Table1.RecordCount;
while not Table1.EOF do
begin
for i := 0 to Table1.FieldCount-1 do
StringGrid1.Cells[i,row] := Table1.Fields.AsString;
Inc (row);
Table1.Next;
end;
end;
***************************
Yuvarlak Form Olusturma
procedure TForm1.FormCreate(Sender: TObject);
var
region: HRgn;
begin
{ yuvarlak form olusturur }
region:=CreateEllipticRgn(1,1,200,200);
SetWindowRgn(handle, region, true);
end;
***************************
Key Kodlari
{ Virtual Keys, Standard Set }
VK_LBUTTON = 1;
VK_RBUTTON = 2;
VK_CANCEL = 3;
VK_MBUTTON = 4; { NOT contiguous with L & RBUTTON }
VK_BACK = 8;
VK_TAB = 9;
VK_CLEAR = 12;
VK_RETURN = 13;
VK_SHIFT = $10;
VK_CONTROL = 17;
VK_MENU = 18;
VK_PAUSE = 19;
VK_CAPITAL = 20;
VK_KANA = 21;
VK_HANGUL = 21;
VK_JUNJA = 23;
VK_FINAL = 24;
VK_HANJA = 25;
VK_KANJI = 25;
VK_CONVERT = 28;
VK_NONCONVERT = 29;
VK_ACCEPT = 30;
VK_MODECHANGE = 31;
VK_ESCAPE = 27;
VK_SPACE = $20;
VK_PRIOR = 33;
VK_NEXT = 34;
VK_END = 35;
VK_HOME = 36;
VK_LEFT = 37;
VK_UP = 38;
VK_RIGHT = 39;
VK_DOWN = 40;
VK_SELECT = 41;
VK_PRINT = 42;
VK_EXECUTE = 43;
VK_SNAPSHOT = 44;
VK_INSERT = 45;
VK_DELETE = 46;
VK_HELP = 47;
{ VK_0 thru VK_9 are the same as ASCII '0' thru '9' ($30 - $39) }
{ VK_A thru VK_Z are the same as ASCII 'A' thru 'Z' ($41 - $5A) }
VK_LWIN = 91;
VK_RWIN = 92;
VK_APPS = 93;
VK_NUMPAD0 = 96;
VK_NUMPAD1 = 97;
VK_NUMPAD2 = 98;
VK_NUMPAD3 = 99;
VK_NUMPAD4 = 100;
VK_NUMPAD5 = 101;
VK_NUMPAD6 = 102;
VK_NUMPAD7 = 103;
VK_NUMPAD8 = 104;
VK_NUMPAD9 = 105;
VK_MULTIPLY = 106;
VK_ADD = 107;
VK_SEPARATOR = 108;
VK_SUBTRACT = 109;
VK_DECIMAL = 110;
VK_DIVIDE = 111;
VK_F1 = 112;
VK_F2 = 113;
VK_F3 = 114;
VK_F4 = 115;
VK_F5 = 116;
VK_F6 = 117;
VK_F7 = 118;
VK_F8 = 119;
VK_F9 = 120;
VK_F10 = 121;
VK_F11 = 122;
VK_F12 = 123;
VK_F13 = 124;
VK_F14 = 125;
VK_F15 = 126;
VK_F16 = 127;
VK_F17 = 128;
VK_F18 = 129;
VK_F19 = 130;
VK_F20 = 131;
VK_F21 = 132;
VK_F22 = 133;
VK_F23 = 134;
VK_F24 = 135;
VK_NUMLOCK = 144;
VK_SCROLL = 145;
{ VK_L & VK_R - left and right Alt, Ctrl and Shift virtual keys.
Used only as parameters to GetAsyncKeyState() and GetKeyState().
No other API or message will distinguish left and right keys in this way. }
VK_LSHIFT = 160;
VK_RSHIFT = 161;
VK_LCONTROL = 162;
VK_RCONTROL = 163;
VK_LMENU = 164;
VK_RMENU = 165;
VK_PROCESSKEY = 229;
VK_ATTN = 246;
VK_CRSEL = 247;
VK_EXSEL = 248;
VK_EREOF = 249;
VK_PLAY = 250;
VK_ZOOM = 251;
VK_NONAME = 252;
VK_PA1 = 253;
VK_OEM_CLEAR = 254;
*************************************
form üzerinde herhangi bir nesneyi tasimak
procedure TForm1.Button1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
const
sc_DragMove=$F012;
begin
ReleaseCapture;
Button1.Perform(WM_SYSCOMMAND, sc_DragMove, 0);
end;
**************************************
Verilen web sitesini Internet Explorer'da acmak
procedure TForm1.Button1Click(Sender: TObject);
begin
winexec('C:\Program Files\Internet Explorer\iexplore.exe www.delphiturk.com',SW_MAXIMIZE);
end;
*************************************
VeriTabanindan Excele Aktarim.
{Form üzerine ole serverla baglanti kurmak icin "servers" bilesenlerinden "ExcelApplication"
nesnesini eklemeniz gerekir.
IRange.AutoFormat(6,xxxx,xxxx,xxxx,xxxx,xxxx,xxxx);
Bu Satirdaki Rakami 1-15 arasinada Degistirerek degisik Formatlar elde edebilirsiniz}
procedure TForm1.Button1Click(Sender: TObject);
var IRange : Excel97.Range;
i,Row : integer;
begin
if not ExcelApplication1.Visible[0] then //excel acikmi
begin
excelApplication1.Visible[0]:= True; //acik degilse ac
excelApplication1.Workbooks.Add(xxxx,0); //yeni calisma kitabi olustur
end
else //excel aciksa yeni calisma sayfasi ekle
excelApplication1.Sheets.Add(xxxx,xxxx,xxxx,xxxx,1);
// Alan Basliklarini aktar
IRange := excelApplication1.ActiveCell;
for i := 0 to Table1.Fields.count-1 do
begin
IRange.Value := Table1.Fields.DisplayLabel;
IRange := IRange.Next;
end;
// Kayitlari Aktar
Table1.DisableControls;
try
Table1.First;
Row :=2;
while not Table1.Eof do
begin
IRange := ExcelApplication1.Range['A'+IntToStr(Row),'A'+IntToStr(Row)];
for i := 0 to Table1.Fields.Count-1 do
begin
IRange.Value := Table1.Fields.Value;
IRange := IRange.Next;
end;
Table1.Next;
Inc(Row);
end;
finally
Table1.EnableControls;
end;
// Auto format
IRange:= ExcelApplication1.Range['A1','D'+IntToStr(Row-1)];
IRange.AutoFormat(6,xxxx,xxxx,xxxx,xxxx,xxxx,xxxx);
end;
**************************
Excel dosyasindaki bir hucreye ulasmak
// uses kismina ComObj ekle
procedure TForm1.Button1Click(Sender: TObject);
var Book : Variant;
FileName : string;
Excel,Sheet : Variant;
begin
Excel := CreateOleObject('Excel.Application');
repeat
FileName := Excel.GetOpenFileName;
until FileName <> '0';
Book := Excel.WorkBooks.Open(FileName);
Excel.Visible := False;
Sheet := Book.Worksheets[1];
Showmessage(Sheet.Cells[1,1]);
end;
--------------------**********************************--------------------------
Buton üzerine birden çok satır yazmak ?
procedure TForm1.Button1Click(Sender: TObject);
var
i : integer;
begin
i:=GetWindowLong(Button1.Handle,GWL_STYLE );
SetWindowLong (Button1.Handle,GWL_STYLE , i or BS_MULTILINE);
Button1.Caption := 'satır1'#13#10'satır2';
end;
******************************
Form'u transparan yapmak ?
procedure TForm1.Button1Click(Sender: TObject);
var
i : integer;
begin
i:=GetWindowLong(Button1.Handle,GWL_STYLE );
SetWindowLong (Button1.Handle,GWL_STYLE , i or BS_MULTILINE);
Button1.Caption := 'satır1'#13#10'satır2';
end;
********************************
Screensaver oluşturmak ?
{
Screensaver oluşturmak için öncelikle şunları bilmelisiniz :
Screensaver lar iki model içerir : configuration ve running mode
.scr uzantısına sahiptirler, .exe değil !
Fakat normal program gibidirler.
Windows bu programları /c parametresi ile configurasyon modunda
/s modu ile de running (çalışma modunda) başlatır.
}
procedure TForm1.FormCreate(Sender: TObject);
begin
if ParamCount > 0 then
begin
if ParamStr(1) = '/c' then
begin
{start configuration form}
end
else
begin
if ParamStr(1) = '/s' then
begin
{start screensaver}
end;
end;
end;
end;
*******************************************
Masaüstündekipixel rengini öğrenmek ?
function DesktopColor(const x,y: integer): TColor;
var
cCanvas;
begin
c:=TCanvas.create;
c.handle:=GetWindowDC(GetDesktopWindow);
result:=getpixel(c.handle,x,y);
c.free;
end;
procedure TForm1.Timer1Timer(Sender: TObject);
var
pos: TPoint;
begin
GetCursorPos(Pos);
Panel1.Color:=DesktopColor(pos.x, pos.y);
end;
*********************************
Form'un taşınmasınıengellemek ?
type
TForm1 = class(TForm)
private
Procedure WMSysCommand( Var msg: TWMSysCommand ); message WM_SYSCOMMAND;
public
{ Public tanımlar }
end;
var
Form1: TForm1;
implementation
{$R *.DFM}
procedure TForm1.WMSysCommand(var msg: TWMSysCommand);
begin
if (msg.CmdType and $FFF0) = SC_MOVE then begin
msg.result := 0;
exit;
end;
inherited;
end;
************************************
TRichedit/TMemoüzerinde get col row olayları ?
function RichRow(mRichedit) : LongInt;
begin
Result:=SendMessage(m.Handle,EM_LINEFROMCHAR,m.SelStart,0);
end;
function RichCol(mRichedit) : LongInt;
begin
Result:=m.SelStart-SendMessage(m.handle,EM_LINEINDEX,SendMessage(m.Handle,EM_LINEFROMCHAR,m.SelStart,0),0);
end;
procedure TForm1.RichEdit1KeyUp(Sender: TObject; var Key: Word;
Shift: TShiftState);
begin
Label1.Caption:= Format('%d : %d',[RichCol(form1.richedit1),RichRow(form1.richedit1)]);
end;
************************************
System iconlarını kullanabilir miyiz ?
{
possible constants:
- IDI_APPLICATION
- IDI_ASTERISK
- IDI_EXCLAMATION
- IDI_HAND
- IDI_QUESTION
}
//Icons
procedure TForm1.Button1Click(Sender: TObject);
var
iconIcon;
begin
icon:=TIcon.Create;
icon.Handle:=LoadIcon(0,IDI_HAND);
Canvas.Draw(30,100,icon);
end;
{
possible constants:
- OBM_BTNCORNERS
- OBM_BTSIZE
- OBM_CHECK
- OBM_CHECKBOXES
- OBM_CLOSE
- OBM_COMBO
- OBM_DNARROW
- OBM_DNARROWD
- OBM_DNARROWI
- OBM_LFARROW
- OBM_LFARROWD
- OBM_LFARROWI
- OBM_MNARROW
- OBM_REDUCE
- OBM_RESTORE
- OBM_REDUCED
- OBM_SIZE
- OBM_UPARROW
- OBM_ZOOM
}
//Bitmaps
procedure TForm1.Button2Click(Sender: TObject);
var
bitmapBitmap;
begin
bitmap:=TBitmap.Create;
bitmap.Handle:=LoadBitmap(0,makeintresource(OBM_RESTORE));
canvas.Draw(100,100,bitmap);
end;
*****************************
Animasyonlu program ikon'u ?
var
icon1oolean;
...
procedure TForm1.Timer1Timer(Sender: TObject);
begin
if icon1=false then
begin
Application.icon:=Image1.Picture.Icon;
icon1:=true;
end
else
begin
Application.icon:=Image2.Picture.Icon;
icon1:=false;
end;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
icon1:=true;
end;
**************************
Memo kayıtlarıiçin UNDO fonksiyonu ?
procedure TForm1.Button1Click(SenderObject);
begin
memo1.perform(em_undo, 0, 0);
end;
*************************
Form Yapıştırma
procedure TForm2.FormShow(Sender: TObject);
begin
Form3.SetBounds(2,2,Panel1.Width-4,Panel1.Height-4);
Form3.Show;
end;
--
procedure TForm3.CreateParams(var Params: TCreateParams);
begin
inherited CreateParams(Params);
Params.Style := Params.Style or WS_CHILD;
Params.Style := WS_CHILD;
Params.WndParent := Form2.Panel1.Handle;
end;
************************
Locate metoduyla birden fazla alana göre arama
Dataset.Locate('aramasahasi1 ; aramasahasi2 ;aramasahasi3 ; ....',
VarArrayOf([AranacakKelime1,AranacakKelime2,AranacakKelime3,...]),[loPartialKey]);
locate tipi => [loCaseInsensitive]
