propedit.~pas

数据属性设置控件

{***************************************************************
 *
 * Unit Name: PropEdit
 * Purpose  :用于设置数据库字段的属性值
 * Author   :
 * History  :00-10-26
 *
 ****************************************************************}


unit PropEdit;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, CheckLst, Math, DB, DBCtrls, DesignIntf,DesignEditors{设置属性编辑器时用}, SetProp;

type
  TCheckPropProperty = class(TPropertyEditor)
    function GetAttributes: TPropertyAttributes; override;
    function GetValue: string; override;
    procedure Edit; override;
  end;

  TPropEdit = class(TCheckListBox)
  private
    FProp: Integer;
    FStartPos: Integer;
    FReverse: Boolean;
    FCheckItems: TStrings;
    function GetProp: Integer;
    procedure SetProp(const Value: Integer);
    procedure SetCheck;
    procedure SetStartPos(const Value: Integer);
    procedure SetReverse(const Value: Boolean);
    function GetProp1: Integer;
    function GetProp2: Integer;
    procedure SetCheckItems(const Value: TStrings);
  protected
    procedure DblClick; override;
  public
    constructor Create(AOwner: TComponent); override;
  published
    property Prop: Integer read GetProp write SetProp;
    property Prop1: Integer read GetProp1 stored False;
    property Prop2: Integer read GetProp2 stored False;
    property StartPos: Integer read FStartPos write SetStartPos;
    property Reverse: Boolean read FReverse write SetReverse;
    property CheckItems: TStrings read FCheckItems write SetCheckItems;
  end;

  TDBPropEdit = class(TPropEdit)
  private
    FDataLink: TFieldDataLink;
    procedure DataChange(Sender: TObject);
    procedure UpdateDate(Sender: TObject);
    function GetDataField: string;
    function GetDataSource: TDataSource;
    procedure SetDataField(const Value: string);
    procedure SetDataSource(const Value: TDataSource);
    procedure CMExit(var Message: TWMNoParams); message CM_EXIT;
    function GetReadOnly: Boolean;
    procedure SetReadOnly(const Value: Boolean);
  protected
    procedure Loaded; override;
    procedure ClickCheck; override;
    procedure DblClick; override;
    procedure Notification(AComponent: TComponent; Operation: TOperation); override;
    procedure CMGetDataLink(var Message: TMessage); message CM_GETDATALINK;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
  published
    property DataField: string read GetDataField write SetDataField;
    property DataSource: TDataSource read GetDataSource write SetDataSource;
    property ReadOnly: Boolean read GetReadOnly write SetReadOnly default False;
  end;

  function CheckBit(Status, B1: Integer;
                          B2: Integer = 0;
                          B3: Integer = 0;
                          B4: Integer = 0;
                          B5: Integer = 0;
                          B6: Integer = 0;
                          B7: Integer = 0;
                          B8: Integer = 0;
                          B9: Integer = 0;
                          B10: Integer = 0): Boolean;

  function SetBit(Status, B1: Integer;
                        B2: Integer = 0;
                        B3: Integer = 0;
                        B4: Integer = 0;
                        B5: Integer = 0;
                        B6: Integer = 0;
                        B7: Integer = 0;
                        B8: Integer = 0;
                        B9: Integer = 0;
                        B10: Integer = 0): Integer;

procedure Register;

implementation

procedure Register;
begin
  RegisterComponents('hf comp', [TPropEdit, TDBPropEdit]);
  RegisterPropertyEditor(TypeInfo(TStrings), TPropEdit, 'Items', TCheckPropProperty);
  RegisterPropertyEditor(TypeInfo(TStrings), TPropEdit, 'CheckItems', TCheckPropProperty);
end;

function CheckBit(Status, B1: Integer;
                          B2: Integer = 0;
                          B3: Integer = 0;
                          B4: Integer = 0;
                          B5: Integer = 0;
                          B6: Integer = 0;
                          B7: Integer = 0;
                          B8: Integer = 0;
                          B9: Integer = 0;
                          B10: Integer = 0): Boolean;
var
  I: Integer;
  B: Integer;
begin
  Result := True;
  B := 0;
  for I := 1 to 10 do
  begin
    if I = 1 then B := B1
    else if I = 2 then B := B2
    else if I = 3 then B := B3
    else if I = 4 then B := B4
    else if I = 5 then B := B5
    else if I = 6 then B := B6
    else if I = 7 then B := B7
    else if I = 8 then B := B8
    else if I = 9 then B := B9
    else if I = 10 then B := B10;

    if B = 0 then
      Exit;
    if B > 0 then
      Result := Odd(Status shr (Abs(B) - 1))
    else Result := not Odd(Status shr (Abs(B) - 1));

    if not Result then
      Exit;
  end;
