ComboBox

Írjunk Delphi alkalmazást, melyben a ComboBox listakezelő szerepet játszik. A listát szöveges állományban tárolja, melyből saját beolvasó rutinnal tölti be. A programból való kilépéskor a listát szintén a saját rutinja segítségével lemezre menti.

Enter hatására a Text mezőben lévő nem üres szöveget adja a listához, de csak akkor, ha még nem szerepelt rajta. Lehessen a listából törölni. Lehessen CheckBox segítségével választani rendezett és nem rendezett állapot között. Az elemek fölösleges Space karaktereket nem tartalmazhatnak.

A Form szerkesztő nézetben:

A program egy lehetséges futási képe:

A program listája:

unit UCBLista;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes,

Graphics, Controls, Forms,
  Dialogs, StdCtrls;

type
  TfmCBLista = class(TForm)
    btKilepes: TButton;
    lbCBLista: TLabel;
    cbLista: TComboBox;
    btDel: TButton;
    chSorted: TCheckBox;
procedure btKilepesClick(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure cbListaKeyPress(Sender: TObject; var Key: Char);
procedure btDelClick(Sender: TObject);
procedure chSortedClick(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

var
  fmCBLista: TfmCBLista;
  DNev: String;
  FText: Text;

implementation

{$R *.dfm}

Function ValidSt(S: String): String;
Var I, N: Byte;
    Ws: String;
    Van: Boolean;
Begin
  N:= Length(S); ValidSt:=''; If N=0 Then Exit; Ws:= S;
While (N>0) And (Ws[N]=' ') Do
Begin Ws:= Copy(Ws,1,N-1); Dec(N) End; If Ws='' Then Exit;
While Ws[1]=' ' Do Begin Ws:= Copy(Ws,2,N-1); Dec(N) End;
  Van:= True;
If N>3 Then While Van Do
Begin
    Van:= False; N:= Length(Ws);
For I:=2 To N-1 Do If (Ws[I]=' ') And (Ws[I+1]=' ') Then
Begin
      Van:= True; Ws:= Copy(Ws,1,I) + Copy(Ws,I+2,N-I-1);
End;
End;
  ValidSt:= Ws;
End;

procedure TfmCBLista.btKilepesClick(Sender: TObject);
begin
  cbLista.Items.SaveToFile(DNev);
  Close;
end;

procedure TfmCBLista.FormCreate(Sender: TObject);
begin
  DNev:= 'Lista.txt';
If Not FileExists(DNev) Then
Begin AssignFile(FText,DNev); ReWrite(FText); CloseFile(FText) End;
With cbLista Do
Begin Items.LoadFromFile(DNev); ItemIndex:= -1 End;
end;

procedure TfmCBLista.cbListaKeyPress(Sender: TObject; var Key: Char);
begin
If Key=#13 Then
With cbLista Do
Begin
If (ValidSt(Text)<>'') And (Items.IndexOf(ValidSt(Text))=-1) Then
    Items.Add(ValidSt(Text)); Text:= '';
End;
end;

procedure TfmCBLista.btDelClick(Sender: TObject);
begin
With cbLista Do
Begin If ItemIndex>=0 Then Items.Delete(ItemIndex); Text:= '' End;
  cbLista.SetFocus;
end;

procedure TfmCBLista.chSortedClick(Sender: TObject);
begin
With cbLista Do With chSorted Do
Begin Sorted:= Not Sorted; Checked:= Sorted End;
  cbLista.SetFocus;
end;

end.

Rekordok használata

Ez az egyszerű program a rekordok használatát demonstrálja. Az adatokat tipizált lemezes állományban tárolja, melyet futáskor betölt, a programból való kilépéskor pedig automatikusan a lemezre ment. Ha a lemezes állomány nem létezik, akkor üres tartalommal automatikusan létrehozza.

A program az adatokat egy sztringrácsban jeleníti meg, melynek sorai egy rekord mezőit tartalmazza. A sztringrács cellái editálhatók. A rács utolsó sora összesítést tartalmaz, mely cellaváltásra aktualizálódik és tartalmát billentyűzetről átírni csak ideiglenesen lehet.

Új rekord beszúrására, illetve rekordok törlésére nyomógombok állnak rendelkezésre. A maximális rekordszámot a max nevű konstans tartalmazza.

A program futási képe:

A program listája:

unit URekord;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes,

Graphics, Controls, Forms,
  Dialogs, Grids, StdCtrls;

type
  TfmRekord = class(TForm)
    lbRekord: TLabel;
    sgTabla: TStringGrid;
    btKilepes: TButton;
    btIns: TButton;
    btDel: TButton;
Procedure Lemezrol;
Procedure Lemezre;
Procedure RekordTablabol(Sor:Word);
Procedure RekordTablaba(Sor:Word);
Procedure Szamol;
procedure FormCreate(Sender: TObject);
procedure btKilepesClick(Sender: TObject);
procedure btInsClick(Sender: TObject);
procedure btDelClick(Sender: TObject);
procedure sgTablaClick(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

  St11=String[11];
  St24=String[24];
  St32=String[32];

  TRekord=Record
Ind: LongInt;
    Nev: St32;
    SzulDat: St11;
    Nem: Char;
    Szak: St24;
    Kredit: Word;
    OsztDij: LongInt;
    Tandij: LongInt;
    Atlag: Real;
End;

Const Max=1000;
      CRekord:TRekord=(Ind:0;
                       Nev:'';
                       SzulDat:'';
                       Nem:' ';
                       Szak:'';
                       Kredit:0;
                       OsztDij:0;
                       Tandij:0;
                       Atlag:0);

var
  fmRekord: TfmRekord;
  RSz: LongInt;
  FRekord: File Of TRekord;
  RekordT: Array[1..Max] Of TRekord;
  DNev: String;

implementation

{$R *.dfm}

Procedure TfmRekord.Lemezrol;
Begin
  RSz:= 0;
  AssignFile(FRekord,DNev); {$I-}Reset(FRekord);{$I+}
If IOResult<>0 Then ReWrite(FRekord)
Else While Not EOF(FRekord) Do
Begin
      Inc(RSz); Read(FRekord, RekordT[RSz]);
End;
  CloseFile(FRekord);
End;

Procedure TfmRekord.Lemezre;
Var I: LongInt;
Begin
With sgTabla Do For I:= 1 To RowCount-2 Do RekordTAblaba(I);
  AssignFile(FRekord,DNev); ReWrite(FRekord);
For I:= 1 To RSz Do Write(FRekord, RekordT[I]);
  CloseFile(FRekord);
End;

Procedure TfmRekord.RekordTablabol(Sor:Word);
Var N: Word;
    K: Integer;
    R: Real;
Begin
With sgTabla Do With RekordT[Sor] Do
Begin
    Val(Cells[0,Sor],N,K); If K=0 Then Ind:= N Else Ind:= 0;
    Nev:= Cells[1,Sor];
    SzulDat:= Cells[2,Sor];
If Cells[3,Sor]<>'' Then Nem:= Cells[3,Sor][1] Else Nem:= ' ';
    Szak:= Cells[4,Sor];
    Val(Cells[5,Sor],N,K); If K=0 Then Kredit:= N Else Kredit:= 0;
    Val(Cells[6,Sor],N,K); If K=0 Then OsztDij:= N Else OsztDij:= 0;
    Val(Cells[7,Sor],N,K); If K=0 Then Tandij:= N Else Tandij:= 0;
    Val(Cells[8,Sor],R,K); If K=0 Then Atlag:= R Else Atlag:= 0;
End;
End;

Procedure TfmRekord.RekordTablaba(Sor:Word);
Var Ws: String;
Begin
With sgTabla Do With RekordT[Sor] Do
Begin
    Cells[0,Sor]:= IntToStr(Ind);
    Cells[1,Sor]:= Nev;
    Cells[2,Sor]:= SzulDat;
    Cells[3,Sor]:= Nem;
    Cells[4,Sor]:= Szak;
    Cells[5,Sor]:= IntToStr(Kredit);
    Cells[6,Sor]:= IntToStr(OsztDij);
    Cells[7,Sor]:= IntToStr(Tandij);
    Ws:= FloatToStr(Atlag);
    Ws[Pos(',',Ws)]:= '.';
    Cells[8,Sor]:= Ws;
End;
End;

Procedure TfmRekord.Szamol;
Var I, ASz: Word;
    Oszt, TDij: LongInt;
    Atl: Real;
    Ws: String;
Begin
For I:= 1 To RSz Do RekordTablabol(I);
  Oszt:= 0; TDij:= 0; Atl:= 0; ASz:= 0;
With sgTabla Do
Begin
For I:= 1 To RSz Do With RekordT[I] Do
Begin
      Oszt:= Oszt+OsztDij;
      TDij:= TDij+Tandij;
If Atlag<>0 Then Inc(ASz);
      Atl:= Atl+Atlag;
End;
    Cells[6,RowCount-1]:= IntToStr(Oszt);
    Cells[7,RowCount-1]:= IntToStr(TDij);
If ASz<>0 Then
Begin
      Ws:= FloatToStr(Atl/ASz);
      Ws[Pos(',',Ws)]:= '.';
      Cells[8,RowCount-1]:= Ws
End Else Cells[8,RowCount-1]:= '0';
End;
End;

procedure TfmRekord.sgTablaClick(Sender: TObject);
Var I: Word;
begin
With sgTabla Do
Begin
    Cells[1,RowCount-1]:= 'Összesen:';
For I:= 2 To 5 Do Cells[I,RowCount-1]:= '';
End;
For I:= 1 To RSz Do RekordTablabol(I); Szamol;
end;

procedure TfmRekord.btKilepesClick(Sender: TObject);
begin
  Lemezre;
  Close;
end;

procedure TfmRekord.FormCreate(Sender: TObject);
Var I: LongInt;
begin
  DNev:= 'Hallgatók.dat';
  Lemezrol;
With sgTabla Do
Begin
    RowCount:= RSz+2;
    ColWidths[1]:= 150;
    ColWidths[2]:= 64;
    ColWidths[3]:= 32;
    ColWidths[4]:= 100;
    ColWidths[6]:= 48;
    ColWidths[7]:= 48;
    Cells[0,0]:= 'Index';
    Cells[1,0]:= 'Név';
    Cells[2,0]:= 'Szül.Dat.';
    Cells[3,0]:= 'Nem';
    Cells[4,0]:= 'Szak';
    Cells[5,0]:= 'Kredit';
    Cells[6,0]:= 'Ösztöndíj';
    Cells[7,0]:= 'Tandíj';
    Cells[8,0]:= 'Átlag';
    Cells[1,RowCount-1]:= 'Összesen:';
For I:= 1 To RSz Do RekordTablaba(I);
End;
  Szamol;
end;

procedure TfmRekord.btInsClick(Sender: TObject);
Var I, J: Word;
begin
With sgTabla Do
Begin
    RowCount:= RowCount+1;
For I:= RowCount-1 DownTo Row+1 Do
For J:= 1 To ColCount-1 Do Cells[J,I]:= Cells[J,I-1];
    Cells[0,Row]:= IntToStr(Row); For J:= 1 To ColCount-1 Do Cells[J,Row]:= '';
For I:= 1 To RowCount-2 Do Cells[0,I]:= IntToStr(I);
    Cells[0,RowCount-1]:= '';
End;
  Inc(RSz); For I:= 1 To RSz Do RekordTablabol(I); Szamol;
end;

procedure TfmRekord.btDelClick(Sender: TObject);
Var I, J: Word;
begin
With sgTabla Do
Begin
If Row=RowCount-1 Then Exit;
For I:= Row To RowCount-2 Do
For J:= 1 To ColCount-1 Do Cells[J,I]:= Cells[J,I+1];
For J:= 1 To ColCount-1 Do Cells[J,Rowcount-1]:= '';
    RowCount:= RowCount-1;
For I:= 1 To RowCount-2 Do Cells[0,I]:= IntToStr(I);
    Cells[0,RowCount-1]:= '';
If (Row>1) And (Row=RowCount-1) Then Row:= Row-1;
End;
  RekordT[RSz]:= CRekord;
  Dec(RSz); For I:= 1 To RSz Do RekordTablabol(I); Szamol;
end;

end.

Menük

Összetettebb programjaink megkövetelik, hogy a végrehajtandó feladatokat részekre bontsuk. Tesszük ezt azért, hogy egy-egy részt külön formon, a többitől elválasztva kezeljünk. Ez megkönnyíti a vizuális tervezést. Mert igaz, hogy láthatóságok (Visible tulajdonság) állításával egyetlen formon is el lehetne helyezni a vizuális elemeket, de szerkesztési időben mindegyik látható lenne, ami - elég sok elem esetén - lehetetlenné tenné az elemek helyének, méretének egérrel történő beállítását. Így a geometriai tulajdonságokat futási időben, értékadással lehetne csak beállítani. Ez fölösleges és nehézkes is lenne.

A legcélravezetőbb megoldás erre az esetre MDI alkalmazás készítése, melynek formjait menüből hozzuk létre. Ebben a szakaszban lépésről lépésre leírom, hogyan kell menüvezérelt MDI alkalmazást készíteni.

Indítsuk az IDE-t, adjunk a fő-formunknak például fmMDIDemo nevet. Kezdeményezzünk mentést, és az előre létrehozott MDIDemo mappába mentsük ki a projektünket, UMDIDemo illetve PMDIDemo nevekkel. A form FormStyle tulajdonságát állítsuk be fsMDIForm-ra:

Adjunk a projectünkhöz két újabb formot. Legyen a nevük fmA és fmB. Mindkettő FormStyle tulajdonságát állítsuk fsMDIChild-re (gyermekablak). Mentsünk mindent (Save All), és az új formokhoz tartozó Unitokat nevezzük el UA illetve UB-vel.

A Standard palettáról helyezzünk egy MainMenu elemet a fmMDIDemo formra. Nevezzük el FoMenu-nek. Ez a menü kétdimenziós. A fő-menüpontok mindig láthatók (ha egyébként nem tesszük láthatatlanná). A fő-menüpontok a képernyő címsora alatt foglalnak helyet. A formra helyezett MainMenu elemen történő kettős kattintással lépjünk be a menüszerkesztőbe és adjunk nevet az első fő-menüpontnak. Legyen ez miMDIDemo. A Caption tulajdonságát pedig állítsuk MDI Demo-ra:

Automatikusan létrejöttek a kétirányú továbbfejlesztés lehetőségei, az első menüpont alatt az almenüpont, míg mellette a második fő-menüpont helye. Az első almenüpont neve legyen miA a Caption tulajdonsága legyen: A.

A második almenüpont neve legyen miB, Caption tulajdonsága pedig: B.

Gyakran előfordul, hogy az almenüpontokat csoportokba célszerű sorolni. Az egymáshoz hasonló funkciókból állíthatunk össze csoportokat. Itt most a programból való kilépés menüpontot válasszuk el a formok kiválasztására alkalmas A és B menüponttól. Az elválasztás kialakítása: a harmadik almenüpont neve legyen miElvalaszto, Caption tulajdonsága: -. Ennek a jelnek (mínusz vagy elválasztójel) a hatására elválasztó vonal keletkezik az almenüpontok között.

Az utolsó almenüpont neve legyen miExit, Caption-ja pedig legyen Exit. A neve a funkcióját fogja tükrözni, ezzel ki lehet majd lépni a programból.

Zárjuk be a menüszerkesztőt. Futtassuk a programot. A menüpontok már megjelennek, csak még nem funkcionálnak:

Váltsunk át a fő-formunknál kódnézetre, és a használatba veendő Unitok listáját bővítsük a két saját Unittal.

Váltsunk újra form nézetre, a formon a menük a futáshoz hasonlóan jelennek meg és megnyílnak, csak értelemszerűen az funkciójuk nem hajtódik végre. Sőt, a menüpontok kiválasztásával (egér klikk) lehet a funkciókat elhelyezni a kódlistába. Legyen a menükiválasztás eredménye a neki megfelelő form létrejötte és megjelenése. Ez a következő kódrészlettel érhetjük el az fmA esetén:

Természetesen az előző lépést hajtsuk végre az fmB esetén is. Ez követően futtassuk programunkat. A következő látványban lesz részünk:

Evvel az állapottal a következő problémák vannak: futtatáskor a gyermekablakok is létrejöttek, sőt ha be szeretnénk zárni, akkor csak minimális méretig lehet eltüntetni őket (a bal alsó sarokba kerülnek, mintha az a tálca lenne). Igaz még, hogy ha teljes méretet állítunk be rájuk, akkor az egész formot takarják, nevük a címsorban szögletes zárójelben jelenik meg. Ha menüből újra kiválasztjuk, akkor a gyermekablak új példánya jelenik meg. Ez utóbbiak nem problémák, de tudni kell, hogy a rendszer ilyen beállításnál így működik.

Annak érdekében, hogy a gyermekablakok csak a menüpontra való kattintás után jelenjenek meg, a következőt kell tenni. Nyissuk meg az IDE Project menüpontja Options… menüpontját, majd a gyermek formokat (fmA, fmB) helyezzük át az Auto-Create forms ablakból az Available forms ablakba a > feliratú nyomógomb segítségével:

Így most már csak akkor jelennek meg a gyermekablakok, ha menüből aktiváljuk őket. A bezárási probléma megoldása a következő. Váltsunk át az fmA form formnézetére, majd az Object Inspector Events részére és kattintsunk kettőt az OnClose eseményen. Ennek hatására a kódlistában a form zárásakor végrehajtandó események beírására van lehetőségünk. Azt kellene elérni, hogy a form záráskor valóban záródjon, a lefoglalt memóriaterülete felszabaduljon. Ez a következő utasítással érhetjük el:

Tegyük meg ugyanezt az fmB formmal is. Ezzel a menüpontok és a gyermekablakok MDI alkalmazáson belüli összekapcsolását megoldottuk. Ha a formokra még egy-egy címkével a nevüket is ráírjuk, akkor láthatóvá válik, hogy az egyes formok egymástól függetlenül szerkeszthetők.

Utolsó lépésként az Exit menüponthoz rendeljük hozzá a főform zárását. Válasszuk a főform formnézetét, kattintsunk a menün, azon belül az Exit menüponton és a generált kódrészletbe írjuk be a Close parancsot:

Ennek hatására az Exit menüpont a főform zárására alkalmas.

A főprogram és a két almodul listája:

unit UMDIDemo;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes,

Graphics, Controls, Forms,
  Dialogs, Menus, UA,UB;

type
  TfmMDIDemo = class(TForm)
    FoMenu: TMainMenu;
    miMDIDemo: TMenuItem;
    miA: TMenuItem;
    miB: TMenuItem;
    miElvalaszto: TMenuItem;
    miExit: TMenuItem;
procedure miAClick(Sender: TObject);
procedure miBClick(Sender: TObject);
procedure miExitClick(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

var
  fmMDIDemo: TfmMDIDemo;

implementation

{$R *.dfm}

procedure TfmMDIDemo.miAClick(Sender: TObject);
begin
  fmA:= TfmA.Create(Self);
  fmA.Show;
end;

procedure TfmMDIDemo.miBClick(Sender: TObject);
begin
  fmB:= TfmB.Create(Self);
  fmB.Show;
end;

procedure TfmMDIDemo.miExitClick(Sender: TObject);
begin
  Close;
end;

end.

(***************************************)

unit UA;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, 

Graphics, Controls, Forms,
  Dialogs, StdCtrls;

type
  TfmA = class(TForm)
    lbA: TLabel;
procedure FormClose(Sender: TObject; var Action: TCloseAction);
private
{ Private declarations }
public
{ Public declarations }
end;

var
  fmA: TfmA;

implementation

{$R *.dfm}

procedure TfmA.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  Action:= caFree;
end;

end.

(*********************************************)

unit UB;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, 

Graphics, Controls, Forms,
  Dialogs, StdCtrls;

type
  TfmB = class(TForm)
    lbB: TLabel;
procedure FormClose(Sender: TObject; var Action: TCloseAction);
private
{ Private declarations }
public
{ Public declarations }
end;

var
  fmB: TfmB;

implementation

{$R *.dfm}

procedure TfmB.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  Action:= caFree;
end;

end.

Almenük

Készítsünk a Menük szakaszban elkészített projectben a B menüpontnak almenüt. Legyen ennek az almenünek két menüpontja: B1 és B2. Ezt a következőképpen érhetjük el. A fő Form formnézetében kettős kattintással a FoMenu ikonján lépjünk be a menüszerkesztőbe. Válasszuk ki a B menüpontot, majd egér jobbgombja segítségével előhívott helyi menüben válasszuk a Create Submenu menüpontot. Ekkor a következőt kapjuk:

A létrejött almenüpontot nevezzük el miB1-nek, Caption tulajdonságának adjunk B1 értéket:

Hasonlóan a megjelent újabb almenüpont lehetőségre állítsunk be miB2 és B2 értékeket.

Ha most futtatjuk a programot, akkor azt tapasztaljuk, hogy az almenü megjelenésével egyszerre a B form is létrejön annak ellenére, hogy a B menüponton nem kattintottunk. Ennek elkerülésére tegyük megjegyzésbe a B formot generáló és megjelenítő két sort. Továbbá a fmB1 és fmB2 formokra is hajtsuk végre az fmA és fmB formoknál lépéseket: állítsunk be FormStyle tulajdonságokat fsMDIChild-re, vegyük ki az Auto-Create listából őket és a Close eseményükbe írjuk be az Action:= caFree; kódot. Ezek után az fmB1 és fmB2 ugyanúgy működik, mintha rendes menüpont lenne. Ugyanakkor ebben a formában az fmB form funkció nélkül maradt.

A menük végén még annyit, hogy a menüszerkesztőben a menüpontok közé a helyi menü segítségével szúrhatunk be új menüsorokat és törölhetünk meglévőket (Insert és Delete). A project listája gyakorlatilag ugyanolyan sorokból áll az átalakítás után, mint előtte, ezért ennek megjelenítésétől eltekintek.

PopUp menük

A PopUp menüket szokás lokális (előbukkanó) menüknek is nevezni. Helyezzünk a formra szerkesztési időben a Standard palettáról egy PopupMenu ikont. Ezen az ikonon kettőt kattintva a menüszerkesztőbe jutunk. A Menü és Almenü szerkesztéséhez hasonlóan adjunk neveket a menüpontoknak: Alfa, Béta, Gamma, Választóvonal, Exit:

Az Alfa menüponthoz rendeljük hozzá az Alfa szöveg véletlen helyen történő megjelenését. A Bétához hasonlóan a Béta szöveg megjelenését. A Gamma menüpont kiválasztására rajzoljon a program egy (10,10) bal felső csúcspontú, véletlen oldalhosszú téglalapot. Az Exit kiválasztása a program befejezését jelentse. Futtassuk a programot és a formon az egér jobb fülével kattintva, próbáljuk előhozni a menüt. Nem fog sikerülni. Egy lépés ugyanis még hiányzik. A PopUp menü ugyanis csak valamely látható elemen való kattintás esetén jelenik meg. Ezt a kérdéses vizuális elem PopupMenu tulajdonságában kell beállítani. A tulajdonság kiválasztása után a már definiált PupupMenu-k listájából a hozzárendelendőt ki kell választani. Ahhoz tehát, hogy a jelen menünk működjön, az egyetlen vizuális elemnek, a főformnak a PopupMenu-véjé kell tenni. Ezek után már működni fog a menü. A futási kép lehet például ilyen:

A program listája:

unit UPopUpMenu;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes,

Graphics, Controls, Forms,
  Dialogs, Menus;

type
  TfmPopUpMenu = class(TForm)
    pmPopUpMenu: TPopupMenu;
    pmAlfa: TMenuItem;
    pmBeta: TMenuItem;
    pmGamma: TMenuItem;
    N1: TMenuItem;
    pmExit: TMenuItem;
procedure pmExitClick(Sender: TObject);
procedure pmAlfaClick(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure pmBetaClick(Sender: TObject);
procedure pmGammaClick(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

var
  fmPopUpMenu: TfmPopUpMenu;

implementation

{$R *.dfm}

procedure TfmPopUpMenu.pmExitClick(Sender: TObject);
begin
  Close;
end;

procedure TfmPopUpMenu.FormCreate(Sender: TObject);
begin
  Randomize;
end;

procedure TfmPopUpMenu.pmAlfaClick(Sender: TObject);
begin
  Canvas.TextOut(Random(500),Random(300),'Alfa');
end;

procedure TfmPopUpMenu.pmBetaClick(Sender: TObject);
begin
  Canvas.TextOut(Random(500),Random(300),'Béta');
end;

procedure TfmPopUpMenu.pmGammaClick(Sender: TObject);
begin
  Canvas.Rectangle(10,10,Random(500),Random(300));
end;

end.

Status Bar

Hasznos lehet programjainkban, ha futás közben bizonyos információk állandóan láthatók a képernyőn. Erre a legkézenfekvőbb megoldás a form alján a státuszsor (Status Bar). Ebben a projectben létrehozunk egy státuszsort, és benne megjelenítünk a program futása szempontjából lényeges információkat.

A project szokásos előkészítése után a főformra helyezzünk el egy StatusBar-t a Win32 palettáról. Az elem a form alsó részében, teljes szélességben, egy alapértelmezett karakternyi vastagságban jelenik meg, kerettel, jobb alsó csúcsánál átméretező ikonnal, ha a látvány nem a teljes képernyő. A StatusBar neve legyen stMinta. Kettős kattintással juthatunk a StatusBar Panelszerkesztőjébe.

Az első Ikonja segítségével a StatusBar-ba paneleket szúrhatunk, a másodikkal törölhetünk. A nyilak segítségével a paneleken mozoghatunk. A panel szélességét a Width tulajdonsága tartalmazza, mely szükség szerint módosítható. Szúrjunk be 4 panelt (0-3), és állítsunk be a szélességeket: 100, 80, 60, 40. (Az utolsó szélességi érték mindig a maradék lesz, a beállított értéktől függetlenül.) A szélességek a form megjelenítési méreteitől nem függnek, ha valamely panel már nem fér a form ablakába, akkor nem látszik.

A panelek legfontosabb tulajdonsága a Text. Ide beírhatjuk azokat az információkat, amelyet a program futása alatt látni szeretnénk. A 0. panelen például jelenjen meg a következő: Felhasználó: admin. A következőben jelenítsük meg a CapsLock állapotát, a harmadikban a program indításától eltelt időt, a negyedikben a gépi dátumot és időt. Ez utóbbiak csak futási időben értelmezhetők, ezért ehhez kódolásra van szükség. Mivel a megjelenített információk időben változnak (változhatnak), ezért a megjelenítést időzítőre bízzuk. Helyezzünk a formra egy időzítőt a System palettáról. Nevezzük el tmIdozito-nek. Az időzítő Interval tulajdonságát ne változtassuk meg (1000), így a StatusBar másodpercenként fog frissülni. Az időzítő feladatát a listába az időzítőn történő kettős kattintással generálódott szakaszban kell elhelyezni. A kódot a project listájából kiolvashatjuk.

A program futási képe:

A program listája:

unit UStatusBar;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes,

Graphics, Controls, Forms,
  Dialogs, ComCtrls, ExtCtrls;

type
  TfmStatusBar = class(TForm)
    stMinta: TStatusBar;
    tmIdozito: TTimer;
procedure tmIdozitoTimer(Sender: TObject);
procedure FormCreate(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

var
  fmStatusBar: TfmStatusBar;
  Start: TDateTime;

implementation

{$R *.dfm}

procedure TfmStatusBar.FormCreate(Sender: TObject);
begin
  Start:= Now;
end;

procedure TfmStatusBar.tmIdozitoTimer(Sender: TObject);
begin
With stMinta Do
Begin
If Odd(GetKeyState(VK_CAPITAL)) Then Panels[1].Text:='CAPS bekapcs'
Else Panels[1].Text:='';
    Panels[2].Text:= TimeToStr(Start-Now);
    Panels[3].Text:= DateToStr(Now)+' / '+TimeToStr(Now);
End;
end;

end.

Színes sztringrács

Gyakran előfordulhat, hogy igen méretes, akár 50 x 40-es StringGrid-el kell dolgoznunk egy Delphi programban. Ha editáljuk, vagy egyszerűen csak keresünk benne, gond lehet az, hogy vajon melyik sorban és oszlopban van a kiválasztott cella. Erre mutat megoldást a képen látható program listája. De nemcsak rögzített cellákat, hanem a belső cellák tartalmát is lehet különböző színekkel megjeleníteni, ami függhet a cella koordinátáitól, vagy a tartalmától is. Példámban a reáltárgyakat színesen, a többit feketével jelenítettem meg. A kiválasztott cella Kedd 7. óra és zöld színű. Még egy érdekessége van a programnak: futtása ESC billentyűre befejeződik.

A program futási képe:

A program listája:

unit USzin;

interface

uses
  Windows, Messages, SysUtils, Classes, 

Graphics, Controls, Forms, Dialogs, Grids, StdCtrls;

type
  TfmSzin = class(TForm)
    sgRacs: TStringGrid;
    lbOrarend: TLabel;
procedure sgRacsDrawCell(Sender: TObject; Col, Row: Integer;
      Rect: TRect; State: TGridDrawState);
procedure FormCreate(Sender: TObject);
procedure sgRacsClick(Sender: TObject);
procedure sgRacsKeyPress(Sender: TObject; var Key: Char);
private
{ Private declarations }
public
{ Public declarations }
end;

var
  fmSzin: TfmSzin;
  ACol, ARow: Integer;

implementation

{$R *.DFM}

procedure TfmSzin.sgRacsDrawCell(Sender: TObject; Col, Row: Integer;
  Rect: TRect; State: TGridDrawState);
begin
With sgRacs.Canvas.Brush Do
Begin
{rögzített cellák}
If (gdFixed In State) And ((Col=ACol) Or (Row=ARow)) Then
    Color:= clRed Else Color:=clBtnFace;

{kiválasztott cella}
If gdSelected In State Then Color:= clGreen;

{a táblázat belseje}
If Not((gdSelected In State) Or (gdFixed In State)) Then
Case Odd(Col) XOr Odd(Row) Of
      True: Color:= clWindow;
      False: Color:= clSilver;
End;
End;
With sgRacs.Canvas.Font Do
Begin
If sgRacs.Cells[Col,Row]='Matematika' Then Color:= clRed;
If sgRacs.Cells[Col,Row]='Fizika' Then Color:= clPurple;
If sgRacs.Cells[Col,Row]='Kémia' Then Color:= clFuchsia;
If sgRacs.Cells[Col,Row]='Biológia' Then Color:= clOlive;
If sgRacs.Cells[Col,Row]='Földrajz' Then Color:= clGreen;
End;
{szöveg beállítása rácson belül: +6 +4}
{kövér betüket akkor tud, ha DefaultDrawing=True}
  sgRacs.Canvas.TextRect(Rect,Rect.Left+6,Rect.Top+4,sgRacs.Cells[Col,Row]);
If gdFocused In State Then sgRacs.Canvas.DrawFocusRect(Rect);
end;

procedure TfmSzin.FormCreate(Sender: TObject);
Var I: Word;
begin
With sgRacs Do
Begin
    ColWidths[0]:= 24;
For I:= 1 To 7 Do Cells[0,I]:= IntToStr(I)+'.';
    Cells[1,0]:= 'Hétfő';
    Cells[2,0]:= 'Kedd';
    Cells[3,0]:= 'Szerda';
    Cells[4,0]:= 'Csütörtök';
    Cells[5,0]:= 'Péntek';

    Cells[1,1]:= 'Biológia';
    Cells[1,2]:= 'Matematika';
    Cells[1,3]:= 'Osztályfőnöki';
    Cells[1,4]:= 'Magyar';
    Cells[1,5]:= 'Angol/Német';
    Cells[1,6]:= 'Testnevelés';

    Cells[2,1]:= 'Fizika';
    Cells[2,2]:= 'Ének';
    Cells[2,3]:= 'Magyar';
    Cells[2,4]:= 'Történelem';
    Cells[2,5]:= 'Földrajz';
    Cells[2,6]:= 'Informatika';

    Cells[3,1]:= 'Angol/Német';
    Cells[3,2]:= 'Rajz';
    Cells[3,3]:= 'Kémia';
    Cells[3,4]:= 'Matematika';
    Cells[3,5]:= 'Testnevelés';
    Cells[3,6]:= 'Magyar';

    Cells[4,1]:= 'Magyar';
    Cells[4,2]:= 'Földrajz';
    Cells[4,3]:= 'Angol/Német';
    Cells[4,4]:= 'Biológia';
    Cells[4,5]:= 'Fizika';
    Cells[4,6]:= 'Történelem';

    Cells[5,1]:= 'Matematika';
    Cells[5,2]:= 'Történelem';
    Cells[5,3]:= 'Angol/Német';
    Cells[5,4]:= 'Kémia';
    Cells[5,5]:= 'Magyar';
    Cells[5,6]:= 'Informatika';
    Col:= 2;
    Row:= 7;
    ACol:= Col;
    ARow:= Row;
End;
end;

procedure TfmSzin.sgRacsClick(Sender: TObject);
begin
With sgRacs Do
Begin
    ACol:= Col;
    ARow:= Row;
    RePaint;
End;
end;

procedure TfmSzin.sgRacsKeyPress(Sender: TObject; var Key: Char);
begin
If Key=#27 Then Application.Terminate;
end;

end.

Drag and Drop

A grafikus operációs rendszerek hasznos szolgáltatása a Drag&Drop, azaz vonszolási technika. Grafikus elemeinket megfoghatjuk, mozgathatjuk, és egy olyan objektum felé helyezve, mely képes a vonszolt elemet fogadni, elengedhetjük, aminek következtében az elem az új objektumban fog megjelenni. Ez a technika Delphi-ben is könnyen megvalósítható.

Legyen kis alkalmazásunkban elsőként két listadoboz, melyekből egy-egy elemet megfoghatunk és a másikba egérrel áttehetjük. Második részben egy listadobozból egy sztrigrácsba helyezhessünk át elemeket úgy, hogy az elengedés helye a cellát is jelölje ki. A harmadik részben beviteli mező tartalmát helyezhessük át az elsőből a másodikba. A beállításhoz az objektumok onMouseDown, onDragOver és onDragDrop eseménykezelőinek megírása szükséges.

A program futtatási képe, amikor már az elemeket, illetve az elemek egy részét már áthelyeztük a fogadó objektumba:

A program listája:

unit UDrag;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, 

Graphics, Controls, Forms, Dialogs, StdCtrls, Grids;

type
  TfmDrag = class(TForm)
    lbDrag: TLabel;
    btKilepes: TButton;
    ldA: TListBox;
    ldB: TListBox;
    ldC: TListBox;
    sgRacs: TStringGrid;
    edA: TEdit;
    edB: TEdit;
procedure btKilepesClick(Sender: TObject);
procedure ldAMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
procedure ldBMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
procedure ldADragOver(Sender, Source: TObject; X, Y: Integer;
      State: TDragState; var Accept: Boolean);
procedure ldBDragOver(Sender, Source: TObject; X, Y: Integer;
      State: TDragState; var Accept: Boolean);
procedure ldADragDrop(Sender, Source: TObject; X, Y: Integer);
procedure ldBDragDrop(Sender, Source: TObject; X, Y: Integer);
procedure ldCMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
procedure sgRacsDragOver(Sender, Source: TObject; X, Y: Integer;
      State: TDragState; var Accept: Boolean);
procedure sgRacsDragDrop(Sender, Source: TObject; X, Y: Integer);
procedure edAMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
procedure edBDragOver(Sender, Source: TObject; X, Y: Integer;
      State: TDragState; var Accept: Boolean);
procedure edBDragDrop(Sender, Source: TObject; X, Y: Integer);
private
{ Private declarations }
public
{ Public declarations }
end;

var
  fmDrag: TfmDrag;

implementation

{$R *.dfm}

procedure TfmDrag.btKilepesClick(Sender: TObject);
begin
  Close;
end;

procedure TfmDrag.ldAMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  ldA.BeginDrag(False);
  ldB.ItemIndex:= -1;
  ldC.ItemIndex:= -1;
end;

procedure TfmDrag.ldBMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  ldB.BeginDrag(False);
  ldA.ItemIndex:= -1;
  ldC.ItemIndex:= -1;
end;

procedure TfmDrag.ldADragOver(Sender, Source: TObject; X, Y: Integer;
  State: TDragState; var Accept: Boolean);
begin
  Accept:= True;
end;

procedure TfmDrag.ldBDragOver(Sender, Source: TObject; X, Y: Integer;
  State: TDragState; var Accept: Boolean);
begin
  Accept:= True;
end;

procedure TfmDrag.ldADragDrop(Sender, Source: TObject; X, Y: Integer);
begin
With ldB Do
Begin
If ItemIndex=-1 Then Exit;
    ldA.Items.Add(Items[ItemIndex]);
    Items.Delete(ItemIndex);
End;
end;

procedure TfmDrag.ldBDragDrop(Sender, Source: TObject; X, Y: Integer);
begin
With ldA Do
Begin
If ItemIndex=-1 Then Exit;
    ldB.Items.Add(Items[ItemIndex]);
    Items.Delete(ItemIndex);
End;
end;

procedure TfmDrag.ldCMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  ldC.BeginDrag(True);
  ldA.ItemIndex:= -1;
  ldB.ItemIndex:= -1;
end;

procedure TfmDrag.sgRacsDragOver(Sender, Source: TObject; X, Y: Integer;
  State: TDragState; var Accept: Boolean);
begin
  Accept:= True;
end;

procedure TfmDrag.sgRacsDragDrop(Sender, Source: TObject; X, Y: Integer);
Var ACol, ARow: Integer;
begin
With ldC Do With sgRacs Do
Begin
If ItemIndex=-1 Then Exit;
    ACol:= X Div ColWidths[0];
    ARow:= Y Div RowHeights[0];
If ACol*ARow>0 Then
Begin
      Col:= ACol; Row:= ARow;
      Cells[Col,Row]:= Items[ItemIndex];
      Items.Delete(ItemIndex);
End;
End;
end;

procedure TfmDrag.edAMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  edA.BeginDrag(True);
end;

procedure TfmDrag.edBDragOver(Sender, Source: TObject; X, Y: Integer;
  State: TDragState; var Accept: Boolean);
begin
  Accept:= True;
end;

procedure TfmDrag.edBDragDrop(Sender, Source: TObject; X, Y: Integer);
begin
  edB.Text:= edA.Text;
  edA.Text:= '';
end;

end.

Keresés listából előválasztással

Ha egy programban hosszú stringlistából (például névsorból) kell elemet kiválasztanunk, akkor sem a TListBox, sem TComboBox típusú vezérlők nem adnak erre maximális segítséget. Kívánatos lenne, hogy a kereső input mezőbe való beírás közben, a listából már csak azokat az elemeket lássuk a vezérlőben, amelyek eleje a beírt szöveggel megegyezik. Így várhatóan egyre rövidebb a megjelenített lista, megkönnyítve ezzel keresést, majd kiválasztást. Oldjuk meg ezt az egyszerű feladatot egy formon.

A feladat megnevezését hordozó címke mellett a következő elemeket fogjuk használni: egy TEdit mező a keresendő szöveg fogadására, egy TList elem a szűrt lista megjelenítésére, egy nem látható TList elemet a teljes lista tárolására. A listát string-tömbben fogjuk tárolni, és az egyszerűség végett véletlen választással fogjuk feltölteni. Szükség lesz még egy Új lista létrehozására és a programból való Kilépés-re alkalmas nyomógombokra. Két TLabel elemen jelenítjük meg a lista aktuális hosszát, valamint kiválasztás után az elem eredeti indexét.

Lássunk néhány futtatási képet. Futtatás után először ezt láthatjuk:

Ha elkezdjük beírni a keresendő stringet, minden újabb karakterre a lista szűkül:

Végül a megjelenők közül a keresettre kattintva megkapjuk, hogy a teljes listában hányadik elemet kerestük:

A programból való kilépés nélkül új listát kérhetünk. Valós környezetben természetesen a tömbben kell elhelyezni a böngészendő stringlistát.

A program listája:

unit UListSel;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, 

Graphics, Controls, Forms, Dialogs, StdCtrls;

type
  TfmListSel = class(TForm)
    lbListSel: TLabel;
    edListSel: TEdit;
    ldListSel: TListBox;
    btUjList: TButton;
    btKilepes: TButton;
    lbIndex: TLabel;
    ldShadow: TListBox;
    lbListH: TLabel;
Procedure UjLista;
procedure FormCreate(Sender: TObject);
procedure edListSelChange(Sender: TObject);
procedure btKilepesClick(Sender: TObject);
procedure btUjListClick(Sender: TObject);
procedure ldListSelClick(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

Const Max=10000;

var
  fmListSel: TfmListSel;
  Lista: Array[1..Max] Of String;

implementation

{$R *.dfm}

procedure TfmListSel.btKilepesClick(Sender: TObject);
begin
  Close;
end;

Procedure TfmListSel.UjLista;
Var I, J: Word;
Begin
  edListSel.Text:= ''; lbIndex.Caption:= '0'; ldShadow.Clear;
With ldListSel Do
Begin
    Clear;
For I:= 1 To Max Do
Begin
      Lista[I]:= '';
For J:= 1 To Random(24)+6 Do Lista[I]:= Lista[I]+Chr(97+Random(26));
      Items.Add(Lista[I]);
      ldShadow.Items.Add(Lista[I]);
End;
    lbListH.Caption:= IntToStr(Items.Count);
End;
End;

procedure TfmListSel.FormCreate(Sender: TObject);
begin
  UjLista;
end;

procedure TfmListSel.edListSelChange(Sender: TObject);
Var I: Word;
begin
With edListSel Do With ldListSel Do
Begin
    Clear;
For I:= 1 To Max Do If Text<>'' Then
Begin If Pos(Text,Lista[I])=1 Then Items.Add(Lista[I]) End
Else Items.Add(Lista[I]);
    lbListH.Caption:= IntToStr(Items.Count);
End;
  lbIndex.Caption:= '0';
end;

procedure TfmListSel.btUjListClick(Sender: TObject);
begin
  UjLista; edListSel.SetFocus;
end;

procedure TfmListSel.ldListSelClick(Sender: TObject);
begin
With ldListSel Do With edListSel Do
Begin
    Text:= Items[ItemIndex];
    lbIndex.Caption:= IntToStr(ldShadow.Items.IndexOf(Text));
End;
end;

end.