Programlama yapalım ve Öğrenelim.

Hayali Uretilen Buton Ve Editlere Nasıl Tuş Kombinasyonu Atanır

Aşağıdaki Örnek Kod ile Edit1 İçerisine Yazmış Olduğumuz Rakam Kadar Forma

Edit ile Buton Ekliyor

Yapmaya Çalıştığım İse Oluşturulan Bu Butonlara Tıklanması Sonucu

Program İçerisinde İstenilen Bir İşlemi Yapması

// Kısaca Bu Butonlara Buttonclick Edit'lerede Key Press Özelliği Atamaya

// Çalışıyorum Bana Bu Konuda Yardımcı Olursanız Sevinirim

// Umarım Aşağıdaki Kodlar Benim Gibi Yeni Başlayanlara Yardımcı Olur

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

var

basla,son:integer;

yazi:TEdit ;

buton:TButton ;

etiket:TLabel ;

begin

if key=char(13) then

begin

son:=strtoint(edit1.Text);

for basla:=1 to son do

begin

etiket:=TLabel.Create(self);//Forma Label Eklemek

etiket.Parent :=(self);

yazi:=TEdit.Create(self); //forma edit eklemek

yazi.Parent:=(self);

buton:=TButton.Create(self);

buton.Parent :=(self);

with buton do

begin

Left :=475;

Top:=(basla*30);

Width :=20;

Height :=19;

Caption:=IntToStr(basla-1);

Name :='buton'+IntToStr(basla);

end ;

with yazi do

begin

Left :=500;

Top:=(basla*30);

Name :='satir'+IntToStr(basla);

end ;

end;

Programlarınızda Ayrı Diller Kullanma

***Arladaşlar kod çalışmakta %100 denenmiştir zaten mantık işi çok kolay***

hemem 1 proje açıyoruz ve içine 2 label , 2 button ve 1 de memo koyuyoruz

* ve 2 adet dosya yapıyoruz 1.si "ing.lng" 2. si "tur.lng" ve 1. ile 2. satırlarına

birinin ingilizcesi birin de türkçesini yazısınız ve aşğıdakileri uygulayınız:

procedure TForm1.FormCreate(Sender: TObject);

begin

Button1.Caption := 'İngilizce';

Button2.Caption := 'Türkçe';

if FileExists('ing.lng') then begin

button1.Enabled := true;

end else

button1.Enabled := false;

if FileExists('tur.lng') then begin

button2.Enabled := true;

end else

button2.Enabled := false;

Memo1.Clear;

Memo1.Visible := false;

end;

procedure dilyukle;

begin

Form1.Label1.Caption := form1.Memo1.Lines.Strings[0];

Form1.Label2.Caption := form1.Memo1.Lines.Strings[1];

end;

procedure TForm1.Button1Click(Sender: TObject);

begin

memo1.Lines.LoadFromFile('ing.lng');

dilyukle;

end;

procedure TForm1.Button2Click(Sender: TObject);

begin

memo1.Lines.LoadFromFile('tur.lng');

dilyukle;

end;

end.

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

Kronometre Yapımı

unit Unit1;

interface

uses

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

Dialogs, ExtCtrls, Gauges;

type

TForm1 = class(TForm)

Gauge1: TGauge;

Gauge2: TGauge;

Timer1: TTimer;

Timer2: TTimer;

procedure FormCreate(Sender: TObject);

procedure Timer1Timer(Sender: TObject);

procedure Timer2Timer(Sender: TObject);

private

{ Private declarations }

public

{ Public declarations }

end;

var

Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);

var

saat,dakika,saniye,salise:word;

begin

with gauge1 do begin

minvalue:=0;

maxvalue:=60;

kind:=gkpie;

showtext:=True;

decodetime(now,saat,dakika,saniye,salise);

progress:=(saniye) mod 60;

end;

with gauge2 do begin

minvalue:=0;

maxvalue:=100;

kind:=gkpie;

showtext:=True;

progress:=0;

end;

procedure TForm1.Timer1Timer(Sender: TObject);

var

saat,dakika,saniye,salise:word;

begin

decodetime(now,saat,dakika,saniye,salise);

gauge1.Progress:=(saniye) mod 60;

gauge2.Progress:=0;

end;

procedure TForm1.Timer2Timer(Sender: TObject);

begin

gauge2.Progress:=(gauge2.Progress+5) mod 100;

end;

end.

Neoturk: Forum - "bmp dosyasini otomatik kucultmek"

15 Aralık 2005 13:31

bmp dosyasini otomatik kucultmek