end;

function SetBit(Status, B1: Integer;
                        B2: Integer = 0;
                        B3: Integer = 0;
                        B4: Integer = 0;
                        B5: Integer = 0;
                        B6: Integer = 0;
                        B7: Integer = 0;
                        B8: Integer = 0;
                        B9: Integer = 0;
                        B10: Integer = 0): Integer;
var
  I: Integer;
  B: Integer;
begin
  Result := Status;
  B := 0;  
  for I := 1 to 10 do
  begin
    if I = 1 then B := B1
    else if I = 2 then B := B2
    else if I = 3 then B := B3
    else if I = 4 then B := B4
    else if I = 5 then B := B5
    else if I = 6 then B := B6
    else if I = 7 then B := B7
    else if I = 8 then B := B8
    else if I = 9 then B := B9
    else if I = 10 then B := B10;

    if B = 0 then
      Exit;

    if B < 0 then
      Result := Result and (not Round(IntPower(2, Abs(B) - 1)))
    else Result := Result or Round(IntPower(2, Abs(B) - 1));

//    if not Result then
//      Exit;
  end;
end;

{ TPropEdit }

constructor TPropEdit.Create(AOwner: TComponent);
var
 sList:string;
 v:TStrings;
begin

  sList:='a;b;c;';
  v:=TStrings.Create;
  v.Strings[0]:='a';
  v.Strings[1]:='b';

  inherited Create(AOwner);
  FCheckItems := TStringList.Create;
  Height := 40;
  Width := 100;
  FReverse := False;


end;

procedure TPropEdit.DblClick;
begin
  State[ItemIndex] := cbGrayed;
  inherited;
end;

function TPropEdit.GetProp: Integer;
var
  I, II, P: Integer;
  Check: Boolean;
begin
  P := 0;
  for I := FStartPos to FCheckItems.Count - 1 do
  begin
    if FCheckItems.Strings[I][1] = ';' then
      Check := FReverse or False
    else
    begin
      II := Items.IndexOf(FCheckItems.Strings[I]);
      if FReverse then
        Check := not Checked[II]
      else Check := Checked[II];
    end;

    if Check then
      P := P or Round(IntPower(2, I - FStartPos))
    else P := P and (not Round(IntPower(2, I - FStartPos)));
  end;
  Result := P;
end;

function TPropEdit.GetProp1: Integer;
var
  I, II, P: Integer;
  Check: Boolean;
begin
  P := 0;
  for I := FStartPos to FCheckItems.Count - 1 do
  begin
    if FCheckItems.Strings[I][1] = ';' then
      Check := False
    else
    begin
      II := Items.IndexOf(FCheckItems.Strings[I]);
      Check := not (State[II] = cbGrayed);
    end;

    if Check then
      P := P or Round(IntPower(2, I - FStartPos))
    else P := P and (not Round(IntPower(2, I - FStartPos)));
  end;
  Result := P;
end;

function TPropEdit.GetProp2: Integer;
var
  I, II, P: Integer;
  Check: Boolean;
begin
  P := 0;
  for I := FStartPos to FCheckItems.Count - 1 do
  begin
    if FCheckItems.Strings[I][1] = ';' then
      Check := False
    else
    begin
      II := Items.IndexOf(FCheckItems.Strings[I]);

      if FReverse then
        Check := State[II] = cbUnchecked
      else Check := Checked[II];
    end;

    if Check then
      P := P or Round(IntPower(2, I - FStartPos))
    else P := P and (not Round(IntPower(2, I - FStartPos)));
  end;
  Result := P;
end;

procedure TPropEdit.SetCheck;
var
  I, II: Integer;
begin
  for I := FStartPos to FCheckItems.Count - 1 do
  begin
    if FCheckItems.Strings[I][1] = ';' then
      Continue
    else
      II := Items.IndexOf(FCheckItems.Strings[I]);

    if FReverse then
      Checked[II] := not ((FProp or Round(IntPower(2, I - FStartPos))) = FProp)
    else Checked[II] := ((FProp or Round(IntPower(2, I - FStartPos))) = FProp);
  end;
end;

procedure TPropEdit.SetCheckItems(const Value: TStrings);
begin
  FCheckItems.Assign(Value);
