home *** CD-ROM | disk | FTP | other *** search
/ PC World Plus! (NZ) 2001 June / HDC50.iso / Runimage / Delphi50 / Help / Examples / Combobox / COMBFORM.PAS < prev    next >
Pascal/Delphi Source File  |  1999-08-11  |  7KB  |  309 lines
  1. unit combform;
  2.  
  3. interface
  4.  
  5. uses
  6.   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  7.   StdCtrls, ComCtrls, Menus, ExtCtrls;
  8.  
  9. type
  10.   TComboForm = class(TForm)
  11.     CbDrop: TComboBox;
  12.     CbDropList: TComboBox;
  13.     CbSimple: TComboBox;
  14.     Label1: TLabel;
  15.     Label2: TLabel;
  16.     Label3: TLabel;
  17.     Label4: TLabel;
  18.     MainMenu1: TMainMenu;
  19.     ComboStyle: TMenuItem;
  20.     CmSimple: TMenuItem;
  21.     CmDrop: TMenuItem;
  22.     CmDropList: TMenuItem;
  23.     Add1: TMenuItem;
  24.     CmAddString: TMenuItem;
  25.     CmAddStringAt: TMenuItem;
  26.     Search1: TMenuItem;
  27.     CmFindString: TMenuItem;
  28.     CmFindIndex: TMenuItem;
  29.     CmDelete: TMenuItem;
  30.     CmList: TMenuItem;
  31.     CmDelString: TMenuItem;
  32.     CmDelIndex: TMenuItem;
  33.     CmShowList: TMenuItem;
  34.     CmClear: TMenuItem;
  35.     N1: TMenuItem;
  36.     Label5: TLabel;
  37.     EdCursel: TEdit;
  38.     EdCuridx: TEdit;
  39.     EdCurlen: TEdit;
  40.     EdEdit: TEdit;
  41.     EdEditlen: TEdit;
  42.     CmSortList: TMenuItem;
  43.     Bevel1: TBevel;
  44.     procedure ComboStyleClick(Sender: TObject);
  45.     procedure CmSimpleClick(Sender: TObject);
  46.     procedure CmDropClick(Sender: TObject);
  47.     procedure CmDropListClick(Sender: TObject);
  48.     procedure FormCreate(Sender: TObject);
  49.     procedure ComboChange(Sender: TObject);
  50.     procedure CmClearClick(Sender: TObject);
  51.     procedure CmDelStringClick(Sender: TObject);
  52.     procedure CmDelIndexClick(Sender: TObject);
  53.     procedure CmFindStringClick(Sender: TObject);
  54.     procedure CmFindIndexClick(Sender: TObject);
  55.     procedure CmAddStringClick(Sender: TObject);
  56.     procedure CmAddStringAtClick(Sender: TObject);
  57.     procedure Button1Click(Sender: TObject);
  58.     procedure CmSortListClick(Sender: TObject);
  59.     procedure CmListClick(Sender: TObject);
  60.     procedure CmShowListClick(Sender: TObject);
  61.   private
  62.     { Private declarations }
  63.     FCbActive: TComboBox;
  64.     procedure SetCbActive(cb: TComboBox);
  65.  
  66.     procedure NewSelection;
  67.     procedure DeleteAt(idx: Integer);
  68.     procedure AddAt(idx: Integer; s: string);
  69.     procedure SelectAt(idx: Integer);
  70.  
  71.     function FindString(s: string): Integer;
  72.  
  73.     property CbActive: TComboBox read FCbActive write SetCbActive;
  74.   public
  75.     { Public declarations }
  76.   end;
  77.  
  78. var
  79.   ComboForm: TComboForm;
  80.  
  81. implementation
  82.  
  83. uses inptform;
  84.  
  85. {$R *.DFM}
  86.  
  87. // -------------- //
  88. // event handlers //
  89. // -------------- //
  90.  
  91. procedure TComboForm.FormCreate(Sender: TObject);
  92. begin
  93.   FCbActive := CbSimple;
  94.   CbSimple.Visible := True;
  95.   CbDrop.Visible := False;
  96.   CbDropList.Visible := False;
  97.   NewSelection;
  98. end;
  99.  
  100. // Control notifications
  101. // ---------------------
  102.  
  103. //
  104. // close form
  105. //
  106. procedure TComboForm.Button1Click(Sender: TObject);
  107. begin
  108.   Close;
  109. end;
  110.  
  111. procedure TComboForm.ComboChange(Sender: TObject);
  112. begin
  113.   NewSelection;
  114. end;
  115.  
  116.  
  117. // ComboBox menu
  118. // -------------
  119.  
  120. procedure TComboForm.ComboStyleClick(Sender: TObject);
  121. begin
  122.   CmSimple.Checked := CbActive = CbSimple;
  123.   CmDrop.Checked := CbActive = CbDrop;
  124.   CmDropList.Checked := CbActive = CbDropList;
  125. end;
  126.  
  127. procedure TComboForm.CmSimpleClick(Sender: TObject);
  128. begin
  129.   CbActive := CbSimple;
  130. end;
  131.  
  132. procedure TComboForm.CmDropClick(Sender: TObject);
  133. begin
  134.   CbActive := CbDrop;
  135. end;
  136.  
  137. procedure TComboForm.CmDropListClick(Sender: TObject);
  138. begin
  139.   CbActive := CbDropList;
  140. end;
  141.  
  142. // Add menu
  143. // --------
  144. procedure TComboForm.CmAddStringClick(Sender: TObject);
  145. var
  146.   s: string;
  147. begin
  148.   if InputForm.GetString('String to add:', s) then
  149.     AddAt(0, s);
  150. end;
  151.  
  152. procedure TComboForm.CmAddStringAtClick(Sender: TObject);
  153. var
  154.   i: Integer;
  155.   s: string;
  156. begin
  157.   if InputForm.GetString('String to add:', s)
  158.       and InputForm.GetInteger('Index to insert at:', i) then
  159.     AddAt(i, s);
  160. end;
  161.  
  162. // Find menu
  163. // ---------
  164. procedure TComboForm.CmFindStringClick(Sender: TObject);
  165. var
  166.   s: string;
  167. begin
  168.   if InputForm.GetString('String to select:', s) then
  169.     SelectAt(FindString(s));
  170. end;
  171.  
  172. procedure TComboForm.CmFindIndexClick(Sender: TObject);
  173. var
  174.   i: Integer;
  175. begin
  176.   if InputForm.GetInteger('Index to select:', i) then
  177.     SelectAt(i);
  178. end;
  179.  
  180.  
  181. // Delete menu
  182. // -----------
  183. procedure TComboForm.CmDelStringClick(Sender: TObject);
  184. var
  185.   s: string;
  186. begin
  187.   if InputForm.GetString('String to delete:', s) then
  188.     DeleteAt(FindString(s));
  189. end;
  190.  
  191. procedure TComboForm.CmDelIndexClick(Sender: TObject);
  192. var
  193.   i: Integer;
  194. begin
  195.   if InputForm.GetInteger('Index to delete:', i) then
  196.     DeleteAt(i);
  197. end;
  198.  
  199. procedure TComboForm.CmClearClick(Sender: TObject);
  200. begin
  201.   CbActive.Clear;
  202. end;
  203.  
  204.  
  205. // List menu
  206. // ---------
  207. procedure TComboForm.CmShowListClick(Sender: TObject);
  208. begin
  209.   CbActive.DroppedDown := not CbActive.DroppedDown;
  210. end;
  211.  
  212. procedure TComboForm.CmSortListClick(Sender: TObject);
  213. begin
  214.   CbActive.Sorted := not CbActive.Sorted;
  215. end;
  216.  
  217. procedure TComboForm.CmListClick(Sender: TObject);
  218. begin
  219.   CmShowList.Enabled := CbActive <> CbSimple;
  220.   CmSortList.Checked := CbActive.Sorted;
  221. end;
  222.  
  223.  
  224. // --------------- //
  225. // private methods //
  226. // --------------- //
  227.  
  228. procedure TComboForm.NewSelection;
  229. begin
  230.   if CbActive.ItemIndex = -1 then
  231.     EdCursel.Text := ''
  232.   else
  233.     EdCursel.Text := CbActive.Items[CbActive.ItemIndex];
  234.   EdCuridx.Text := IntToStr(CbActive.ItemIndex);
  235.   EdCurlen.Text := IntToStr(length(EdCursel.Text));
  236.  
  237.   EdEdit.Text := CbActive.Text;
  238.   EdEditlen.Text := IntToStr(length(EdEdit.Text));
  239. end;
  240.  
  241. procedure TComboForm.SetCbActive(cb: TComboBox);
  242. begin
  243.   if FCbActive <> cb then
  244.   begin
  245.     FCbActive.Visible := False;
  246.     FCbActive := cb;
  247.     FCbActive.Visible := True;
  248.     NewSelection;
  249.   end;
  250. end;
  251.  
  252.  
  253. //
  254. // Delete an item from the active combobox given its index.
  255. // Ignores bogus indices.
  256. //
  257. procedure TComboForm.DeleteAt(idx: Integer);
  258. begin
  259.   if idx >= 0 then
  260.     CbActive.Items.Delete(idx);
  261. end;
  262.  
  263.  
  264. //
  265. // Add a string into the active combobox at the given index.
  266. // If the index is too big, append the item, if too small,
  267. // insert it at the top.
  268. //
  269. procedure TComboForm.AddAt(idx: Integer; s: string);
  270. begin
  271.   if idx > CbActive.Items.Count then
  272.     CbActive.Items.Append(s)
  273.   else
  274.   begin
  275.     if idx < 0 then
  276.       idx := 0;
  277.     CbActive.Items.Insert(idx, s);
  278.   end;
  279. end;
  280.  
  281.  
  282. //
  283. // Select an item in the active combobox given it's index.
  284. // A bogus index will result in an exception.
  285. procedure TComboForm.SelectAt(idx: Integer);
  286. begin
  287.   CbActive.ItemIndex := idx;
  288.   NewSelection;
  289. end;
  290.  
  291.  
  292. //
  293. // Find the index of an item in the combobox given a string.
  294. // If the string does not exist, return -1.
  295. //
  296. function TComboForm.FindString(s: string): Integer;
  297. var
  298.   i: Integer;
  299. begin
  300.   i := 0;
  301.   while (i < CbActive.Items.Count) and (CbActive.Items[i] <> s) do
  302.     inc(i);
  303.   Result := i;
  304. end;
  305.  
  306.  
  307.  
  308. end.
  309.