Programlama yapalım ve Öğrenelim.

PgUp ve PgDown tuşları ile formu aşağı yukarı kaydırma

Kalabalık veya küçültülmüş formlarda, bazı kontroller, görünmeyen bölgede kalırlar. Gerektiğinde Kaydırma çubukları ile formun görünmeyen bölgelerine ulaşmak elbetteki mümkündür. Bu işlem, klavye kullanılarak da şu şekilde yapılabilir.

Form.Keypreview özelliği TRUE olmalıdır.

unit Unit1;

interface

uses

Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,

StdCtrls;

type

TForm1 = class(TForm)

Edit1: TEdit;

Memo1: TMemo;

ListBox1: TListBox;

procedure FormKeyDown(Sender: TObject; var Key: Word;

Shift: TShiftState);

private

{ Private declarations }

public

{ Public declarations }

end;

var

Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.FormKeyDown(Sender: TObject; var Key: Word;

Shift: TShiftState);

const

delta=10;

begin

with vertscrollbar do

if key=vk_next then position:=position+delta

else if key=vk_prior then position:=position-delta;

end;

end.

Özel yazı karakteri

Kendi yazı karakterinizi kullanın.

unit Unit1;

interface

uses

Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,

StdCtrls;

type

TForm1 = class(TForm)

Button1: TButton;

procedure Button1Click(Sender: TObject);

private

{ Private declarations }

public

{ Public declarations }

end;

var

Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.Button1Click(Sender: TObject);

var

dc:hdc;

thefont:hfont;

begin

dc:=getdc(handle);

thefont:=createfont( 24, //yükseklik

16, //ortalama karakter genişliği

0, //yatış açısı

0, //yönlendiröe açısı

400,//yazı karakteri ağırlığı

0, //italiklik bayrağı

0, //alt çizgi bayrağı

0, //vurgu bayrağı

oem_charset,// karakter seti

out_default_precis,//çıkış vurgusu

clip_default_precis,//kesme vurgusu

default_quality,//çıktı kalitesi

default_pitch or ff_script,//vurgu ve aile

'script'//ad

);

selectobject(dc,thefont);

textout(dc,10,10,'Merhaba Dünya',24);

releasedc(handle,dc);

deleteobject(thefont);

end;

end.

Ekran koruyucu

Bir ekran koruyucusu nasıl olur. İşte örneği:

" Proje dosyasına, projenin ekran koruyucu olacağına dair bir bilgi satırı eklenmelidir.

{$D SCRSAVE <Ekran koruyucu adı}>

" Ana formdaki kenarlıklar, ve ikonlar tamamen kaldırılmalıdır.

" Form aktif hale gelirken, Left ve Top değerleri "0" a eşitlenmelidir.

" Form.Windowstate=WsMaximized olmalıdır.

" Formun yaratılması esnasında, Application.Onmessage olay yordamına, Ekran koruyucunun devreden çıkmasını sağlayacak yordam atanmalıdır.

" Program parametrelerine "/c" eklenmelidir. (Run | Parameters menüsünden)

" Program derlendikten sonra uzantısı "SCR" olarak değiştirilmeli ve Windows dizinine kopyalanmalıdır.

Scrn.PAS

unit Scrn;

interface

uses

SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,

Forms, Dialogs, ExtCtrls;

type

TScrnFrm = class(TForm)

tmrTick: TTimer;

procedure tmrTickTimer(Sender: TObject);

procedure FormShow(Sender: TObject);

procedure FormHide(Sender: TObject);

procedure FormActivate(Sender: TObject);

private

{ Private declarations }

procedure DrawSphere(x, y, size : integer; color : TColor);

procedure DeactivateScrnSaver(var Msg : TMsg; var Handled : boolean);

public

{ Public declarations }

end;

var

ScrnFrm: TScrnFrm;

implementation

{$R *.DFM}

var

crs : TPoint; {Fare imlecinin orjinal yeri.}

function Min(a, b : integer) : integer;

begin

if b < a then

Result := b

else

Result := a;

end; {Min}

procedure TScrnFrm.DrawSphere(x, y, size : integer; color : TColor);

var

i, dw : integer;

cx, cy : integer;

xy1, xy2 : integer;

r, g, b : byte;

begin

with Canvas do begin

{Fırça ve kalem şekilleri.}

Pen.Style := psClear;

Brush.Style := bsSolid;

Brush.Color := color;

{Renk karışımları.}

r := GetRValue(color);

g := GetGValue(color);

b := GetBValue(color);

{Topların çizimi.}

dw := size div 16;

for i := 0 to 15 do begin

xy1 := (i * dw) div 2;

xy2 := size - xy1;