delphide herhangi bir bmp dosyasını alıp istediğim pixel boyutlarında

küçültüp tekrar kayıt ettirmek istiyorum nasıl yapabilirim.

kc_Ak

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

aşağıdaki kodlarla yapabilirsin ancak aynı şeyi jpeg türü dosyalar

içinde yapmak istersen http://b-yaz.blogspot.com

adresinde gerekli kodları bulabilirsin. kolay gelsin

procedure ResimBoyutlandir(Yol:string; KaydedilecekYol:string; yukseklik:integer; genislik:integer);

var

bmp : TBitmap;

bmp1 : TBitmap;

XRect : TRect;

begin

bmp := TBitmap.Create;

bmp1 := TBitmap.Create;

bmp.LoadFromFile(Yol);

bmp1.Height := yukseklik;

bmp1.Width := genislik;

XRect := Rect(0, 0, genislik, yukseklik);

bmp1.Canvas.StretchDraw(XRect,bmp);

bmp1.SaveToFile(KaydedilecekYol);

bmp.Free;

bmp1.Free;

end;

procedure TForm1.Button1Click(Sender: TObject);

begin

ResimBoyutlandir('c:resim.bmp','d:baskaresim.bmp',600,600);

end;

dijital_k

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

dijital_k arkadaşımıza teşekkürler.......

koda yorum eklemek istiyorum,

istenilen pixel boyutlarında resmi küçültme istediğine karşın

yukarıdaki kod örneği doğrudur, ancak, yatay ve dikey genişlik otomatik

olarak oranlanmadığı için, orjinal resme duyarlı bir orantılama yapmaz.

verilecek olan sayılar, orjinal resmin ebat-boyutu ile doğru orantılı

olmak zorundadır, daha sağlıklı olur düşüncesindeyim.

kodu şu şekilde değiştiriyorum:

procedure ResimBoyutlandir(Yol,KaydedilecekYol:string; oran:real);

var

orjinal : TBitmap;

yeni : TBitmap;

XRect : TRect;

y,g:integer;

begin

orjinal := TBitmap.Create;

yeni := TBitmap.Create;

orjinal.LoadFromFile(Yol);

y:=trunc(orjinal.Height*oran);g:=trunc(orjinal.Width*oran);

yeni.Height :=y;

yeni.Width :=g;

XRect := Rect(0, 0, g, y);

yeni.Canvas.StretchDraw(XRect,orjinal);

yeni.SaveToFile(KaydedilecekYol);

yeni.Free;

orjinal.Free;

end;

procedure TForm1.Button1Click(Sender: TObject);

begin

ResimBoyutlandir('C:deneme.bmp','c:deneme_oran_0-8.bmp',0.8);//0.8 kat

ResimBoyutlandir('C:deneme.bmp','c:deneme_oran_1-0.bmp',1);//1 kat

ResimBoyutlandir('C:deneme.bmp','c:deneme_oran_1-5.bmp',1.5);//1.5 kat

end;

kolay gelsin.........

saygılarımla_

neoturk_

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

Neoturk: Forum - "excel hakkında uzmanlık sorusu"

15 Aralık 2005 13:25

Excelle Delpiden Erişen Arkadaşlara Uzmanlık Sorusu

Kodbanktan veya başka kaynaklardan excele veri aktarmayla

ilgili bir çok kaynak var. ama benim yapmak istediğim

şey daha basit ama bir türlü yapamadım.

sorun şu:

opendialog ile bir excell dosyası alıyorum.

bunun içindeki sayfaların (sheet) listesini almak isitiyorum

kaçtane sayfa varsa sadece adlarını nasıl alabilirim.

ilgilenen herkese teşekkürler.

hurtik

cevap:

öncelikle sorduğunuz güzel soru için teşekkür ederim,

lütfen sorunuza asla "basit" anlamı kullanmayınız....

sorduğunuz soru "bilgiye dayalı" bir sorudur.

kodu yazıyorum:

(sormuş olduğunuz soruya basit dediğiniz için

daha fazla aklıma gelen kod ilavelerini yazmayacağım)

forma 1 adet button 1 adet memo1 yerleştirin:

//...written by neoturk 16.12.2005

procedure excel_sayfalarini_goster(dosyaadi:string;xmemo:Tmemo);

var a:variant;m:integer;

begin

xmemo.Clear;

xmemo.Lines.add('Dosya adı='+dosyaadi);

a:=CreateOleObject('Excel.Application');

if fileexists(dosyaadi)=false then

begin

