refer.pas

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

procedure TCustomReference.ListLinkDataChanged;
begin
  FKeyField := nil;
  if FListLink.Active and (FKeyFieldName <> '') then begin
    FKeyField := FListLink.DataSet.FindField(FKeyFieldName);
    if Not CanUseQuery then
      RefreshText;
  end;
end;

procedure TCustomReference.ListSourceChanged(Sender : TObject);
begin
  FListLink.DataSource := FGridLayout.DataSource;
end;

procedure TCustomReference.TryUseQuery(FChangeAssignField : Boolean; V : Variant);
Var
  St : string;
  FDataType: TFieldType;
begin
  FCanUseQuery := False;
  FDataType := ftUnknown;
  FQuery.Close;
  FQuery.DataBaseName := '';
  FQuery.SQL.Clear;
  FAssignQueryField := Nil;
  FKeyQueryField := Nil;
  if FUseQuery  And (FListLink.DataSet <> Nil) then begin
     St := '';
     if(FAssignField <> Nil) And (FChangeAssignField) then begin
       St := FAssignField.FieldName;
       FDataType := FAssignField.DataType;
     end else if (FKeyField <> nil) then begin
       St := FKeyField.FieldName;
       FDataType := FKeyField.DataType;
     end;

     if(Length(St) > 0) And (Length(FTableName) > 0) then begin
       FQuery.DataBaseName := FDataBaseName;
       FQuery.SQL.Add('Select * From ' + FTableName + ' Where');
       FQuery.SQL.Add(St + ' = :par');
       FQuery.Params[0].DataType := FDataType;
       FQuery.Params[0].Value := GetDataTypedValue(V);
       try
         FQuery.Open;
         if(FAssignField <> Nil) then
           FAssignQueryField := FQuery.FindField(FAssignField.FieldName);
         if (FKeyField <> nil) then
           FKeyQueryField := FQuery.FindField(FKeyField.FieldName);
         FCanUseQuery := True;
       except
         {TODO : Show Message with Error}
       end;
     end;
  end;
end;

procedure TCustomReference.SetObjectsInPlace;
begin
 if (csLoading in ComponentState) then exit;
 LabelPanel.Height := FLabel.Height + 2;
 LabelPanel.Visible := FVisibleText;
 MaskEdit.Top := 0;
 LabelPanel.Top := 0;
 if Not (FVisibleText) then begin
    labelPanel.Width := 0;
    MaskEdit.Left := 0;
    MaskEdit.Width := Width;
    Height := MaskEdit.Height;
  end
  else begin
    if(MaskEdit.Height > LabelPanel.Height) then begin
      Height := MaskEdit.Height;
      LabelPanel.Top := Trunc((Height - LabelPanel.Height)/2) + 1;
    end
    else begin
      Height := LabelPanel.Height;
      MaskEdit.Top := Trunc((Height - MaskEdit.Height)/2) + 1;
    end;
    case AlignText of
      rtLeft :
        begin
          MaskEdit.Left := 0;
          LabelPanel.Left := MaskEdit.Width + ReferenceShareEdit;
          LabelPanel.Width := Width - LabelPanel.Left - 1;
        end;
      rtRight:
        begin
          LabelPanel.Left := 0;
          MaskEdit.Left := Width - MaskEdit.Width;
          LabelPanel.Width := MaskEdit.Left - ReferenceShareEdit - 1;
        end;
      end;
  end;
  FLabel.Width := LabelPanel.Width - 2;
end;

procedure TCustomReference.WMSize( var Message: TWMSize );
begin
  SetObjectsInPlace;
  inherited;
end;

{TReference}
function TReference.GetEditMask : String;
begin
  Result := MaskEdit.EditMask;
end;

procedure TReference.SetEditMask(Value : String);
begin
  MaskEdit.EditMask := Value;
end;

{TDBReference}
constructor  TDBReference.Create(AOwner : TComponent);
begin
  inherited Create(AOwner);
  FDataLink := TFieldDataLink.Create;
  FDataLink.Control := Self;
  FDataLink.OnDataChange := DataChange;
  MaskEdit.OnKeyPress := DoKeyPress;
end;

destructor TDBReference.Destroy;
begin
  MaskEdit.OnKeyPress := Nil;
  FDataLink.Free;
  FDataLink := nil;
  inherited;
end;

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

procedure TDBReference.DoOnChange(FState : TReferenceState);
Var
  V : Variant;
begin
  inherited;
  if(FKeyField <> Nil) And (FDataLink.Field <> Nil) then begin
    case  State of
      rsInvalided:  V := Null;
      rsNulled:  V := Null;
      rsValided:
        if(CanUseQuery) then begin
          if(FAssignQueryField <> Nil) then
            V := FAssignQueryField.Value
          else  V := FKeyQueryField.Value;
          MaskEdit.Text := FKeyQueryField.Text;
        end else
        begin
          if(FAssignField <> Nil) then
            V := FAssignField.Value
          else V := FKeyField.Value;
        end;
    end;
    if(FDataLink.Field.Value <> V) then begin
     if (dsBrowse = FDataLink.DataSet.State) And FDataLink.DataSet.Active And
     FDataLink.DataSource.AutoEdit then
       FDataLink.DataSet.Edit;
     if ((dsInsert = FDataLink.DataSet.State) Or ((dsEdit = FDataLink.DataSet.State)))then
      FDataLink.Field.Value := V;
    end;
  end;
