home *** CD-ROM | disk | FTP | other *** search
/ Chip 2002 March / Chip_2002-03_cd1.bin / zkuste / delphi / kolekce / d5 / sStyleFree.exe / sIBControls.pas < prev    next >
Pascal/Delphi Source File  |  2001-11-02  |  4KB  |  180 lines
  1. unit sIBControls;
  2.  
  3. interface
  4.  
  5. uses
  6.   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  7.   StdCtrls,  Shared, StrUtils, IBQuery, IBDatabase, sStyleUtil, sControls,
  8.   DBGridEh, sCustomComboBox, sSharedIB;
  9.  
  10. type
  11.  
  12.   TsIBSorter = class(TsCustomSorter)
  13.   private
  14.   public
  15.     procedure Execute; override;
  16.  
  17.   published
  18.     property DBGrid;
  19.     property Active;
  20.     property OnDockDrop;
  21.     property OnDockOver;
  22.     property OnDragDrop;
  23.     property OnDragOver;
  24.     property OnEndDock;
  25.     property OnEndDrag;
  26.     property Align;
  27.     property Alignment;
  28.     property BevelInner;
  29.     property BevelOuter;
  30.     property BevelWidth;
  31.     property BorderWidth;
  32.     property BorderStyle;
  33.     property Caption;
  34.     property Color;
  35.     property Ctl3D;
  36.     property DragCursor;
  37.     property Enabled;
  38.     property FullRepaint;
  39.     property Font;
  40.     property ParentColor;
  41.     property ParentCtl3D;
  42.     property ParentFont;
  43.     property ParentShowHint;
  44.     property PopupMenu;
  45.     property ShowHint;
  46.     property TabOrder;
  47.     property TabStop;
  48.     property Visible;
  49.     property OnClick;
  50.     property OnDblClick;
  51.     property OnEnter;
  52.     property OnExit;
  53.     property OnMouseDown;
  54.     property OnMouseMove;
  55.     property OnMouseUp;
  56.     property OnResize;
  57.   end;
  58.  
  59.   TsIBComboBox = class(TsCustomComboBox)
  60.   private
  61.     { Private declarations }
  62.   protected
  63.     FDatabase : TIBDatabase;
  64.     { Protected declarations }
  65.   public
  66.     function Generate : integer; override;
  67.     { Public declarations }
  68.   published
  69.  
  70.     property Enabled;
  71.     property Font;
  72.     property Hint;
  73.     property ItemHeight;
  74.     property Items;
  75.     property MaxLength;
  76.     property DropDownCount;
  77.     property ParentFont;
  78.     property ParentShowHint;
  79.     property PopupMenu;
  80.     property ShowHint;
  81.     property Sorted;
  82.     property Style;
  83.     property TabOrder;
  84.     property Text;
  85.     property Visible;
  86.     property CharCase;
  87.     property sStyle;
  88.     property Active;
  89.     property Database:TIBDatabase read FDatabase write FDatabase;
  90.     property SQL;
  91.     property CharsInCode;
  92.  
  93.     property OnChange;
  94.     property OnClick;
  95.     property OnContextPopup;
  96.     property OnDblClick;
  97.     property OnDragDrop;
  98.     property OnDragOver;
  99.     property OnDrawItem;
  100.     property OnEndDock;
  101.     property OnEndDrag;
  102.     property OnKeyDown;
  103.     property OnKeyPress;
  104.     property OnKeyUp;
  105.     property OnMeasureItem;
  106.     property OnStartDock;
  107.     property OnStartDrag;
  108.     { Published declarations }
  109.   end;
  110.  
  111. implementation
  112.  
  113. procedure TsIBSorter.Execute;
  114. var
  115.   s, StartText : string;
  116. begin
  117.   StartText := TIBQuery(DBGrid.DataSource.DataSet).SQL.Text;
  118.   if pos('ORDER BY', UpperCase(StartText)) > 0 then begin
  119.     StartText := copy(StartText, 1, pos('ORDER BY', UpperCase(StartText)) - 1);
  120.   end;
  121.   s := GenText;
  122.   if s <> '' then begin
  123.     SelectIBQuery(TIBQuery(DBGrid.DataSource.DataSet), StartText + ' order by ' + s);
  124.   end;
  125. end;
  126.  
  127. // ---------------------------------------------
  128. function TsIBComboBox.Generate : integer;
  129. var
  130.   q: TIBQuery;
  131.   s, t: string;
  132. begin
  133.   Result := 0;
  134.   if Assigned(Database) and (SQL.Text<>'') then begin
  135.     q:=TIBQuery.Create(Self);
  136.     q.Database := Database;
  137.     q.SQL.Assign(SQL);
  138.     q.Open;
  139.  
  140.     q.first;
  141.     Clear;
  142.     if sStyle.DefaultString<>'' then begin
  143.       Items.Add(sStyle.DefaultString);
  144.     end;
  145.     while not q.eof do begin
  146.       if (CharsInCode > 0) and (q.FieldCount > 1) then begin
  147. //       t := StrUtils.AddCharR
  148.  
  149.        if Length(q.Fields[1].AsString) < CharsInCode then begin
  150.          s:='0';
  151.          while Length(s) < CharsInCode - length(q.Fields[1].AsString) do begin
  152.            s:=s+'0';
  153.          end;
  154.          t := s + q.Fields[1].AsString + ' - ' + q.Fields[0].AsString;
  155.        end
  156.  
  157.        else begin
  158.          t := q.Fields[1].AsString + ' - ' + q.Fields[0].AsString;
  159.        end;
  160.       end
  161.       else begin
  162.         t := q.Fields[0].AsString;
  163.       end;
  164.       Items.Add(t);
  165.       q.next;
  166.     end;
  167.     q.Free;
  168.     if Items.Count < 24 then begin
  169.       DropDownCount := Items.Count;
  170.     end;
  171.     Result := Items.Count;
  172.     if sStyle.DefaultString <> '' then begin
  173.       ItemIndex := 0;
  174.     end;
  175.     ItemHeight := 16;
  176.   end;
  177. end;
  178.  
  179. end.
  180.