Brush.Color := RGB(Min(r + (i * 8), 255), Min(g + (i * 8), 255),

Min(b + (i * 8), 255));

Ellipse(x + xy1, y + xy1, x + xy2, y + xy2);

end;

end; {TScrnFrm.DrawSphere}

procedure TScrnFrm.DeactivateScrnSaver(var Msg : TMsg; var Handled : boolean);

var

done : boolean;

begin

if Msg.message = WM_MOUSEMOVE then

done := (Abs(LOWORD(Msg.lParam) - crs.x) > 5) or

(Abs(HIWORD(Msg.lParam) - crs.y) > 5)

else

done := (Msg.message = WM_KEYDOWN) or (Msg.message = WM_KEYUP) or

(Msg.message = WM_SYSKEYDOWN) or (Msg.message = WM_SYSKEYUP) or

(Msg.message = WM_ACTIVATE) or (Msg.message = WM_NCACTIVATE) or

(Msg.message = WM_ACTIVATEAPP) or (Msg.message = WM_LBUTTONDOWN) or

(Msg.message = WM_RBUTTONDOWN) or (Msg.message = WM_MBUTTONDOWN);

if done then

Close;

end; {TScrnFrm.DeactivateScrnSaver}

procedure TScrnFrm.tmrTickTimer(Sender: TObject);

const

sphcount : integer = 0;

var

x, y : integer;

size : integer;

r, g, b : byte;

color : TColor;

begin

Inc(sphcount);

x := Random(ClientWidth);

y := Random(ClientHeight);

size := 25;

x := x - size div 2;

y := y - size div 2;

r := Random($80);

g := Random($80);

b := Random($80);

DrawSphere(x, y, size, RGB(r, g, b));

end; {TScrnFrm.tmrTickTimer}

procedure TScrnFrm.FormShow(Sender: TObject);

begin

GetCursorPos(crs);

tmrTick.Interval := 100;

tmrTick.Enabled := true;

Application.OnMessage := DeactivateScrnSaver;

ShowCursor(false);

end; {TScrnFrm.FormShow}

procedure TScrnFrm.FormHide(Sender: TObject);

begin

Application.OnMessage := nil;

tmrTick.Enabled := false;

ShowCursor(true);

end; {TScrnFrm.FormHide}

procedure TScrnFrm.FormActivate(Sender: TObject);

begin

WindowState := wsMaximized;

end; {TScrnFrm.FormActivate}

end.

Spheres.DPR

program Spheres;

uses

Forms,

SysUtils,

Scrn in 'SCRN.PAS' {ScrnFrm};

{$R *.RES}

{$D SCRNSAVE Spheres Ekran koruyucu}

begin

{Sadece birkez çalışmalı.}

if hPrevInst = 0 then

begin

if (ParamCount > 0) and (UpperCase(ParamStr(1)) = '/S') then

begin

Application.CreateForm(TScrnFrm, ScrnFrm);

application.initialize;

Application.Run;

end else application.Terminate;

end;

end.

Bir nesnedeki özelliklerin listesi

procedure ObjectInspector(

Obj : TObject;

Items : TStrings );

var

n : integer;

PropList : TPropList;

begin

n := 0;

GetPropList(

Obj.ClassInfo,

tkProperties + [ tkMethod ],

@PropList );

while( (Nil <> PropList[ n ]) and

(n < High(PropList)) ) do

begin

Items.Add(

PropList[ n ].Name + ': ' +

PropList[ n ].PropType^.Name );

Inc( n );

end;

Haberleşme portlarına erişim

Haberleşme kanallarından bilgi almak veya kanallara bilgi yazmak için aşağıdaki fonksiyonlar kullanılabilir. Belirtilen numaradaki kanala her seferinde bir Byte bilgi yazılabilir veya kanaldan 1 Byte''ık bilgi okunabilir.

function ReadPortB

( wPort : Word ) : Byte;

begin

asm

mov dx, wPort

in al, dx

mov result, al

end;

procedure WritePortB

( wPort : Word; bValue : Byte );

begin

asm

mov dx, wPort

mov al, bValue

out dx, al

end;

Bileşen özelliklerinin Kayıt defterinde saklanması

Bileşenlerin, Published tipindeki özellikleri, kayıt defterine yazılarak, gelecekte tekrar kullanılmak üzere saklanabilir. Örnek kod aşağıdadır.

unit unit1;

interface

uses

Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,registry,TypInfo,

StdCtrls;

type

TForm1 = class(TForm)

xxzzbtn1: TButton;

procedure xxzzbtn1Click(Sender: TObject);

private

{ Private declarations }

public

{ Public declarations }

end;

procedure SaveToRegistry(Obj: TPersistent; Reg: TRegistry);

procedure SaveToKey(Obj: TPersistent; const KeyPath: string);

