Programlama yapalım ve Öğrenelim.

MOUSE TAKİP EDEN YAZI

FORMA BİR TİMER BİR LABEL EKLEYİN.

FORMU TRASPARANT YAPIN

LABEL FORMUN EN SOL VE ENÜST KÖŞESİNDE OLSUN AYRICA LABELIN YAZI BOYUTUNU BÜYÜLTÜN.

VE LABEL CAPTİONA DİLEDİĞİNİZİ YAZIN. İKİNCİ BİR TİMER EKLEYEREK YAZIYI DEĞİŞKEN YAPABİLİRSİNİZ YADA YANIP SÖNEN YAZI YAPABİLİRSNİZ. BEN İKİNCİ TİMERA SİSTEM TARİHİNİ ZAMANINI EKLEDİM. MOUSE NERDE TARİH ORDA KOLAY GELSİN.

procedure TForm1.Timer1Timer(Sender: TObject);

var

m:tmouse;

begin

m:=tmouse.create;

form1.Left:=m.CursorPos.x;

form1.top:=m.CursorPos.y;

m.Free;

end;

procedure TForm1.FormCreate(Sender: TObject);

begin

SetWindowLong( Handle,GWL_STYLE,GetWindowLong( Handle, GWL_STYLE )and not WS_CAPTION );

SetWindowLong(Application.Handle,GWL_EXSTYLE, WS_EX_TOOLWINDOW);

SetWindowPos(Handle, HWND_TOPMOST, 0, 0, 0, 0, SWP_NOMOVE or SWP_NOSIZE);

end;

end.

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

Richedit html tag

unit Unit1;

interface

uses

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

Dialogs, StdCtrls, ComCtrls;

type

TForm1 = class(TForm)

RichEdit1: TRichEdit;

Button1: TButton;

procedure Button1Click(Sender: TObject);

private

{ Private declarations }

public

{ Public declarations }

end;

var

Form1: TForm1;

implementation

{$R *.dfm}

procedure HTMLSyntax(RichEdit: TRichEdit; TextCol, TagCol, DopCol: TColor);

var

i, iDop: Integer;

s: string;

Col: TColor;

isTag, isDop: Boolean;

begin

iDop := 0;

isDop := False;

isTag := False;

Col := TextCol;

RichEdit.SetFocus;

for i := 0 to Length(RichEdit.Text) do

begin

RichEdit.SelStart := i;

RichEdit.SelLength := 1;

s := RichEdit.SelText;

if (s = '<') or (s = '{') then isTag := True;

if isTag then

if (s = '"') then

if not isDop then

begin

iDop := 1;

isDop := True;

end

else

isDop := False;

if isTag then

if isDop then

begin

if iDop <> 1 then Col := DopCol;

end

else

Col := TagCol

else

Col := TextCol;

RichEdit.SelAttributes.Color := Col;

iDop := 0;

if (s = '>') or (s = '}') then isTag := False;

end;

RichEdit.SelLength := 0;

end;

procedure TForm1.Button1Click(Sender: TObject);

begin

RichEdit1.Lines.BeginUpdate;

HTMLSyntax(RichEdit1, clblack, clRed, clGreen);

RichEdit1.Lines.EndUpdate;

end;

end.

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

Excel'den Paradox'a aktarım'a Ek

Bu konuyla ilgili olarak, daha önce bir kodlama örneği göndermiştim.

Delphi Türk Kodbank programında veya Forum/Kodbankası kısmında NeverFear olarak arattırma

yaparsanız o örneğe ulaşabilirsiniz.

İşinizi görmesi dileğimle,

Çalışmalarınızda başarılar dilerim.

NeverFear - kaheri579@hotmail.com

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

Form üzerindeki bileşenlere topluca işlemler

NeverFear - kaheri579@hotmail.com

for I := 0 to ComponentCount -1 do

begin

if (Components[I] is TEdit) then TEdit(Components[I]).Text:= '';

if (Components[I] is TMemo) then TMemo(Components[I]).Clear;

if (Components[I] is TMaskEdit) then

begin

if (TMemo(Components[I]).Name <> 'MskEdit_CekimTarih') and

(TMemo(Components[I]).Name <> 'MskEdit_SistemTarih') then

TMaskEdit(Components[I]).Text:= '';

end;

Bu kodlamaya ek yapmak sizin isteğinize bağlı olarak arttırılabilir.

Örneğin:

ComboBox ekleyebilirsiniz

