Programlama yapalım ve Öğrenelim.

URLLabel

{Ekleyen : Wolverine }

{Web Sayfalarındaki Linkler'e Benzeyen Bir Label

İşinize Yarayabilir

mUrlLabel.pas adında bir dosya oluşturun ve aşağıdaki kodları yapıştırın.

Daha sonra delphi'ye yükleyin. }

unit mUrlLabel;

interface

uses

Windows, Messages, SysUtils, Classes, Forms, StdCtrls, ShellAPI,

Controls, Graphics;

{$IFDEF VER90} //if Delphi2, define new cursor type, Delphi 3 has this built-in

const

crHandPoint = 5;

{$ENDIF}

type

TmUrlLabel = class(TLabel)

private

FURL: string;

OrigFontColor,

FActiveColor: TColor;

procedure SetURL(const NewURL: string);

public

constructor Create(AOwner: TComponent); override;

procedure Click; override;

procedure CMMouseEnter(var Msg: TWMMouse); message CM_MOUSEENTER;

procedure CMMouseLeave(var Msg: TWMMouse); message CM_MOUSELEAVE;

published

property URL: string read FURL write SetURL;

property ActiveColor: TColor read FActiveColor write FActiveColor default clPurple;

property Cursor default crHandPoint;

end;

procedure Register;

implementation

{$IFDEF VER90} //link "hand" cursor resource only if Delphi 2, since 3 has it already built-in

{$R mUrlLabel.res}

{$ENDIF}

{---------------------------------------------------------------------------}

constructor TmUrlLabel.Create(AOwner: TComponent);

begin

inherited Create(AOwner);

{$IFDEF VER90}

Screen.Cursors[crHandPoint] := LoadCursor(HInstance, PChar('HANDCUR'));

{$ELSE}

Layout := tlCenter;

{$ENDIF}

Cursor := crHandPoint;

FActiveColor := clPurple;

with Font do begin

Color := clBlue;

Style := [fsUnderline, fsBold];

end;

{---------------------------------------------------------------------------}

procedure TmUrlLabel.Click;

var

TempURL: string;

begin

inherited Click;

if Trim(FURL) = '' then

TempURL := Trim(Caption)

else

TempUrl := Trim(FURL);

if TempURL <> '' then

ShellExecute(GetDesktopWindow(), 'open', PChar(TempURL), nil, nil, SW_SHOWNORMAL);

end;

{---------------------------------------------------------------------------}

procedure TmUrlLabel.CMMouseEnter(var Msg: TWMMouse);

begin

inherited;

OrigFontColor := Font.Color;

Font.Color := FActiveColor;

end;

{---------------------------------------------------------------------------}

procedure TmUrlLabel.CMMouseLeave(var Msg: TWMMouse);

begin

inherited;

Font.Color := OrigFontColor;

end;

{---------------------------------------------------------------------------}

procedure TmUrlLabel.SetURL(const NewURL: string);

begin

FURL := NewURL;

//if we have default caption (control name), then use new URL as caption

if Caption = Name then Caption := NewURL;

end;

{---------------------------------------------------------------------------}

procedure Register;

begin

RegisterComponents('Moon', [TmUrlLabel]);

end;

{---------------------------------------------------------------------------}

end.

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

DBASE Dosyası Yarat (Versiyon-İndexli)

DBASE Dosyası Yarat (Versiyon-İndexli)

// Hazırlayan Cengiz IŞILDAR

// cisildar@hotmail.com / cisildar@yahoo.com

uses

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

Dialogs, StdCtrls, ExtCtrls, DBCtrls, Mask, DB, DBTables, bde, Menus;

type

TForm2 = class(TForm)

{ DBEdit2: TDBEdit; // bu alanalar hazırladığım programla ilgili

DBEdit3: TDBEdit;

DBEdit4: TDBEdit;

DBEdit5: TDBEdit;

DBEdit6: TDBEdit;

Bevel1: TBevel;

DBEdit7: TDBEdit;

DBEdit8: TDBEdit;

DBEdit9: TDBEdit;

DBEdit10: TDBEdit;

DBEdit11: TDBEdit;

DBEdit12: TDBEdit;

Bevel2: TBevel;

DBEdit13: TDBEdit;

DBEdit14: TDBEdit;

DBEdit15: TDBEdit;

DBEdit16: TDBEdit;

Label1: TLabel;

Label2: TLabel;

Label3: TLabel;

Label4: TLabel;

Label5: TLabel;

Label6: TLabel;

Label7: TLabel;

Label8: TLabel;

Label9: TLabel;

Label10: TLabel;

Label11: TLabel;

Label12: TLabel;

DBEdit17: TDBEdit;

DBEdit18: TDBEdit;

Label13: TLabel;

Label14: TLabel;

Label15: TLabel;

Label16: TLabel;

Label17: TLabel;

Label18: TLabel;

Label19: TLabel;

Label20: TLabel;

Label21: TLabel;

Label22: TLabel;

DBEdit19: TDBEdit;

DBEdit20: TDBEdit;

Label23: TLabel;

Label24: TLabel;

Label25: TLabel;

Bevel3: TBevel;

DBText1: TDBText;

DataSource1: TDataSource;

DBMemo1: TDBMemo;

DBNavigator1: TDBNavigator;

DBMemo2: TDBMemo;

DBMemo3: TDBMemo;} /// bu bölümler sizi ilgilendirmez

/// hazırladığım programla ilgili

TForm2 = class(TForm)

Table1: TTable;

// formun üzerin table iconu yerleştirdim dosyayı oluşturabilmek için

// program bunu Type kısmına otomatik yazar

private

{ Private declarations }

public

Procedure dosyalama;

Procedure Yeni_Yil_Dosyasi_Yarat;

Procedure Dosya_Sec;

var

Form2: TForm2;

implementation

uses GIRIS, BOSKAYIT, DATALAR, DOSYA_KLASOR, Math;

//GIRIS, BOSKAYIT, DATALAR, DOSYA_KLASOR, Math; Bu bölümün baglantılı olacağı bölümler kullanabilmem için yazdım burayı dikkate almayın

PROCEDURE TForm2.Yeni_Yil_Dosyasi_Yarat;

var

Aktifyil:String;

Ayil,Aay,Agun:word;

begin

decodedate(date,Ayil,Aay,Agun); // tarihi gün,ay,yıl olarak parçalıyorum

Aktifyil:=IntToStr(Ayil); // Yılı String'e çeviyorum dosya ismi o yıl olsun

// integer vd diğer sayısal biçimde olursa hata

// verir

Table1.Close; //table1 dosyasını kapat

if not Table1.Exists then // dosyanın varlığı sorgulanıyor

begin // yoksa oluşturma işlemine başla

with Table1 do

begin

active := false; // dosya aktif ise pasif hale getir // aksi takdirde aktif dosyayı tekraradan oluşturamazsınız

DatabaseName:='C:EVRAKBASKANLIKVERI'; //dosyanın oluşturalacağı klasörü belirtim

TableLevel:=4; {Versiyon Dbase 4 dosyası

Versiyon 3(Dbase III Plus) yapsanızda delphi kendisi versiyon

4 çeviriyor manyakça bir bir durum (niye çevirdiğini anlamadım)}

TableType:=ttDBase; // dosya tipi dbase olsun.

//uses kısmına (DBTables) yerleştirmezseniz hata verir

TableName:=Aktifyil; // yıl mesela 2004 ise dosya ismi 2004.dbf olacaktır

// ve indeksin adıda 2004.mdx olacaktır.

FieldDefs.Clear; // Dosyanın alanlarını temizle

FieldDefs.Add('KAYITNO',ftinteger,0,false);

{ FieldDefs.Add('KAYITNO',ftinteger,0,false); sıfır değeri vermezseniz hata

verir.sıfır değeri verirseniz 11 karakterlik sayısal alan oluşturur}

FieldDefs.Add('TARIH',ftDate,0,false);

FieldDefs.Add('SAYI',ftString,11,false);

FieldDefs.Add('EVRKONU',ftString,100,false);

FieldDefs.Add('OZET',ftString,150,false);

FieldDefs.Add('NEREDEN',ftString,80,false);

FieldDefs.Add('NEREYE',ftString,80,false);

FieldDefs.Add('RSTAR',ftDate,0,false);

FieldDefs.Add('RSNO',ftInteger,0,false);

FieldDefs.Add('RDDOSYA',ftString,20,false);

FieldDefs.Add('GELENNO',ftInteger,0,false);

FieldDefs.Add('GELENTAR',ftDate,0,false);

FieldDefs.Add('EVRTURU',ftString,15,false);

FieldDefs.Add('SAYFASAYI',ftInteger,0,false);

FieldDefs.Add('EKI',ftInteger,0,false);

FieldDefs.Add('BAGLANTI',ftString,15,false);

FieldDefs.Add('NOT',ftString,150,false);

FieldDefs.Add('NOT1',ftString,150,false);

FieldDefs.Add('RAFSUTNO',ftInteger,0,false);

FieldDefs.Add('RAFSIRNO',ftInteger,0,false);

FieldDefs.Add('KLASADI',ftInteger,0,false);

FieldDefs.Add('KLASNO',ftInteger,0,false);

FieldDefs.Add('DOSYANO',ftInteger,0,false);

FieldDefs.Add('EVSIRNO',ftInteger,0,false);

IndexDefs.Clear;

IndexDefs.add('KAYITX','KAYITNO',[]);

// [] boş geçmemim sebebi artan (A-Z), (0-9) sırada indexleme yapması için

IndexDefs.add('TARIHX','TARIH',[]);

IndexDefs.add('SAYIX','SAYI',[]);

IndexDefs.add('RSTARX','RSTAR',[]);

IndexDefs.add('RSNOX','RSNO',[],);

IndexDefs.add('RDDOSYAX','RDDOSYA',[]);

IndexDefs.add('GELENX','GELENNO;GELENTAR;NEREDEN',[ixExpression]);

// ixExpression kullanmamım sebebi birden fazla alanı tek bir index'de birleştirmek

IndexDefs.add('NEREDENX','NEREDEN;NEREYE',[ixExpression]);

IndexDefs.add('KONUTURX','EVRKONU;EVRTUR',[ixExpression]);

IndexDefs.add('KLASOR','KLASADI;KLASNO',[ixExpression]);

IndexDefs.add('DOSYAX','DOSYANO;EVSIRNO',[ixExpression]);

CreateTable; // artık dosyayı oluştur

end;

sakın ha

Form Create kısmında oluşturmayın

Formu Oluşturduktan sonra sorgu içinde yapmaya çalışın

Form yaratılırken hata verebilir

Harf Sil Function

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

*** 'ARKADAŞLAR LÜTFEN KODBANK"TAN YARDIM İSTEMEYİN' ***

************* 'FORUMLARDAN YARDIM İSTEYİN' *************

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

//Bu konuda diğer arkadaşlarıma katılıyorum. Lütfen kodbank'tan yardım istemeyin.

//Ayrıca lütfen sorulan sorulara cevap vermeyin. Zaten bir çok şey var kodbank'ta

//bir iki soruya baktım adamın sorduğu sorunun cevabı abartmıyorum en fazla 15 satır

//(konu) altta, yani eski konu. Millet beleşe alışmış. Soru sor cevaplasınlar diye.

//Tekrar söylüyorum LÜTFEN SORULARA CEVAP YAZMAYIN...

//Soru soran arkadaşlar sizde forumlardan yardım alın veya herkesin mail adresi mevcut

//4-5 kişiye mail atsanız bir cevap alırsınız. Bende böyle yaptım. Kesinlikle

//Kodbank'a soru yazmadım.

//Aşağıdaki Kodlar bir string içerisindeki istediğiniz harfleri silip kalanları

//veriyor. Burada silinecek kısmına aynı string gibi harfleri yazıyorsunuz veya

//boşluk bırakıyorsunuz. Örneğin '1w3aXc5 ' gibi... eğer metninizde yandaki harfler

//veya örnekteki gibi boşluk varsa onları silip kalanı veriyor.

//Dikkat küçük ve büyük harf duyarlıdır. Dolayısıyla küçük 'a' siliceğiniz zaman

//büyük'A'yı silmez.

//Bana lazım olmuştu. Eski projelerimi incelerken farkettim ve paylaşmak istedim.

// Öncelikle aşağıdaki function'ı unit'inizin aşağıdaki kısmından sonra tanımlayın.

//implementation

//{$R *.DFM}

Function HarfSil(Metin: String; Silinecek: Pchar): String;

var

I,A: Integer;

begin

For I := Length(Metin) downto 1 do

begin

For A := Length(Silinecek) downto 0 do

begin

if Metin <> EmptyStr then

begin

if (Metin[I] in [Silinecek[A]]) then

begin

Delete(Metin, I, 1);

end;

Result := Metin;

end;

// Kullanımı (Mesela Bir Edit'in Onchange Olayında)

procedure TForm1.Edit1Change(Sender: TObject);

begin

Label1.Caption := HarfSil(Edit1.Text,'1w3aXc5 ');

end;

//Edit1.Text := 'Lşsc4xwZX5aqw236 '; olduğunu kabul edersek

//Sonuç 'Lşs4xZq26' olacaktır.

// İlginç, farklı ve kullanışlı kodları olanlar bad_badboy_boy@hotmail.com 'a

// mail atabilir. Teşekkürler.