adefctrl.pas

来自「delphi编程控件」· PAS 代码 · 共 1,755 行 · 第 1/5 页

procedure CreateStdDBDefControl;
Var
  i :  Integer;
begin
  SdtDBDefControlList := TList.Create;
  for i := 0 to SdtDBDefControlCount - 1 do begin
    SdtDBDefControlList.Add(GetDBDefControlClass(SdtDBDefControlType[i]).Create(Nil));
    TCustomAutoDBDefControl(SdtDBDefControlList[i]).FIsDefault := True;
  end;
end;

procedure DestroyStdDBDefControl;
Var
  i :  Integer;
begin
  for i := 0 to SdtDBDefControlCount - 1 do
    TAutoDBDefControl(SdtDBDefControlList[i]).Free;
  SdtDBDefControlList.Free;
end;

function GetStdDBDefControl(AControlType : TAutoDBDefControlType) : TAutoDBDefControl;
Var
  i : Integer;
begin
  Result := Nil;
  for i := 0 to SdtDBDefControlCount - 1 do
    if (SdtDBDefControlType[i] = AControlType) then begin
      Result := TAutoDBDefControl(SdtDBDefControlList[i]);
      break;
    end;
end;

function GetDBDefControlClass(AControlType : TAutoDBDefControlType) : TAutoDBDefControlClass;
const
  DefControlClasses: array[TAutoDBDefControlType] of TAutoDBDefControlClass = (
    Nil,                      //adctUnknown
    TAutoDBDefMaskEdit,       //adctMaskEdit
    TAutoDBDefBtnEdit,       //adctBtnEdit    
    TAutoDBDefMemo,           //adctMemo
    TAutoDBDefImage,          //adctImage
    TAutoDBDefListBox,        //adctListBox
    TAutoDBDefComboBox,       //adctComboBox
    TAutoDBDefCheckBox,       //adctCheckBox
    TAutoDBDefRadioGroup,     //adctRadioGroup
    TAutoDBDefLookupListBox,  //adctLookupListBox
    TAutoDBDefLookupComboBox, //adctLookupComboBox
    TAutoDBDefReference,      //adctReference
    TAutoDBDefDate,           //adctDate
//    TAutoDBDefDateTime,       //adctDateTime
    TAutoDBDefTime,           //adctTime
    TAutoDBDefSpinImage,      //adctSpinImage
    TAutoDBDefImageCombo,     //adctImageCombo
    TAutoDBDefImageList,      //adctImageList
    TAutoDBDefCustomControl); //adctCustomControl
begin
  Result := DefControlClasses[AControlType];
end;

function GetDBDefControl(ATemplate : TAutoRepository; AField : TField) : TAutoDBDefControl;
Const
  DefControlType : array [TFieldType] of TAutoDBDefControlType =
    (adctMaskEdit, //ftUnknown
     adctMaskEdit, //ftString
     adctMaskEdit, //ftSmallint
     adctMaskEdit, //ftInteger
     adctMaskEdit, //ftWord,
     adctCheckBox, //ftBoolean,
     adctMaskEdit, //ftFloat,
     adctMaskEdit, //ftCurrency,
     adctMaskEdit, //ftBCD,
     adctDate,     //ftDate,
     adctTime, //ftTime,
     adctMaskEdit, //ftDateTime,
     adctMemo, //ftBytes,
     adctMemo, //ftVarBytes,
     adctMaskEdit, //ftAutoInc,
     adctMaskEdit, // ftBlob,
     adctMemo, //ftMemo,
     adctImage, //ftGraphic,
     adctMemo, //ftFmtMemo,
     adctMaskEdit, //ftParadoxOle,
     adctMaskEdit, //ftDBaseOle,
     adctMaskEdit //ftTypedBinary
     {$IFDEF DELPHI3_0}
     ,adctMaskEdit //  ftCursor
     {$ENDIF}
     {$IFDEF DELPHI4}
     ,adctMaskEdit,
     adctMaskEdit,
     adctMaskEdit,
     adctMaskEdit,
     adctMaskEdit,
     adctMaskEdit,
     adctMaskEdit
     {$ENDIF}
);
Var
  i, j : Integer;
  AControlType : TAutoDBDefControlType;
