Programlama yapalım ve Öğrenelim.

Hata mesajı kontrolü

Herhangi bir iş yapılırken, örneğin, diskete erişilmek istendiğinde, eğer sürücüde disket yoksa, windows bir hata mesajı verir. Bu tür mesajlara krıtik hata mesajı denir. Eğer kendiniz bu hataları kontrol edip, gereğini yapacaksanız, windowsun mesaj vermesinin engellenmesi gerekir.Bu işlem "SetErrorMode" fonksiyonu ile yapılabilir.

var

wOldErrorMode : Word;

begin

wOldErrorMode :=

SetErrorMode(

SEM_FAILCRITICALERRORS );

try

{

hata mesajına sebep olabilecek kod buraya yazılır.

}

finally

{

bir önceki hata moduna dön.

}

SetErrorMode( wOldErrorMode );

end;

Ekran koruyucu kurulması

Sistemde tanımlı olan ekran koruyucunun değiştirilmesi veya en baştan tanımlanması için gereken kod aşağıdadır. Uses listesine eklenmesi gereken fmxutil.pas demosdoc dizini altında bulunmaktadır.

//uses ..demosdocfmxutil.pas

procedure TForm1.Button1Click(Sender: TObject);

begin

ExecuteFile('rundll32.exe',

'desk.cpl,InstallScreenSaver C:Windowsgpf.scr',

'',

SW_SHOW);

end;

ListBox yazı tipinin değiştirilmesi

Tek bir satır kod yazarak wm_SetFont mesajına duyarlı bileşenlerin, yazı tipleri değiştirilebilir.

SendMessage( Listbox1.handle, wm_SetFont, GetStockObject(System_Fixed_Font), 1);

Taşınabilir Panel

Programın çalışması esnasında, form üzerindeki bileşenlerin yerleri ancak, program içerisinden verilecek komutlarla değiştirilebilir. Aşağıdaki kod örneği ile çalışan bir programda, normal bir panel, fare yardımı ile taşınabilir hale gelmektedir. Bu kod panelin OnMouseDown olay yordamı içerisine yazılmalıdır.

procedure TForm1.Panel1MouseDown(Sender: TObject; Button: TMouseButton;

Shift: TShiftState; X, Y: Integer);

const

SC_DragMove = $F012;

begin

ReleaseCapture;

panel1.perform(WM_SysCommand, SC_DragMove, 0);

end;

CD-ROM kapağının kapatılması

TmediaPlayer, bir CD-ROM'a komuta ediyorsa, Eject tuşuna basıldığında,, CD-ROM kapağını açabilir. Fakat tekrar Eject tuşuna basıldığında açık durumdaki kapağı kapatamaz. Bu nedenle bir adet kapat butonu kullanılmalıdır. Aşağıdaki kod örneğinde, başka bir buton kullanılarak kapağın kapatılması gösterilmektedrir.

procedure TForm1.Button1Click(Sender: TObject);

begin

if MediaPlayer1.Mode = mpOpen then

begin

mciSendCommand(MediaPlayer1.DeviceID,

MCI_SET,MCI_SET_DOOR_CLOSED,0);

Button1.Caption := '&Open'

end

else

begin

mciSendCommand(MediaPlayer1.DeviceID

,MCI_SET,MCI_SET_DOOR_OPEN,0);

Button1.Caption := '&Close';

end;

Genel olarak bu işlemin yapılması için ise Mmsystem uniti kullanılarak, aşağıdaki fonksiyonlar kullanılabilir.

CD-ROM Kapağını açmak için;

mciSendString('Set cdaudio door open wait', nil, 0, handle);

CD-ROM Kapağını kapatmak için;

mciSendString('Set cdaudio door closed wait', nil, 0, handle);

Çalışma esnasında, bileşen sayısının kontrolü

Uygulama tarafından kullanılmakta olan bileşen sayısının bulunması mümkündür. Henüz yaratılmamış olanlar, bu sayıya dahil edilmeyecektir. Uygulamalar tarafından kullanılmakta olan formların tümü Screen nesnesi ne bağlıdırlar. Her formun üzerindeki bileşenlerin sayısı ise ComponentCount özelliğinde saklanmaktadır. Aşağıdaki kod örneğinde bu özelliklerden yararlanılarak, uygulama üzerindeki toplam bileşen sayısı bulunmaktadır.

