adefctrl.pas

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

     if (CompareText(FValueCheck, FDataLink.Field.Text) = 0) then
       Result := True;
end;

procedure TDBGridInplaceCheckBox.ChangeCheckState;
begin
  FDataLink.Edit;
  if(FDataLink.Editing) then begin
    if FDataLink.Field.DataType = ftBoolean then
      FDataLink.Field.AsBoolean := Not FDataLink.Field.AsBoolean
    else begin
      if(Checked) then
        FDataLink.Field.Text := FValueCheck
      else FDataLink.Field.Text := FValueUncheck;
    end;   

  end;
end;

procedure TDBGridInplaceCheckBox.DataChange(Sender: TObject);
begin
  Repaint;
end;

procedure TDBGridInplaceCheckBox.UpdateData(Sender: TObject);
begin
  Repaint;
end;

procedure TDBGridInplaceCheckBox.SetDataSource(Value: TDataSource);
begin
  FDataLink.DataSource := Value;
end;

procedure TDBGridInplaceCheckBox.SetDataField(const Value: string);
begin
  FDataLink.FieldName := Value;
end;

procedure TDBGridInplaceCheckBox.KeyPress(var Key: Char);
begin
  inherited KeyPress(Key);
  case Key of
    #8, ' ':
      ChangeCheckState;
    #27:
      FDataLink.Reset;
  end;
end;

procedure TDBGridInplaceCheckBox.MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
 if(Button = mbLeft) then
   ChangeCheckState;
end;

procedure TDBGridInplaceCheckBox.Paint;
Var
  ARect : TRect;
  State : Integer;
begin
  Canvas.Brush.Color := Color;
  ARect := ClientRect;
  Canvas.FillRect(ARect);
  if(Checked) then
    State := DFCS_CHECKED
  else State := 0;
  DrawFrameControl(Canvas.Handle, ARect, DFC_BUTTON, DFCS_BUTTONCHECK Or State);
end;

procedure TDBGridInplaceCheckBox.WMGetDlgCode(var Msg: TWMGetDlgCode);
begin
  Msg.Result := DLGC_WANTARROWS;
end;

{TDBGridInplaceCheckBox}
type
TPopupImageListbox = class;

TDBGridInplaceImageCombo = class(TCustomControl)
private
  FDataLink: TFieldDataLink;
  FLookupSource : TDataSource;
  FItems : TStrings;
  FImages : TStrings;
  FValues : TStrings;
  FButtonWidth : Integer;
  FImageList : TImageList;
  FAlignment : TAlignment;
  FImageAlignment : TAutoImageAlign;
  FPopupList : TPopupImageListBox;
  FDataList: TDBLookupListBox;
  FActiveList : TWinControl;
  FIsLookup : Boolean;
  FListVisible : Boolean;
  FKeyField : String;
  FListField : String;
  FPressed : Boolean;
  FTracking : Boolean;
  FListFieldIndex : Integer;
  FDataChanging : Boolean;
  FDropDownRows : Integer;

  procedure DataChange(Sender: TObject);
  function GetField: TField;
  procedure SetDataField(const Value: string);
  procedure SetDataSource(Value: TDataSource);
  procedure SetIsLookUp(Value : Boolean);
  procedure UpdateData(Sender: TObject);
  procedure StopTracking;
  procedure TrackButton(X,Y: Integer);
  procedure ListMouseUp(Sender: TObject; Button: TMouseButton;
    Shift: TShiftState; X, Y: Integer); 
  procedure WMGetDlgCode(var Msg: TWMGetDlgCode); message WM_GETDLGCODE;
protected
  procedure KeyDown(var Key: Word; Shift: TShiftState); override;
  procedure KeyPress(var Key: Char); 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 Paint; override;
  procedure CloseUp(Accept: Boolean);
  procedure DropDown;
public
  constructor Create(AOwner: TComponent); override;
  destructor Destroy; override;

  property Alignment : TAlignment read FAlignment write FAlignment;
  property ImageAlignment : TAutoImageAlign read FImageAlignment write FImageAlignment;
  property Field: TField read GetField;
  property DataField: string write SetDataField;
  property DataSource: TDataSource write SetDataSource;
  property ImageList : TImageList read FImageList write FImageList;
  property Items : TStrings read FItems;
  property Images : TStrings read FImages;
  property IsLookup : Boolean read FIsLookup write SetIsLookup;
  property KeyField : String read FKeyField write FKeyField;
  property ListField : String read FListField write FListField;  
  property ListFieldIndex : Integer read FListFieldIndex write FListFieldIndex;
  property LookupSource : TDataSource read FLookupSource write FLookupSource;
  property Values : TStrings read FValues;
end;

{TPopupImageListbox }
TPopupImageListbox = class(TAutoImageListbox)
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;
public
  property Strings : TStrings read FStrings;
end;

procedure DrawImageCombo(ACanvas : TCanvas; AImageList : TImageList; AFont : TFont;
              AText : String; ImageIndex : Integer; ARect : TRect; Align : TAlignment;
              AImageAlign : TAutoImageAlign; ASelected, AFocused : Boolean);
const
  AlignFlags : array [TAlignment] of Integer =
    ( DT_LEFT or DT_EXPANDTABS or DT_NOPREFIX  Or DT_EDITCONTROL,
      DT_RIGHT or DT_EXPANDTABS  or DT_NOPREFIX Or DT_EDITCONTROL,
      DT_CENTER or DT_EXPANDTABS or DT_NOPREFIX Or DT_EDITCONTROL);
