Živě.cz o počítačích a internetu

Tipy a triky v Delphi, díl 27. - Funkce "autocomplete " v komponentě ComboBox; Přidávání položek do menu za běhu aplikace; Průhledný formulář

Jan Šindelář - 30.1.2002

Funkce "autocomplete " v komponentě ComboBox

Běžným standardem dnešních aplikací bývá, že rozbalovací seznamy – ComboBoxy – mají tzv. funkci autocomplete, což jednoduše řečeno znamená, že nemusíte procházet celým dlouhým seznamem všech položek nebo vypisovat celý její název, ale po napsání části slova se vám automaticky nabídne nejbližší (nejpodobnější) slovo. Jistě tuto funkci všichni dobře znáte (např. při zadávání adresy v Internet Exploreru apod.), takže netřeba dalšího vysvětlování. V případě delších seznamů je to funkce jistě velmi užitečná a uživatelům ulehčuje život. A právě teď si ukážeme, jak na to.

Nejprve umístěte na formulář komponentu ComboBox (není třeba nijak upravovat její vlastnosti) a naplňte ji testovacími daty. Způsob naplnění nechám na vás, kvůli zjednodušení klidně použijte přímo editor v Object Inspectoru. V případné "ostré" aplikaci samozřejmě můžete data zadávat i přímo za běhu programu, na způsobu celkem nezáleží. A pak už jen vytvořte události OnKeyDown a OnChange podle následujícího zdrojového kódu (nezapomeňte též na proměnnou LastKey):

var
  LastKey: Word;

procedure TForm1.ComboBox1KeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
  LastKey := Key;
end;

procedure TForm1.ComboBox1Change(Sender: TObject);
var
  Srch: string;
  ix: Integer;
begin
Srch := combobox1.Text;
if LastKey = $08 then
begin
  LastKey := 0;
  Exit;
end;
  LastKey := 0;
  ix := combobox1.Perform(CB_FINDSTRING, - 1, Longint(PChar(Srch)));
  if ix > CB_ERR then
  begin
  combobox1.ItemIndex := ix;
  combobox1.SelStart  := Length(Srch);
  combobox1.SelLength := (Length(combobox1.Text) - Length(Srch));
  end;
end;

Přidávání položek do menu za běhu aplikace

Většina windowsových aplikací má obvykle nějaké to hlavní menu (samozřejmě ne všechny, to je jasné). Je to již zažitý zvyk, že většina hlavních funkcí dané aplikace je dostupná právě přes hlavní menu. V případě, že jeho podoba je neměnná, můžete jeho návrh v klidu vypracovat při tvorbě aplikace včetně všech událostí a vizuální podoby a nemusíte si s ním už dělat další starosti. Co když ovšem nastane případ, kdy struktura jednotlivých položek v menu ještě není při návrhu aplikace zcela jasná a nebo se mění dynamicky podle aktuální situace? Právě pro ten případ si ukážeme, jak za běhu programu položky do menu přidávat a mazat.

V naší ukázce se nejprve po kliknutí na první tlačítko naplní menu položkami (budou to pro tentokrát názvy fontů písma nainstalovaných v systému) a po stisknutí druhého tlačítka dojde opět k jejich smazání. Když vyberete položku z menu, bude její název (jako ukázka jak přiřadit položce událost OnClick) zobrazena v textovém popisku – Labelu. Tak tedy na prázdný formulář umístěte dvě tlačítka, dále jeden Label a nakonec MainMenu; do něho přidejte jednu položku s názvem Fonts. Zbytek už je vidět ze zdrojového kódu:

procedure TForm1.Fonts1Click(Sender: TObject);
begin
  if Sender <> Fonts1 then Label1.Caption := (Sender as TMenuItem).Caption;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  NewItem: TMenuItem;
  i: Integer;
begin
  for i := 0 to Screen.Fonts.Count -1 do
  begin
    NewItem := TMenuItem.Create(Self);
    NewItem.Caption := Screen.Fonts.Strings[i];
    NewItem.OnClick := Fonts1Click;
    Fonts1.Add(NewItem);
  end;
end;

procedure TForm1.Button2Click(Sender: TObject);
var
i: Integer;
begin
for i:=1 to Fonts1.Count do Fonts1.Delete(0);
end;

Ačkoliv procedura na mazání položek vypadá na první pohled poněkud zvláštně, věřte, že to není překlep. Opravdu mažeme stále dokola položku s indexem nula. K jednotlivým položkám se samozřejmě přistupuje běžným způsobem přes číslo jejich indexu (počítáno od nuly). Pokud však chceme postupně mazat všechny položky, jejich indexy se pochopitelně postupně zmenšují stejně jako jejich celkový počet (parametr Count).

Mazání všech položek ale asi není běžná činnost, proto si stačí pamatovat, že danou položku smažeme prostě a jednoduše pomocí jejího indexu, a v té souvislosti je nutné si uvědomit, že se tím pádem jednak zmenší jejich celkový počet a posunou se i indexy zbylých položek.

Průhledný formulář

Další z oblíbených příkladů na řadě diskusních fór je průhledný formulář. Opět se jedná spíše o ukázku možností, jak pracovat s formulářem, než o reálné použití v aplikacích. I když člověk nikdy neví.

V naší ukázce se po stisku prvního tlačítka formulář zprůhlední, po stisknutí tlačítka dvě se vše vrátí do původního stavu. Je třeba upozornit na to, že veškeré ostatní vizuální komponenty zůstanou nezměněny, takže například tlačítka se jaksi "vznášejí v prostoru". Taktéž zůstane zobrazen okraj formuláře.

private
    { Private declarations }
    FullRgn, ClientRgn, CtlRgn: THandle;
    procedure Pruhledny;
    procedure Nepruhledny;
  end;

{...}

implementation

{...}

procedure TForm1.Pruhledny;
var
  AControl: TControl;
  A, Margin, X, Y, CtlX, CtlY: Integer;
begin
  Margin    := (Width - ClientWidth) div 2;
  FullRgn  := CreateRectRgn(0, 0, Width, Height);
  X        := Margin;
  Y        := Height - ClientHeight - Margin;
  ClientRgn := CreateRectRgn(X, Y, X + ClientWidth, Y + ClientHeight);
  CombineRgn(FullRgn, FullRgn, ClientRgn, RGN_DIFF);
  for A := 0 to ControlCount - 1 do 
  begin
    AControl := Controls[A];
    if (AControl is TWinControl) or (AControl is TGraphicControl) then with AControl do 
      begin
        if Visible then 
        begin
          CtlX  := X + Left;
          CtlY  := Y + Top;
          CtlRgn := CreateRectRgn(CtlX, CtlY, CtlX + Width, CtlY + Height);
          CombineRgn(FullRgn, FullRgn, CtlRgn, RGN_OR);
        end;
      end;
  end;
  SetWindowRgn(Handle, FullRgn, True);
end;

procedure TForm1.Nepruhledny;
begin
FullRgn := CreateRectRgn(0, 0, Width, Height);
CombineRgn(FullRgn, FullRgn, FullRgn, RGN_COPY);
SetWindowRgn(Handle, FullRgn, True);
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
Pruhledny;
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
Nepruhledny;
end;