function BilesenSayisi : Integer;

var

TopBilesen,

F_Form : Integer;

begin

TopBilesen := 0;

for F_Form := 0 to (Screen.FormCount - 1) do begin

TopBilesen := TopBilesen + Screen.Forms[F_Form].ComponentCount;

end;

Result := TopBilesen;

end;

Fare imlecinin, istenen kontrol üzerine getirilmesi

Fare imlecinin form üzerindeki kontrollerden birisi, örneğin bir buton üzerine getirilmesi için;

Butonun orta noktası hesaplanmalıdır. Örneğin butonun eni 24 ve boyu da 24 ise

xC := Buton.Left + ( buton.width div 2 );

yC := buton.Top + ( buton.height div 2 );

Bulunan değerler Tpoint kayıt tipi içerisine yerleştirilir.

ptBtn : TPoint;

Btn := Point( xC, yC );

Butonun orta noktasına karşılık gelen ekran koordinatları bulunmalıdır.

ptBtn:=buton.Parent.ScreenToClient( buton.ClientToScreen (ptBtn ));

Fere imlecinin pozisyonunu, bulunan ekran koordinatı değeri kullanılarak değiştirilir.

SetCursorPos( ptBtn.X, ptBtn.Y );

Alt-? Tuş kombinasyonu

Bir çok uygulamaya, programcılar tarafından çeşitli maksatlarla, genellikle de geliştirme ekibi hakkında bilgi vermek için, gizli, sürpriz pencereler yerleştirilmektedir. Zaman zaman dergilerde bu tür uygulamalarla ilgili bilgiler yayınlanmaktadır. Bu tekniği kendi programlarınız içerisinde de kullanabilirsiniz.. Aşağıdaki kod örneğinde, form üzerinde tuşa basıldığında, karakterler bir dizi haline getirilip, listedekilerle karşılaştırılmaktadır. listedekilerden bir tanesi ile çakıştığında ise bir mesaj gösterilmektedir.

unit surpriz;

interface

uses

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

type

Tst=array[1..4] of string;

const

strings:Tst= ('merhaba','güle güle','sürüm','sürpriz');

type

TForm1 = class(TForm)

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

Shift: TShiftState);

procedure FormCreate(Sender: TObject);

private

{ Private declarations }

public

{ Public declarations }

s:string;

end;

var

Form1: TForm1;

implementation

{$R *.DFM}

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

Shift: TShiftState);

var

i:integer;

tamam:integer;

begin

if (shift=[ssalt]) and (key>=$41) and (key<=$5A) then begin

s:=s+chr(key);

tamam:=0;

for i:=1 to 4 do

begin

if (s=copy(strings[i],1,length(s))) then Tamam:=-i;

if (s=strings[i]) then Tamam:=i;

end;

if Tamam=0 then s:='';

if Tamam>0 then showmessage(strings[Tamam]);

end;

procedure TForm1.FormCreate(Sender: TObject);

begin

S:='';

end;

end.

Programın duraklatılması

Uses

....

Winprocs

....;

Procedure delay(millisecs : longint);

{ Milisaniyelik duraklatma }

var

Bitir : longint;

begin

bitir := gettickcount + millisecs;

while bitir - gettickcount < 0 do

Application.ProcessMessages;

end; { delay }

Delay(5000), 5 saniyelik bir duraklamaya sebep olur.

Yazı karakteri stilinin değiştirilmesi

with edit1 do

begin

Font.Style := Font.Style + [fsStrikeOut];

Font.Style := Font.Style + [fsUnderline];

Font.Style := Font.Style - [fsBold];

end;

Mevcut bir davranışın değiştirilmesi

Bir sınıf elemanı olan davranışın, alt sınıflarda değiştirilerek kullanılması şu şekilde olur.

Sınıf tanımının Protected bölümündeki tanımlama;

…

procedure Click ; override ;

…

Implementation bölümündeki tanımlama

procedure TYeniButton.Click ;

begin

inherited Click ;

(Owner as TForm).Close ;

end ;

Kes, Kopyala, Yapştır

Kesme, Kopyalama ve Yapıştırma işlemlerini, Klavye kullanılarak yapmak oldukça kolaydır. Bu işlemler menü elemanları vasıtasıyla da yapılabilir. Şayet bileşen, bu komutları aldığında ne yapacağını biliyorsa, Windows mesajlarını kullanmak en uygun hareket tarzıdır.