procedure SaveSetToRegistry(const Name: string; Value: Integer; gTypeInfo: PTypeInfo; Reg: TRegistry);

procedure SaveObjToRegistry(const Name: string; Obj: TPersistent; Reg: TRegistry);

procedure SavePropToRegistry(Obj: TPersistent; PropInfo: PPropInfo;Reg: TRegistry);

var

Form1: TForm1;

implementation

{$R *.DFM}

{integer sayıların, bitlerine ulaşabilmek için, bir tip kümesi oluşturulmalıdır. }

const

BitsPerByte = 8;

type

TIntegerSet = set of 0..SizeOf(Integer)*BitsPerByte - 1;

{ Özellik kümesini, ayrı bir alt anahtar altına BOLLEAN olarak kaydederek, sonradan REGEDIT vasıtasıyla düzeltme imkanı elde edilir. }

procedure SaveToRegistry(Obj: TPersistent; Reg: TRegistry);

var

PropList: PPropList;

PropCount: Integer;

I: Integer;

begin

{ Published özelliklerin listesini oluştur. }

PropCount := GetTypeData(Obj.ClassInfo)^.PropCount;

GetMem(PropList, PropCount*SizeOf(PPropInfo));

try

GetPropInfos(Obj.ClassInfo, PropList);

{ Her özelliği, mevcut anahtara ait bir değer olarak sakla }

for I := 0 to PropCount-1 do

SavePropToRegistry(Obj, PropList^[I], Reg);

finally

FreeMem(PropList, PropCount*SizeOf(PPropInfo));

end;

{ Published özellikleri, verilen anahtarın altına değer olarak yaz. Bu anahtar, HKEY_CURRENT_USER.anahtarının altında yer alacaktır. }

procedure SaveToKey(Obj: TPersistent; const KeyPath: string);

var

Reg: TRegistry;

begin

Reg := TRegistry.Create;

try

if not Reg.OpenKey(KeyPath, True) then

raise ERegistryException.CreateFmt('Anahtar yaratılamadı: %s',[KeyPath]);

SaveToRegistry(Obj, Reg);

finally

Reg.Free;

end;

procedure SaveSetToRegistry(const Name: string; Value: Integer;

gTypeInfo: PTypeInfo; Reg: TRegistry);

var

OldKey: string;

I: Integer;

pppTypeInfo:PPTypeInfo;

begin

pppTypeInfo := GetTypeData(gTypeInfo)^.CompType;

OldKey := '' + Reg.CurrentPath;

if not Reg.OpenKey(Name, True) then

raise ERegistryException.CreateFmt('Anahtar yaratılamadı: %s',[Name]);

{ Enumarated tipli değişken değerlerini teker teker dolaş }

with GetTypeData(gTypeInfo)^ do

for I := MinValue to MaxValue do

{ her küme elemanı için, bir BOOLEAN değer yaz. }

Reg.WriteBool(GetEnumName(gTypeInfo, I), I in TIntegerSet(Value));

{ Üst anahtara dön. }

Reg.OpenKey(OldKey, False);

end;

{Bütün alt nesnelerin özelliklerini, alt anahtar altına yaz}

procedure SaveObjToRegistry(const Name: string; Obj: TPersistent;Reg: TRegistry);

var

OldKey: string;

begin

OldKey := '' + Reg.CurrentPath;

{ Nesne için bir alt anahtar aç. }

if not Reg.OpenKey(Name, True) then

raise ERegistryException.CreateFmt('Anahtar yaratılamadı: %s',[Name]);

{ Nesne özelliklerini sakla }

SaveToRegistry(Obj, Reg);

{Üst anahtara dön }

Reg.OpenKey(OldKey, False);

end;

{ Bir davranışın kayıt defterine saklanması. }

procedure SaveMethodToRegistry(const Name: string; const Method:TMethod;Reg: TRegistry);

var

MethodName: string;

begin

{ Method işaretçisi nil ise sadece boş bir karakter dizisi yaz. }

if Method.Code = nil then

MethodName := ''

else

{ davranışın adını bul. }

MethodName := TObject(Method.Data).MethodName(Method.Code);

Reg.WriteString(Name, MethodName);

end;

{ Tek bir özelliği kayıt defterine mevcut anahtarın altına kaydetmek için }

procedure SavePropToRegistry(Obj: TPersistent; PropInfo: PPropInfo;Reg: TRegistry);

begin

with PropInfo^ do

case PropType^.Kind of

tkInteger,

tkChar,

tkWChar:

begin

{ ordinal özellikleri integer olarak sakla. }

Reg.WriteInteger(Name, GetOrdProp(Obj, PropInfo));

end;

tkEnumeration:

