home *** CD-ROM | disk | FTP | other *** search
/ QBasic & Borland Pascal & C / Delphi5.iso / Runimage / Delphi50 / Source / Vcl / DBINPREQ.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1999-08-11  |  3.8 KB  |  160 lines
  1.  
  2. {*******************************************************}
  3. {                                                       }
  4. {       Borland Delphi Visual Component Library         }
  5. {                                                       }
  6. {       Copyright (c) 1996,99 Inprise Corporation       }
  7. {                                                       }
  8. {*******************************************************}
  9.  
  10. unit DBInpReq;
  11.  
  12. {$R-}
  13.  
  14. interface
  15.  
  16. uses Windows, Classes, SysUtils, Forms, Controls, StdCtrls, ExtCtrls,
  17.   BDE, Dialogs;
  18.  
  19. type
  20.   TInputReqDialog = class(TForm)
  21.     OKButton: TButton;
  22.     CancelButton: TButton;
  23.     InputOptions: TPanel;
  24.     NoPromptAgain: TCheckBox;
  25.     ErrorHelp: TLabel;
  26.     InputMessage: TLabel;
  27.     ErrorGroupBox: TPanel;
  28.     ErrorGoupBoxSpacer: TPanel;
  29.     DescriptionGroupBox: TPanel;
  30.     DescriptionGroupBoxSpacer: TPanel;
  31.     procedure InputOptionsClick(Sender: TObject);
  32.   private
  33.     FCBInfo: PCBInputDesc;
  34.     FSelection: Integer;
  35.     procedure SetCBInfo(var CBInfo: CBInputDesc);
  36.     procedure GetCBInfo(var CBInfo: CBInputDesc);
  37.   end;
  38.  
  39. function InputRequest(var InputReqInfo: CBInputDesc): CBRType;
  40.  
  41. implementation
  42.  
  43. uses DB, DBTables;
  44.  
  45. {$R *.DFM}
  46.  
  47. function InputRequest(var InputReqInfo: CBInputDesc): CBRType;
  48. begin
  49.   Result := cbrUSEDEF;
  50.   with TInputReqDialog.Create(Application) do
  51.   try
  52.     SetCBInfo(InputReqInfo);
  53.     begin
  54.       ShowModal;
  55.       if ModalResult = mrOK then
  56.       begin
  57.         GetCBInfo(InputReqInfo);
  58.         Result := cbrCHKINPUT;
  59.       end;
  60.     end;
  61.   finally
  62.     Free;
  63.   end;
  64. end;
  65.  
  66. procedure TInputReqDialog.SetCBInfo(var CBInfo: CBInputDesc);
  67.  
  68.   procedure CreateRadioButton(Index: Integer; const Cap: string);
  69.   begin
  70.     with TRadioButton.Create(Self) do
  71.     begin
  72.       Top := Index * (Height + 2) + 7;
  73.       Left := 5;
  74.       Width := InputOptions.Width - 10;
  75.       Caption := Cap;
  76.       Tag := Index;
  77.       OnClick := InputOptionsClick;
  78.       Parent := InputOptions;
  79.     end;
  80.   end;
  81.  
  82. var
  83.   I: Integer;
  84.   Sel: Integer;
  85. begin
  86.   FCBInfo := @CBInfo;
  87.   with CBInfo do
  88.   begin
  89.     InputMessage.Caption := szMsg;
  90.     for I := 0 to iCount - 1 do
  91.       CreateRadioButton(I, acbEntry[I].szKeyWord);
  92.     NoPromptAgain.Checked := bSave;
  93.     Sel := iSelection;
  94.     if (Sel < 1) or (Sel > iCount) then Sel := 1;
  95.     ActiveControl := InputOptions.Controls[Sel - 1] as TWinControl;
  96.   end;
  97. end;
  98.  
  99. procedure TInputReqDialog.GetCBInfo(var CBInfo: CBInputDesc);
  100. begin
  101.   with CBInfo do
  102.   begin
  103.     iSelection := FSelection + 1;
  104.     bSave := NoPromptAgain.Checked;
  105.   end;
  106. end;
  107.  
  108. procedure TInputReqDialog.InputOptionsClick(Sender: TObject);
  109. begin
  110.   FSelection := (Sender as TComponent).Tag;
  111.   if (FSelection >= 0) and (FSelection < FCBInfo.iCount) then
  112.     ErrorHelp.Caption := FCBInfo.acbEntry[FSelection].szHelp;
  113. end;
  114.  
  115. type
  116.   TInputReqClass = class
  117.     FCBInputReq: CBInputDesc;
  118.     FCallBack: TBDECallback;
  119.   public
  120.     destructor Destroy; override;
  121.     function InputReqCallBack(CBInfo: Pointer): CBRType;
  122.     procedure RegisterCallback(Session: TSession);
  123.   end;
  124.  
  125. destructor TInputReqClass.Destroy;
  126. begin
  127.   if Assigned(Session) and (Session.Active) then
  128.     FCallBack.Free;
  129. end;
  130.  
  131. procedure TInputReqClass.RegisterCallback(Session: TSession);
  132. begin
  133.   FCallBack := TBDECallback.Create(Self, nil, cbINPUTREQ,
  134.     @FCBInputReq, SizeOf(FCBInputReq), InputReqCallBack, False);
  135. end;
  136.  
  137. function TInputReqClass.InputReqCallBack(CBInfo: Pointer): CBRType;
  138. begin
  139.   try
  140.     Result := InputRequest(PCBInputDesc(CBInfo)^);
  141.   except
  142.     Result := cbrUseDef;
  143.   end;
  144. end;
  145.  
  146. var
  147.   InputReqClass: TInputReqClass;
  148.  
  149. procedure InitProc(Session: TSession);
  150. begin
  151.   InputReqClass.RegisterCallback(Session);
  152. end;
  153.  
  154. initialization
  155.   InputReqClass := TInputReqClass.Create;
  156.   RegisterBDEInitProc(InitProc);
  157. finalization
  158.   InputReqClass.Free;
  159. end.
  160.