xmemo.Lines.add('dosya bulunamadı');

exit;

end;

a.workbooks.open(dosyaadi);

a.visible := false;

xmemo.lines.add('Sayfa sayısı = '+inttostr(a.sheets.count));

for m:=1 to a.sheets.count do xmemo.lines.add(a.workbooks[1].worksheets[m].Name);

a.workbooks.close;

//final

end;

procedure TForm1.Button1Click(Sender: TObject);

begin

//deneme.xls dosyasının sayfalarının isimlerini memo1 içine göster

excel_sayfalarini_goster('c:deneme.xls',memo1);

end;

kolay gelsin........

saygılarımla_

neoturk_

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

Neoturk: Forum - "SQL yazmayla ilgili"

14 Aralık 2005 22:11

Slm beyler sorun delphi de SQL yazmayla ilgili

SQL text i yazarken içerde (' ') işareti kullanmam gerekiyo

ama ben tırnağı açtığım zaman ilk tırnağı kapattım sanıyo

'SELECT * FROM tablo WHERE alan1 like '%a%''

sorgusunu nasıl yazabilirim. ilgilenenlere teşekkürler.

Programmer_18

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

Örneğin QuotedStr('aaa') yazdığında delphi bunu SQL 'e tırank içinde gönderiyor.

'SELECT * FROM tablo WHERE alan1 like '+ QuotedStr('%aaa%')

Karahan1453

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

Saol kardeş ilgilendiğin için. Bu bana komik bi sorun gibi gelmişti

ama böyle bi çözümü olduğunu tahmin etmiştim. tekrar teşekkürler.

Programmer_18

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

cevap:

karahan1453 arkadaşımıza teşekkürler..........

not: tek tırnak kullanmanız gereken yerlerde çift tırnak kullanabilirsiniz.

aşağıdaki örnekleri inceleyiniz....

Bu konuda fazlaca döküman ve kod örneği görebilirsiniz kodbank içerisinde.

Kullandığınız veritabanı Paradox olsun Access olsun farketmez,

sql cümlecikleri hepsinde geçerlidir.

dbgrid,table ve datasource ayarlarınızı yaptığınızı varsayıyorum.

( dbgridin datasource = datasource1 olarak yaptınız vs vs ... )

verdiğiniz tablo adı ve kolonunuza göre sql cümlecikleri şunlar olabilir:

1) SELECT * FROM CARI WHERE C_ADI ="neoturk"

> c_adı neoturk olanları listeler.

2) SELECT * FROM CARI WHERE C_ADI ="neoturk" ORDER BY C_ADI ASC

> c_adı neoturk olanları listeler ve c_adi kolonuna göre sıralar.

ASC - Adan Zye doğru sıralar

DESC - Zden Aya doğru sıralar

3) SELECT * FROM CARI WHERE C_ADI like "neoturk*"

> c_adı neoturk ile başlayanları listeler. ( * kullandım dikkat )

ORDEY BY ... kullanabilirsiniz, süsleyebilirsiniz.

4) SELECT * FROM CARI WHERE C_ADI like "%neoturk%"

> c_adı içerisinde neoturk geçenleri listeler ( % kullandım dikkat )

ORDEY BY ... kullanabilirsiniz, süsleyebilirsiniz.

5) 'SELECT * FROM CARI WHERE C_ADI like "'+edit1.text+'*"'

> c_adı edit1 hücresindeki hece ile başlayanları listeler.

...