{ enumerated değerleri kendi isimleriyle sakla. }

Reg.WriteString(Name, GetEnumName(PropType^, GetOrdProp(Obj,PropInfo)));

tkFloat:

{ floating point değerleri Double olarak sakla. }

Reg.WriteFloat(Name, GetFloatProp(Obj, PropInfo));

tkString,

tkLString:

{ Store değerler strin olarak kalsın. }

Reg.WriteString(Name, GetStrProp(Obj, PropInfo));

tkVariant:

{ variant değerler string olarak saklansın. }

Reg.WriteString(Name, GetVariantProp(Obj, PropInfo));

tkSet:

{ kümeler alt anahtara saklansın. }

SaveSetToRegistry(Name, GetOrdProp(Obj, PropInfo), PropType^,Reg);

tkClass:

{ sınıflar da alt sınıf olarak saklansın, özellikleri de bu anahtarın altına değer olarak yazılsın.}

SaveObjToRegistry(Name, TPersistent(GetOrdProp(Obj, PropInfo)),Reg);

tkMethod:

{ davranışlar isim olarak yazılsın. }

SaveMethodToRegistry(Name, GetMethodProp(Obj, PropInfo), Reg);

end;

procedure TForm1.xxzzbtn1Click(Sender: TObject);

var

r:tregistry;

begin

r:=tregistry.create;

r.openkey('f1delphi'+form1.name,true);

SaveToRegistry(form1, R);

r.free;

end;

end.

ListBox içerisinde artan arama

Bir listbox içerisinden seçilerek başka bir alana, örneğin bir edit kontrolüne atanacak değerlerin seçim için, artan arama yapılabilir. Artan arama , edit içerisine yazdığınız bilgiye uygun olan ListBox elemanının otomatik olarak seçili hale gelmesi demektir.

Kod örneği aşağıdadır.

unit incsearch;

interface

uses

Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,

StdCtrls;

type

TForm1 = class(TForm)

ListBox1: TListBox;

Edit1: TEdit;

procedure FormCreate(Sender: TObject);

procedure Edit1Change(Sender: TObject);

procedure Edit1KeyDown(Sender: TObject; var Key: Word;

Shift: TShiftState);

private

{ Private declarations }

public

{ Public declarations }

end;

var

Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.FormCreate(Sender: TObject);

begin

// ComboBox'un içine birşeyler doldurun

end;

procedure TForm1.Edit1Change(Sender: TObject);

var

S : Array[0..255] of Char;

begin

StrPCopy(S, Edit1.Text);

with ListBox1 do

ItemIndex := Perform(LB_SELECTSTRING, 0, LongInt(@S));

end;

procedure TForm1.Edit1KeyDown(Sender: TObject; var Key: Word;

Shift: TShiftState);

begin

if key=vk_return then edit1.text:=listbox1.Items[listbox1.itemindex];

end;

end.

Sistem menüsünün geliştirilmesi

unit sysmenu;

interface

uses

SysUtils, WinTypes, WinProcs, Messages, Classes,

Graphics, Controls, Forms, Dialogs, Menus;

type

TForm1 = class(TForm)

procedure FormCreate(Sender: TObject);

private

{ Private declarations }

public

{Aşağıdaki tanım, mesaj yakalama yordamı içindir.

Yeni eklenen menü elemanına tıklandığının tespiti

için kullanılacaktır.}

procedure WinMsgHandler(var Msg : TMsg;

var Handled : Boolean);

end;

var

Form1: TForm1;

const

MyItem = 100; {Herhangi bir WORD değer olabilir.}

implementation

{$R *.DFM}

procedure TForm1.FormCreate(Sender: TObject);

begin

{Varolandan farklı bir mesaj yakalama yordamı kullanılacak}

Application.OnMessage := WinMsgHandler;

{Menüye Bir ayıraç ekleniyor.}

AppendMenu(GetSystemMenu(Self.Handle, False), MF_SEPARATOR, 0, '');

{Mevcut sistem menüsünün en sonuna,

Yeni menü ekleniyor}

AppendMenu(GetSystemMenu(Self.Handle, False), F_BYPOSITION, MyItem, 'Yeni &Menü');

end;

procedure TForm1.WinMsgHandler(var Msg : TMsg;

var Handled : Boolean);

begin

{Eğer mesaj, sistem mesajı ise...}

if Msg.Message=WM_SYSCOMMAND then

if Msg.wParam = MyItem then

{Menünüzün yapacağı işle ilgili kod buraya yazılacak}

ShowMessage('Yenü menüye tıkladınız!!!');

end;

end.

Bir Tedit.text bilgisindeki değişikliğin farkedilmesi

var

changed:boolean;

i:integer;

begin

changed:=false;

