home *** CD-ROM | disk | FTP | other *** search
/ Delphi Magazine Collection 2001 / Delphi Magazine Collection 20001 (2001).iso / DISKS / Issue26 / sdrop14 / SDROP14.ZIP / SDropDemo1.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1997-09-03  |  5.8 KB  |  207 lines
  1. unit SDropDemo1;
  2. {$A+,B-,G+,H+,O+,J-,T+,U-,V+,W-,X+} //Set up compiler
  3. {$D-,L-,Q-,R-,Y-} //Comment out to debug
  4.  
  5. interface
  6.  
  7. uses
  8.   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  9.   StdCtrls, ExtCtrls, STools, SDropLst, ComCtrls;
  10.  
  11. type
  12.   TfrmDropDemo = class(TForm)
  13.     SDropList2: TSDropList;
  14.     SDropList3: TSDropList;
  15.     Panel1: TPanel;
  16.     SDropList1: TSDropList;
  17.     Edit2: TEdit;
  18.     rgOnSelect: TRadioGroup;
  19.     cbStyle: TCheckBox;
  20.     cbDropFocus: TCheckBox;
  21.     cbDropAltDn: TCheckBox;
  22.     rgBorderStyle: TRadioGroup;
  23.     rgShowButton: TRadioGroup;
  24.     rgButtonPos: TRadioGroup;
  25.     SDropList4: TSDropList;
  26.     PageControl1: TPageControl;
  27.     TabSheet1: TTabSheet;
  28.     TabSheet2: TTabSheet;
  29.     Memo1: TMemo;
  30.     Memo2: TMemo;
  31.     cbCaret: TCheckBox;
  32.     cbStayDown: TCheckBox;
  33.     ComboBox1: TComboBox;
  34.     Label1: TLabel;
  35.     Label2: TLabel;
  36.     Label3: TLabel;
  37.     SDropList5: TSDropList;
  38.     Label4: TLabel;
  39.     SDropEdit1: TSDropEdit;
  40.     Label5: TLabel;
  41.     procedure rgOnSelectClick(Sender: TObject);
  42.     procedure cbStyleClick(Sender: TObject);
  43.     procedure cbDropFocusClick(Sender: TObject);
  44.     procedure cbDropAltDnClick(Sender: TObject);
  45.     procedure cbCaretClick(Sender: TObject);
  46.     procedure rgBorderStyleClick(Sender: TObject);
  47.     procedure rgShowButtonClick(Sender: TObject);
  48.     procedure rgButtonPosClick(Sender: TObject);
  49.     procedure cbStayDownClick(Sender: TObject);
  50.     procedure SDropList5DrawListItem(Control: TWinControl; Index: Integer;
  51.       Rect: TRect; State: TOwnerDrawState);
  52.     procedure SDropEdit1WantForm(Sender: TObject; var SubForm: TForm;
  53.       var DestroyOnClose: Boolean);
  54.     procedure SDropEdit1Exit(Sender: TObject);
  55.     procedure SDropList4AutoExpand(Sender: TObject; Hit: Boolean;
  56.       var Revert: Boolean; var NewText: String);
  57.     procedure SDropList2Click(Sender: TObject);
  58.   private
  59.     { Private declarations }
  60.   public
  61.     { Public declarations }
  62.   end;
  63.  
  64. var
  65.   frmDropDemo: TfrmDropDemo;
  66.  
  67. implementation
  68.  
  69. uses SDropDemo2;
  70.  
  71. {$R *.DFM}
  72.  
  73.  
  74.  
  75.  
  76.  
  77. procedure TfrmDropDemo.rgOnSelectClick(Sender: TObject);
  78. begin
  79.   Case rgOnSelect.ItemIndex Of
  80.     0: begin SDropList1.List.DoOnClick:= doTakeValue;
  81.        SDropList1.List.DoOnReturnKey:= doTakeValue; end;
  82.     1: begin SDropList1.List.DoOnClick:= doDefault;
  83.        SDropList1.List.DoOnReturnKey:= doDefault; end;
  84.     2: begin SDropList1.List.DoOnClick:= doGoAway;
  85.        SDropList1.List.DoOnReturnKey:= doGoAway; end;
  86.   End;
  87.   SDropList1.DisplayForm(Sender);
  88. end;
  89.  
  90. procedure TfrmDropDemo.cbStyleClick(Sender: TObject);
  91. begin
  92.   if cbStyle.checked then SDropList1.Style:= dlsDropDownList
  93.   else SDropList1.Style:= dlsDropDown;
  94.   SDropList1.SetFocus;
  95. end;
  96.  
  97. procedure TfrmDropDemo.cbDropFocusClick(Sender: TObject);
  98. begin
  99.   with SDropList1 do
  100.     if cbDropFocus.Checked then
  101.       DropDownOn:= DropDownOn+[DropOnGetFocus]
  102.     else DropDownOn:= DropDownOn-[DropOnGetFocus];
  103.   SDropList1.SetFocus;
  104. end;
  105.  
  106. procedure TfrmDropDemo.cbDropAltDnClick(Sender: TObject);
  107. begin
  108.   with SDropList1 do
  109.     if cbDropFocus.Checked then
  110.       DropDownOn:= DropDownOn+[DropOnAltArrow]
  111.     else DropDownOn:= DropDownOn-[DropOnAltArrow];
  112.   SDropList1.SetFocus;
  113. end;
  114.  
  115.  
  116. procedure TfrmDropDemo.cbCaretClick(Sender: TObject);
  117. begin
  118.   SDropList1.CaretAtEnd:=cbCaret.Checked;
  119.   SDropList1.SetFocus;
  120. end;
  121.  
  122. procedure TfrmDropDemo.rgBorderStyleClick(Sender: TObject);
  123. begin
  124.   Case rgBorderStyle.ItemIndex of
  125.     0:  With SDropList1 do begin
  126.         ParentColor:=True; BorderStyle:=bsNone; end;
  127.     1: With SDropList1 do begin
  128.         Color:=clWindow; BorderStyle:=bsSingle; Ctl3D:=False; end;
  129.     2: With SDropList1 do begin
  130.         Color:=clWindow; BorderStyle:=bsSingle; Ctl3D:=True; end;
  131.   end; // Case
  132. end;
  133.  
  134. procedure TfrmDropDemo.rgShowButtonClick(Sender: TObject);
  135. begin
  136.   Case rgShowButton.ItemIndex of
  137.     0: SDropList1.ButtonShow:=btnShowYes;
  138.     1: SDropList1.ButtonShow:=btnShowNo;
  139.     2: SDropList1.ButtonShow:=btnShowFocus;
  140.   end; // Case
  141. end;
  142.  
  143. procedure TfrmDropDemo.rgButtonPosClick(Sender: TObject);
  144. begin
  145.   Case rgButtonPos.ItemIndex of
  146.     0: SDropList1.ButtonAlign:=btnRight;
  147.     1: SDropList1.ButtonAlign:=btnLeft;
  148.   end; // Case
  149. end;
  150.  
  151.  
  152. procedure TfrmDropDemo.cbStayDownClick(Sender: TObject);
  153. begin
  154.   SDropList1.ButtonStayDown:=cbStayDown.Checked;
  155. end;
  156.  
  157.  
  158. procedure TfrmDropDemo.SDropList5DrawListItem(Control: TWinControl;
  159.   Index: Integer; Rect: TRect; State: TOwnerDrawState);
  160. var
  161.   TempStr1, TempStr2: String;
  162.   Rect1, Rect2: TRect;
  163.   I,J,K: Integer;
  164. begin
  165.   TempStr1:= TSDropList(Control.Owner).Items[Index];
  166.   SetLength(TempStr1, Pos('::',TempStr1)-1);
  167.   TempStr2:= TSDropList(Control.Owner).Items[Index];
  168.   Delete(TempStr2, 1, Pos('::',TempStr2)+1);
  169.   I:=Pos('&',TempStr2);J:=0;K:=0;
  170.     While I > 0 do begin
  171.       J:=J+I+K; Insert('&',TempStr2,J); Inc(K);
  172.       I:=Pos('&',PChar(TempStr2)+J+K); end;
  173.   with TDropListLB(Control).Canvas do begin
  174.     with Rect do begin
  175.       SetRect(Rect1,Left,Top,Left+TextWidth('WWW'),Bottom);
  176.       SetRect(Rect2,Rect1.Right,Top,Right,Bottom); end;
  177.     DrawTextEx(Handle,PChar(TempStr1),Length(TempStr1),
  178.      Rect1,DT_END_ELLIPSIS, nil);
  179.     DrawTextEx(Handle,PChar(TempStr2),Length(TempStr2),
  180.      Rect2,DT_END_ELLIPSIS, nil); end;
  181. end;
  182.  
  183.  
  184. procedure TfrmDropDemo.SDropEdit1WantForm(Sender: TObject;
  185.   var SubForm: TForm; var DestroyOnClose: Boolean);
  186. begin
  187.   SubForm:=frmDropEdit;
  188. end;
  189.  
  190. procedure TfrmDropDemo.SDropEdit1Exit(Sender: TObject);
  191. begin
  192.   SDropEdit1.CloseForm;
  193. end;
  194.  
  195. procedure TfrmDropDemo.SDropList4AutoExpand(Sender: TObject; Hit: Boolean;
  196.   var Revert: Boolean; var NewText: String);
  197. begin
  198.   if not Hit then begin Revert:=True; Beep; end;
  199. end;
  200.  
  201. procedure TfrmDropDemo.SDropList2Click(Sender: TObject);
  202. begin
  203.   With SDropList2 do if Showing then CloseForm else DisplayForm(Sender);
  204. end;
  205.  
  206. end.
  207.