Kesme;

if GetFocus <> 0 then { Seçili bir pencere varmı? }

SendMessage( GetFocus, WM_CUT, 0, 0

Kopyalama;

if GetFocus <> 0 then { Seçili bir pencere varmı? }

SendMessage( GetFocus, WM_COPY, 0, 0

Yapıştırma;

if GetFocus <> 0 then { Seçili bir pencere varmı? }

SendMessage( GetFocus, WM_PASTE, 0, 0);

Fare imlecinin, pencere üzerinde olup olmadığının kontrolü

Form'un OnMouseMove olayında;

procedure TForm1.FormMouseMove(Sender: TObject; Shift: TShiftState; X,

Y: Integer);

var

P : TPoint;

begin

P.X := X;

P.Y := Y;

if PtInRect (ClientRect,P) then {bütün pencere için sadece "rect"}

MouseCapture := True

else

begin

MouseCapture := False;

ShowMessage ('Benim üzerimde değil');

end;

GetKeyBoardState

Sistem tuşlarının durumunu öğrenmenin en kolay yolu, klavye üzerindeki LED'lere bakmaktır. Kod içerisinden bunu anlamanın yolu ise aşağıdadır.

Tuş durumları, paneller üzerindeki yazının sönük veya koyu olması ile gösterilmektedir. Bu nedenle form üzerine 4 adet panel yerleştirip isimlerini Captio özelliklerini ayarlayın. Ttimer bileşeninin OnTimer olayına da aşağıdaki kodu yazın.

procedure TForm1.Timer1Timer(Sender: TObject);

const

vkconsts: array[0..3] of Word=(vk_Scroll, vk_Insert, vk_Capital, vk_NumLock);

PanelColor: array[Boolean] of TColor=(clGray, clBlack);

var

Toggles: array[0..3] of Bool;

Panels: array[0..3] of TPanel ;

I: Integer;

begin

for I := Low(vkconsts) to High(vkconsts) do

begin

Toggles[I] := Bool(GetKeyState(vkconsts[I]) and 1);

if stToggles[I]<>Toggles[I] then

begin

stToggles[I] := Toggles[I];

case i of

0:PanelScrollLock.Font.Color:=PanelColor[Toggles[I]];

1:PanelINS.Font.Color:=PanelColor[Toggles[I]];

2: PanelCAPS.Font.Color:=PanelColor[Toggles[I]];

3:PanelNUM.Font.Color:=PanelColor[Toggles[I]];

end;

Olay yakalama yordamlarının dinamik olarak atanması

Dinamik olarak bir PopUp menü yaratıldığında, menü elemanlarının altına, seçildiklerinde yapacakları işlerle ilgili olarak doğrudan kod yazmak mümkün değildir. Bunun yerine, hangi menü elemanının ne yapacağını bilen tek bir yordam yazıp, gerektiğinde çağırabilirsiniz. Sender özelliğine göre, seçilen menü elemanı da tespit edilip, gereken kod çalıştırılabilir.

procedure MyPopUpClick(Sender : TObject);

begin

end;

Yukarıdaki yordam PopUp menünün OnClick olayına şu şekilde eşitlenir.

procedure TForm1.TestButtonClick(Sender: TObject);

begin

MyPopUp.OnClick = MyPopUpClick;

end;

Sender parametresinin kullanılması

with Sender as TEdit do

begin

case Tag of

1: birşeyler yap

2: Başka birşeyler yap

end; {case}

end;

Büyük metinlerin panodan alınması

var

Buffer: PChar;

MyHandle : THandle;

TextLength : Integer;

begin

MyHandle := Clipboard.GetAsHandle(CF_TEXT);

Buffer := GlobalLock(MyHandle);

If Buffer = Nil then

begin

GlobalUnlock(MyHandle);

exit;

end;

TextLength := StrLen(buffer);

Windows sürüm numarasının okunması

GetVersion api fonksiyonu kullanılarak, çalışmakta olan Windows'un sürüm numarası nasıl alınabilir. Bu fonksiyonun dödürdüğü sonuç içerisinde sürüm numarası nasıl ayıklanır?

program Winvrsn;

uses

WinTypes,

WinProcs,

SysUtils;

procedure TForm1.Button2Click(Sender: TObject);

var

WinVersion : Word;

DosVersion : Word;

VersionString : String;

begin

WinVersion := GetVersion and $0000FFFF;

DosVersion := (GetVersion and $FFFF0000) shr 16;

VersionString := 'DOS : ' + IntToStr(Hi(DOSVersion)) + '.' + IntToStr(Lo(DOSVersion)) + #13 +

'Windows : '+ IntToStr(Lo(WinVersion)) + '.' + IntToStr(Hi(WinVersion)) + #0;

MessageBox(0, @VersionString[1],'Version Information', MB_ICONINFORMATION or MB_OK)

end;

Program guruplarının listbox bileşenine doldurulması

Sistemde tanımlı olan program guruplarının elde edilip, bir listbox içerisine doldurulması için neler yapılmalıdır?

unit Unit1;

interface

uses

Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,StdCtrls, DdeMan;

type

TForm1 = class(TForm)

Button1: TButton;

FGroupsList: TListBox;

FDDEClient: TDdeClientConv;

procedure Button1Click(Sender: TObject);

private

{ Private declarations }

public

{ Public declarations }

Procedure ReadGroups;

end;

var

Form1: TForm1;

implementation

{$R *.DFM}

Procedure TForm1.ReadGroups;

Var

GroupData : PChar;

TmpStr : String;

FNumGroups, i : integer;

begin

GroupData := FDDEClient.RequestData('Groups');

FGroupsList.Clear;

FNumGroups := 0;

if GroupData = nil then

exit

else

begin

i := 0;

TmpStr := '';

While GroupData[i] <> #0 do

begin

if GroupData[i] = #13 then

begin

FGroupsList.items.Add(TmpStr);

TmpStr := '';

i := i + 1;

end

else

TmpStr := TmpStr + GroupData[i];

i := i + 1;

end;

StrDispose(GroupData);

end;

procedure TForm1.Button1Click(Sender: TObject);

begin

ReadGroups

end;

end.

Yukarıdaki kod için kullanılan form ise şu şekildedir.

object Form1: TForm1

Left = 200

Top = 111

Width = 374

Height = 486

Caption = 'Form1'

Font.Charset = DEFAULT_CHARSET

Font.Color = clWindowText

Font.Height = -13

Font.Name = 'MS Sans Serif'

Font.Style = []

PixelsPerInch = 120

TextHeight = 16

object Button1: TButton

Left = 280

Top = 408

Width = 75

Height = 41

Caption = 'Button1'

TabOrder = 0

OnClick = Button1Click

end

object FGroupsList: TListBox

Left = 8

Top = 0

Width = 265

Height = 449

ItemHeight = 16

TabOrder = 1

end

object FDDEClient: TDdeClientConv

DdeService = 'progman'

Left = 48

Top = 88

LinkInfo = (

'Service progman'

'Topic ')

end

TListBox ve TComboBox bileşenleri içerisine resim yerleştirilmesi

ListBox ve ComboBox bileşenleri içerisine yerleştirilen seçimlik elemanların, sadece metin değil, aynı zamanda BMP formatındaki resimleri de içermesi, tasarladığınız kullanıcı arayüzlerinin, diğerlerinden farklı olmasını sağlar. Bunun için hazırlanmış olan örnek kod aşağıdadır.

Unit1.pas;

unit Unit1;

interface

uses

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

StdCtrls;

type

TForm1 = class(TForm)

ComboBox1: TComboBox;

ListBox1: TListBox;

procedure FormCreate(Sender: TObject);

procedure FormClose(Sender: TObject; var Action: TCloseAction);

procedure ComboBox1DrawItem(Control: TWinControl; Index: Integer;

Rect: TRect; State: TOwnerDrawState);

procedure ComboBox1MeasureItem(Control: TWinControl; Index: Integer;

var Height: Integer);

procedure ListBox1DrawItem(Control: TWinControl; Index: Integer;

Rect: TRect; State: TOwnerDrawState);

procedure ListBox1MeasureItem(Control: TWinControl; Index: Integer;

var Height: Integer);

private

{ Private declarations }

public

{ Public declarations }

end;

var

Form1: TForm1;

TheBitmap1, TheBitmap2, TheBitmap3, TheBitmap4,

TheBitmap5 : TBitmap;

implementation

{$R *.DFM}

procedure TForm1.FormCreate(Sender: TObject);

begin

TheBitmap1 := TBitmap.Create;

TheBitmap1.LoadFromFile('C:Program FilesBorlandDelphi 3imagesbuttonsglobe.bmp');

TheBitmap2 := TBitmap.Create;

TheBitmap2.LoadFromFile('C:Program FilesBorlandDelphi 3imagesbuttonsvideo.bmp');

TheBitmap3 := TBitmap.Create;

TheBitmap3.LoadFromFile('C:Program FilesBorlandDelphi 3imagesbuttonsgears.bmp');

TheBitmap4 := TBitmap.Create;

TheBitmap4.LoadFromFile('C:Program FilesBorlandDelphi 3imagesbuttonskey.bmp');

TheBitmap5 := TBitmap.Create;

TheBitmap5.LoadFromFile('C:Program FilesBorlandDelphi 3imagesbuttonstools.bmp');

ComboBox1.Items.AddObject('Bitmap1: Globe', TheBitmap1);

ComboBox1.Items.AddObject('Bitmap2: Video', TheBitmap2);

ComboBox1.Items.AddObject('Bitmap3: Gears', TheBitmap3);

ComboBox1.Items.AddObject('Bitmap4: Key', TheBitmap4);

ComboBox1.Items.AddObject('Bitmap5: Tools', TheBitmap5);

ListBox1.Items.AddObject('Bitmap1: Globe', TheBitmap1);

ListBox1.Items.AddObject('Bitmap2: Video', TheBitmap2);

ListBox1.Items.AddObject('Bitmap3: Gears', TheBitmap3);

ListBox1.Items.AddObject('Bitmap4: Key', TheBitmap4);

ListBox1.Items.AddObject('Bitmap5: Tools', TheBitmap5);

end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);

begin

TheBitmap1.Free;

TheBitmap2.Free;

TheBitmap3.Free;

TheBitmap4.Free;

TheBitmap5.Free;

end;

procedure TForm1.ComboBox1DrawItem(Control: TWinControl; Index: Integer;

Rect: TRect; State: TOwnerDrawState);

var

Bitmap: TBitmap;

Offset: Integer;

begin

with (Control as TComboBox).Canvas do

begin

FillRect(Rect);

Bitmap := TBitmap(ComboBox1.Items.Objects[Index]);

if Bitmap <> nil then

begin

BrushCopy(Bounds(Rect.Left + 2, Rect.Top + 2, Bitmap.Width,

Bitmap.Height), Bitmap, Bounds(0, 0, Bitmap.Width,

Bitmap.Height), clRed);

Offset := Bitmap.width + 8;

end;

{ display the text }

TextOut(Rect.Left + Offset, Rect.Top, Combobox1.Items[Index])

end;

procedure TForm1.ComboBox1MeasureItem(Control: TWinControl; Index:Integer; var Height: Integer);

begin

height:= 20;

end;

procedure TForm1.ListBox1DrawItem(Control: TWinControl; Index: Integer;

Rect: TRect; State: TOwnerDrawState);

var

Bitmap: TBitmap;

Offset: Integer;

begin

with (Control as TListBox).Canvas do

begin

FillRect(Rect);

Bitmap := TBitmap(ListBox1.Items.Objects[Index]);

if Bitmap <> nil then

begin

BrushCopy(Bounds(Rect.Left + 2, Rect.Top + 2, Bitmap.Width,

Bitmap.Height), Bitmap, Bounds(0, 0, Bitmap.Width,

Bitmap.Height), clRed);

Offset := Bitmap.width + 8;

end;

{ display the text }

TextOut(Rect.Left + Offset, Rect.Top, Listbox1.Items[Index])

end;

procedure TForm1.ListBox1MeasureItem(Control: TWinControl; Index: Integer;

var Height: Integer);

begin

height:= 20;

end;

end.

Unit1.dfm

object Form1: TForm1

Left = 211

Top = 155

Width = 526

Height = 320

Caption = 'Form1'

Font.Charset = DEFAULT_CHARSET

Font.Color = clWindowText

Font.Height = -16

Font.Name = 'System'

Font.Style = []

OnClose = FormClose

OnCreate = FormCreate

PixelsPerInch = 120

TextHeight = 20

object ComboBox1: TComboBox

Left = 33

Top = 38

Width = 206

Height = 22

Style = csOwnerDrawVariable

ItemHeight = 16

TabOrder = 0

OnDrawItem = ComboBox1DrawItem

OnMeasureItem = ComboBox1MeasureItem

end

object ListBox1: TListBox

Left = 270

Top = 35

Width = 189

Height = 209

ItemHeight = 16

Style = lbOwnerDrawVariable

TabOrder = 1

OnDrawItem = ListBox1DrawItem

OnMeasureItem = ListBox1MeasureItem

end

Basit bir DLL şablonu

Delphi'de DLL hazırlamak hiç te zor değil. Aşağıdaki kod örneği derlendiğinde, uzantısı otomatik olarak,DLL olarak verilecektir.. Bu DLL "Fonksiyon" isimli tek bir fonksiyon ihraç etmektedir.

library Dllframe;

uses WinTypes;

function Fonksiyon : string ; export ;

begin

Result := 'DLL' den merhaba!' ;

end;

exports

Fonksiyon;

begin

end.

İpucu penceresinin özelleştirilmesi

Standart ipucu penceresi, kısmen de olsa özelleştirilebilir. İşte örneği.

Type

TMyHintWindow = Class (THintWindow)

Constructor Create (AOwner: TComponent); override;

end;

var

Form1: TForm1;

implementation

Constructor TMyHintWindow.Create (AOwner: TComponent);

begin

Inherited Create (AOwner);

canvas.brush.color:=clwhite;

Canvas.Font.Name := 'Courier New';

Canvas.Font.Size := 72;

end;

procedure TForm1.FormCreate(Sender: TObject);

begin

Application.ShowHint := false;

HintWindowClass := TMyHintWindow;

Application.ShowHint := True;

end;

Dizi sabiti tanımı

TYPE

NAME1 = Array[1..4,1..10] of Integer;

Const

NAME2 : NAME1 = ((1,2,3,4,5,6,7,8,9,10),

(1,2,3,4,5,6,7,8,9,10),

(1,2,3,4,5,6,7,8,9,10));

StrinGrid bileşeni içerisindeki metnin hizalaması

StringGrid bileşeni hücrelerindeki metin, Grid1DrawCell olay yordamına eklenecek birkaç satır kodla hizalanabilir.

procedure Tform1.Grid1DrawCell(Sender: TObject; Col, Row: Longint;

Rect: TRect; State: TGridDrawState);

var l_oldalign : word;

begin

if (row=0) or (col<2) then

grid1.canvas.font.style:=grid1.canvas.font.style+[fsbold];

if col<>1 then

begin

l_oldalign:=settextalign(grid1.canvas.handle,ta_right);

grid1.canvas.textrect(rect,rect.right-2, Rect.top+2,grid1.cells[col,row]);

settextalign(grid1.canvas.handle,l_oldalign);

end

else

begin

grid1.canvas.textrect(rect,rect.left+2,rect.top+2,grid1.cells[col,row]);

end;

grid1.canvas.font.style:=grid1.canvas.font.style-[fsbold];

end;

end.

TstringGrid bileşeninden bir satırın silinmesi

Bu fonksiyonu "RowNumber" parametresi ile belirtilen satırı StringGrid bileşeninden siler.

procedure GridDeleteRow(RowNumber : Integer; Grid : TStringGrid);

Var

i : Integer;

Begin

Grid.Row := RowNumber;

If (Grid.Row = Grid.RowCount -1) Then

Begin

{On the last row}

Grid.RowCount := Grid.RowCount - 1;

End

Else

Begin

{Not the last row}

For i := RowNumber To Grid.RowCount - 1 Do

Begin

Grid.Rows[i] := Grid.Rows[i+ 1];

End;

Grid.RowCount := Grid.RowCount - 1;

End;

TstringGrid satırının en alta gönderilmesi

Bu fonksiyon, "RowNumber" parametresi ile belirtilen satırı, StringGrid bileşeninin en son satırına gönderir.

procedure GridMoveRowToBottom(RowNumber : Integer; Grid : TStringGrid);

Var

i : Integer;

Begin

Grid.Row := RowNumber;

Grid.RowCount := Grid.RowCount + 1;

Grid.Rows[Grid.RowCount-1] := Grid.Rows[Grid.Row];

For i := RowNumber+1 To Grid.RowCount -1 Do

Begin

Grid.Rows[i-1] := Grid.Rows[i];

End;

Grid.RowCount := Grid.RowCount - 1;

End;

Sistemde tanımlı yazıcıların listelenmesi

//uses printers

var

printer:tprinter;

begin

printer:=tprinter.create;

listbox1.items.assign(printer.printers)

end;

Yazdırma

Kullanıcı butona bastığında, bir adet Bitmap nesnesi yaratılıp, içeriği dosyadan alınmakta ve kağıdı ortalayacak şekilde resim basılmaktadır.

//uses printers

procedure TForm1.Button1Click(Sender: TObject);

var

TBitmap bmp;

begin

bmp = TBitmap.Create;

bmp.LoadFromFile('MyBitmap.bmp');

with Printer do

begin

BeginDoc;

Canvas.Draw((PageWidth - bmp.Width) div 2,

(PageHeight - bmp.Height) div 2,bmp);

EndDoc;

end;

bmp.Free;

end;

istenen yazıcının seçimi

Sistemde tanımlı birden fazla yazıcı varsa, yazıcılar 0'dan başlayacak şekilde numaralanır. İstenen yazıcının kullanılabilmesi veya hangi yazıcının seçili olduğunun öğrenilmesi için, Tprinter nesnesininin Printerindex özelliği kullanılır. Kullanılmakta olan yazıcının numarası bu özellikte saklanır. Değiştirilecek ise, kullanılacak yazıcının numarası, yine bu özelliğe atanır. Bu özellikte "-1" değeri varsa, varsayılan yazıcı seçili muamelesi görür.

//uses printers

var

printer:tprinter;

begin

printer:=tprinter.create;

printer.printerindex:=0;

end;

Yazıcı yazı tipleri

Seçili durumaki yazıcı tarafından desteklenmekte olan yazı tipleri aşağıdaki yöntemle listelenir.

//uses printers

var

printer:tprinter;

begin

printer:=tprinter.create;

listbox1.items.assign(printer.fonts)

end;

HEX->Dec

Aşağıdaki fonksiyon, 16 tabanındaki bir sayının ondalık sayıya çevirilmesi için kullanılabilecek bir fonksiyondur.

procedure TForm1.Button1Click(Sender: TObject);

CONST HEX : ARRAY['A'..'F'] OF INTEGER = (10,11,12,13,14,15);

VAR str : String;

Int,

i : integer;

BEGIN

STR:=EDIT1.TEXT;

Int := 0;

FOR i := 1 TO Length(str) DO

IF str[i] < 'A' THEN Int := Int * 16 + ORD(str[i]) - 48

ELSE Int := Int * 16 + HEX[str[i]];

edit1.text:=inttostr(int);

end;

Hafıza miktarı

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}

