Jak předat pole objektů do funkce? – Delphi – Fórum – Programujte.com

V souvislosti s předchozím dotazem, jsem napsal tento kód - trochu zkrácený...

procedure TForm1.otevriTest(filename: string);
var f:textfile;
    s1,  s3,pracadr,pom:string;
    i1,i2:integer;
    prehodit:boolean;
begin

label1.font.name := fontOtazky;
label1.font.size := fontsize;
if uppercase(fontOtazky)='SYSTEM' then
  begin
   label1.font.name := 'Arial CE';
   label1.font.size := fontsizeCe;
  end
else
  begin
  if uppercase(fontOdpovedi)='SYSTEM' then
    begin
     edit1.font.name := 'Arial CE';
     edit1.font.size := fontsizeCe;
     listbox1.font.name := 'Arial CE';
     listbox1.font.size := fontsize;
    end;
  end;

edit1.font.name := fontOdpovedi;
edit1.font.size := fontsize;
if uppercase(fontOdpovedi)='HEBREW' then
  begin
   listbox1.font.name := 'Hebrew';
   listbox1.font.size := fontsizeHebrew;
   listbox1.font.charset := DEFAULT_CHARSET;
  end
else
  begin
  if uppercase(fontOtazky)='HEBREW' then
    begin
     label1.font.size:=fontsizeHebrew;
    end;
  end;

label5.font.name:=fontOdpovedi;
label5.font.size:=fontsize;
if uppercase(fontOdpovedi)='SYSTEM' then
  begin
   label5.font.name:='Arial CE';
   label5.font.size:=fontsizeCe;
  end;
{
  else
  begin
   label5.font.name:='Hebrew';
   label5.font.size:=fontsize-2;
  end;}

  {gauge1.forecolor:=clblack;
gauge1.hint:='Výsledky testu ještě nebudou uloženy';}
    dalsiotazka;
end;

procedure Tform1.prepareFont(str:string);
begin
end;

teď to chci dát do funkce prepareFont... Argumenty by měli být string a pole které bude obsahovat ty objekty, které se mají změnit. Jednak jak tam předat ty položky (label1, edit1, listbox1 apod.)

Volání podobné jako prepareFont('Hebrew',[label1, edit1, listbox1]) jak deklarovat takovou funkci a jak to zavolat? Taky nevím jestli je všude nutný ten uppercase, ne že by to vadilo, ale není to zbytečný?

#1 oxidián

zjednoduš si to, udělej si 2 objekty s fonty a ty pak přiřazuj objektům pak ti bude stačit už jen případná úprava velikosti. 

// v definiční oblasti var
FonHeb, FonAri : TFont;

// v inicializační funkci

FonHeb := TFont.Create;
FonHeb.Name := 'Hebrew';
FonHeb.SIze := 18;
FonHeb.Charset := DEFAULT_CHARSET;

FonAri := TFont.Create;
FonAri := 'Arial CE';
FonAri.size := 12;
FonAri.Charset := EUROPEAN_CHARSET;

// a pak v tý tovjí funkci už budeš jen přiřazovat fonty podle podmínek
label.font := FonHeb;  // pokud nebudeš měnit velikost tak je to celé

pak můžeš mít ještě seznam názvů objektů a procházet prvky formuláře na názvy a když je nalezen tak změnit podle podmínek.

#1 oxidián
ten upercase si udělej na každou proměnou 1 a pak jen testuj 