if (Components[I] is TTable) and (TTable(Components[I]).Modified

if (Components[I] is TButton) then TButton(Components[I]).Enabled

İşinizi görmesi dileğimle,

Çalışmalarınızda başarılar dilerim.

NeverFear - kaheri579@hotmail.com

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

Delphi Türkçe (Design-Runtime)

NeverFear - kaheri579@hotmail.com

*** Bu konu daha önce defalarca anlatılmış. Ancak, yeni başlayanlar açısından hem

klavuz hem de bu konunun derli toplu olmasını amaçladım. Ama şunu da yazmadan

geçemeyeceğim. Madem programlamaya başladın, detaylı araştırmayı da ihmal etmeyin.

Delphi Help dosyasını kullanmayı alışkanlık haline getirin.

Her sıkıntını "Armut Piş Ağzıma Düş" düşüncesiyle çözmeye kalkarsan, programlama

konusunu şimdiden bırakmanda fayda var düşüncesindeyim. Zira, sadece kendini

oyalamış olursun.

Bu konuya, Delphi Forum altında "Delphi Türkçe (Design-Runtime)", "NeverFear" ya da

"kaheri579@hotmail.com" şeklinde arama yapıp ulaşabilirsin.

İşinizi görmesi dileğimle,

Çalışmalarınızda başarılar dilerim.

NeverFear - kaheri579@hotmail.com

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

Sistem kontrol bileşeni (component) - tam destek sağlıyor

NeverFear - kaheri579@hotmail.com

Ancak, üzerinde yaptığım bazı değişikliklerle Delphi 2,3,4,5,6,7 tarafından

desteklenmekte ve denenmiştir. 2005(destekliyor) ve sonraki sürümleri için denemedim.

** Bileşenin açıklama ve uyarı satırlarını Türkçe yaptım ve Delphi 2,3,4,5,6,7 tarafından

desteklenmesini kolaylaştırdım. Pek katkıda bulunduğumu söyleyemem.

Bileşen;

APM,CPU,Devices,DirectX,Disk,Engines(BDE,ODBC),Media,Memory,Network(Adaptor,TCP/IP),

OperatingSystem(OS),Video(Adaptor),WorkStation(BiosDate,BiosName,LastBoot,SystemUpTime)

ve benzeri birçok konuda kodlama yapmaktan kurtarıyor.

Örnek -> ShowMessage(SD.OS.TimeZone); -> Sonuç: GTB Standart Saati

ShowMessage(SD.Devices.Monitor.Strings[0]); -> Sonuç: HYUNDAI DeluxScan P910+

ShowMessage(SD.Disk.FileSystem); -> Sonuç: CDFS (FAT,FAT16,FAT32,RAW,NTFS)

ShowMessage(SD.Engines.BDE); -> Sonuç: 5.2.0.2

ShowMessage(SD.Workstation.Name); -> Sonuç: WTCC //Bilgisayar Adı

ShowMessage(SD.Workstation.User); -> Sonuç: Formula One //Aktif Kullanıcı

//Bilgisayar Adı'yla Aktif Kullanıcı'yı birbirine karıştırmayın.

//Bunlar çok farklı tanımlamalar.

ShowMessage(SD.Workstation.BiosDate); -> Sonuç: 07/31/07

ShowMessage(SD.Network.IPAddress); -> Sonuç: 10.0.0.2 ... gibi.

* Bu örnekleri çoğaltmak mümkün.

** Bileşenin tüm dosyalarını isteklilere gönderebilirim. Zira, internetten indirdiğimde

lisans gerektirmiyordu(serbest kullanımlı).

** Bu bileşeni sorunsuz kullanabilmeniz için;

C:Program FilesBorlandDelphiX(5,6,7)SourceToolsAPI altındaki DesignIntf.pas ve

DesignMenus.pas dosyalarını C:Program FilesBorlandDelphiX(5,6,7)Lib dizinine

kopyalamalısınız.

** Kullanımı ile ilgili diğer açıklayıcı bilgiyi de benden edinebilirsiniz.

** Bileşenin aşağıdaki kodlaması;

procedure Register;

begin

RegisterComponents('MiTeC',[TSysData]); // 'MiTeC' ifadesini değiştirebilirsin

// ' işaretlerini yok etmemelisin(yeni başlayanlar için geçerli)

end; //şeklinde olabilir.

** Bu bileşenin kullanımından kısa bir örnek;

//*.pas kısmı

unit Sistem;

interface

uses

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

StdCtrls, ExtCtrls, Registry, WinTypes, SysData{SD};

type

TForm1 = class(TForm)

SD: TSysData;

Panel1: TPanel; Panel2: TPanel; Panel3: TPanel; Panel4: TPanel;

Panel5: TPanel; Panel6: TPanel; Panel7: TPanel; Panel8: TPanel;

Label1: TLabel; Label2: TLabel; Label3: TLabel; Label4: TLabel;

Label5: TLabel; Label6: TLabel; Label7: TLabel; Label8: TLabel;

procedure FormShow(Sender: TObject);

private

{ Private declarations }

public

{ Public declarations }

end;

var

Form1: TForm1;

Year, Month, Day: string;

implementation

{$R *.DFM}

procedure TForm1.FormShow(Sender: TObject);

var

BiosTarih: string;

Sene: integer;

begin

with SD do begin

if CPU.Features.MMX then

Label1.Caption:= ': ' + CPU.Vendor + ' ' + CPU.VendorID + 'MMX ' + IntToStr(CPU.Freq) + 'MHz'

else Label1.Caption:= ': ' + CPU.Vendor + ' ' + CPU.VendorID + ' ' + IntToStr(CPU.Freq) + 'MHz';

Label2.Caption:= ': ' + Workstation.BIOSCopyright;

BiosTarih:= Workstation.BIOSDate;

Month:= Copy(BiosTarih,1,2);

Day:= Copy(BiosTarih,4,2);

Year:= Copy(BiosTarih,7,2);

Sene:= StrToInt(Year);

if Sene <= 99 then //Bios tarihindeki Year genellikle 2 digit gelir

Year:= IntToStr(1900 + Sene) // yıl 99'a eşit veya küçükse 1900 ekler

else Year:= IntToStr(2000 + Sene); // yıl 99'dan büyükse 2000 ekler.

// bu 2099 yılına kadar geçerli

// hele o yıl bir gelsin ! ona da çare bulunur.

// ama tabii ben bunu diğer yazılımlarda

// kontrol altında tutuyorum. Bu bir örnek...

BIOSTarih:= Day + '/' + Month + '/' + Year;

Label3.Caption:= ': ' + BiosTarih;

Label4.Caption:= ': ' + FormatFloat('#,0',(Memory.PhysicalTotal/1024)/1024) + 'MB Ram';

Label5.Caption:= ': ' + Network.Adapter[0];

Label6.Caption:= ': ' + Network.IPAddress;

Label7.Caption:= ': ' + Video.Adapter[0] + ' [ ' + Video.BIOSVersion + ' ]';

with Workstation do begin

Label8.Caption:= ': ' + DateTimeToStr(LastBoot) + ' [ Sistem ; ' +

FormatSeconds(SystemUpTime,True,False,False) + ' ]''den beri açık';

end;

end.

//*.dfm kısmı

object Form1: TForm1

Left = 260

Top = 138

Width = 544

Height = 375

Caption = 'Form1'

Color = clBtnFace

Font.Charset = DEFAULT_CHARSET

Font.Color = clWindowText

Font.Height = -11

Font.Name = 'MS Sans Serif'

Font.Style = []

OldCreateOrder = False

OnShow = FormShow

PixelsPerInch = 96

TextHeight = 13

object SpdBtn_Yenile: TSpeedButton

Left = 231

Top = 212

Width = 75

Height = 25

Caption = 'Y&enile'

Flat = True

OnClick = SpdBtn_YenileClick

end

object Panel1: TPanel

Left = 4

Top = 4

Width = 500

Height = 25

Alignment = taLeftJustify

BevelInner = bvLowered

BevelOuter = bvLowered

Caption = ' İşlemci'

TabOrder = 0

object Label1: TLabel

Left = 80

Top = 6

Width = 32

Height = 13

Caption = 'Label1'

end

object Panel2: TPanel

Left = 4

Top = 29

Width = 500

Height = 25

Alignment = taLeftJustify

BevelInner = bvLowered

BevelOuter = bvLowered

Caption = ' Bios Adı'

TabOrder = 1

object Label2: TLabel

Left = 80

Top = 6

Width = 32

Height = 13

Caption = 'Label2'

end

object Panel3: TPanel

Left = 4

Top = 54

Width = 500

Height = 25

Alignment = taLeftJustify

BevelInner = bvLowered

BevelOuter = bvLowered

Caption = ' Bios Tarihi'

TabOrder = 2

object Label3: TLabel

Left = 80

Top = 6

Width = 32

Height = 13

Caption = 'Label3'

end

object Panel4: TPanel

Left = 4

Top = 79

Width = 500

Height = 25

Alignment = taLeftJustify

BevelInner = bvLowered

BevelOuter = bvLowered

Caption = ' Bellek'

TabOrder = 3

object Label4: TLabel

Left = 80

Top = 6

Width = 32

Height = 13

Caption = 'Label4'

end

object Panel5: TPanel

Left = 4

Top = 104

Width = 500

Height = 25

Alignment = taLeftJustify

BevelInner = bvLowered

BevelOuter = bvLowered

Caption = ' Ethernet Kartı'

TabOrder = 4

object Label5: TLabel

Left = 80

Top = 6

Width = 32

Height = 13

Caption = 'Label5'

end

object Panel6: TPanel

Left = 4

Top = 129

Width = 500

Height = 25

Alignment = taLeftJustify

BevelInner = bvLowered

BevelOuter = bvLowered

Caption = ' TCP/IP Adresi'

TabOrder = 5

object Label6: TLabel

Left = 80

Top = 6

Width = 32

Height = 13

Caption = 'Label6'

end

object Panel7: TPanel

Left = 4

Top = 154

Width = 500

Height = 25

Alignment = taLeftJustify

BevelInner = bvLowered

BevelOuter = bvLowered

Caption = ' Ekran Kartı'

TabOrder = 6

object Label7: TLabel

Left = 80

Top = 6

Width = 32

Height = 13

Caption = 'Label7'

end

object Panel8: TPanel

Left = 4

Top = 179

Width = 500

Height = 25

Alignment = taLeftJustify

BevelInner = bvLowered

BevelOuter = bvLowered

Caption = ' Son Açılış'

TabOrder = 7

object Label8: TLabel

Left = 80

Top = 6

Width = 32

Height = 13

Caption = 'Label8'

end

object SD: TSysData

Left = 52

Top = 248

end

İşinizi görmesi dileğimle,

Çalışmalarınızda başarılar dilerim.

NeverFear - kaheri579@hotmail.com

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

TQuickReport - TQuickRep sorunu ( Rapor.DLL)

NeverFear - kaheri579@hotmail.com

Quickrep.dcu-TQuickReport (ki *.pas dosyayı hiçbir yerde bulamadım) Delphi 2.0,

Quickrpt.dcu-TQuickRep ise Delphi 3,4,5,6,7 ... X dosyası.

Delphi 2.0 ile yazdığım bir rapor görüntüleme ekranını, Quickrep.pas dosyasını hiçbir

yerde bulamamam (Delphi Türk Forum'da da aramış ve yardım istemiştim) ve QuickReport'un

standart görüntüleme ekranını kullanmak istememem nedeniyle, raporlama konusunda epey

sıkıntı çektim. Ancak, Delphi 2.0 ile oluşturduğum bir DLL sayesinde bu sorunumu çözdüm.

Delphi'nin hangi sürümü olursa olsun, bu DLL dosyayı(rapor.dll) aktifleştirerek kendi

rapor görüntüleme ekranımı sorunsuz bir şekilde kullanabiliyorum.

Benim gibi aynı sorunu yaşayan arkadaşlarla bu DLL projemi paylaşabilirim. Ancak, bu proje

dosya Delphi 2.0 içindir.

--------------------------------------------------------------------------------

** Rapor.Dll **

library Rapor;

uses

Rapor1 in 'Rapor1.pas',

Unit1 in 'Unit1.pas' {Form1},

Unit2 in 'Unit2.pas' {Form2},

Unit3 in 'Unit3.pas' {Form3},

Unit4 in 'Unit4.pas' {Form4}; //asıl projenin benzeri

{$R *.RES}

{$L+}

exports

Unit1,

Unit2,

Unit3,

Unit4; //çoğaltmanız mümkün (asıl projenin benzeri)

begin

end.

--------------------------------------------------------------------------------

** Rapor1.pas ** //GenelSabit ismini verebileceğin bir *.pas dosya oluşturabilirsin.

unit Rapor1; //GenelSabit.pas dosyasında *.dfm yok. Sadece bir Unit

interface

uses SysUtils, Messages, Classes, Graphics, Controls, Forms, GenelSabit;

procedure Unit_1(Sender: TObject); export;

procedure Unit_2(Sender: TObject); export;

procedure Unit_3(Sender: TObject); export;

procedure Unit_4(Sender: TObject); export;

implementation

uses Unit1, Unit2, Unit3, Unit4;

procedure Unit_1(Sender: TObject); export;

begin

try

Application.CreateForm(TForm1, Form1);

Form1.ShowModal;

finally

Form1.Free;

end;

procedure Unit_2(Sender: TObject); export;

begin

try

Application.CreateForm(TForm2, Form2);

Form2.ShowModal;

finally

Form2.Free;

end;

procedure Unit_3(Sender: TObject); export;

begin

try

Application.CreateForm(TForm3, Form3);

Form3.ShowModal;

finally

Form3.Free;

end;

procedure Unit_4(Sender: TObject); export;

begin

try

Application.CreateForm(TForm4, Form4);

Form4.ShowModal;

finally

Form4.Free;

end;

end.

--------------------------------------------------------------------------------

** Unit1.pas **

unit Unit1;

interface

uses

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

Grids, DBGrids, DB, DBTables, StdCtrls, Buttons, Mask, DBCtrls, ExtCtrls,

GenelSabit, Printers, Quickrep;

type

TForm1 = class(TForm)

Table1: TTable;

DataSource1: TDataSource;

Table2: TTable;

DataSource2: TDataSource;

DBGrid1: TDBGrid;

DBGrid2: TDBGrid;

YAZICI: TPrintDialog;

procedure FormCreate(Sender: TObject);

procedure BitBtn_onizlemeClick(Sender: TObject);

private

aReport: TQuickReport;

public

procedure ShowPreview;

procedure Rapor_Hazirla;

end;

var

Form1: TForm1;

implementation

uses Unit1_1, RPTGoruntu;

{$R *.DFM}

procedure TForm1.FormCreate(Sender: TObject);

begin

{$I-}

GetLastError;

PATH:= ExtractFilePath(ParamStr(0));

if PATH[Length(PATH)] = '' then PATH:= Copy(PATH,1,Length(PATH)-1);

ChDir(PATH);

if IOResult <> 0 then MkDir(PATH);

AppPATH:= PATH;

GENEL_DATA_PATH:= AppPATH + 'Genel Datalar';

ChDir(GENEL_DATA_PATH);

if IOResult <> 0 then MkDir(GENEL_DATA_PATH);

LISTEPATH:= AppPATH + 'Listeler';

ChDir(LISTEPATH);

if IOResult <> 0 then MkDir(LISTEPATH);

Label1.Caption:= '';

Label2.Caption:= '';

Veri_Dosya_Olustur;

FilmNo:= 1;

EksikNo:= 0;

Table2.Last;

if Table2.RecordCount <> 0 then

Label1.Caption:= FormatFloat('#,###',DBGrid1.Fields[0].Value);

Table2.Last;

Label2.Caption:= FormatFloat('#,###',DBGrid2.Fields[0].Value);

Table1.First;

RdGrp_ListeTipi.ItemIndex:= 0;

RdGrp_ListeTipiClick(Self);

end;

procedure TForm1.Rapor_Hazirla;

begin

with frm_Unit1_1.Table3 do begin

Active:= False;

DatabaseName:= LISTEPATH + '';

TableName:= 'BosFilm.db';

TableType:= ttParadox;

Active:= True;

Last;

ShowMessage('Boş Film Numarası Sayısı = ' + FormatFloat('#,###',RecNo));

Filter:= 'BosNo>=' + Memo_No1.Text + ' and BosNo<=' + Memo_No2.Text;

Filtered:= True;

end;

frm_Unit1_1.QRpt.Orientation:= Printer.Orientation; //QRpt --> TQuickReport;

frm_Unit1_1.QRpt.ShowProgress:= False;

aReport:= frm_Unit1_1.QRpt;

end;

procedure TForm1.ShowPreview;

begin

try

Application.CreateForm(Tfrm_RPTGoruntu, frm_RPTGoruntu);

frm_RPTGoruntu.Caption:= Application.Title + ' - Boş Film Numaraları';

frm_RPTGoruntu.ShowModal;

finally

frm_RPTGoruntu.Free;

end;

procedure TForm1.BitBtn_onizlemeClick(Sender: TObject);

begin

BitBtn_Kapat.Enabled:= False;

BitBtn_onizleme.Enabled:= False;

BitBtn_yazdir.Enabled:= False;

Screen.Cursor:= crHourGlass;

Printer.PrinterIndex:= -1;

try

Application.CreateForm(Tfrm_Unit1_1, frm_Unit1_1);

Rapor_Hazirla;

QRPrinter.OnPreview:= ShowPreview;

aReport.Preview;

finally

frm_Unit1_1.Free;

BitBtn_Kapat.Enabled:= True;

BitBtn_onizleme.Enabled:= True;

BitBtn_yazdir.Enabled:= True;

end;

Screen.Cursor:= crDefault;

end;

--------------------------------------------------------------------------------

** Ana projeden çağırılışı **

unit AnaMenu;

interface

uses

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

ComCtrls, DB, DBTables, Menus, ExtCtrls, GenelSabit, RaporDLL;

//RaporDLL.pas dosyasının kodları aşağıda.

type

Tfrm_AnaMenu = class(TForm)

implementation

{$R *.DFM}

procedure Tfrm_AnaMenu.submnu_BosFilmNoClick(Sender: TObject);

begin

Screen.Cursor:= crAppStart;

Unit_1(submnu_BosFilmNo);

Screen.Cursor:= crDefault;

end;

--------------------------------------------------------------------------------

** Rapor.pas **

unit RaporDLL;

interface

procedure Unit_1(Sender: TObject); external 'Rapor.dll';

procedure Unit_2(Sender: TObject); external 'Rapor.dll';

procedure Unit_3(Sender: TObject); external 'Rapor.dll';

procedure Unit_4(Sender: TObject); external 'Rapor.dll';

//procedure sayısını Rapor.Dll'de olduğu gibi çoğaltmak mümkün.

implementation

end.

--------------------------------------------------------------------------------

*** Yukarıdaki kodlama projenin tamamı değil, bir örnektir.

İşinizi görmesi dileğimle,

Çalışmalarınızda başarılar dilerim.

NeverFear - kaheri579@hotmail.com

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

Çok satırlı, hareketli Menu ve Button Bar

NeverFear - kaheri579@hotmail.com

*** Projenin tamamını, aşağıdaki konu anlatımından sonra tam kodlama olarak

inceleyebilirsiniz.

//Öncelikle yapılması gerekenler.

Yeni bir proje açın. Form üzerine 1 ControlBar, 1 PopupMenu, 1 StatusBar(isteğe bağlı),

1 ImageList(isteğe bağlı) ekleyin. ControlBar üzerine de 2 ToolBar bırakın.

ToolBar1 -> Menüler, ToolBar2 -> Düğmeler için kullanılacak.

TMainMenu'de olduğu gibi TPopupMenu(Name = Dosya yapın)'de de TMenuItem oluşturun.

Bunlardan birine Kapat adını verin. Caption = &Kapat, ShortCut = Alt+F4(listede bulamazsınız

klavyeden siz yazın - programı çalıştırdığında menüde K(K altında _ olarak)apat Alt+F4

şeklinde göreceksin).

ToolBar1 üzerinde sağ tuş yapın ve New Button'u tıklayın. Kolayca bulabilmen ve düzenli

olması için Name = Amnu_Dosya yazın. Bunu, ismini Dosya verdiğiniz PopupMenu'ye

bağlayın. Caption = &Dosya olsun.

ToolBar2 üzerinde sağ tuş yapın ve New Button'u tıklayın. Kolayca bulabilmeniz ve

düzenli olması için Name = Btn_Kapat yazın. Caption'ı boşaltın. ImageList'e bağlayın ve

Kapat için ImageList'e eklediğiniz Index'teki Bitmap veya Icon'u kullanın. OnClick

olayına Close; kodlayın. PopupMenu'de ismini Kapat verdiğiniz menünün OnClick olayını

buraya bağlayın.

Hazırlıklarınız bitti sayılır. Bundan sonraki geliştirmeler size kalmış.

Projenizi çalıştırdığınızda, Delphi veya MSOffice uygulamalarında olduğu gibi

(buna benzer birçoğunda), ister yan yana ister alt altta menü ve düğme çubuklarını

hareket ettirebildiğini göreceksin.

Ancak bir sorun var. Her yeni menü için PopupMenu eklemeniz gerekiyor. Ben bu sorunu

çözemedim. Tek bir MainMenu veya PopupMenu ile işi bitiremedim. Aslında, bu konuda

benim de yardıma ihtiyacım var :)

Not:

implementation

uses consts; //bu satırı eklemeyi unutmayın.

//------------------------------------------------------------------------------

//*.dpr

program ControlBar;

uses

Forms,

ControlBar_1 in 'ControlBar_1.pas' {Form1};

{$R *.RES}

begin

Application.Initialize;

Application.CreateForm(TForm1, Form1);

Application.Run;

end.

//------------------------------------------------------------------------------

//*.dfm

object Form1: TForm1

Left = 187

Top = 128

BorderIcons = [biSystemMenu, biMinimize]

BorderStyle = bsSingle

Caption = 'Form1'

ClientHeight = 325

ClientWidth = 538

Color = clBtnFace

Font.Charset = DEFAULT_CHARSET

Font.Color = clWindowText

Font.Height = -11

Font.Name = 'MS Sans Serif'

Font.Style = []

OldCreateOrder = False

Position = poScreenCenter

OnClose = FormClose

OnCreate = FormCreate

PixelsPerInch = 96

TextHeight = 13

object ControlBar1: TControlBar

Left = 0

Top = 0

Width = 538

Height = 89

AutoSize = True

BevelEdges = [beTop, beBottom]

TabOrder = 0

DesignSize = (

538

85)

object ToolBar1: TToolBar

Left = 11

Top = 2

Width = 278

Height = 21

AutoSize = True

ButtonHeight = 21

ButtonWidth = 63

Caption = 'ToolBar1'

DockSite = True

DragMode = dmAutomatic

EdgeBorders = []

EdgeInner = esNone

EdgeOuter = esNone

Flat = True

ShowCaptions = True

TabOrder = 0

Transparent = True

Wrapable = False

object Amnu_Dosya: TToolButton

Left = 0

Top = 0

AutoSize = True

Caption = '&Dosya'

DropdownMenu = Dosya

Grouped = True

PopupMenu = Dosya

end

object Amnu_Muhasebe: TToolButton

Left = 41

Top = 0

AutoSize = True

Caption = '&Muhasebe'

DropdownMenu = Muhasebe

Grouped = True

ImageIndex = 1

PopupMenu = Muhasebe

end

object Amnu_Personel: TToolButton

Left = 102

Top = 0

AutoSize = True

Caption = '&Personel'

DropdownMenu = Personel

Grouped = True

ImageIndex = 2

PopupMenu = Personel

end

object ToolBar2: TToolBar

Left = 302

Top = 2

Width = 150

Height = 22

AutoSize = True

Caption = 'ToolBar1'

EdgeBorders = []

EdgeInner = esNone

EdgeOuter = esNone

Flat = True

Images = ImageList1

TabOrder = 1

Transparent = True

Wrapable = False

object Btn_OnIzle: TToolButton

Left = 0

Top = 0

ImageIndex = 0

end

object Btn_Kapat: TToolButton

Left = 23

Top = 0

ImageIndex = 1

ParentShowHint = False

OnClick = Btn_KapatClick

end

object Btn_Print: TToolButton

Left = 46

Top = 0

Caption = 'Btn_Print'

ImageIndex = 2

end

object TabbedNotebook1: TTabbedNotebook

Left = 11

Top = 28

Width = 442

Height = 48

Anchors = []

Constraints.MaxHeight = 55

TabFont.Charset = DEFAULT_CHARSET

TabFont.Color = clBtnText

TabFont.Height = -11

TabFont.Name = 'MS Sans Serif'

TabFont.Style = []

TabOrder = 2

object TTabPage

Left = 4

Top = 24

Caption = '&Raporlar'

end

object TTabPage

Left = 4

Top = 24

Caption = '&Belgeler'

end

object StatusBar1: TStatusBar

Left = 0

Top = 306

Width = 538

Height = 19

Panels = <

item

Width = 50

end>

end

object ImageList1: TImageList

Left = 172

Top = 212

Bitmap = {

494C010103000400040010001000FFFFFFFFFF10FFFFFFFFFFFFFFFF424D3600

0000000000003600000028000000400000001000000001001000000000000008

0000000000000000000000000000000000000000000000000080000000800000

0000000000000000000000000000000000000000000000000000000000000000

000000000000000000000000000000000000000000800080630C630C00800080

0000008000000000000000000000000000000000E75D604C604C604C604C604C

604C604C604C604C004C004C004CE75D0000000000000000000021042925C618

4208C6189652630C000000000000000000000000000000000000000000000000

0000000000000000000000000000000000000000A59418E339E7B5D65AEB73CE

8490008000800000008000000000000000000000605C605C605CE05CE05CE05C

E05C605C605C605C605C605C605C004C0000000000000000C618BD77BD77D65A

B756AF35EF3D5A6BDE7BE71C0000000000000000000000000000000000000000

00000000000000000000000000000000000031C65AEB39E75AEBB5D67BEFB5D6

DEFBDEFB94D28490008000800000008000000000605CE05CE05CE05CE75DFF7F

FF7FFF7FFF7FE75D605C605C605C004C00000000C6181863DE7BBD779C73B556

D65AAD356B2DEF3D734E1863FF7F000000000000000000000000000000000000

0000000000000000000000000000000000005AEB73CE18E37BEFB5D69CF352CA

BDF718E373CE73CED6DA94D28490000000800000605CE05CE05CEF5DFF7FEF5D

675D675DEF5DFF7F675E605C605C004C000000005A6BDE7BBD779C73CE39EF3D

9452D65AD65AD65A524AC618EF3D000000000000000000000000000000000000

0000000000000000000000000000000000007BEF18E339E77BEFB5D639E7F7DE

18E3B5D608A108A16BADB5D69CF339E700000000E05CE05CE75DFF7FE75DE05C

E05CE05CE05CE75DFF7F675D605C604C0000000039679C73CE3939675A6B734E

94521042CE399452F75E8E42CE39000000000000000000000000000000000000

0000000000000000000000000000000000009CF3F7DE39E79CF3B5D639E7F7DE

D6DA08A129A5C69829A54AA939E77BEF00800000E05CE05CFF7FEF5DE05CE05C

FF7FFF7FE05CE05CEF5DFF7F605C604C00000000CE399C737B6F5A6B7B6F9C73

BD777B6FD65AD65A524A8C31EF3D000000000000000000000000000000000000

0000000000000000000000000000000000009CF3F7DE5AEB9CF3B5D67BEF31C6

18E34AA908A111918CB1ADB518E35AEB00000000E05CE05CFF7FE75DE05CE05C

FF7FFF7FE05CE05C675DFF7F605C604C000000009C737B6F5A6B39675A6BBD77

BD77F75EF75E9C739C7339673146000000000000000000000000000000000000

000000000000000000000000000000000000BDF718E35AEBBDF7B5D69CF331C6

5AEB6BAD08A11D82ADB1ADB55AEB39E700000000E05C605DFF7FE75DE05CE05C

FF7FFF7FE05CE05C675DFF7F605C604C0000000031465A6B5A6BD65A5A6BDE7B

BD77BD77BD779C737B6FB5564A29000000000000000000000000000000000000

000000000000000000000000000000000000BDF718E37BEFBDF7B5D639E731C6

7BEF29A54AA929A5C698ADB57BEF18E300800000E05C675DFF7FEF5DE05CE05C

FF7FFF7FE05C605CEF5DFF7FE05C604C0000000000006B2DBD77BD77B556F75E

B556314694529C73D65AEF3D0000000000000000000000000000000000000000

000000000000000000000000000000000000DEFB18E37BEFDEFBB5D69CF373CE

F7DEBDF7E79C10C2ADB594D2F7DEF7DE00800000E05C675DE75DFF7FE75DE05C

E05CE05CE05C675DFF7F675DE05C604C0000000000000000D75ADF521F5F9F6F

BD775A6B5A6B08214A2900000000000000000000000000000000000000000000

000000000000000000000000000000000000DEFBD6DAF7DEDEFBADB5D6DAD6DA

D6DAF7DEFFFFFFFFFFFF5AEBD6DAD6DA00800000605DE75D675DEF5DFF7FEF5D

675D675DEF5DFF7FE75DE05CE05C604C000000000000000092317F5B7F5B7F5B

7F5B5F5BA7140000000000000000000000000000000000000000000000000000

000000000000000000000000000000000000FFFFFFFFFFFF52CA8CB1ADB594D2

94D252CA8CB194D2CEB94AA98CB173CE00800000675DE75DE75D675DE75DFF7F

FF7FFF7FFF7FE75DE05CE05CE05C604C000000000000000057469F679F679F67

9F679F6700000000000000000000000000000000000000000000000000000000

00000000000000000000000000000000000029A594D27BEFF7DE39E739E7DEFB

BDF79CF3B5D673CEADB5E79C29A510C200800000675DE75DE75DE75D675D675D

675D675D605D605DE05CE05CE05C604C00000000000000007E67BF6FBF6FBF6F

BF6F7E6700000000000000000000000000000000000000000000000000000000

0000000000000000000000000000000000000000000000000000C698C698EFBD

18E3BDF731C68CB18CB131C65AEBE79C00000000EF5D675D675D605D605DE05C

E05CE05CE05CE05CE05CE05C605CE75D0000000000005029DF77DF77DF77DF77

DF77F33D00000000000000000000000000000000000000000000000000000000

0000000000000000000000000000000000000000000000000000000000000000

000000000000C618A59400800000000000000000000000000000000000000000

000000000000000000000000000000000000000000009D6FFF7FFF7FFF7FFF7F

FF7F000000000000000000000000000000000000000000000000000000000000

000000000000000000000000000000000000424D3E000000000000003E000000

2800000040000000100000000100010000000000800000000000000000000000

000000000000000000000000FFFFFF00E3FFFFFFF80F0000807F8001E0030000

000F800180010000000180018001000000008001800100000000800180010000

00008001800100000000800180010000000080018001000000008001C0030000

00008001E00F000000008001E01F000000008001E03F000000008001C03F0000

F0008001C03F0000FFC7FFFF807F000000000000000000000000000000000000

000000000000}

end

object Dosya: TPopupMenu

Images = ImageList1

TrackButton = tbLeftButton

Left = 88

Top = 212

object GenelTanmlamalar1: TMenuItem

Caption = 'Genel Tanımlamalar'

object SabitveDeikenTanmlamalar1: TMenuItem

Caption = '&Sabit ve Değişken Tanımlamaları'

Default = True

end

object KullancFirmaBilgiGirii1: TMenuItem

Caption = '&Kullanıcı Firma Bilgi Girişi'

end

object MteriFirmaBilgiGirii1: TMenuItem

Caption = '&Müşteri Firma Bilgi Girişi'

end

object N1: TMenuItem

Caption = '-'

end

object Kapat: TMenuItem

Caption = '&Kapat'

Default = True

ImageIndex = 1

ShortCut = 32883

OnClick = Btn_KapatClick

end

object Muhasebe: TPopupMenu

Images = ImageList1

TrackButton = tbLeftButton

Left = 116

Top = 212

object letmeDefteriGirileri1: TMenuItem

Caption = 'İşl&etme Defteri Girişleri'

Default = True

end

object Personel: TPopupMenu

Images = ImageList1

TrackButton = tbLeftButton

Left = 144

Top = 212

object BilgiGirileri1: TMenuItem

Caption = '&Personel Kayıt İşlemleri'

Default = True

end

//------------------------------------------------------------------------------

//*.pas

unit ControlBar_1;

interface

uses

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

Menus, ImgList, ComCtrls, TabNotBk, ToolWin, ExtCtrls, StdCtrls, Buttons;

type

TForm1 = class(TForm)

ImageList1: TImageList;

ControlBar1: TControlBar;

ToolBar1: TToolBar;

Amnu_Dosya: TToolButton;

Dosya: TPopupMenu;

GenelTanmlamalar1: TMenuItem;

Amnu_Muhasebe: TToolButton;

Muhasebe: TPopupMenu;

letmeDefteriGirileri1: TMenuItem;

ToolBar2: TToolBar;

Btn_OnIzle: TToolButton;

Btn_Kapat: TToolButton;

StatusBar1: TStatusBar;

Amnu_Personel: TToolButton;

Personel: TPopupMenu;

BilgiGirileri1: TMenuItem;

N1: TMenuItem;

Kapat: TMenuItem;

SabitveDeikenTanmlamalar1: TMenuItem;

KullancFirmaBilgiGirii1: TMenuItem;

MteriFirmaBilgiGirii1: TMenuItem;

TabbedNotebook1: TTabbedNotebook;

Btn_Print: TToolButton;

procedure Btn_KapatClick(Sender: TObject);

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

private

{ Private declarations }

public

{ Public declarations }

end;

var

Form1: TForm1;

implementation

uses consts;

{$R *.DFM}

procedure TForm1.Btn_KapatClick(Sender: TObject);

begin

Close;

end;

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

begin

if MessageDlg('Program Kapatılıyor ...', mtConfirmation,

[mbYes, mbNo], 0) = mrYes then Action:= caFree

else Action:= caNone;

end;

end.

//------------------------------------------------------------------------------

İşinizi görmesi dileğimle,

Çalışmalarınızda başarılar dilerim.

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