sql cümlelerinde karşılaşılan tek tırnak ( ' ) problemi vardır,

bunu 2 şekilde önleyebilirsiniz,

#39 kullanarak ( 39 nolu ascii karakterin karşılığı tirnaktir )

" ( tab tuşunun üzerindeki tuşda bulunan çifttırnak kullanarak )

örnekler:

sqlcumle:='SELECT * FROM CARI WHERE C_ADI like "'+edit1.text+'*"' ( doğrudur )

sqlcumle:='SELECT * FROM CARI WHERE C_ADI like '+#39+edit1.text+'*'+#39 ( doğrudur )

sqlcumle:='SELECT * FROM CARI WHERE C_ADI like ''+edit1.text+'*'' ( yanlıştır )

sqlcumle:='SELECT * FROM CARI WHERE C_ADI like '''+edit1.text+'*''' ( doğrudur )

hangi yöntem size kolay geliyor ise onu kullanınız.

ben şahsen çifttırnak ( " ) olanı tercih ediyorum, kodlama karışmıyor o zaman...

access de sql cümleciklerini şöyle kullanabilirsin:

...

adoquery1.sql.text:=sqlcumle;//cümleyi ata

adoquery1.sql.open;//çalıştır, göster

( ilgili dbgrid üzerinde gösterecektir )

...

kolay gelsin........

saygılarımla_

neoturk_

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

Neoturk: Forum -"querydeki seçili alanların silinmesi"

14 Aralık 2005 19:23

tdbgrid ve SQL ile silme hakkında yardım

selam arkadaşlar,

tdbgrid içine listelettiğim kayıtları tek tek seçerek ve

SQL ile table den nasıl silebilirim. konu ile ilgili

SQL kodunu yazarsanız sevinirim.

delete komutunu kullandım fakat seçtiğim alanadaki tüm kayıtları siliyor.

ben sadece seçilen kayıtların silinmesini sağlayan SQL kodunu istiyorum.

saygı ve seviglerimle hoşçakalın...

memolipascal

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

tablo adı tablox varsayalım ve sira_no diye bir alanı olsun.

Dbgrid in bağlı olduğu nesne de Query1 olsun.

Query2.close;

Query2.sql.clear;

Query2.sql.add(DELETE FROM tablox WHERE sira_no='+Query1.fieldbyname('sira_no').asstring);

Query2.execSQL;

Karahan1453

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

çok teşekkür ederim de

Query2 ifadesini neden kullandığını anlayamadım kodlamada hata olabilirmi saygılar..

memolipascal

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

15 Aralık 2005 14:06

Query1 de listeleme işlemini , Query2de de silme işlemini yaptırmak için.

Yani iki farklı işlem için iki tane Query koydum.

Bir tanede koyabilirsin tabiki.Ama sildikten sonra listeleme için

gerekli SQL satırını tekrar yazmalısın.

Karahan1453

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

merhaba,

karahan1453 arkadaşımıza teşekkürler...

memolipascal, görüyorum ki veri tabanına hemen uyum sağlamaya başlamışsın.

güzel...

sorunun cevabını daha kısa bir kod ile çözümleyebiliriz:

query1 sorgu sonuçlarındaki seçili olan kayıtları silmek için

şunları yaptırman gerekiyor:

query1 in ilişkilendirildiği dbgrid nesnesinin özelliklerinden,

options sekmesine gir, multiselect özelliğine true değeri ata.

(çoklu seçim yapmasına izin verdirmek için)

gerekirse rowselect özelliğine de true değeri ata.

//...written by neoturk 16.12.2005

//kaç adet seçili satır olduğunu öğrenmek için

showmessage'seçili satır sayısı = '+inttostr(dbgrid1.SelectedRows.Count));

//seçili olan satırların hepsini silmek için

dbgrid1.SelectedRows.Delete; //veri tabanında siler

(ben bu yöntemi kullanıyorum, kod kalabalığı başka yerlerde gerekli...)

bu kadar...........

kolay gelsin_

saygılarımla_

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

Neoturk: Forum - "memo içindeki verileri sıralamak"

14 Aralık 2005 19:20

MEMO İÇİNDE SIRALAMA

Arkadaşlar öncelikle herkese merhaba şimdi benim sorunum şu

bi memo içinde bulunan değerleri alfbetik veya küçükten büyüğe doğru

sıralamam gerek... yani kısacası memonun içindeki değerleri

nasıl sıralarım yardım edeenlere şimdiden teşekkürler...

herkese kolay gelsin...

LeWo

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

15 Aralık 2005 01:03

Önce memo dakileri sorted özelliği true olan bir listbox a atıp onları

tekrar memo içine alabilirsin.

Karahan1453

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

cevap:

sıralama kodları ile ilgili örnekleri önceki yazılarımda göndermiştim.

bakınız: "listbox içindeki elemanları sıralamak"

memo içindeki verileri sıralatıp tekrar aynı memo içerisine

aktarmak için aşağıya gereken kodu yazıyorum......

forma 1 adet memo(içine bilgiler giriniz), 1 adet button yerleştiriniz.

//...written by neoturk - 16.12.2005

procedure sirala(xmemo:Tmemo;tur:string);

var tx:tstringlist;m:integer;

begin

tx:=tstringlist.Create;

tx.Text:=xmemo.Text;

tx.Sort;xmemo.Clear;

if tur='duz' then

xmemo.Text:=tx.Text

else

begin

for m:=tx.Count-1 downto 0 do xmemo.Lines.add(tx.Strings[m]);

end;

tx.Free;

//final

end;

procedure TForm1.Button1Click(Sender: TObject);

begin

sirala(memo1,'duz');

//sirala(memo1,'ters');

end;

not: Lewo arkadaşım, gördüğüm kadarı ile hala kendini geliştirmiyorsun.

önceki sorduğun sorulara nispeten bu sorduğun soru beni açıkçası üzdü...

ki senin bunu yazabiliyor olabilmen gerekiyor idi....

şu ana kadar sormuş olduğun sorulara bakarak bu yorumumu yaptım.

kodlama mantığını geliştir,

daldan dala sıçrıyorsun.........

kolay gelsin......

saygılarımla_

neoturk_

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

Neoturk: Forum - "Memo satırlarından bilgi almak"

14 Aralık 2005 09:32

Memo satırlarından bilgi almak

Kolay gelsin arkadaşlar.

Yapamadığım şey Memo satırlarından mesela

6. satırdaki yazının ilk 5 kelimesini silip geri

kalanını labele aktarmak. çok araştırdım fakat bir

türlü yolunu bulamadım. Yardımlarınızı bekliyorum. Çok teşekkürler.

bilmor

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

14 Aralık 2005 18:02

memoda satirlar 0. satirdan baslar

var str : String ;

begin

str := Copy(Memo.Lines[5],6,Length(Memo.Lines[5]-5) );

Label.caption := str;

end;

burada ben 6. harften basladim kelime icin kac kelime oldugu vs..

bilgisini alman lazim ornek olarak bosluk lari sayarak kac kelime

oldugunu anlaya bilirsin 6 harfden itibaren oldugunu varsayarak

yukaridaki ornegi yazdim kolay gelsin

ziya69

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

cevap:

ziya69 arkadaşımıza verdiği cevap için teşekkürler....

kodu biraz daha esnek hale getirmek istiyorum,

forma 1 adet memo, 1 adet button yerleştiriniz,

//...written by neoturk - 16.12.2005

procedure goster(xmemo:Tmemo;satir_index,baslangic:integer;xlabel:Tlabel);

var x:string;

begin

x:=xmemo.Lines[satir_index];

xlabel.Caption:=copy(x,baslangic,999);

end;

procedure TForm1.Button1Click(Sender: TObject);

begin

memo1.clear;

memo1.Height:=200;

memo1.Width:=500;

memo1.lines.Add('merhaba');

memo1.lines.Add('bu bir delphi çalışmasıdır');

memo1.lines.Add('amaç esnek bir procedure yazarak');

memo1.lines.Add('istenilen bir memo içerisindeki');

memo1.lines.Add('istenilen satırdaki');

memo1.lines.Add('başlangıç yerinden itibaren geri kalan satırları');

memo1.lines.Add('istenilen label içerisine yazdırmak');

memo1.lines.Add('delphi programlama kolaydır ve bol pratik ister');

memo1.lines.Add('neoturk');

//memo1'in 8.satırının(7 nolu index) 8.karakterinden itibaren olan yeri

//label1 içine yaz.

goster(memo1,7,8,label1);

//goster(memo9,7,8,label23); //gibi....

end;

kolay gelsin..........

saygılarımla_

neoturk_

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

Neoturk: Forum - "Memo satırlarından bilgi almak"

14 Aralık 2005 09:32

Memo satırlarından bilgi almak

Kolay gelsin arkadaşlar.

Yapamadığım şey Memo satırlarından mesela

6. satırdaki yazının ilk 5 kelimesini silip geri

kalanını labele aktarmak. çok araştırdım fakat bir

türlü yolunu bulamadım. Yardımlarınızı bekliyorum. Çok teşekkürler.

bilmor

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

14 Aralık 2005 18:02

memoda satirlar 0. satirdan baslar

var str : String ;

begin

str := Copy(Memo.Lines[5],6,Length(Memo.Lines[5]-5) );

Label.caption := str;

end;

burada ben 6. harften basladim kelime icin kac kelime oldugu vs..

bilgisini alman lazim ornek olarak bosluk lari sayarak kac kelime

oldugunu anlaya bilirsin 6 harfden itibaren oldugunu varsayarak

yukaridaki ornegi yazdim kolay gelsin

ziya69

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

cevap:

ziya69 arkadaşımıza verdiği cevap için teşekkürler....

kodu biraz daha esnek hale getirmek istiyorum,

forma 1 adet memo, 1 adet button yerleştiriniz,

//...written by neoturk - 16.12.2005

procedure goster(xmemo:Tmemo;satir_index,baslangic:integer;xlabel:Tlabel);

var x:string;

begin

x:=xmemo.Lines[satir_index];

xlabel.Caption:=copy(x,baslangic,999);

end;

procedure TForm1.Button1Click(Sender: TObject);

begin

memo1.clear;

memo1.Height:=200;

memo1.Width:=500;

memo1.lines.Add('merhaba');

memo1.lines.Add('bu bir delphi çalışmasıdır');

memo1.lines.Add('amaç esnek bir procedure yazarak');

memo1.lines.Add('istenilen bir memo içerisindeki');

memo1.lines.Add('istenilen satırdaki');

memo1.lines.Add('başlangıç yerinden itibaren geri kalan satırları');

memo1.lines.Add('istenilen label içerisine yazdırmak');

memo1.lines.Add('delphi programlama kolaydır ve bol pratik ister');

memo1.lines.Add('neoturk');

//memo1'in 8.satırının(7 nolu index) 8.karakterinden itibaren olan yeri

//label1 içine yaz.

goster(memo1,7,8,label1);

//goster(memo9,7,8,label23); //gibi....

end;

kolay gelsin..........

saygılarımla_

neoturk_

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

Neoturk: Forum - "yazıya göre renkli richedit"

14 Aralık 2005 02:07

Richedit

richedit'e her karakter girişinde yazıyı kontrol ederek renklendirmesini

istiyorum, mesela

'delphi' yazarsam richeditte anında "delphi" yazısı kırmızı renke dönüşecek

'borland' yazarsam richeditte anında "borland" yazısı yeşil renke dönüşecek gibi..

shafack

cevap:

merhaba,

güzel sorunuz için teşekkür ederim.

forma 1 adet richedit 1 adet button yerleştiriniz.

//...written by neoturk - 16.12.2005

procedure TForm1.Button1Click(Sender: TObject);

const ozel_kelime_sayisi=7;

var

ozel_kelimeler:array[1..ozel_kelime_sayisi] of string;

ozel_renkler:array[1..ozel_kelime_sayisi] of integer;

posx,m,n:integer;x:string;

function toplam(sonsatir:integer):integer;

var t,m:integer;

begin

t:=0;

for m:=sonsatir downto 0 do t:=t+length(richedit1.lines[m])+2;

result:=t;

//final

end;

begin

m:=1;ozel_kelimeler[m]:='neoturk ';ozel_renkler[m]:=clred;

m:=2;ozel_kelimeler[m]:='delphi ';ozel_renkler[m]:=clgreen;

m:=3;ozel_kelimeler[m]:='programlama ';ozel_renkler[m]:=clblue;

m:=4;ozel_kelimeler[m]:='praktik ';ozel_renkler[m]:=clred;

m:=5;ozel_kelimeler[m]:='çalışması ';ozel_renkler[m]:=claqua;

m:=6;ozel_kelimeler[m]:='byte ';ozel_renkler[m]:=cllime;

m:=7;ozel_kelimeler[m]:='function';ozel_renkler[m]:=clpurple;

richedit1.Clear;

richedit1.Lines.add('delphi richeditte nasıl renkli satırlar yapabiliriz');

richedit1.Lines.add('bu örnek bir praktik çalışmasıdır');

richedit1.Lines.add('amacım özel kelimeleri renklendirmektir');

richedit1.Lines.add('algoritması kolay bir çalışmadır');

richedit1.Lines.add('programlama deneyimini geliştirir');

richedit1.Lines.add('tek dikkat edilecek olan nokta');

richedit1.Lines.add('toplam functionundaki +2 sayısının eklenmiş olmasıdır');

richedit1.Lines.add('çünkü satır sonu özel karakteri 2 byte yer kaplar.');

richedit1.Lines.add('1 byte demek 1 karakter demektir.');

richedit1.Lines.add('ayrıca özel kelimeler dizisindeki');

richedit1.Lines.add('boşluk durumu tercihe bırakılmıştır.');

richedit1.Lines.add('örnek olarak function kelimesinde boşluk yoktur');

richedit1.Lines.add('functionel örneğinde olduğu gibi....');

richedit1.Lines.add('neoturk delphi programcısıdır');

for m:=0 to richedit1.Lines.Count-1 do

begin

x:=richedit1.Lines[m];

for n:=1 to ozel_kelime_sayisi do

begin

posx:=pos(ozel_kelimeler[n],x);

if posx>0 then

begin

richedit1.SelStart:=toplam(m-1)+posx-1;

richedit1.SelLength:=length(ozel_kelimeler[n]);

with richedit1.SelAttributes do

Color := ozel_renkler[n];

end;

//final

end;

yazı yazma anında renklendirmek için richeditin keypress olayından

faydalanabiliriz. bu durumda akıllı bir sorgulama-renklendirme motoru yazmak

gerekiyor. bunu şu anda aklımdan yazdım ama vaktim az olduğu için başka

bir zamana bırakıyorum.

bu örneği geliştirerek kendinize göre düzenleyiniz....

saygılarımla_

neoturk_

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

Neoturk: Forum - "yazıya göre renkli richedit"

14 Aralık 2005 02:07

Richedit

richedit'e her karakter girişinde yazıyı kontrol ederek renklendirmesini

istiyorum, mesela

'delphi' yazarsam richeditte anında "delphi" yazısı kırmızı renke dönüşecek

'borland' yazarsam richeditte anında "borland" yazısı yeşil renke dönüşecek gibi..

shafack

cevap:

merhaba,

güzel sorunuz için teşekkür ederim.

forma 1 adet richedit 1 adet button yerleştiriniz.

//...written by neoturk - 16.12.2005

procedure TForm1.Button1Click(Sender: TObject);

const ozel_kelime_sayisi=7;

var

ozel_kelimeler:array[1..ozel_kelime_sayisi] of string;

ozel_renkler:array[1..ozel_kelime_sayisi] of integer;

posx,m,n:integer;x:string;

function toplam(sonsatir:integer):integer;

var t,m:integer;

begin

t:=0;

for m:=sonsatir downto 0 do t:=t+length(richedit1.lines[m])+2;

result:=t;

//final

end;

begin

m:=1;ozel_kelimeler[m]:='neoturk ';ozel_renkler[m]:=clred;

m:=2;ozel_kelimeler[m]:='delphi ';ozel_renkler[m]:=clgreen;

m:=3;ozel_kelimeler[m]:='programlama ';ozel_renkler[m]:=clblue;

m:=4;ozel_kelimeler[m]:='praktik ';ozel_renkler[m]:=clred;

m:=5;ozel_kelimeler[m]:='çalışması ';ozel_renkler[m]:=claqua;

m:=6;ozel_kelimeler[m]:='byte ';ozel_renkler[m]:=cllime;

m:=7;ozel_kelimeler[m]:='function';ozel_renkler[m]:=clpurple;

richedit1.Clear;

richedit1.Lines.add('delphi richeditte nasıl renkli satırlar yapabiliriz');

richedit1.Lines.add('bu örnek bir praktik çalışmasıdır');

richedit1.Lines.add('amacım özel kelimeleri renklendirmektir');

richedit1.Lines.add('algoritması kolay bir çalışmadır');

richedit1.Lines.add('programlama deneyimini geliştirir');

richedit1.Lines.add('tek dikkat edilecek olan nokta');

richedit1.Lines.add('toplam functionundaki +2 sayısının eklenmiş olmasıdır');

richedit1.Lines.add('çünkü satır sonu özel karakteri 2 byte yer kaplar.');

richedit1.Lines.add('1 byte demek 1 karakter demektir.');

richedit1.Lines.add('ayrıca özel kelimeler dizisindeki');

richedit1.Lines.add('boşluk durumu tercihe bırakılmıştır.');

richedit1.Lines.add('örnek olarak function kelimesinde boşluk yoktur');

richedit1.Lines.add('functionel örneğinde olduğu gibi....');

richedit1.Lines.add('neoturk delphi programcısıdır');

for m:=0 to richedit1.Lines.Count-1 do

begin

x:=richedit1.Lines[m];

for n:=1 to ozel_kelime_sayisi do

begin

posx:=pos(ozel_kelimeler[n],x);

if posx>0 then

begin

richedit1.SelStart:=toplam(m-1)+posx-1;

richedit1.SelLength:=length(ozel_kelimeler[n]);

with richedit1.SelAttributes do

Color := ozel_renkler[n];

end;

//final

end;

yazı yazma anında renklendirmek için richeditin keypress olayından

faydalanabiliriz. bu durumda akıllı bir sorgulama-renklendirme motoru yazmak

gerekiyor. bunu şu anda aklımdan yazdım ama vaktim az olduğu için başka

bir zamana bırakıyorum.

bu örneği geliştirerek kendinize göre düzenleyiniz....

saygılarımla_

neoturk_

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

Neoturk: Forum - "tray icon"

15 Aralık 2005 19:56

Herkese Merhaba

Benim bir sorunum var

formu tray icon atıyorum,mouse ayarlarını yapıyorum fakat

programım açılışta tray icon yerleşsin ve form görünmesin istiyorum

baktığım örneklerde form1.visible:=False yazılmış ama bende işe yaramıyor

yada ben beceremedim.

Kısaca program açılışta direkt tray icon'a gidecek ve

ana form gözükmeyecek nasıl yaparım.

Şimdiden teşekkürler

fatoş2

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

Bugün 02:36

bence kod sıralamasında yanlış yapıyon ki

form tray e indikten sonra form da görünmez hale geliyosa.

yada direct formun properies inden visible ını false yapara dene.

umarım yardımcı olabilmişimdir.

kolay gelsin...

umutumsu

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

dediğinizi denedim olmadı.

kodumda böyle

SetWindowLong(Application.Handle, GWL_EXSTYLE, WS_EX_TOOLWINDOW);

BorderIcons := [biSystemMenu];

with IconNotifyData do

begin

hIcon := Application.Icon.Handle;

uCallbackMessage := WM_USER + 1;

cbSize := sizeof(IconNotifyData);

Wnd := Handle;

uID := 100;

uFlags := NIF_MESSAGE + NIF_ICON + NIF_TIP;

sztip:='Program Tray Üzerinde';

end;

StrPCopy(IconNotifyData.szTip, Application.Title);

Shell_NotifyIcon(NIM_ADD, @IconNotifyData);

Form1.Visible:=False;

ama çalıştıramıyorum

fatoş2

cevap:

merhaba,

aşağıdaki şekilde bir uygulama yapınız

- form üzerine popupmenu1 dizayn ediniz.

- 4 tanem itemi olsun. formugizle,formugöster,merhaba,çıkış

//...written by neoturk - 16.12.2005

var

Form1: TForm1;

stray:NOTIFYICONDATA;

implementation

{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);

begin

SetWindowLong(Application.Handle, GWL_EXSTYLE, WS_EX_TOOLWINDOW);

with stray do

begin

cbsize:=sizeof(stray);

wnd:=form1.handle;

hicon:=Application.icon.Handle;

uID:=0;

sztip:='deneme tray icon';

uflags:=7;

uCallBackMessage:=$200;

end;

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

Y: Integer);

var nokta:TPoint;

begin

getCursorPos(nokta);

if (x=$205) then PopupMenu1.Popup(nokta.x,nokta.y);{popup1 i çalıştır}

end;

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

begin

Shell_NotifyIcon(2,@stray);{tray ikonu gizle}

end;

procedure TForm1.FormHide(Sender: TObject);

begin

shell_notifyicon(0,@stray){tray ikonu göster}

end;

procedure TForm1.FormShow(Sender: TObject);

begin

Shell_NotifyIcon(2,@stray);{tray ikonu gizle}

end;

procedure TForm1.formugizle1Click(Sender: TObject);

begin

form1.Hide;

end;

procedure TForm1.formugster1Click(Sender: TObject);

begin

form1.Show;

end;

procedure TForm1.merhabafatode1Click(Sender: TObject);

begin

showmessage('merhaba fatoş');

end;

procedure TForm1.programdank1Click(Sender: TObject);

begin

form1.Close;

end;

not: açılışta formun "oncreate" olayında "direkt olarak"

visible özelliğini kullanarak formu gizleyemezsiniz.

bunu farklı bir kod ile yapmanız gerekiyor.

diğer bir yöntem ise bir timer yerleştirin, 1salise sonra formu

gizlemesini söyleyin.timer1i kapatın. bu da başka bir çözüm yoludur.

formun "oncreate" olayına aşağıdaki kodu kullanınız:

//gerçek gizlemek için

setwindowlong(application.handle,GWL_EXSTYLE,WS_EX_TOOLWINDOW);

application.showmainform:=false;

form1.Hide;

//sahte gizlemek için

form1.top:=-100;

form1.left:=-100;

form1.width:=0;

form1.height:=0;

sahte gizleme yaparsanız trayicon ile birlikte rahatlıkla kullanabilirsiniz.

formun onshow olayına form1.top-left-width-height ayarlarını eski haline

dönüştürmeniz gerekiyor. bunun içinde başlangıçtaki orjinal değerleri

bir değişken serisinde saklayınız. gizlerken tekrar sahte gizleme yapabilirsiniz.

gerçek gizleme yaparken trayiconu beraberinde "oncreate" olayında kullanamazsınız.

program açıldıktan form gösterildikten sonra istekleriniz yerine getirilir.

(formu gizle-göster özellikleri form gösterildikten sonra çalışır)

tercihinize göre uygun kombinasyonları kodlayınız............