home *** CD-ROM | disk | FTP | other *** search
/ DOS/V Power Report 1997 August / VPR9708A.ISO / D3TRIAL / INSTALL / DATA.Z / COMBFORM.PAS < prev    next >
Pascal/Delphi Source File  |  1997-05-07  |  7KB  |  310 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. //  イベントハンドラ //
  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. // コントロール通知
  101. // ---------------------
  102.  
  103. //
  104. // フォームを閉じる
  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 メソッド  //
  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. // インデックスが指定された場合は、アクティブなコンボボックスから項目を削除する
  255. // 該当するインデックスがないときは無視する
  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. // 特定のインデックスでアクティブなコンボボックスに文字列を追加する
  266. // インデックスが大きすぎるときは項目を末尾に追加し、
  267. // 小さすぎるときは先頭に挿入する。
  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. // インデックスが指定された場合は、アクティブなコンボボックスの項目を選択する
  284. // 該当するインデックスがないときは例外が発生する
  285. //
  286. procedure TComboForm.SelectAt(idx: Integer);
  287. begin
  288.   CbActive.ItemIndex := idx;
  289.   NewSelection;
  290. end;
  291.  
  292.  
  293. //
  294. // 文字列が指定された場合は、コンボボックスで項目のインデックスを見つける
  295. // 文字列が存在しないときは、－１を返す
  296. //
  297. function TComboForm.FindString(s: string): Integer;
  298. var
  299.   i: Integer;
  300. begin
  301.   i := 0;
  302.   while (i < CbActive.Items.Count) and (CbActive.Items[i] <> s) do
  303.     inc(i);
  304.   Result := i;
  305. end;
  306.  
  307.  
  308.  
  309. end.
  310.