begin
  Result := Nil;
  if(AField = Nil) then begin
    Result := GetStdDBDefControl(DefControlType[ftUnknown]);
    exit;
  end;
  if(ATemplate <> Nil) then begin
    for i := 0 to ATemplate.DefDataSets.Count - 1 do begin
      if(AField.DataSet = ATemplate.DefDataSets[i].DataSet) then
        for j := 0 to ATemplate.DefDataSets[i].DefFields.Count - 1 do
          if(AField = ATemplate.DefDataSets[i].DefFields[j].Field) then begin
            Result := ATemplate.DefDataSets[i].DefFields[j].DBDefControl;
            exit;
          end;
    end;
  end;
  if(Result = Nil) then begin
    AControlType := DefControlType[AField.DataType];
    if(AControlType = adctMaskEdit) And AField.Lookup then
      AControlType := adctLookupComboBox;
    Result := GetStdDBDefControl(AControlType);
  end;
end;

procedure DrawTextOnGridCanvas(ACanvas : TCanvas; AFont : TFont;
  ARect : TRect;   AAlignment : TAlignment; AText : String; Selected : Boolean);
const
  AlignFlags : array [TAlignment] of Integer =
    ( DT_LEFT or DT_WORDBREAK or DT_VCENTER or DT_SINGLELINE or DT_EXPANDTABS or DT_NOPREFIX,
      DT_RIGHT or DT_WORDBREAK or DT_VCENTER or DT_SINGLELINE or DT_EXPANDTABS or DT_NOPREFIX,
      DT_CENTER or DT_WORDBREAK or DT_VCENTER or DT_SINGLELINE or DT_EXPANDTABS or DT_NOPREFIX );
Var
  ASt : String;
begin
  ACanvas.Font := AFont;
  if Selected then
    ACanvas.Font.Color := clWhite
  else ACanvas.Font.Color := AFont.Color;
  ACanvas.FillRect(ARect);
  InflateRect(ARect, -2, 0);
  ASt := AText;
  GetDrawText(ACanvas, ARect,  AAlignment, ASt);
  DrawText(ACanvas.Handle, PChar(ASt), Length(ASt), ARect, AlignFlags[AAlignment]);
end;

function IsNumeric(St : String) : Boolean;
Var
  i : Integer;
begin
  Result := False;
  for i := 1 to Length(St) do
    if Not (((St[i] >= '0') And (St[i] <= '9'))
    Or ((St[i] = '-') And (i = 1))) then
      exit;
  Result := True;
end;


function GetDBDefControlParentType(WinControl : TWinControl) : TAutoDBDefParentType;
Var
  AParent : TWinControl;
begin
  Result := adptUnknown;
  if(WinControl.Parent is TCustomAutoDBGrid)
  Or (WinControl is TCustomAutoDBGrid) then begin
    Result := adptGrid;
    exit;
  end;
  AParent := WinControl;
  while (AParent <> Nil) do begin
    if (AParent is TCustomAutoDBPanel) then begin
      Result := adptPanel;
      exit;
    end;
    if(AParent is TFilterScrollBox)
    or (AParent is TFilterTabControl)  then begin
      Result := adptFilter;
      exit;
    end;
    AParent := AParent.Parent;
  end;

end;

type
TEditStyle = (esSimple, esEllipsis, esPickList);
TPopupListbox = class;

TDBGridInplaceEdit = class(TDBEdit)
private
  FButtonWidth: Integer;
  FPickList: TPopupListbox;
  FItems : TStrings;
  FActiveList: TWinControl;
  FGridLayout : TAutoGridLayout;
  FRepository : TAutoRepository;
  FReferencePanel : TReferencePanel;
  FReferenceWidth : Integer;
  FReferenceHeight : Integer;
  FKeyField : String;
  FEditStyle: TEditStyle;
  FListVisible: Boolean;
  FTracking: Boolean;
  FPressed: Boolean;
  FDropDownCount : Integer;
  FSorted : Boolean;
  FReferencePanelAlign : TReferenceAlign;
  FScrollBars : TScrollStyle;
  FOnBtnClick : TNotifyEvent;

  procedure ListMouseUp(Sender: TObject; Button: TMouseButton;
    Shift: TShiftState; X, Y: Integer);
  procedure SetEditStyle(Value: TEditStyle);
  procedure StopTracking;
  procedure TrackButton(X,Y: Integer);
  procedure CMCancelMode(var Message: TCMCancelMode); message CM_CancelMode;
  procedure WMCancelMode(var Message: TMessage); message WM_CancelMode;
  procedure WMKillFocus(var Message: TMessage); message WM_KillFocus;
  procedure WMLButtonDblClk(var Message: TWMLButtonDblClk); message wm_LButtonDblClk;
  procedure WMPaint(var Message: TWMPaint); message wm_Paint;
  procedure WMSetCursor(var Message: TWMSetCursor); message WM_SetCursor;
