home *** CD-ROM | disk | FTP | other *** search
/ Chip 2001 December / Chip_2001-12_cd1.bin / zkuste / delphi / kolekce / d3456 / ALEXSOFT.ZIP / DBFORMS.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  2001-09-04  |  8.1 KB  |  265 lines
  1. (*////////////////////////////////////////////////////////////////////////////
  2. //   Part of AlexSoft VCL/DLL Library.                                      //
  3. //   All rights reserved. (c) Copyright 1998.                               //
  4. //   Created by: Alex Rabichooc                                             //
  5. //**************************************************************************//
  6. //  Users of this unit must accept this disclaimer of warranty:             //
  7. //    "This unit is supplied as is. The author disclaims all warranties,    //
  8. //    expressed or implied, including, without limitation, the warranties   //
  9. //    of merchantability and of fitness for any purpose.                    //
  10. //    The author assumes no liability for damages, direct or                //
  11. //    consequential, which may result from the use of this unit."           //
  12. //                                                                          //
  13. //  This Unit is donated to the public as public domain.                    //
  14. //                                                                          //
  15. //  This Unit can be freely used and distributed in commercial and          //
  16. //  private environments provided this notice is not modified in any way.   //
  17. //                                                                          //
  18. //  If you do find this Unit handy and you feel guilty for using such a     //
  19. //  great product without paying someone - sorry :-)                        //
  20. //                                                                          //
  21. //  Please forward any comments or suggestions to Alex Rabichooc at:        //
  22. //                                                                          //
  23. //  a_rabichooc@yahoo.com or alex@carmez.mldnet.com                         //
  24. /////////////////////////////////////////////////////////////////////////////*)
  25.  
  26. unit DBForms;
  27.  
  28. interface
  29.  
  30. uses
  31.   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  32.   StdCtrls, Buttons, dbedfld, dbBoxGrd, ExtCtrls, DBPanel, Db, DBxNav,
  33.   DBInsert, StdUtils;
  34.  
  35. type
  36.   TDBForm = class(TForm)
  37.   private
  38.     FParentField: TField;
  39.     FOnPrint: TNotifyEvent;
  40.     FLoaded: boolean;
  41.     procedure WMClose(var Message: TMessage); Message WM_CLOSE;
  42.     procedure SetOnPrint(const Value: TNotifyEvent);
  43.   protected
  44.     procedure DoShow; override;
  45.     procedure Paint; override;
  46.   public
  47.     property ParentField: TField read FParentField;
  48.     procedure PrintForm;
  49.   published
  50.     property OnPrint: TNotifyEvent read FOnPrint write SetOnPrint;
  51.   end;
  52.  
  53.   TDBFormClass = class of TDBForm;
  54.  
  55.   TDefaultForm = class(TDBForm)
  56.     paBottom: TPanel;
  57.     DBPanel: TRaDBPanel;
  58.     DataSource: TDataSource;
  59.     paTop: TPanel;
  60.     DBInsert: TRaDBInsert;
  61.     paRight: TPanel;
  62.     sbStyle: TSpeedButton;
  63.     sbOrientation: TSpeedButton;
  64.     paBottomLeft: TPanel;
  65.     Navigator: TRaDBNavigator;
  66.     sbExit: TSpeedButton;
  67.     sbReplaceAndExit: TSpeedButton;
  68.     SpeedButton1: TSpeedButton;
  69.     procedure sbReplaceAndExitClick(Sender: TObject);
  70.     procedure sbExitClick(Sender: TObject);
  71.     procedure DBInsertClick(Sender: TObject);
  72.     procedure FormKeyDown(Sender: TObject; var Key: Word;
  73.       Shift: TShiftState);
  74.     procedure FormShow(Sender: TObject);
  75.     procedure sbStyleClick(Sender: TObject);
  76.     procedure sbOrientationClick(Sender: TObject);
  77.     procedure FormClose(Sender: TObject; var Action: TCloseAction);
  78.     procedure SpeedButton1Click(Sender: TObject);
  79.   private
  80.     FPrintFormClass: TFormClass;
  81.     procedure CheckButtons;
  82.     procedure DoPrint(Sender: TObject);
  83.     procedure SetPrintFormClass(const Value: TFormClass);
  84.   protected
  85.     property PrintFormClass: TFormClass read FPrintFormClass write SetPrintFormClass;
  86.   public
  87.     constructor Create(AOwner: TComponent); override;
  88.   end;
  89.  
  90. implementation
  91.  
  92. {$R *.DFM}
  93.  
  94. uses frmDSrce, dbTools, dbPrint;
  95.  
  96. {TDBForm}
  97. procedure TDBForm.WMClose(var Message: TMessage);
  98. var i, AModalResult: Integer;
  99.  
  100. begin
  101.    for i := 0 to ControlCount-1 do
  102.      if Controls[i] is TWinControl then
  103.      SendMessage((Controls[i] as TWinControl).Handle, CN_CLOSEDBFORM,
  104.                                                              Message.WParam, 0);
  105.    Inherited;
  106.    AModalResult := Message.WParam;
  107.    if AModalResult < 0 then
  108.       if (Owner <> nil) and
  109.          (Owner is TWinControl) and
  110.          (Owner as TWinControl).HandleAllocated then
  111.    begin
  112.       PostMessage((Owner as TWinControl).Handle, CN_REPLACEFIELD, 0,
  113.                                                         LParam(ParentField));
  114.       ModalResult := mrOk;
  115.    end;
  116. end;
  117.  
  118. procedure TDBForm.DoShow;
  119. var KeyField, LKeyField: TField;
  120.     LDataSet: TDataSet;
  121. begin
  122.    GetReplaceParams(FParentField, KeyField, LKeyField, LDataSet);
  123.    if (LDataSet <> nil) and (LKeyField <> nil) and (KeyField <> nil) and
  124.       (LDataSet.Active) then
  125.      if not LDataSet.Locate(LKeyField.FieldName, KeyField.Value, []) then
  126.         LDataSet.First;
  127.    Inherited;
  128. end;
  129.  
  130. procedure TDBForm.SetOnPrint(const Value: TNotifyEvent);
  131. begin
  132.    FOnprint := Value;
  133. end;
  134.  
  135. procedure TDBForm.PrintForm;
  136. begin
  137.   if Assigned(FOnPrint) then
  138.      FOnprint(Self);
  139. end;
  140.  
  141. procedure TDBForm.Paint;
  142. var ParentForm: TCustomForm;
  143. begin
  144.   Inherited;
  145.   if not FLoaded then
  146.   begin
  147.     if Owner is TControl then
  148.     begin
  149.       FLoaded := True;
  150.       ParentForm := GetParentForm(Owner as TControl);
  151.       if (ParentForm <> nil) and
  152.          (ParentForm.Left = Left) and
  153.          (ParentForm.Top = Top) and
  154.          (ParentForm.Width = Width) and
  155.          (ParentForm.Height = Height) then
  156.       begin
  157.          Left := Left+20;
  158.          Top := Top-20;
  159.       end;
  160.     end;
  161.   end;
  162. end;
  163.  
  164. {TDefaultForm}
  165. constructor TDefaultForm.Create(AOwner: TComponent);
  166. begin
  167.    Inherited;
  168.    OnPrint := DoPrint;
  169.    if not Assigned(FPrintFormClass) then
  170.      FPrintFormClass := TfmDBPrint;
  171. end;
  172.  
  173. procedure TDefaultForm.sbReplaceAndExitClick(Sender: TObject);
  174. begin
  175.    SendMessage(Handle, WM_CLOSE, -100, 0);
  176. end;
  177.  
  178. procedure TDefaultForm.sbExitClick(Sender: TObject);
  179. begin
  180.    Close;
  181.    ModalResult := mrCancel;
  182. end;
  183.  
  184. procedure TDefaultForm.DBInsertClick(Sender: TObject);
  185. var AControl: TWincontrol;
  186. begin
  187.    AControl := nil;
  188.    with DBPanel do
  189.     if Box.CanFocus and (Box.DataSource = DataSource) then
  190.        AControl := FindNextControl(Box, True, True, False)
  191.       else
  192.     if Grid.CanFocus and (Grid.DataSource = DataSource) then
  193.        AControl := Grid;
  194.     if AControl <> nil then AControl.SetFocus;
  195. end;
  196.  
  197. procedure TDefaultForm.FormKeyDown(Sender: TObject; var Key: Word;
  198.   Shift: TShiftState);
  199. begin
  200.    if (Shift = []) and (Key = VK_F7) then
  201.        Navigator.BtnClick(nbSearch);
  202. end;
  203.  
  204. procedure TDefaultForm.CheckButtons;
  205. begin
  206.    sbStyle.Visible := DBPanel.PanelStyle <> psAuto;
  207.    sbStyle.Enabled := sbStyle.Visible;
  208.    sbOrientation.Visible := sbStyle.Down;
  209.    sbOrientation.Enabled := sbOrientation.Visible;
  210. end;
  211.  
  212. procedure TDefaultForm.FormShow(Sender: TObject);
  213. begin
  214.    sbStyle.Down := DBPanel.PanelStyle = psBox;
  215.    sbOrientation.Down := DBPanel.Orientation = orHorizontal;
  216.    CheckButtons;
  217. end;
  218.  
  219. procedure TDefaultForm.sbStyleClick(Sender: TObject);
  220. begin
  221.    if sbStyle.Down then
  222.       DBPanel.PanelStyle := psBox
  223.      else
  224.       DBPanel.PanelStyle := psGrid;
  225.    CheckButtons;
  226. end;
  227.  
  228. procedure TDefaultForm.sbOrientationClick(Sender: TObject);
  229. begin
  230.    if sbOrientation.Down then
  231.       DBPanel.Orientation := orHorizontal
  232.      else
  233.       DBPanel.Orientation := orVertical;
  234.    CheckButtons;
  235.    Application.ProcessMessages;
  236.    DBInsertClick(Self);
  237. end;
  238.  
  239. procedure TDefaultForm.FormClose(Sender: TObject;
  240.   var Action: TCloseAction);
  241. begin
  242.    if MustFreeForm(DataSource.DataSet) then
  243.      Action := caFree;
  244. end;
  245.  
  246. procedure TDefaultForm.DoPrint(Sender: TObject);
  247. begin
  248.   if (DataSource.DataSet = nil) or not Assigned(PrintFormClass) then
  249.     exit;
  250.   PrintFormClass.Create(Self).Free;
  251.   SetFocus;
  252. end;
  253.  
  254. procedure TDefaultForm.SpeedButton1Click(Sender: TObject);
  255. begin
  256.    PrintForm;
  257. end;
  258.  
  259. procedure TDefaultForm.SetPrintFormClass(const Value: TFormClass);
  260. begin
  261.   FPrintFormClass := Value;
  262. end;
  263.  
  264. end.
  265.