Var
  r : TRect;
  Image: TBitmap;
  ImageFlag : Boolean;
  Drawflag : Integer;
begin
  with ACanvas do  begin
    Font := AFont;
    if(ASelected) then begin
      Brush.Color := clHighLight;
      Font.Color := clWhite;
    end;
    FillRect(ARect);
    InflateRect(ARect, -1, -1);
    ImageFlag := (AImageList <> Nil) And (ImageIndex > -1)
                  And (ImageIndex < AImageList.Count);
    if ImageFlag then begin
      SetRect(r, ARect.Left, ARect.Top,
         ARect.Left + ((ARect.Bottom - ARect.Top) * AImageList.Width) div AImageList.Height, ARect.Bottom);
      Image := TBitmap.Create;
      AImageList.GetBitmap(ImageIndex, Image);
      StretchDraw(r, Image);
      Image.Free;
    end else r := ARect;
    if(AFocused) then
      Windows.DrawFocusRect(Handle, ARect);
    if (AImageList <> Nil) then begin
      InflateRect(ARect, -2, -2);
      if(AImageAlign = aliLeft) then
        ARect.Left := r.Right + 2
      else ARect.Right := r.Left - 2;
    end;
    Inc(ARect.Left);
    Dec(ARect.Right);
    DrawFlag := AlignFlags[Align] Or DT_VCENTER or DT_SINGLELINE;
    DrawText(Handle, PChar(AText), Length(AText), ARect, DrawFlag Or DT_EDITCONTROL);
  end;
end;

procedure TPopupImageListbox.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 TPopupImageListbox.CreateWnd;
begin
  inherited CreateWnd;
  Windows.SetParent(Handle, 0);
  CallWindowProc(DefWndProc, Handle, wm_SetFocus, 0, 0);
end;

procedure TPopupImageListbox.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 TPopupImageListbox.MouseUp(Button: TMouseButton; Shift: TShiftState;
  X, Y: Integer);
begin
  inherited MouseUp(Button, Shift, X, Y);
  TDBGridInplaceImageCombo(Owner).CloseUp((X >= 0) and (Y >= 0) and
      (X < Width) and (Y < Height));
end;

constructor TDBGridInplaceImageCombo.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FDataLink := TFieldDataLink.Create;
  FDataLink.Control := Self;
  FDataLink.OnDataChange := DataChange;
  FDataLink.OnUpdateData := UpdateData;
  FLookupSource := TDataSource.Create(self);
  FItems := TStringList.Create;
  FImages := TStringList.Create;
  FValues := TStringList.Create;    
  FButtonWidth := GetSystemMetrics(SM_CXVSCROLL);
  FAlignment := taLeftJustify;
  FActiveList := Nil;
  FIsLookup := False;
  FListFieldIndex := 0;
  FListVisible := False;
  FPressed := False;
  FDataChanging := False;
end;

destructor TDBGridInplaceImageCombo.Destroy;
begin
  FDataLink.Free;
  FLookupSource.Free;
  FItems.Free;
  FImages.Free;
  FValues.Free;
  inherited Destroy;
end;

procedure TDBGridInplaceImageCombo.CloseUp(Accept: Boolean);
Var
  MasterField: TField;
  ListValue: Variant;
begin
  FDataChanging := True;
  if FListVisible then begin
    if GetCapture <> 0 then SendMessage(GetCapture, WM_CANCELMODE, 0, 0);
    if FActiveList = FDataList then
      ListValue := FDataList.KeyValue
    else
      if FPopupList.ItemIndex <> -1 then
        ListValue := Values[FPopupList.ItemIndex];
    SetWindowPos(FActiveList.Handle, 0, 0, 0, 0, 0, SWP_NOZORDER or
        SWP_NOMOVE or SWP_NOSIZE or SWP_NOACTIVATE or SWP_HIDEWINDOW);
    FListVisible := False;
    if Assigned(FDataList) then
      FDataList.ListSource := Nil;
    if(Field.Lookup) then
      FLookupSource.DataSet := Nil;
    Invalidate;
    if Accept then
      if FActiveList = FDataList then begin
        if(Field.Lookup) then begin
          MasterField := FDataLink.DataSet.FieldByName(Field.KeyFields);
          if MasterField.CanModify then begin
            FDataLink.DataSet.Edit;
            MasterField.Value := ListValue;
          end;
        end else
         if Field.CanModify then begin
          FDataLink.DataSet.Edit;
          Field.Text := ListValue;
        end;
      end else
        if (Not VarIsNull(ListValue))
        And (Field.CanModify) then begin
          FDataLink.DataSet.Edit;
          Field.Text := ListValue;
        end;
  end;
  FDataChanging := False;  
end;

procedure TDBGridInplaceImageCombo.DropDown;
var
  P: TPoint;
  i, Y: Integer;
begin
  if Not FListVisible then begin
    if FActiveList = FDataList then  begin
      FDataList.Width := Width;    
      FDataList.Color := Color;
      FDataList.Font := Font;
      FDataList.RowCount := FDropDownRows;
      if Field.Lookup then
        with Field do begin
          FLookupSource.DataSet := Field.LookupDataSet;
          FDataList.KeyField := Field.LookupKeyFields;
          FDataList.ListField := LookupResultField;
          FDataList.KeyValue := FDataLink.DataSet.FieldByName(Field.KeyFields).Value;
        end
      else begin
        FDataList.KeyField := KeyField;
        FDataList.ListField := ListField;
        FDataList.KeyValue := Field.Value;
      end;
      FDataList.ListSource := FLookupSource;
    end else