function
...
begin
fontOtazky := uppercase(fontOtazky);
fontOdpovedi := uppercase(fontOdpovedi;
...
if fontOdpovedi='SYSTEM' then....

strukturově by bylo lepší nejdřív vyřešit všechny fornty pro otázky a pak pro odpovědi, nemíchat to. pak by se to dalo řešit ještě přes switch case of

#2 MilanL
oprava kodu u druhého fontu při inicializaci  v 2 řádce má být FonAri.Name := 'Arial CE';

řešení přes switch CASE OF 

function
...
begin
fontOtazky := uppercase(fontOtazky);
fontOdpovedi := uppercase(fontOdpovedi;
...
case fontOtazky[1] of  	// musí být ordinární typ tzn podle 1 znaku názvu fontu
                       	// v případě, že více fontů mělo stejný 1. znak musel
			// by se pod obsluhou toho znaku udělat rozskok podle
			// dalších
  'S' : ....;	// fontOtazky = 'SYSTEM'
  'H' : ....;	// fontOtazky = 'HEBREW' 
  'B' : ....;    // fontOtazky = 'BWGRKI' - řečtina
   atd..;
  else ...;
end;

// Opakovat pro fontOdpovedi

#4 MilanL
ještě 1 drobné vylepšení  

function
...
var
  Fon : TFont;
  L5zmensit : bolean;	
begin
fontOtazky := uppercase(fontOtazky);
fontOdpovedi := uppercase(fontOdpovedi;
...
case fontOtazky[1] of  	// musí být ordinární typ tzn podle 1 znaku názvu fontu
                       	// v případě, že více fontů mělo stejný 1. znak musel
			// by se pod obsluhou toho znaku udělat rozskok podle
			// dalších
  'S' : Fon := FonAri;	// fontOtazky = 'SYSTEM'
  'H' : Fon := FonHeb;	// fontOtazky = 'HEBREW' 
  'B' : ....;    	// fontOtazky = 'BWGRKI' - řečtina
   atd..;		// další fonty Otazky 
  else ...;		// default
end;

// zde pak nastavit všechny componenty otázky
 componenta.font := Fon;

case fontOdpovedi[1] of // musí být ordinární typ tzn podle 1 znaku názvu fontu
                       	// v případě, že více fontů mělo stejný 1. znak musel
			// by se pod obsluhou toho znaku udělat rozskok podle
			// dalších
  'S' : Fon := FonAri;	// fontOdpovědi = 'SYSTEM'
  'H' : begin		// fontOdpovědi = 'HEBREW'
	  Fon := FonHeb;
          L5zmensit := true;
	end;		 
  'B' : ....;    	// fontOdpovědi = 'BWGRKI' - řečtina
   atd..;    		// další fontyOdpovědi 	
  else ...;		// default
end;

// opět doplnit fonty do component odpovědí
Label5.font := Fon;
if L5zmensit then Label5.Font.size := Label5.font.size - 2;

#4 MilanL
tomu prepareFont(TFont,[pole názvů]) bych se bejt tebou vyhnul, musel bys udělat smyčku procházení component formuláře (ted z hlavy nevím jestli to bere přímo i z panelů nebo bys musel panely procházet zvlášť), testovat názvy component na to pole názvů, pak podle typu componenty přetypovat a nastavovat font.

#2 MilanL
Díky, prozkoumám to zítra.

#7 oxidián
návrh fontPrepare, stačí vložit za Case switche

procedure FontPrepare(fon : TFont; pole : array of string); // pole = názvy component
var
  I:integer;
begin
  if length(pole)<1 then exit; 			// prázdné pole
  for I := 0 to ComponentCount - 1 do		// projdi komponenty formuláře
    if Components[I].name in pole then		// testuj zda je název
						// komponenty v seznamu pole
    begin  
      if Component[I] is TEdit then TEdit(Component[I]).Font = fon;  
      if Component[I] is TLabel then TLabel(Component[I]).Font = fon;  
      if Component[I] is TListBox then TListBox(Component[I]).Font = fon;
	... podobně pro všechny potřebné typy component
POZOR ošetření size u L5 s fontem Hebrew nutno ošetřit zvlášť.třeba zde
      if (Component[I].name = 'Label5') and 
         (TLabel(Component[I]).font.name[1] = 'H') 
         then TLabel(Component[I]).font.size := 
                            TLabel(Component[I]).font.size-2;    end;    
 end;

pokud bys přidal do deklarace procedury ještě argument size : boolean můžeš si zjednodušit tu druhou podmínku u Label5 místo testu názvu fontu jen size

if (component[I].name='Label5') and size then ...

Ty pole stringů, můžeš mít předdefinovaný jako constantu na začátku a jen případně přidávat ubírat názvy, kterých se to týká.

const

 poleOtaz : array [0..počet-1] of string = ('Názvy','komponent','otázek kde se mění font',....);
 poleOdp : array [0..počet-1] of string = ('Názvy','komponent','odpovědí kde se mění font',....);
 

volání funkce

fontPrepare(Fon,poleOtaz);

Jenže ten program má umožňovat několik velikostí fontů. Hlavní změny velikosti se dají očekávat u hebrejštiny. Takže např. zatímco normální font u hebrejštiny bude mít velikost 30, pokud si uživatel zvolí že chce větší font, tak mu nastavím třeba 50 nebo 60 ... Pokud bude chtít menší, použiju 20... Takže 3 velikosti. U řeckého fontu něco podobného... No a to bych musel dělat 7x-8x font jen kvůli velikosti...

var HebFont1,HebFont2,HebFont3,GreFont1,GreFont2,GreFont3,SysFont1,SysFont2 : TFont;

a teď to všechno nastavit. To je trochu uhozené, nemyslíš? Navíc pokud to dělat tak složitě tak už by to rovnou chtělo celé zabalit do jednoho wrapovacího objektu ... Takže např.  var Fonty: FFont; dále iniciovat Fonty...

#9 oxidián
stačí ti 1 proměná fontu pro každý to písmo, základní velikost si nastavíš z configuráku a pak při každé uživatelské změně a pak provedeš tu přeformátovací funkci, nepředpokládám, že by uživatel nastavoval ručně velikost písma každého prvku, na zmenšení zvětšení v některém prvku jako máš u label5 bys měl, pak ale mít asi int array velikostí a v poli si najít sousední menší nebo větší velikost.

měl by sis rozmyslet co vlastně chceš aby to umělo, vem si že tam máš u různých prvků různé velikosti a různé barvy. a potřebuješ u fontu měnit Název, velikost, charset a případně barvu.

jediné další řešení vidím ve vytvoření shematu komponenta, + pole vlastností fontu

pak bys musel změnit tu část ve font prepare z if components[I] in pole na hledání ve schematu a nastavení parametrů z něj.

#9 oxidián
Tys v tom fontPrepare(string,[Label1,Edit1]) asi myslel, že ti bude stačit udělat cyklus na projetí toho pole  a v něm pak pole[I].font.name := string ale tak to v delphi prostě nefunguje, musíš projít componenty formuláře najít jí podle názvu podle typu správně přetypovat a tam teprve nastavovat viz. moje procedura fontPrepare v #8 MilanL

#11 MilanL
jinak postup, uživatel změní velikost písma hebrejštiny, ty jen u FonHeb změníš size a promítneš pomocí font prepare bud do Otázek nebo odpovědí.a to je vše. nepotřenuješ žádné další proměnné fontů,

jinak si font prepare můžeš přetížit, jednou bude vstup font, podruhý string s názvem potřetí int s velikostí  po čtvrtý název a velikost po pátý barva (aby se nepletlo s velikostí nutno přehodit argumenty jednou mít int,pole a podruhé pole,int.

Dneska už nestíhám. Začal jsem dělat menu pro fonty pro tři velikosti písma. Tak budou stačit tři proměnné pouze zapíšu jakou velikost písma si uživatel zvolil.

#13 oxidián
zestručním potřebuješ řešit tyto situace pro 2 skupiny prvků: prvky Otázky a prvky Odpovědi :

1) nastavení fontů - mělo by být určeno párem : Jazyk otázek - Jazyk odpovědí, mělo by se nastavovat při výběru způsobu testování

2) velikost a barva písma : nějaké = výchozí nastavení by mělo být při výběru testu, uživatel může měnit, potřebuješ pak promítnout změny včetně případného zvětšení zmenšení nebo jiné barvy u konkrétních prvků

3) uložení do parametrů uživatele a obnova

Máš tam chybu, není žádný EUROPEAN_CHARSET
ale EASTEUROPE_CHARSET

var  fontsizeHebrewSmaller, fontsizeCe:integer;

procedure TForm1.FormCreate(Sender: TObject);
var   i : integer;
begin

sysFont := TFont.Create;
sysFont.name := 'Arial CE';
sysFont.size := 16;
sysFont.charset := EASTEUROPE_CHARSET;
greFont := TFont.Create;
greFont.name := 'Arial CE';
greFont.size := 18;
greFont.charset := EASTEUROPE_CHARSET;
hebFont := TFont.Create;
hebFont.name := 'Hebrew';
hebFont.size := 30;
hebFont.Charset := DEFAULT_CHARSET;
fontsizeHebrewSmaller:=22;
fontsizeCe:=12;
...
end;

Moc velké zjednodušení to není. Protože v procedurách, které spouštím při kliknutí na menu musím změnit ty přednastavené hodnoty - tzn. v případě že programátor bude chtít změnit velikost písma musí sahat do dvou míst v kódu místo do jednoho. Jinak bych musel vytvářet dvoje proměnné s původníma a s aktuálníma hodnotama.

Jak opravit toto aby výsledkem byl integer?

sysFont:=sysFont*1.625;
fontsizeCe:=fontsizeCe*1.25;

#15 oxidián
funkce Round(float) vrací integer

sysFont:=sysFont * round(1.625);
fontsizeCe:=fontsizeCe * round(1.25);

Mám ale chybu Operator not applicapble to this operand type

#15 oxidián
jinak koukám že máš nějakej navyklej způsob pojmenovávání.

Já upřednostňuju nejřív třídu a pak název, proto jsem je pojmenoval fonHeb (jako font Hebrejština) to samé u komponent formulářů např místo Listbox1 bych měl lbOdpoved, eOdpoved (edit), lOdpoved (label), lOdpSpravne a proměnné bUlozeno (boolean), sNazev (string), asPole (array of string)...

#17 oxidián
ee musíš zaokrouhlovat celej výpočet

a sysfont máš typu font nemůžeš s ním takhle počítat

sysFont.size := Round(sysFont.size * 1.625); 
fontsizeCe:=Round(fontsizeCe *1.25); 

A jak mám teda převést velikost písma na číslo nebo to nejde? Nebo jak by si to písmo zvětšil ty pomocí poměru?

#20 oxidián
odpověď máš v  #19 MilanL ty výpočty tam už jsou upravený, aby fungovaly

už chápu, já se pořád díval na tu pravou stranu místo doleva

#22 oxidián
Zamklo se ti to vlákno s ClearEdit, jde hlavně o to, že ty funkce používáš na špatných místech a nevyužíváš moc dobře proměný. Formulář bys měl mít startovanej s prázdnými políčky, pak v create do listboxu načíst seznam. ClearEdit spouštět na konci ukládací rutiny, po uložení editace nebo nové knihy, případně na tlačítko pro výmaz rozepsaného.

Samozřejmě by to šlo i přes OnEnter, kdybys tam rozšířil podmínku

if isLoaded and (Sender=Edit1) then...

problém tam vidím v tom, že pokud bys editoval, tak na to políčko nesmíš bo by ti to vše smazalo.

To vlákno jsem zamknul protože jsem to už vyřešil. Dořešil jsem to přes pridatClick nebo jak se to jmenuje ubratClick a BookClose nebo jak se to jmenuje... to už neřeš.

Ale chci tě požádat aby ses mrkl na současnou verzi. Když přidáš knihu a chceš ji editovat mělo by se tlačítko Uložit aktivovat. Vlastně by vůbec nemělo být deaktivované. Nevím proč je zamknuté. Mohl bys to zjistit? Tlačítko Přidat funguje správně to je zděděné z původní verze z modulu Jmeno.

Už jsme na to přišel, řeší se to v té funkci:

procedure TBooksDialog.Edit1Change(Sender: TObject);
begin
editsCleared:=false;

if Edit1.text<>'' then
 begin
  pridat.enabled := true;
  save1.enabled := true;
  OKbtn.enabled := true;
  Caption:='Učebnice: '+ Edit2.text;
 end
else
 begin
   pridat.enabled := false;
   save1.enabled := false;
   OKbtn.enabled:=false;
   Caption:='Zadání Autora';
 end;
end;

#25 oxidián
Vypadá to zvláštně. Zkus to přepsat do OOP.

To ne, na to nemám čas.

#27 oxidián
no časem budeš muset pokud chceč rozšířit to fungování.

Jinak do edit change ti to vleze jen, když změníš položku, navíc to máš zatím postavený pouze na 1 položku, když je správně a chceš opravit jinou tak tam obsluha není.

S tím Captionem bych si vůbec nehrál, pak si můžeš pro všechny Edit políčka udělat jednu change proceduru 

procedure TBooksDialog.EditChange(Sender: TObject);
begin
editsCleared:=false;

if TEdit(Sender).text<>'' then
 begin
  pridat.enabled := true;
  save1.enabled := true;
  OKbtn.enabled := true;
  //Caption:='Učebnice: '+ Edit2.text;
 end
else
 begin
   pridat.enabled := false;
   save1.enabled := false;
   OKbtn.enabled:=false;
   //Caption:='Zadání Autora';
 end;
end;

#28 MilanL
ještě drobnost

Caption si uprav v listboxClick na konci

Caption := 'Editace učebnice: ' + Edit2.text

a přidej si to ještě do eventu OnExit u edit2