for i:=0 to componentcount-1 do

if components[i] is tedit then

changed:=(components[i] as tedit).modified;

if changed then showmessage('değişti');

end;

ComboBox bileşeninin, içine girildiğinde açılması ve kapanması

Sendmessage(combobox1.handle,cb_showdropdown,integer(true),0);

Sendmessage(combobox1.handle,cb_showdropdown,integer(false),0);

Yazıcıya doğrudan baskı gönderme işlemi

unit Esc1;

interface

uses

SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,Forms, Dialogs, StdCtrls;

type

TForm1 = class(TForm)

Button1: TButton;

procedure Button1Click(Sender: TObject);

private

{ Private declarations }

public

{ Public declarations }

end;

var

Form1: TForm1;

implementation

uses

Printers;

{$R *.DFM}

{ "PASSTHROUGH" yapısını belirle }

type TPrnBuffRec = record

BuffLength : word;

Buffer : array [0..255] of char;

end;

procedure TForm1.Button1Click(Sender: TObject);

var

Buff : TPrnBuffRec;

TestInt : integer;

s : string;

begin

{ "PASSTHROUGH" işleminin desteklendiğinden emin ol }

TestInt := PASSTHROUGH;

if Escape(Printer.Handle,

QUERYESCSUPPORT,

sizeof(TestInt),

@TestInt,

nil) > 0 then

begin

{ Baskıyı başlat }

Printer.BeginDoc;

{ Doğrudan gönderilecek metni hazırla }

s := ' Test satırı ';

{ Mtni Buffer'a kopyala }

StrPCopy(Buff.Buffer, s);

{ Buffer uzunluğunu ayarla }

Buff.BuffLength := StrLen(Buff.Buffer);

{ Gönder}

Escape(Printer.Canvas.Handle,

PASSTHROUGH,

@Buff,

nil);

{ Baskıyı bitir }

Printer.EndDoc;

end;

end.

Bilgisayarı kapatıp yeniden başlatma

Bilgisayarı kapatıp, yeniden başlatmak için kullanılabilecek bir kod parçacığı aşağıdadır. Not : Bu kodu denemeden önce, dosyalarınızı kaydedin.

asm

cli

@@WaitOutReady: {Meşgul- 8042 yeni bir komut için hazır olana kadar bekle}

in al,64h {8042 durumunu oku}

test al,00000010b { 1 nolu bit veri giriş bufferinin dolu olduğunu gösterişri }

jnz @@WaitOutReady

mov al,0FEh { "reset" = 8042 pin 0 }

out 64h,al

{ PC kapanıp yeniden açılacak }

End;

Delphi - .....................................

Delphide yazdığınız program içinden başka bir pencerenin boyutlarını değiştirmek

// Diyelimki bir program içerisinden ekranda çalışır durumdaki Not Defterinin boyutlarını ve/veya konumunu değiştirmek istediniz

// İşte size güzel bir örnek. Formunuza 1 Buton koyun ve Click olayına aşağıdaki kodları ekleyin.

// Not Defterinin ekranda açık durduğundan emin olun ve butona basın. Boyut değişecektir.

Unit Unit1;

Interface

Uses

Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,

Dialogs, StdCtrls;

Type

TForm1 = Class(TForm)

Button1: TButton;

Procedure Button1Click(Sender: TObject);

Private

{ Private declarations }

Public

{ Public declarations }

End;

Var

Form1 : TForm1;

Implementation

{$R *.dfm}

Function PencereninBoyutunuDegistir(PencereAdresi : Hwnd; Yukseklik, Genislik: Integer; EkraniOrtala : Boolean): Boolean;

Var

Pencere : TRect;

Begin

Result := False;

Try

GetWindowRect(PencereAdresi, Pencere);

If EkraniOrtala Then MoveWindow(PencereAdresi,(Screen.Width-Genislik) Div 2,(Screen.Height-Yukseklik) Div 2,Yukseklik,Genislik,True)

Else MoveWindow(PencereAdresi,Pencere.Left,Pencere.Top,Yukseklik,Genislik,True);

Except

Result := False;

End;

Result := True;

End;

Procedure TForm1.Button1Click(Sender: TObject);

Var

NotDefteri : Hwnd;

Begin

NotDefteri:=FindWindow(nil, 'Adsız - Not Defteri');

PencereninBoyutunuDegistir(NotDefteri,250,175,True);

End;

End.

// Kolay gelsin.

// Hakan HAMURCU

// hakan@hamurcu.com

Delphi - .....................................

Herhangibir programın çalışır durumda olup olmadığını öğrenmek

// Şu anda sisteminizde hesap makinasının ve/veya not defterinin çalışır durumda olup olmadığını merak ediyorsanız

// işte size basit bir çözüm. Formunuza 2 adet buton koyun ve aşağıdaki kodları ekleyin.

// Buton1'e basıldığında Hesap Makinasının (calc.exe) o anda çalışıp çalışmadığını

// Buton2'ye basıldığında Not Defterinin (notepad.exe) o anda çalışıp çalışmadığını öğrenebilirsiniz.

// Tabi ki siz sorgulamak istediğiniz EXE dosyasının adını yazarak programı kendinize göre değiştirin.

Unit Calisiyormu;

Interface

Uses

Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,

Dialogs, StdCtrls, TlHelp32; // TlHelp32 ünitesini eklemeyi unutmayın

Type

TForm1 = Class(TForm)

Button1: TButton;

Button2: TButton;

Procedure Button1Click(Sender: TObject);

Procedure Button2Click(Sender: TObject);

Private

{ Private declarations }

Public

{ Public declarations }

End;

Var

Form1 : TForm1;

Implementation

{$R *.dfm}

Function Calisiyormu(DosyaAdi: String): Boolean;

Var

DonguDevam: BOOL;

FSnapshotHandle: THandle;

FProcessEntry32: TProcessEntry32;

Begin

FSnapshotHandle := CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0);