end;

procedure TDBReference.DoKeyPress(Sender: TObject; var Key: Char);
begin
  if(Sender <> MaskEdit) then exit;
  if (Key in [#32..#255]) and (FDataLink.Field <> nil) and
    not FDataLink.Field.IsValidChar(Key) then
  begin
    MessageBeep(0);
    Key := #0;
  end;
  case Key of
    ^H, ^V, ^X, #32..#255:
      FDataLink.Edit;
    #27:
      begin
        FDataLink.Reset;
        MaskEdit.SelectAll;
        Key := #0;
      end;
  end;
end;

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

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

procedure TDBReference.SetDataField(Value : String);
begin
  FDataLink.FieldName := Value;
end;

procedure TDBReference.SetDataSource(Value : TDataSource);
begin
  FDataLink.DataSource := value;
 if Value <> nil then Value.FreeNotification(Self);
end;

procedure TDBReference.SetErrorValue(Value : String);
begin
  FErrorValue := Value;
  if(FKeyField <> Nil) And (FDataLink.Field <> Nil) And (State = rsInvalided) then
    FDataLink.Field.Text := '';
end;

procedure TDBReference.DataChange(Sender : TObject);
begin
  if (FDataLink.Field = nil) then begin
    Text := '';
    exit;
  end else begin
    MaskEdit.EditMask := FDataLink.Field.EditMask;
    if FDataLink.Field.DataType = ftString then
      MaskEdit.MaxLength := FDataLink.Field.Size
    else MaskEdit.MaxLength := 0;
  end;
  if(FAssignField = Nil) Or (FAssignField = FKeyField) then begin
    if (Text = FDataLink.Field.AsString) then  exit;
    if ((dsEdit = FDataLink.DataSet.State) Or (dsInsert = FDataLink.DataSet.State)
    Or (dsBrowse = FDataLink.DataSet.State)) then begin
      if(VarIsNull(FDataLink.Field.Value)) then
        Text := ''
      else Text := FDataLink.Field.AsString;
    end;
  end else begin
    if((FAssignField <> Nil){ And (FAssignField.Value <> FDataLink.Field.Value)}) Or
    ((FAssignQueryField <> Nil) {And (FAssignQueryField.Value <>  FDataLink.Field.Value)}) then
      FindByKeyField(FDataLink.Field.Value, True);
  end;
end;

var
 UserCount: Integer;
  DrawBitmap: TBitmap;

procedure UsesBitmap(Control : TCustomControl);
Var
  BitmapName : PChar;
  St : String;
begin
  if UserCount = 0 then begin
    DrawBitmap := TBitmap.Create;

    St := UpperCase(Control.ClassName);
    St := Copy(St, 2, 100);
    BitmapName := StrAlloc(Length(St) + 1);
    StrPCopy(BitmapName, St);
    DrawBitmap.Handle := LoadBitmap(HInstance, BitmapName);
    StrDispose(BitmapName);
  end;
  Inc(UserCount);
end;

procedure ReleaseBitmap;
begin
  Dec(UserCount);
  if UserCount = 0 then begin
    DrawBitmap.Free;
  end;
end;

constructor  TReferencePanel.Create(AOwner : TComponent);
begin
  inherited;
  ControlStyle := [csAcceptsControls, csCaptureMouse, csClickEvents,
    csSetCaption, csOpaque, csDoubleClicks, csReplicatable];

  UsesBitmap(self);
  Width := 200;
  Height := 50;
  Visible := False;
  BackControl := Nil;
  ChangeStyleFlag := False;
end;

destructor TReferencePanel.Destroy;
begin
  ReleaseBitmap;
  if(BackControl <> Nil) then
    BackControl.Free;
  inherited;
end;

procedure TReferencePanel.WriteState(Writer: TWriter);
Var
 i : Integer;
 List : TList;
begin
  if(BackControl <> Nil) then begin
    List := TList.Create;
    for i := 0 to BackControl.ControlCount - 1 do
       List.Add(BackControl.Controls[i]);
    for i := 0 to List.Count - 1 do
      TWinControl(List[i]).Parent := self;
    List.Free;
  end;
  inherited;
  if(BackControl <> Nil) And (FStyle = bpComponent) then begin
    List := TList.Create;
    for i := 0 to ControlCount - 1 do
      if(Controls[i] <> BackControl) then
        List.Add(Controls[i]);
    for i := 0 to List.Count - 1 do
      TWinControl(List[i]).Parent := BackControl;
    List.Free;
  end;
end;

procedure TReferencePanel.CreateParams( var Params: TCreateParams );
begin
  inherited CreateParams( Params );
  Params.Style := Params.Style or WS_CLIPCHILDREN;
end;

procedure TReferencePanel.SetBounds(ALeft, ATop, AWidth, AHeight: Integer);
begin
  if(Style = bpComponent) then begin
    AWidth := DrawBitmap.Width;
    AHeight := DrawBitmap.Height;
  end;    
  inherited;
end;

procedure TReferencePanel.Loaded;
begin
  inherited;
  SetStyle(FStyle);
end;

procedure  TReferencePanel.Paint;
Var
  r : TRect;
begin
  inherited;
  if(Style = bpComponent) then
     Canvas.Draw(0, 0, DrawBitmap)
  else
    if(csDesigning in ComponentState) then begin
      r := GetClientRect;
      Canvas.FrameRect(r);
    end;
end;

procedure TReferencePanel.SetStyle(Value : TReferencePanelStyle);
Var
  i : Integer;
  List : TList;
begin
  FStyle := Value;

  if (BackControl = Nil) then begin
    BackControl := TWinControl.Create(self);
    with BackControl do begin
      Parent := self;
      Width := 0;
      Height := 0;
      Top := -1;
    end;
  end;

  if(BackControl <> Nil) And Not (csLoading in ComponentState)then begin
    List := TList.Create;
    if(Value = bpComponent) then begin
      for i := 0 to ControlCount - 1 do
        if(Controls[i] <> BackControl) then
          List.Add(Controls[i]);
      for i := 0 to List.Count - 1 do
        TWinControl(List[i]).Parent := BackControl;
    end else begin
      for i := 0 to BackControl.ControlCount - 1 do
          List.Add(BackControl.Controls[i]);
      for i := 0 to List.Count - 1 do
        TWinControl(List[i]).Parent := self;
    end;
    List.Free;
  end;

  if Not (csLoading in ComponentState) then begin
    ChangeStyleFlag := True;
    inherited Height := FHeight;
    inherited Width := FWidth;    
    ChangeStyleFlag := False;
  end;
end;

procedure TReferencePanel.SetHeight(Value : Integer);
begin
  if(Value >= 0) then begin
    FHeight := Value;
    inherited Height := Value;
  end;
end;

procedure TReferencePanel.SetWidth(Value : Integer);
begin
  if(Value >= 0) then begin
    FWidth := Value;
    inherited Width := Value;
  end;
end;

procedure TReferencePanel.WMSize( var Message: TWMSize );
begin
  if(Style <> bpComponent) And Not ChangeStyleFlag then begin
    FHeight := Message.Height;
    FWidth := Message.Width;
  end;
  inherited;
end;


{TReferenceFilter}
constructor TReferenceFilter.Create(AOwner : TComponent);
begin
  inherited;
  FAutoFilter := TAutoFilter.Create(self);
  FAutoFilter.Name := 'Refer';
end;

destructor TReferenceFilter.Destroy;
begin
  FAutoFilter.Free;
  inherited;
end;

procedure TReferenceFilter.DoOnChange(FState : TReferenceState);
begin
  inherited DoOnChange(FState);
  if(FKeyField <> Nil) then
    case State of
      rsInvalided : FAutoFilter.Value := FErrorValue;
      rsNulled : FAutoFilter.Value := FNullValue;
      rsValided :
        if(CanUseQuery) then begin
          if(FAssignQueryField <> Nil) then
            FAutoFilter.Value := FAssignQueryField.AsString
          else FAutoFilter.Value := FKeyQueryField.AsString;
        end else
        begin
         if(FAssignField <> Nil) then
           FAutoFilter.Value := FAssignField.AsString
        else FAutoFilter.Value := FKeyField.AsString;
        end;
    end;
end;

procedure TReferenceFilter.SetErrorValue(Value : String);
begin
  FErrorValue := Value;
  if(FKeyField <> Nil) And (State = rsInvalided) then
     FAutoFilter.Value := FErrorValue;
end;

procedure TReferenceFilter.SetNullValue(Value : String);
begin
  FNullValue := Value;
  if(FKeyField <> Nil) And (State = rsInvalided) then
     FAutoFilter.Value := FNullValue;
end;

function TReferenceFilter.GetOnBeforeFilterChange : TNotifyEvent;
begin
  Result := FAutoFilter.OnBeforeChange;
end;

function TReferenceFilter.GetOnAfterFilterChange : TNotifyEvent;
begin
  Result := FAutoFilter.OnAfterChange;
end;

procedure TReferenceFilter.SetOnBeforeFilterChange(Value : TNotifyEvent);
begin
  FAutoFilter.OnBeforeChange := Value;
end;

procedure TReferenceFilter.SetOnAfterFilterChange(Value : TNotifyEvent);
begin
  FAutoFilter.OnAfterChange := Value;
end;

initialization
  UserCount := 0;

end.