end;

procedure TPropEdit.SetProp(const Value: Integer);
begin
//  if FProp <> Value then
  if Prop <> Value then
  begin
    FProp := Value;
    SetCheck;
  end;
end;

procedure TPropEdit.SetReverse(const Value: Boolean);
begin
  if FReverse <> Value then
  begin
    FReverse := Value;
    SetCheck;
  end;
end;

procedure TPropEdit.SetStartPos(const Value: Integer);
begin
  if FStartPos <> Value then
  begin
    FStartPos := Value;
    SetCheck;
  end;
end;

{ TDBPropEdit }

procedure TDBPropEdit.ClickCheck;
begin
  inherited;

  try
	  FDataLink.Modified;
	  FDataLink.DataSet.Edit;
	  FDataLink.Field.AsInteger := Prop;
  except
  	on e: Exception do
  	   //	Application.HandleException(Sender);
  end;  // try/except

end;

procedure TDBPropEdit.CMExit(var Message: TWMNoParams);
begin
  try
    FDataLink.UpdateRecord;
  except
    SetFocus;
    raise;
  end;
//  SetFocus;
//  DoExit;
  inherited;
end;

constructor TDBPropEdit.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  ControlStyle := ControlStyle + [csReplicatable, csCaptureMouse, csClickEvents];


  try
	  FDataLink := TFieldDataLink.Create;
	  FDataLink.Control := Self;

	  FDataLink.OnDataChange := DataChange;
	  FDataLink.OnUpdateData := UpdateDate;
  except
  	on e: Exception do
  	   //	Application.HandleException(Sender);
  end;  // try/except
end;

procedure TDBPropEdit.DataChange(Sender: TObject);
begin

  try
	  if FDataLink.Field <> nil then
		 Prop := FDataLink.Field.AsInteger;
  except
  	on e: Exception do
  	   //	Application.HandleException(Sender);
  end;  // try/except

end;

destructor TDBPropEdit.Destroy;
begin
  FDataLink.Free;
  FDataLink := nil;
  inherited Destroy;
end;

function TDBPropEdit.GetDataField: string;
begin
  Result:=FDataLink.FieldName;
end;

procedure TDBPropEdit.CMGetDataLink(var Message: TMessage);
begin
  Message.Result := Integer(FDataLink);
end;

function TDBPropEdit.GetDataSource: TDataSource;
begin
  Result:=FDataLink.DataSource;
end;

function TDBPropEdit.GetReadOnly: Boolean;
begin
  Result := (FDataLink.ReadOnly);
end;

procedure TDBPropEdit.Notification(AComponent: TComponent;
  Operation: TOperation);
begin
  inherited Notification(AComponent, Operation);
  if (Operation = opRemove) and (FDataLink <> nil) and
    (AComponent = DataSource) then DataSource := nil;
end;

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

procedure TDBPropEdit.SetDataSource(const Value: TDataSource);
begin
  if not (FDataLink.DataSourceFixed and (csLoading in ComponentState)) then
    FDataLink.DataSource := Value;
  if Value <> nil then Value.FreeNotification(Self);
end;

procedure TDBPropEdit.SetReadOnly(const Value: Boolean);
begin
  FDataLink.ReadOnly := Value;
end;

procedure TDBPropEdit.UpdateDate(Sender: TObject);
begin
  FDataLink.Field.AsInteger := Prop;
end;

procedure TDBPropEdit.Loaded;
begin
  inherited Loaded;
  ControlStyle := ControlStyle + [csReplicatable, csCaptureMouse, csClickEvents];
end;

procedure TDBPropEdit.DblClick;
begin
end;

{ TCheckPropProperty }

procedure TCheckPropProperty.Edit;
var
  SetPropForm: TSetPropForm;
begin
  inherited;
  SetPropForm := TSetPropForm.Create(nil);
  try
    SetPropForm.SetItems(TPropEdit(GetComponent(0)).CheckItems);
    if SetPropForm.ShowModal = mrOK then
    begin
      TPropEdit(GetComponent(0)).CheckItems := SetPropForm.CheckItems;
      TPropEdit(GetComponent(0)).Items := SetPropForm.VisibleItems;
    end;
  finally
    SetPropForm.Free;
  end;
end;

function TCheckPropProperty.GetAttributes: TPropertyAttributes;
begin
  Result := [paDialog, paReadOnly]
end;

function TCheckPropProperty.GetValue: string;
begin
  Result := '(设置标志位)';
end;

end.