FProcessEntry32.dwSize := SizeOf(FProcessEntry32);

DonguDevam := Process32First(FSnapshotHandle, FProcessEntry32);

Result := False;

While Integer(DonguDevam)<>0 Do

Begin

If ((UpperCase(ExtractFileName(FProcessEntry32.szExeFile))=UpperCase(DosyaAdi)) Or (UpperCase(FProcessEntry32.szExeFile)=UpperCase(DosyaAdi))) Then Result := True;

DonguDevam:=Process32Next(FSnapshotHandle, FProcessEntry32);

End;

CloseHandle(FSnapshotHandle);

End;

Procedure TForm1.Button1Click(Sender: TObject);

Begin

If Calisiyormu('calc.exe') Then ShowMessage('Evet Hesap makinası şu anda çalışıyor')

Else ShowMessage('Hayır Hesap makinası şu anda çalışmıyor');

End;

Procedure TForm1.Button2Click(Sender: TObject);

Begin

If Calisiyormu('notepad.exe') Then ShowMessage('Evet Not Defteri şu anda çalışıyor')

Else ShowMessage('Hayır Not Defteri şu anda çalışmıyor');

End;

End.

// Kolay gelsin.

// Hakan HAMURCU

// hakan@hamurcu.com

Delphi - .....................................

Tablo İçinde Seçili Alanların Toplamını Alma

//Alınan DBGrid nesnesini seçerek Özellikler kısmından Option/MultiSelect

//özelliğini True yapınız

procedure TForm1.Button1Click(Sender: TObject);

var

i: Integer;

topla : Single;

begin

if DBGrid1.SelectedRows.Count > 0 then

begin

topla := 0;

with DBGrid1.DataSource.DataSet do

begin

for i := 0 to DBGrid1.SelectedRows.Count-1 do

begin

GotoBookmark(Pointer(DBGrid.SelectedRows.Items[i]));

topla:= topla + ADOTable1.FieldByName('sayi').AsFloat;

end;

Edit1.Text := FloatToStr(topla);

end;

//Ctrl tuşu ile toplamını almak istediniz alanları seçebilirsiniz.

Delphi - .....................................

DbGrid Nesnesine CheckBox ekleme

procedure TForm1.DBGrid1DrawColumnCell(Sender: TObject; const Rect: TRect;

DataCol: Integer; Column: TColumn; State: TGridDrawState);

const

IsChecked : array[Boolean] of Integer = (DFCS_BUTTONCHECK, DFCS_BUTTONCHECK or DFCS_CHECKED);

var

DrawState: Integer;

DrawRect: TRect;

begin

if (gdFocused in State) then

begin

if (Column.Field.FieldName = DBCheckBox1.DataField) then

begin

DBCheckBox1.Left := Rect.Left + DBGrid1.Left + 2;

DBCheckBox1.Top := Rect.Top + DBGrid1.top + 2;

DBCheckBox1.Width := Rect.Right - Rect.Left;

DBCheckBox1.Height := Rect.Bottom - Rect.Top;

DBCheckBox1.Visible := True;

end;

end

else

begin

if (Column.Field.FieldName = DBCheckBox1.DataField) then

begin

DrawRect:=Rect;

InflateRect(DrawRect,-1,-1);

DrawState := ISChecked[Column.Field.AsBoolean];

DBGrid1.Canvas.FillRect(Rect);

DrawFrameControl(DBGrid1.Canvas.Handle, DrawRect,DFC_BUTTON, DrawState);