Function MyGetExt: Integer; Assembler;

asm

Mov AX,$3031;

Out $70,AL;

NOP;

IN AL,$71;

XCHG AH,AL;

Out $70,AL;

NOP;

IN AL,$71;

end;

procedure TForm1.Button1Click(Sender: TObject);

begin

showmessage(inttostr(MyGetExt))

end;

end.

Fare hareket alanının kısıtlanması

Aşağıdaki kod örneğinde, farenin sol tuşuna basılıyken, imleç form üzerinden başka bir yere taşınamamaktadır.

unit Unit1;

interface

uses

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

type

TForm1 = class(TForm)

procedure FormMouseDown(Sender: TObject; Button: TMouseButton;

Shift: TShiftState; X, Y: Integer);

procedure FormMouseUp(Sender: TObject; Button: TMouseButton;

Shift: TShiftState; X, Y: Integer);

private

{ Private declarations }

public

{ Public declarations }

end;

var

Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.FormMouseDown(Sender: TObject; Button: TMouseButton;

Shift: TShiftState; X, Y: Integer);

var

r:trect;

begin

canvas.pen.mode:=pmxor;

canvas.Pen.style:=psdot;

r:=boundsrect;

inflaterect(r,-30,-30);

clipcursor(@r);

end;

procedure TForm1.FormMouseUp(Sender: TObject; Button: TMouseButton;

Shift: TShiftState; X, Y: Integer);

begin

clipcursor(nil);

end;

end.