karakter fonksiyonları-1 (length)
delphi karakter fonksiyonları- 1 ( length )
length komutu ve kullan ı m alanlar ı
lenght fonksiyonu ile girilen karaker say ı s ı alma
girilen bir metnin karakter say ı s ı n ı neden almal ı y ı m ?
e ğ er program ı mda girilen baz ı alanlarda karakter s ı n ı rlamas ı yapmam
gerekiyorsa bunu denetim i ç in kullan ı r ı m .
length fonksiyonunun s ö z dizimi nas ı ld ı r ?
length ( string )
burada string
a ) sabit bir metin olabilir
b ) bir dei ş ken olabilir .
ö rnek
amac ı m ı z bir edit 'e girilien metnin sayısını almak
e ğ er say ı 6 'dan küçükse uyarı versin ve metin kutusunu temizlesin.
forma
1 adet label
1 adet edit
1 adet buton
kontrol ü ekliyelim
* labelin caption 'u ' kullan ı c ı ad ı '
* butonun captionu 'tamam' olsun
*ş imdi butonun on click olay ı na a ş a ğı daki kodu girelim
procedure TForm1 . Button1Click ( Sender : TObject );
var
sy : integer ;
begin
sy := length ( edit1 . Text ); //edite giren textin uzunluğunu al
if sy < 6 then //uzunluğu kontrol et ve
begin
showmessage ( 'kullanıcı adınız en az 6 karakter olmalı' ); //mesajı ver
edit1 . text :="; // editi temizle
form1 . ActiveControl := Edit1 ; //editin üstüne git
end ;
end ;
end .
iyi ç al ış malar
Delphi - .....................................
CLASS ları Ne işe yarar uygulayarak anlayalım.
CLASS lara giri ş seviyesindedir .
Bu makale Class lara giri ş seviyesindedir .
Programlama da programc ı lar ı n en zorland ığı olaylardan biride Nesneye Dayal ı Programlaman ı n kavram ı n ı anlamakt ı r . Class Nedir ? Nesne Nedir ? Constuructor ( Kurucu ) nedir ? Vb …
Ö ncelikle Temelden ba ş layarak ilkel y ö ntemleri kullanal ı m sonra da Modern ( Sosyete ) kodlama y ö ntemlerine ge ç elim . Bak ı n ben bu y ö ntemleri Java da öğ renmi ş tim .
Bir integer dizisinin elemanlar ı n ı ListBox ’ a basan bir program yapal ı m .
procedure TForm1 . Button1Click ( Sender : TObject );
var
dizi : Array [ 0 .. 9 ] of Integer ;
i : Integer ;
begin
dizi [ 0 ]:= 5 ;
dizi [ 1 ]:= 1 ;
dizi [ 2 ]:= 3 ;
dizi [ 3 ]:= 4 ;
dizi [ 4 ]:= 6 ;
dizi [ 5 ]:= 7 ;
dizi [ 6 ]:= 8 ;
dizi [ 7 ]:= 5 ;
dizi [ 8 ]:= 9 ;
dizi [ 9 ]:= 6 ; //Dizilere atanan değerler kullanıcıdan alınabilir.
For i := 0 to high ( dizi ) do
ListBox1 . Items . Add ( intToStr ( Dizi [ i ]));
End ;
Bir dizi olu ş turduk . Bir d ö ng ü a çı p ekrana bast ı rd ı k . İ kinci bir dizi daha ekrana bast ı rmam ı z gerekti ğ ini d üşü nelim . A ş a ğı daki gibi yap ı labilir .
procedure TForm1 . Button1Click ( Sender : TObject );
var
dizi1 : Array [ 0 .. 9 ] of Integer ;
dizi2 : Array [ 0 .. 9 ] of Integer ;
i : Integer ;
begin
dizi1 [ 0 ]:= 5 ;
dizi1 [ 1 ]:= 1 ;
dizi1 [ 2 ]:= 3 ;
dizi1 [ 3 ]:= 4 ;
dizi1 [ 4 ]:= 6 ;
dizi1 [ 5 ]:= 7 ;
dizi1 [ 6 ]:= 8 ;
dizi1 [ 7 ]:= 5 ;
dizi1 [ 8 ]:= 9 ;
dizi1 [ 9 ]:= 6 ; //Dizilere atanan değerler kullanıcıdan alınabilir.
dizi2 [ 0 ]:= 7 ;
dizi2 [ 1 ]:= 7 ;
dizi2 [ 2 ]:= 4 ;
dizi2 [ 3 ]:= 3 ;
dizi2 [ 4 ]:= 6 ;
dizi2 [ 5 ]:= 7 ;
dizi2 [ 6 ]:= 8 ;
dizi2 [ 7 ]:= 5 ;
dizi2 [ 8 ]:= 9 ;
dizi2 [ 9 ]:= 9 ; //Dizilere atanan değerler kullanıcıdan alınabilir.
For i := 0 to high ( dizi1 ) do
ListBox1 . Items . Add ( 'Dizi1 ' + intToStr ( Dizi1 [ i ]));
For i := 0 to high ( dizi2 ) do
ListBox1 . Items . Add ( 'Dizi2 ' + intToStr ( Dizi2 [ i ]));
End ;
Yukar ı da g ö r ü ld üğü gibi iki for d ö ng ü s ü yapt ı k . Halbuki bir int dizisinin ekrana bas ı lmas ı olay ı tek seferde yap ı labilirdi . Burada devreye fonksiyon ve Procedure kavram ı girer . Bir Procedure ile bu i ş i yapsak daha kullan ış l ı olurdu .
Procedure Listele ( Dizi : Array of Integer );
var
i : Integer ;
begin
For i := 0 to high ( dizi ) do
Form1 . ListBox1 . Items . Add ( ' ' + intToStr ( Dizi [ i ]));
Form1 . ListBox1 . Items . Add ( '________' );
End ;
procedure TForm1 . Button1Click ( Sender : TObject );
var
Dizi1 : Array [ 0 .. 9 ] of Integer ;
Dizi2 : Array [ 0 .. 9 ] of Integer ;
Begin
dizi1 [ 0 ]:= 5 ;
dizi1 [ 1 ]:= 1 ;
dizi1 [ 2 ]:= 3 ;
dizi1 [ 3 ]:= 4 ;
dizi1 [ 4 ]:= 6 ;
dizi1 [ 5 ]:= 7 ;
dizi1 [ 6 ]:= 8 ;
dizi1 [ 7 ]:= 5 ;
dizi1 [ 8 ]:= 9 ;
dizi1 [ 9 ]:= 6 ; //Dizilere atanan değerler kullanıcıdan alınabilir.
dizi2 [ 0 ]:= 7 ;
dizi2 [ 1 ]:= 7 ;
dizi2 [ 2 ]:= 4 ;
dizi2 [ 3 ]:= 3 ;
dizi2 [ 4 ]:= 6 ;
dizi2 [ 5 ]:= 7 ;
dizi2 [ 6 ]:= 8 ;
dizi2 [ 7 ]:= 5 ;
dizi2 [ 8 ]:= 9 ;
dizi2 [ 9 ]:= 9 ; //Dizilere atanan değerler kullanıcıdan alınabilir.
Listele ( dizi1 );
Listele ( dizi2 );
End ;
Program ı m ı z daha basitle ş mi ş oldu ğ unu g ö r ü yoruz . 3 nc ü 4 nc ü 5 nci dizimizi listelemek art ı k bizim i ç in daha basit . Diyelimki Dizimizde ki indislerimizin ta şı d ığı de ğ erlerin toplam ı n ı almam ı z gerekiyor bunu bir fonksiyonla halledebiliriz . Program ı m ı z dizimizin hem indislerini ekrana bass ı n hemde toplam ı n ı als ı n .
Function DiziTopla ( Dizi : Array of Integer ): Integer ;
var
Top : Integer ;
i : Integer ;
begin
Top := 0 ;
For i := 0 to high ( dizi ) do
Begin
Top := Top + Dizi [ i ];
Form1 . ListBox1 . Items . Add ( ' ' + intToStr ( Dizi [ i ]));
End ;
Form1 . ListBox1 . Items . Add ( '________' );
Result := Top ;
End ;
procedure TForm1 . Button1Click ( Sender : TObject );
var
Dizi1 : Array [ 0 .. 9 ] of Integer ;
Dizi2 : Array [ 0 .. 9 ] of Integer ;
Begin
dizi1 [ 0 ]:= 5 ;
dizi1 [ 1 ]:= 1 ;
dizi1 [ 2 ]:= 3 ;
dizi1 [ 3 ]:= 4 ;
dizi1 [ 4 ]:= 6 ;
dizi1 [ 5 ]:= 7 ;
dizi1 [ 6 ]:= 8 ;
dizi1 [ 7 ]:= 5 ;
dizi1 [ 8 ]:= 9 ;
dizi1 [ 9 ]:= 6 ; //Dizilere atanan değerler kullanıcıdan alınabilir.
dizi2 [ 0 ]:= 7 ;
dizi2 [ 1 ]:= 7 ;
dizi2 [ 2 ]:= 4 ;
dizi2 [ 3 ]:= 3 ;
dizi2 [ 4 ]:= 6 ;
dizi2 [ 5 ]:= 7 ;
dizi2 [ 6 ]:= 8 ;
dizi2 [ 7 ]:= 5 ;
dizi2 [ 8 ]:= 9 ;
dizi2 [ 9 ]:= 9 ; //Dizilere atanan değerler kullanıcıdan alınabilir.
ShowMessage ( intToStr ( DiziTopla ( dizi1 )));
End ;
Evet Program ı m ı z tek bir fonksiyon ile dizimizi ListBox ’ a hem listeledik hem de dizimizin indislerinin toplam ı n ı ald ı k . Peki dizimizin ü st ü nde ba ş ka i ş lem yapmam ı z gerekebilirmi tabikide kullan ı m alanlar ı m ı z geni ş leyecektir . Ö rne ğ in k üçü kten b ü y ü ye s ı ralama Dizimizin en b ü y ü k indisli elaman ı n bulma vb .. bu tip i ş lemlerin hepsi bir integer dizi si ü zerinde yap ı lacakt ı r . Ve her Fonksiyonumuzu ç a ğı rd ığı m ı zda bu dizimisi ge ç mek zorunda kal ı yoruz . Art ı k Class kavram ı na girme zaman ı geldi .
Class veriler ve bu veriler ü zerinde yap ı lacak i ş lemleri tutan birimdir .
Yukar ı daki ö rneklere dikkat ettiyseniz hep integer dizisi ü zerinde i ş lem yapmaktad ı r . O halde bizim class 'ın amacı integer dizisi üzerinde işlemler yapmalıdır. Class integer dizisini başlangıçta ister. Böylece hep aynı dizi üzerinde işlem yapar
unit Unit1 ;
interface
uses
Windows , Messages , SysUtils , Variants , Classes , Graphics , Controls , Forms ,
Dialogs , StdCtrls ;
type
TDiziClass = Class
Function DiziSum ( dizi : Array of Integer ): Integer ;
Function DiziMax ( dizi : Array of Integer ): Integer ;
End ;
type
TForm1 = class ( TForm )
ListBox1 : TListBox ;
Button1 : TButton ;
procedure Button1Click ( Sender : TObject );
private
{ Private declarations }
public
{ Public declarations }
end ;
var
Form1 : TForm1 ;
implementation
{$R *.dfm}
Function TDiziClass . DiziSum ( dizi : Array of Integer ): Integer ;
var
i , Top : Integer ;
Begin
Top := 0 ;
For i := 0 To high ( Dizi ) do
Begin
Top := Top + Dizi [ i ];
End ;
Result := Top ;
End ;
Function TDiziClass . DiziMax ( dizi : Array of Integer ): Integer ;
var
i , k , Max , Tmp : Integer ;
Begin
i := 0 ;
MAX := dizi [ 0 ];
For i := 0 To high ( Dizi )- 1 do
Begin
if max < dizi [ i + 1 ] Then
Begin
max := dizi [ i + 1 ];
End ;
End ;
Result := Max ;
End ;
procedure TForm1 . Button1Click ( Sender : TObject );
var
Dizi : Array [ 0 .. 9 ] Of Integer ;
i : Integer ;
DiziClass : TdiziClass ;
begin
DiziClass := TDiziClass . Create ;
Dizi [ 0 ] := 300 ;
Dizi [ 1 ] := 301 ;
Dizi [ 2 ] := 302 ;
Dizi [ 3 ] := 303 ;
Dizi [ 4 ] := 170 ;
Dizi [ 5 ] := 304 ;
Dizi [ 6 ] := 1210 ;
Dizi [ 7 ] := 1600 ;
Dizi [ 8 ] := 1700 ;
Dizi [ 9 ] := 10000 ;
ShowMessage ( IntToStr ( DiziClass . DiziMax ( Dizi )));
ShowMessage ( IntToStr ( DiziClass . DiziSum ( Dizi )));
end ;
end .
Yukar ı da g ö r ü ld üğü gibi dizinin elemanlar ı n ı n toplamlar ı n ı ayr ı ca dizinin enb ü y ü k indisli elaman ı n ı yakalad ı k . Ayn ı i ş i class ve fonksiyon kullanmadan yapsayd ı k bir hayli kar ışı k ve uzun olurdu .
_________________
Delphi - .....................................
harf harf arama
procedure TfrmISIgerek . Edit4KeyPress ( Sender : TObject ; var Key : Char );
var
sql1 , sql2 : string ;
begin
if key = #8 then s := copy ( s , 1 , length ( s )- 1 )
else if key = #13 then speedbutton5 . Click
else s := s + key ;
datasource1 . DataSet := query1 ;
sql1 := 'select * from maddeler' ;
sql2 := 'where Materyal like "' + s + '%"' + ' or Materyal like "' + uppercase ( s ) + '%"' ;
query1 . Active := false ;
query1 . SQL . Clear ;
query1 . SQL . Add ( sql1 );
query1 . SQL . Add ( sql2 );
query1 . Active := true ;
end ;
Delphi - .....................................
Basit bir string şifreleme/deşifre etme fonksiyonu
Bir ini veya register i ç inde bak ı ld ığı nda okunmas ı n ı
istemedi ğ iniz stringlerinizi bu fonksiyon yard ı m ı yla
ş ifreleyebilir veya de ş ifre edebilirsiniz .
function RSpassword ( Pass : string ; Mode : Boolean ): String ;
Var Ch : Char ;
TempPass : String ;
Count : Byte ;
begin
If Mode Then { Şifrele }
Begin
TempPass := " ;
Count := Length ( Pass ) ;
while Count > 0 do
Begin
IF Count = length ( Pass ) Then
Begin
Ch := Pass [ Count ];
TempPass := chr ( Ord ( Ch )+ 31 );
End
Else
Begin
TempPass := Chr ( Ord ( Pass [ Count ])+ Ord ( Pass [ Count + 1 ])+ 10 )+ TempPass ;
End ;
Dec ( Count );
End ;
End
Else {Deşifre}
Begin
TempPass := " ;
Count := Length ( Pass ) ;
while Count > 0 do
Begin
IF Count = length ( Pass ) Then
Begin
Ch := Pass [ Count ];
TempPass := chr ( Ord ( Ch )- 31 );
End
Else
Begin
Ch := Pass [ Count ];
TempPass := Chr ( Ord ( Ch )- Ord ( TempPass [ 1 ])- 10 )+ TempPass ;
End ;
Dec ( Count );
End ;
End ;
RSPassword := TempPass ;
end ;
Stringi ş ifrelemek i ç in fonksiyon program da ş a ğı daki ş ekilde ç a ğ r ı lmal ı d ı r ;
[ Degi ş gen ] := RSpassword ([ş ifrelenecek string ], True ));
Stringi de ş ifre etmek i ç in fonksiyon program da ş a ğı daki ş ekilde ç a ğ r ı lmal ı d ı r ;
[ Degi ş gen ] := RSpassword ([ de ş ifre edilecek string ], False ));
Delphi - .....................................
Basit bahis oyunu
//Merhaba Arkadaşlar;
//proje kodları
//////////////////////////////////
program Project1 ;
uses
Forms ,
Unit1 in 'Unit1.pas' {Form1} ;
{$R *.res}
begin
Application . Initialize ;
Application . CreateForm ( TForm1 , Form1 );
Application . Run ;
end .
//////////////////////////////////
//unit .dfm kodları
object Form1 : TForm1
Left = 288
Top = 118
Width = 696
Height = 480
Caption = 'Form1'
Color = clBtnFace
Font. Charset = DEFAULT_CHARSET
Font. Color = clWindowText
Font. Height = - 11
Font . Name = 'MS Sans Serif'
Font . Style = []
OldCreateOrder = False
OnCreate = FormCreate
PixelsPerInch = 96
TextHeight = 13
object SpeedButton1 : TSpeedButton
Left = 464
Top = 40
Width = 23
Height = 22
end
object Label1 : TLabel
Left = 8
Top = 8
Width = 32
Height = 13
Caption = 'Label1'
OnMouseDown = Label1MouseDown
end
object Label2 : TLabel
Left = 144
Top = 88
Width = 32
Height = 13
Caption = 'Label2'
end
object Label3 : TLabel
Left = 240
Top = 88
Width = 65
Height = 17
Caption = 'Label3'
end
object Panel1 : TPanel
Left = 200
Top = 248
Width = 265
Height = 169
Caption = 'Panel1'
TabOrder = 0
end
object Button1 : TButton
Left = 136
Top = 40
Width = 75
Height = 25
Caption = 'Button1'
TabOrder = 1
OnClick = Button1Click
end
object Edit1 : TEdit
Left = 136
Top = 128
Width = 121
Height = 21
TabOrder = 2
Text = 'Edit1'
end
object Button2 : TButton
Left = 224
Top = 40
Width = 75
Height = 25
Caption = 'Button2'
TabOrder = 3
OnClick = Button2Click
end
object para : TEdit
Left = 256
Top = 144
Width = 121
Height = 21
TabOrder = 4
Text = 'para'
OnChange = paraChange
end
object para2 : TEdit
Left = 256
Top = 168
Width = 121
Height = 21
TabOrder = 5
Text = 'para2'
end
object newgame1 : TButton
Left = 608
Top = 0
Width = 75
Height = 25
Caption = 'newgame1'
TabOrder = 6
OnClick = newgame1Click
end
object Quit1 : TButton
Left = 608
Top = 24
Width = 75
Height = 25
Caption = 'Quit1'
TabOrder = 7
OnClick = Quit1Click
end
object Help1 : TButton
Left = 608
Top = 48
Width = 75
Height = 25
Caption = 'Help1'
TabOrder = 8
end
object HowToPlay1 : TButton
Left = 608
Top = 72
Width = 75
Height = 25
Caption = 'HowToPlay1'
TabOrder = 9
end
object bahis : TEdit
Left = 40
Top = 152
Width = 121
Height = 21
TabOrder = 10
Text = 'bahis'
OnChange = bahisChange
end
object Bahis2 : TEdit
Left = 40
Top = 176
Width = 121
Height = 21
TabOrder = 11
Text = 'Bahis2'
end
end
///////////////////////////////
//unit1.pas kodları
/////////////////////////////
unit Unit1 ;
interface
uses
Windows , Messages , SysUtils , Variants , Classes , Graphics , Controls , Forms ,
Dialogs , StdCtrls , ExtCtrls , Buttons , Menus ;
type
TForm1 = class ( TForm )
SpeedButton1 : TSpeedButton ;
Panel1 : TPanel ;
Label1 : TLabel ;
Button1 : TButton ;
Edit1 : TEdit ;
Button2 : TButton ;
Label2 : TLabel ;
para : TEdit ;
para2 : TEdit ;
Label3 : TLabel ;
newgame1 : TButton ;
Quit1 : TButton ;
Help1 : TButton ;
HowToPlay1 : TButton ;
bahis : TEdit ;
Bahis2 : TEdit ;
procedure FormCreate ( Sender : TObject );
procedure Label1MouseDown ( Sender : TObject ; Button : TMouseButton ;
Shift : TShiftState ; X , Y : Integer );
procedure Button1Click ( Sender : TObject );
procedure Button2Click ( Sender : TObject );
procedure paraChange ( Sender : TObject );
procedure bahisChange ( Sender : TObject );
procedure newgame1Click ( Sender : TObject );
procedure Quit1Click ( Sender : TObject );
private
{ Private declarations }
public
{ Public declarations }
end ;
var
Form1 : TForm1 ;
s : array [ 1 .. 40 ] of TSpeedButton ;
i : integer ;
implementation
{$R *.dfm}
procedure TForm1 . FormCreate ( Sender : TObject );
var
l , t : integer ;
begin
t := 0 ;
l := 0 ;
for i := 1 to 40 do begin
s [ i ]:= TSpeedButton . Create ( self );
s [ i ]. Parent := panel1 ;
s [ i ]. Height := 30 ;
s [ i ]. Width := 30 ;
s [ i ]. Left := l ;
s [ i ]. top := t ;
s [ i ]. Caption := IntToStr ( i );
s [ i ]. Font := SpeedButton1 . Font ;
s [ i ]. SendToBack ;
l := l + 30 ;
if (( i mod 8 )= 0 ) then
l := 0 ;
t := 0 + ( i div 8 )* 30 ;
end ;
Label1 . Left := 0 ;
Label1 . Top := 0 ;
Label1 . Width := 240 ;
Label1 . Height := 150 ;
Label1 . BringToFront ;
end ;
procedure TForm1 . Label1MouseDown ( Sender : TObject ; Button : TMouseButton ;
Shift : TShiftState ; X , Y : Integer );
var
a , b : integer ;
begin
if button = mbleft then begin
if y < 30 then
begin
a :=( 1 +( x div 30 ));
if s [ a ]. Font . Color = clBlue then begin
b := StrToInt ( Bahis . Text );
Bahis . Text := IntToStr ( b + 10 );
if b + 10 > 400 then Bahis . Text := '400' ;
s [ a ]. Font . Color := clRed ;
end ;
end
else begin
if y < 60 then
begin
a :=( 9 +( x div 30 ));
if s [ a ]. Font . Color = clBlue then begin
b := StrToInt ( Bahis . Text );
Bahis . Text := IntToStr ( b + 10 );
if b + 10 > 400 then Bahis . Text := '400' ;
s [ a ]. font . Color := clRed ;
end ;
end
else begin
if y < 90 then
begin
a :=( 17 +( x div 30 ));
if s [ a ]. Font . Color = clBlue then begin
b := StrToInt ( Bahis . Text );
Bahis . Text := IntToStr ( b + 10 );
if b + 10 > 400 then Bahis . Text := '400' ;
s [ a ]. Font . Color := clRed ;
end ;
end
else begin
if y < 120 then
begin
a :=( 25 +( x div 30 ));
if s [ a ]. Font . Color = clBlue then begin
b := StrToInt ( Bahis . Text );
Bahis . Text := IntToStr ( b + 10 );
if b + 10 > 400 then Bahis . Text := '400' ;
s [ a ]. Font . Color := clRed ;
end ;
end
else begin
if y < 150 then
begin
a :=( 33 +( x div 30 ));
if s [ a ]. Font . Color = clBlue then begin
b := StrToInt ( Bahis . Text );
Bahis . Text := IntToStr ( b + 10 );
if b + 10 > 400 then Bahis . Text := '400' ;
s [ a ]. Font . Color := clRed ;
end ;
end ;
end ;
end ;
end ;
end ;
end
else begin
if button = mbRight then begin
if y < 30 then
begin
a :=( 1 +( x div 30 ));
if s [ a ]. Font . Color = clRed then begin
b := StrToInt ( Bahis . Text );
Bahis . Text := IntToStr ( b - 10 );
if b - 10 < 0 then Bahis . Text := '0' ;
s [ a ]. font . Color := clBlue ;
end ;
end
else begin
if y < 60 then
begin
a :=( 9 +( x div 30 ));
if s [ a ]. Font . Color = clRed then begin
b := StrToInt ( Bahis . Text );
Bahis . Text := IntToStr ( b - 10 );
if b - 10 < 0 then Bahis . Text := '0' ;
s [ a ]. font . Color := clBlue ;
end ;
end
else begin
if y < 90 then
begin
a :=( 17 +( x div 30 ));
if s [ a ]. Font . Color = clRed then begin
b := StrToInt ( Bahis . Text );
Bahis . Text := IntToStr ( b - 10 );
if b - 10 < 0 then Bahis . Text := '0' ;
s [ a ]. Font . Color := clBlue ;
end ;
end
else begin
if y < 120 then
begin
a :=( 25 +( x div 30 ));
if s [ a ]. Font . Color = clRed then begin
b := StrToInt ( Bahis . Text );
Bahis . Text := IntToStr ( b - 10 );
if b - 10 < 0 then Bahis . Text := '0' ;
s [ a ]. Font . Color := clBlue ;
end ;
end
else begin
if y < 150 then
begin
a :=( 33 +( x div 30 ));
if s [ a ]. Font . Color = clRed then begin
b := StrToInt ( Bahis . Text );
Bahis . Text := IntToStr ( b - 10 );
if b - 10 < 0 then Bahis . Text := '0' ;
s [ a ]. Font . Color := clBlue ;
end ;
end ;
end ;
end ;
end ;
end ;
end ;
end ;
end ;
procedure TForm1 . Button1Click ( Sender : TObject );
var
x , y , z , t , f : integer ;
b : variant ;
begin
Randomize ;
x := 1 + Random ( 40 );
Edit1 . Text := IntToStr ( x );
y := StrToInt ( Para . Text );
if y < 0 Then ShowMessage ( 'oyun bitti' )
else begin
if s [ x ]. Caption = intToStr ( x ) then
begin
for i := 1 to 8 do begin
Randomize ;
t := 1 + Random ( 40 );
end ;
if s [ x ]. Font . Color = clRed then
begin
b := StrToInt ( Bahis . Text );
Para . Text := IntToStr ( y +(( 40 / b )* 100 ));
if b = 400 then Para . Text := IntToStr ( y );
end
else begin
z := StrToInt ( Bahis . Text );
Para . Text := IntToStr ( y - z );
end ;
end ;
end ;
Label1 . Enabled := False ;
Button1 . Visible := False ;
Button2 . Visible := True ;
end ;
procedure TForm1 . Button2Click ( Sender : TObject );
begin
for i := 1 to 40 do
begin
s [ i ]. Font . Color := clBlue ;
end ;
Bahis . Text := '0' ;
Button1 . Visible := True ;
Button2 . Visible := False ;
Label1 . Enabled := True ;
end ;
procedure TForm1 . ParaChange ( Sender : TObject );
begin
Para2 . Text := Para . Text + ' $' ;
end ;
procedure TForm1 . bahisChange ( Sender : TObject );
begin
Bahis2 . Text := Bahis . Text + ' $' ;
end ;
procedure TForm1 . newgame1Click ( Sender : TObject );
begin
Button1 . Visible := True ;
Button2 . Visible := False ;
Para . Text := '1000' ;
Bahis . Text := '0' ;
Edit1 . Text := '0' ;
for i := 1 to 40 do begin
s [ i ]. Font . Color := clBlue ;
end ;
end ;
procedure TForm1 . Quit1Click ( Sender : TObject );
begin
Form1 . Close ;
end ;
end .
Delphi - .....................................
Alpha Form
Flashtaki gibi alpaha efektli form
Timer bileş eninin ontimer olay ı na yaz ı lacak kod :
var
x : integer ;
begin
form1 . alphablend := true ;
for x := 0 to 255 do
form1 . alphablendvalue := x + 10 ;
end ;
Delphi - .....................................
Tmediaplayer Ses Ayarlama
TMediaPlayer Kullanan bir uygulamada ses ayarı
uses
MPlayer , MMSystem ;
const
MCI_SETAUDIO = $0873 ;
MCI_DGV_SETAUDIO_VOLUME = $4002 ;
MCI_DGV_SETAUDIO_ITEM = $00800000 ;
MCI_DGV_SETAUDIO_VALUE = $01000000 ;
MCI_DGV_STATUS_VOLUME = $4019 ;
type
MCI_DGV_SETAUDIO_PARMS = record
dwCallback : DWORD ;
dwItem : DWORD ;
dwValue : DWORD ;
dwOver : DWORD ;
lpstrAlgorithm : PChar ;
lpstrQuality : PChar ;
end ;
type
MCI_STATUS_PARMS = record
dwCallback : DWORD ;
dwReturn : DWORD ;
dwItem : DWORD ;
dwTrack : DWORD ;
end ;
procedure SetMPVolume ( MP : TMediaPlayer ; Volume : Integer );
{ Volume: 0 - 1000 }
var
p : MCI_DGV_SETAUDIO_PARMS ;
begin
{ Volume: 0 - 1000 }
p . dwCallback := 0 ;
p . dwItem := MCI_DGV_SETAUDIO_VOLUME ;
p . dwValue := Volume ;
p . dwOver := 0 ;
p . lpstrAlgorithm := nil ;
p . lpstrQuality := nil ;
mciSendCommand ( MP . DeviceID , MCI_SETAUDIO ,
MCI_DGV_SETAUDIO_VALUE or MCI_DGV_SETAUDIO_ITEM , Cardinal (@ p ));
end ;
function GetMPVolume ( MP : TMediaPlayer ): Integer ;
var
p : MCI_STATUS_PARMS ;
begin
p . dwCallback := 0 ;
p . dwItem := MCI_DGV_STATUS_VOLUME ;
mciSendCommand ( MP . DeviceID , MCI_STATUS , MCI_STATUS_ITEM , Cardinal (@ p ));
Result := p . dwReturn ;
{ Volume: 0 - 1000 }
end ;
//örnek olarak
bir tane scrollbar ekleyip onchange olay ı na
SetMPVolume ( MediaPlayer1 , scrollbar1 . position );
dedi ğ iniz halde kayd ı rma ç ubu ğ u ile sesi k ı s ı p a ç abilirsiniz
Kolay gelsin
Dok ü man ı De ğ erlendirin . DE Ğ ERLEND İ R :
Delphi - .....................................
Timer Kullanımı
unit Unit7 ;
interface
uses
Windows , Messages , SysUtils , Variants , Classes , Graphics , Controls , Forms ,
Dialogs , StdCtrls , ExtCtrls ;
type
TForm1 = class ( TForm )
Timer1 : TTimer ;
Label1 : TLabel ;
Edit1 : TEdit ;
procedure Timer1Timer ( Sender : TObject );
procedure Edit1Change ( Sender : TObject );
procedure FormCreate ( Sender : TObject );
private
{ Private declarations }
public
{ Public declarations }
end ;
var
Form1 : TForm1 ;
flag : boolean ;
implementation
{$R *.dfm}
procedure TForm1 . Timer1Timer ( Sender : TObject );
var
strput : string ;
myfile : Textfile ;
begin
Assignfile ( myfile , 'fast.txt' );
Append ( myfile );
if Label1 . Caption = 'ON' then begin
Label1 . Caption := 'OFF' ;
end
else begin Label1 . Caption := 'ON' ;
end ;
while flag = true do begin
writeln ( myfile , Edit1 . Text );
flag := false ;
end ;
Closefile ( myfile );
end ;
procedure TForm1 . Edit1Change ( Sender : TObject );
begin
flag := true ;
end ;
procedure TForm1 . FormCreate ( Sender : TObject );
begin
flag := true ;
end ;
end .
Delphi - .....................................
Richedit ten RTF formatını okuma
RichEdit nesnesinin RichText ö zelli ğ ini okuyamazs ı n ı z .
Bu kod ile RichEdit nesnesinin alt ı nda yatan RTF kodlar ı n ı okuyabilir
ve bunu Wordpad dosyas ı olarak kaydedebilirsiniz ..
Function GetRTF ( RE : TRichedit ): string ;
Var
strStream : TStringStream ;
Begin
strStream := TStringStream . Create (") ;
Try
RE . PlainText := False ;
RE . Lines . SaveToStream ( strStream ) ;
Result := strStream . DataString ;
Finally
strStream . Free
End ;
End ;
Kullan ı m ı :
Memo1 . Text := GetRTF ( RichEdit1 );
Delphi - .....................................
Açılır kapanır forum
AÇ ILIR - KAPANIR FORM
İş yeri kepengine benzer bir sekilde a ç ilip kapanabilen bir form yaratmak i ç in
kullanilabilecek kod ö rnegi asagidadir . A ç ilma ve kapanma komutu , bu ö rnekte
baslik alani ü zerinde sag fare tusuna basilarak verilmektedir .
uses Printers , Buttons , ShellAPI ;
private
{ Private declarations }
FOldHeight : Integer ;
procedure WMNCRButtonDown ( var Msg : TWMNCRButtonDown );
message WM_NCRBUTTONDOWN ;
procedure TForm1 . FormCreate ( Sender : TObject );
begin
FOldHeight := ClientHeight ;
end ;
procedure TForm1 . WMNCRButtonDown ( var Msg : TWMNCRButtonDown );
var
I : Integer ;
begin
if ( Msg . HitTest = HTCAPTION ) then
if ( ClientHeight = 0 ) then
begin
I := 0 ;
while ( I < FOldHeight ) do begin
I := I + 40 ;
if ( I > FOldHeight ) then
I := FOldHeight ;
ClientHeight := I ;
Application . ProcessMessages ;
end ;
end
else
begin
FOldHeight := ClientHeight ;
I := ClientHeight ;
//kapanma efekti için, I degerini dogrudan "0" a esitlemek
//yerine kademeli olarak azaltabilirsiniz.
I := 0 ;
ClientHeight := I ;
Application . ProcessMessages ;
end ;
end ;
Delphi - .....................................
Yüzden geri sayım
00 den 0 a geri say ı m
100 den 0 a geri sayan program
procedure Delay ( ms : longint );
var TheTime : LongInt ;
begin
TheTime := GetTickCount + ms ;
while GetTickCount < TheTime do
Application . ProcessMessages ;
end ;
procedure TForm1 . Button1Click ( Sender : TObject );
var i , s : integer ;
begin
s := 100 ;
for i := 1 to 100 do begin
s := s - 1 ;
edit1 . Text := inttostr ( s );
Delay ( 1000 );
end ;
end ;
procedure TForm1 . Button2Click ( Sender : TObject );
begin
halt ;
end ;
procedure TForm1 . FormCreate ( Sender : TObject );
begin
edit1 . Text := '100' ;
end ;
Delphi - .....................................