end;

procedure TForm1.DBGrid1ColExit(Sender: TObject);

begin

if DBGrid1.SelectedField.FieldName = DBCheckBox1.DataField then

DBCheckBox1.Visible := False

end;

procedure TForm1.DBGrid1KeyPress(Sender: TObject; var Key: Char);

begin

if (key = Chr(9)) then Exit;

if (DBGrid1.SelectedField.FieldName = DBCheckBox1.DataField) then

begin

DBCheckBox1.SetFocus;

SendMessage(DBCheckBox1.Handle, WM_Char, word(Key), 0);

end;

procedure TForm1.DBCheckBox1Click(Sender: TObject);

begin

if DBCheckBox1.Checked then DBCheckBox1.Caption := DBCheckBox1.ValueChecked

else DBCheckBox1.Caption := DBCheckBox1.ValueUnChecked;

end;

Delphi - .....................................

String Parse

// byDOMUR+

//%100 Çalışan kod...

procedure ParseDelimited(const sl : TStrings; const value : string; const delimiter : string) ;

var

dx : integer;

ns : string;

txt : string;

delta : integer;

begin

delta := Length(delimiter) ;

txt := value + delimiter;

sl.BeginUpdate;

sl.Clear;

try

while Length(txt) > 0 do

begin

dx := Pos(delimiter, txt) ;

ns := Copy(txt,0,dx-1) ;

sl.Add(ns) ;

txt := Copy(txt,dx+delta,MaxInt) ;

end;

finally

sl.EndUpdate;

end;

Delphi - .....................................

Explorer'ı istenen izinle açma shellapi'siz

Selam arkadaşlar

Aşağıdaki kod ile gezgini istediğimiz dizine açabiliriz. Fakat

Shellapi unitini kullanmamız gereklidir. Bu da programın boyutunu büyütür.

En alttaki kod ile ise buna gerek kalmadan aynı islemi yapabiliyoruz.

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

//Windows Gezginini istediğiniz bir klasörle açma

uses kısmına ShellApi unitini ekleyin.

procedure TForm1.Button1Click(Sender: TObject);

begin

ShellExecute(0,'explore', 'C:WINDOWS', //buraya açmak istediğiniz klasörü yazın.

nil, nil, SW_SHOWNORMAL);

end;

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

procedure TForm1.Button1Click(Sender: TObject);

var pyol:string;

begin

pyol:='C:WINDOWS'; //buraya açmak istediğiniz klasörü yazın.

WinExec(Pchar('Explorer.exe '+pyol),SW_SHOW);

end;

Delphi - .....................................

Blue Game Box v.1.01

Blue Game Box v.1.01

Delphi 7.0 ve MySQL İle Yazılmış Güzel Bir Oyun Makinesi

Link: www.bluegamebox.com

Delphi - .....................................

GetLocalFormatSettings düzeltme

NOT: Aşağıdaki örnekteki DecimalSeperator kelimesi yanlıştır.

Doğrusu DecimalSeparator olmalıdır.

Delphi - .....................................

GetLocaleFormatSettings

Selam arkadaşlar,

GetLocaleFormatsettings komutunu kullanarak standart sistem (sayı, yazı, tarih vb)

formatlama ayarları okunabilir. Bulunun için ilk parametresi 0 verilmelidir. Eğer

belli diller için okunmak isteniyorsa ilk parametre o dil için belirlenmiş integer

tipindeki sayı verilmelidir.

Örneğin

1033 Amerikan

1055 Türkçe

Diğer diller için gerekli sayıları internette "List of Locale ID" veya "LCID"

şeklinde arama ile bulmak mümkündür.

Aşağıda Floattostr ve GetLocaleFormatSettings komutlarının kullanımına

örnek bulunmaktadır:

Var s:string; fs:TFormatSettings;

Begin

GetLocaleFormatSettings(0, fs); // Sistem formatlama ayarı okunuyor

s := Floattostr(123.456, fs); // Sonuc = 123,456 (Sistemi Türkçe format ayarlı bilgisayarda)

GetLocaleFormatSettings(1033, fs); // Amerikan sistem formatlama ayarı okunuyor (1033)

s := Floattostr(123.456, fs); // Sonuc = 123.456 (Amerikan format ayarı)

GetLocaleFormatSettings(1055, fs); // Türkçe sistem formatlama ayarı okunuyor (1055)

s := Floattostr(123.456, fs); // Sonuc = 123,456 (Türkçe format ayarı)

fs.DecimalSeperator:='#';

s := Floattostr(123.456, fs) ; // Sonuc = 123#456 (Kullanıcının değiştirdiği ayar)

Delphi - .....................................

Advantage bazı sql komutları

Virtual Table Support