protected
  procedure CreateParams(var Params: TCreateParams); override;
  procedure SetBounds(ALeft, ATop, AWidth, AHeight: Integer); override;
  procedure CloseUp(Accept: Boolean);
  procedure DoDropDownKeys(var Key: Word; Shift: TShiftState);
  procedure DropDown;
  procedure KeyDown(var Key: Word; Shift: TShiftState); override;
  procedure MouseDown(Button: TMouseButton; Shift: TShiftState;
    X, Y: Integer); override;
  procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;
  procedure MouseUp(Button: TMouseButton; Shift: TShiftState;
    X, Y: Integer); override;
  procedure PaintWindow(DC: HDC); override;
  procedure WndProc(var Message: TMessage); override;

  property EditStyle: TEditStyle read FEditStyle write SetEditStyle;
  property ActiveList: TWinControl read FActiveList write FActiveList;
  property PickList: TPopupListbox read FPickList;
  property GridLayout : TAutoGridLayout read FGridLayout;
  property ReferencePanel : TReferencePanel read FReferencePanel write FReferencePanel;
  property ReferenceWidth : Integer read FReferenceWidth write FReferenceWidth;
  property ReferenceHeight : Integer read FReferenceHeight write FReferenceHeight;
  property Repository : TAutoRepository read FRepository write FRepository;
  property DropDownCount : Integer read FDropDownCount write FDropDownCount;
  property Sorted : Boolean read FSorted write FSorted;
  property OnBtnClick : TNotifyEvent read FOnBtnClick write FOnBtnClick;
public
  constructor Create(Owner: TComponent); override;
  destructor Destroy; override;
end;

{ TPopupListbox }

  TPopupListbox = class(TCustomListbox)
  private
    FSearchText: String;
    FSearchTickCount: Longint;
  protected
    procedure CreateParams(var Params: TCreateParams); override;
    procedure CreateWnd; override;
    procedure KeyPress(var Key: Char); override;
    procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
  end;

procedure TPopupListBox.CreateParams(var Params: TCreateParams);
begin
  inherited CreateParams(Params);
  with Params do
  begin
    Style := Style or WS_BORDER;
    ExStyle := WS_EX_TOOLWINDOW;
    WindowClass.Style := CS_SAVEBITS;
  end;
end;

procedure TPopupListbox.CreateWnd;
begin
  inherited CreateWnd;
  Windows.SetParent(Handle, 0);
  CallWindowProc(DefWndProc, Handle, wm_SetFocus, 0, 0);
end;

procedure TPopupListbox.Keypress(var Key: Char);
var
  TickCount: Integer;
begin
  case Key of
    #8, #27: FSearchText := '';
    #32..#255:
      begin
        TickCount := GetTickCount;
        if TickCount - FSearchTickCount > 2000 then FSearchText := '';
        FSearchTickCount := TickCount;
        if Length(FSearchText) < 32 then FSearchText := FSearchText + Key;
        SendMessage(Handle, LB_SelectString, WORD(-1), Longint(PChar(FSearchText)));
        Key := #0;
      end;
  end;
  inherited Keypress(Key);
end;

procedure TPopupListbox.MouseUp(Button: TMouseButton; Shift: TShiftState;
  X, Y: Integer);
begin
  inherited MouseUp(Button, Shift, X, Y);
  TDBGridInPlaceEdit(Owner).CloseUp((X >= 0) and (Y >= 0) and
      (X < Width) and (Y < Height));
end;


constructor TDBGridInplaceEdit.Create(Owner: TComponent);
begin
  inherited Create(Owner);
  ParentCtl3D := False;
  Ctl3D := False;
  TabStop := False;
  BorderStyle := bsNone;
  FButtonWidth := GetSystemMetrics(SM_CXVSCROLL);
  FEditStyle := esSimple;
  FItems := TStringList.Create;
  FGridLayout := TAutoGridLayout.Create(self);
  FDropDownCount := 8;
  FSorted := False;
  FReferencePanelAlign := ralBottom;
  FScrollBars := ssNone;
end;

destructor TDBGridInplaceEdit.Destroy;
begin
  FGridLayout.Free;
  FItems.Free;
  inherited;
end;

procedure TDBGridInplaceEdit.CreateParams(var Params: TCreateParams);
const
  ScrollBar: array[TScrollStyle] of LongInt = (0, WS_HSCROLL, WS_VSCROLL,
    WS_HSCROLL or WS_VSCROLL);
begin
  inherited CreateParams(Params);
  Params.Style := Params.Style or ES_MULTILINE or ScrollBar[FScrollBars];
end;


procedure TDBGridInplaceEdit.SetBounds(ALeft, ATop, AWidth, AHeight: Integer);
var
  R: TRect;
begin
  inherited SetBounds(ALeft, ATop, AWidth, AHeight);
  if Not HandleAllocated then exit;
  SetRect(R, 2, 2, Width - 2, Height);