One of the new system tables is the IOTA table. The IOTA table contains a single row with one

logical field whose value is NULL. The main purpose of the IOTA table is to provide an efficient

method for evaluating an SQL expression on the server. Examples of using the IOTA table include:

To get the current date and time (timestamp) from the server:

SELECT NOW()FROM System.IOTA

Get the currently logged in user:

SELECT USER()FROM System.IOTA

Get a random number from the server:

SELECT RAND FROM System.IOTA

Aggregate Functions

Aggregate functions are used to run calculations on a set of records. These functions generally use

a GROUP BY clause to organize the data to be aggregated into appropriate groups. Advantage supports

the following aggregate functions; AVG, COUNT, MAX, MIN, SUM.

The following example shows the total number of orders and total sales by customer.

SELECT CustID, COUNT(OrderID) as "Orders", SUM(SubTotal) as "Total Sales", AVG(SubTotal) as

"Average Sale" FROM Invoice GROUP BY 1

Mathematical Functions

Many standard mathematical functions are available in the Advantage Query Engine

including conversion functions such as DEGREES and RADIANS which convert the

given values. Many trigonometric functions such as SIN, COS, TAN and PI are

also available.

The RAND function generates a random floating point value between 0 and 1 each

time it is called. It can be initialized by passing in an integer value.

It should only be initialized once per connection. It will use the system

time as a seed value by default so there is generally no need to initialize

the function. The following SQL statement will return 10 random customers

from the customer table.

SELECT TOP 10 (RAND() * 1000) AS SortOrder, CustID, FirstName, LastName

FROM Customer ORDER BY 1;

Date/Time Functions

Most applications have the need to store date and time information.

This data is often used as conditions for reports and other business logic.

For example, the date an invoice is paid is usually a critical item.

The amount of time that has passed since an order was entered and shipped

is a good measure of customer service. There are many date/time functions

that assist with the manipulation of date/time values.

The DAY, HOUR, MINUTE, MONTH, SECOND, QUARTER, WEEK and YEAR functions extract

a portion of the date, time or timestamp value. This information can be used

very effectively in report generation. Allowing the sorting of the information

by any one of these factors. The example SQL statement below shows a summary

of sales by day for 2006.

SELECT SUM(SubTotal) as "Total Sales", DAYNAME(OrderDate) as "Day" FROM Invoice

WHERE YEAR(OrderDate) = 2006 GROUP BY 2 ORDER BY 1 DESC

Manipulating date and time fields is relatively simple. Dates and times are

stored as numbers within the database; therefore, simple math can be used to

manipulate the value. However, if you need to add a specific value, 1 min 30

seconds for example, you can use the TIMESTAMPADD function. This function allows

for adding the exact amount of time you wish. The interval can be in seconds,

minutes, hours, days, weeks, months, quarters or years.

Determining how much time has passed between two dates is another important

operation. This can be accomplished using the TIMESTAMPDIFF function.

Like the TIMESTAMPADD function this function can determine the difference

between two date, time or timestamp fields based on the same intervals mentioned

above. The following SQL statement shows the average and maximum days between

an order and the payment.

SELECT CustID, COUNT(OrderID) as "Orders", AVG(TIMESTAMPDIFF(SQL_TSI_DAY,

OrderDate, PayDate))as "Average Days", MAX(TIMESTAMPDIFF(SQL_TSI_DAY, OrderDate,

PayDate))as "Max Days" FROM Invoice GROUP BY 1

Miscellaneous Functions

Several other functions are available which do not fit into the categories

listed above. The first set of these are administrative type functions.

These include; APPLICATIONID, DATABASE, LASTAUTOINC, NEWIDSTRING and USER.

The LASTAUTOINC function returns the last value assigned to an autoinc field.

This is very useful when you must programmatically determine the value after

an INSERT statement. The NEWIDSTRING returns a Globally Unique Identifier

(GUID) in various formats. The example statement below will display all of

the supported display formats. The screenshot shows two of the most commonly

used GUID formats.

SELECT NEWIDSTRING("M") as "MIME", NEWIDSTRING("F") as "File", NEWIDSTRING("N")

as "Numbers", NEWIDSTRING("D") as "Delimited", NEWIDSTRING("B") as "Bracketed",

NEWIDSTRING("P") as "Parenthesis" FROM system.iota

A variety of information can be obtained about the current connection using the

other administrative functions. The following example SQL statement shows the

current user, database and currently connected application. This functionality

is very useful when creating an audit trail.

SELECT USER() as "User Name", DATABASE() as "Database", APPLICATIONID() as

"Application" FROM system.iota

http://devzone.advantagedatabase.com/dz/content.aspx?Key=42&ID=49

Delphi - .....................................