refer.pas

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

    Width := Height;
    Left := self.Width - Width - 3;
  end;
  SetEditRect;
end;

procedure TRefMaskEdit.DoOnChange(Sender : TObject);
Var
  V : Variant;
begin
  if(Modified) And (FCustomReference <> Nil) And Not (csLoading in ComponentState)then begin
    Modified := Not Modified;
    if(Text <> '') then
      V := Variant(Text)
    else V := Null;
    V := FCustomReference.GetDataTypedValue(V);
    FCustomReference.FindByKeyField(V, False);
  end;
end;


{ TListSourceLink }
procedure TReferenceListSourceLink.ActiveChanged;
begin
  if FCustomReference <> nil then FCustomReference.ListLinkActiveChanged;
end;

procedure TReferenceListSourceLink.DataSetChanged;
begin
  if FCustomReference <> nil then FCustomReference.ListLinkDataChanged;
end;


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

  FListLink := TReferenceListSourceLink.Create;
  FListLink.FCustomReference := Self;

  FGridLayout := TAutoGridLayout.Create(self);
  FGridLayout.OnDataSourceChanged := ListSourceChanged;
  MaskEdit := TRefMaskEdit.Create(self);
  MaskEdit.OnExit := OnExit;

  with MaskEdit do begin
    FCustomReference := self;
    Parent := self;
    BitBtn.OnClick :=  BitBtnClick;
  end;

  LabelPanel := TPanel.Create(self);
  with LabelPanel do begin
    Parent := self;
    BevelInner := bvLowered;
    BevelOuter := bvNone;
    Color := clBtnFace;
  end;
  Color := LabelPanel.Color;  

  FLabel := TLabel.Create(self);
  with FLabel do begin
    Parent := LabelPanel;
    Top := 1;
    Left := 1;
  end;

  FAutoFilter := TAutoFilter.Create(self);
  FAutoFilter.TextBefore := 'Order by ';
  FAutoFilter.Name := 'SQLOrder';

  FQuery := TQuery.Create(self);

  FTextOnError := 'Invalid';
  State := rsNulled;

  Width := 100;
  WinHeight := 150;
  WinWidth := 160;
  FCanUseQuery := False;
  FReferencePanelAlign := ralBottom;
end;

destructor TCustomReference.Destroy;
begin
  FListLink.FCustomReference := nil;
  FListLink.Free;
  FGridLayout.Free;

  if Not (csDestroying in MaskEdit.ComponentState) then
     if(MaskEdit.BitBtn.Focused) then
       MaskEdit.SetFocus;
  MaskEdit.Free;
  FLabel.Free;
  LabelPanel.Free;
  FQuery.Free;

  inherited;
end;

procedure TCustomReference.Notification(AComponent: TComponent; Operation: TOperation);
begin
  inherited;
  if(Operation = opRemove) And (AComponent = FReferencePanel) then
    ReferencePanel := Nil;
end;

function TCustomReference.ChangeTextByPattern(St : String) : String;
Var
  St1 : String;
  j : Integer;
  Field : TField;

function GetLengthSt : Integer;
begin
  Result := 1;
  while (Result <= length(St)) And (((St[Result] >= '0') And (St[Result] <= '9'))
   Or ((St[Result] >= 'A') And (St[Result] <= 'z')) Or (St[Result] = '_')) do
    Inc(Result);
  Dec(Result);

end;
begin
  if Not FListLink.Active And Not CanUseQuery then exit;

  Result := '';
  repeat
    j := Pos('&', St);
    if (j > 0) then begin
      Result := Result + Copy(St,  1, j - 1);
      St := Copy(St,  j + 1, 1000);
      j := GetLengthSt;
      St1 := Copy(St, 1, j);
      St := Copy(St,  j + 1, 1000);
      if CanUseQuery then
         Field := FQuery.FindField(St1)
      else Field := FListLink.DataSet.FindField(St1);
      if(Field <> Nil) then
        Result := Result + Field.AsString;
    end;
  until (j <= 0);
  Result := Result + St;
end;

function TCustomReference.GetQuery : TQuery;
begin
  if FUseQuery then
    Result := FQuery
  else Result := Nil;
end;

function TCustomReference.FindByKeyFieldInList(V : Variant) : Boolean;
begin
  Result := False;
  if (FKeyField = Nil) Or Not (FListLink.Active) Or
    (FListLink.DataSet.EOF and FListLink.DataSet.BOF) then exit;

  if(VarIsNull(V)) then begin
    DoOnChange(rsNulled);
    exit;
  end;

  if(V = FKeyField.Value) then begin
    Result := True;
    DoOnChange(rsValided);
    exit;
  end;

  Result := FListLink.DataSet.Locate(FKeyFieldName, V, [loCaseInsensitive]);
  if Not (Result) then
    DoOnChange(rsInValided)
  else
    DoOnChange(rsValided);
end;

function TCustomReference.FindByKeyField(V : Variant; FChangeAssignField : Boolean) : Boolean;
begin
  Result := False;

  if not VarIsNull(V) then begin

    if(CanUseQuery) And Not (FQuery.EOF) And (V = FKeyQueryField.Value) then begin
      Result := True;
      DoOnChange(rsValided);
      RefreshText;
      exit;
    end;

    if FUseQuery then begin
      TryUseQuery(FChangeAssignField, V);
      if CanUseQuery then begin
        if FQuery.EOF then
          DoOnChange(rsInValided)
        else DoOnChange(rsValided);
        RefreshText;
        exit;
      end;
    end;

    Result := FindByKeyFieldInList(V);
  end
  else  DoOnChange(rsNulled);
  RefreshText;
end;

procedure TCustomReference.GotoKeyFieldValue;
Var
  V : Variant;
begin
  if(Length(MaskEdit.Text) > 0) then
    V := GetDataTypedValue(Variant(MaskEdit.Text))
  else V := Null;  
  FindByKeyField(V, False);
end;

procedure TCustomReference.RefreshText;
begin
  case State of
    rsInvalided : FLabel.Caption := FTextOnError;
    rsNulled : FLabel.Caption := '';
    rsValided :  FLabel.Caption := ChangeTextByPattern(FPatternText);
  end;
  FLabel.Width := LabelPanel.Width - 2;
end;


procedure TCustomReference.DoOnChange(FState : TReferenceState);
begin
  State := FState;
  if(Assigned(FOnChange)) then
    FOnChange(Self);
end;

function TCustomReference.GetDataTypedValue(V : Variant) : Variant;
begin
  Result := NULL;
  if(FKeyField = Nil) Or VarIsNull(V) then exit;
  try
    case FKeyField.DataType of
     ftString : Result := String(V);
     ftSmallint, ftInteger, ftWord, ftAutoInc: Result := Integer(V);
     ftBoolean: Result := Boolean(V);
     ftFloat: Result := Double(V);
     ftCurrency: Result := Currency(V);
     ftDate, ftDateTime: Result := TDateTime(V);
     else   Result := V;
   end;
  except
    Result := Null;
  end;

end;

procedure TCustomReference.Loaded;
begin
  inherited;
  SetObjectsInPlace;
end;

function TCustomReference.GetCanUseQuery : Boolean;
begin
  Result := FCanUseQuery And FUseQuery;
end;

function TCustomReference.GetEditColor : TColor;
begin
  Result := MaskEdit.Color;
end;

function TCustomReference.GetEditWidth : Integer;
begin
  Result := MaskEdit.Width;
end;

function TCustomReference.GetFont : TFont;
begin
  Result := MaskEdit.Font;
end;

function TCustomReference.GetFontText : TFont;
begin
  Result := FLabel.Font;
end;

function TCustomReference.GetGlyph : TBitmap;
begin
  Result := MaskEdit.BitBtn.Glyph;
end;

function TCustomReference.GetLabelColor : TColor;
begin
  Result := LabelPanel.Color;
end;

function TCustomReference.GetNumGlyphs : Integer;
begin
  Result := MaskEdit.BitBtn.NumGlyphs;
end;

function TCustomReference.GetRepository : TAutoRepository;
begin
  Result := FGridLayout.Repository;
end;

function TCustomReference.GetText : String;
begin
  Result := MaskEdit.Text;
end;

procedure TCustomReference.SetAlignText(Value : TAlignReferenceText);
begin
  FAlignText := Value;
  SetObjectsInPlace;
end;

procedure TCustomReference.SetAssignField(Value : String);
begin
  if (FAssignFieldName <> Value) then
    FAssignFieldName := Value;
end;

procedure TCustomReference.SetEditColor(Value : TColor);
begin
  MaskEdit.Color := Value;
end;

procedure TCustomReference.SetEditWidth(Value : Integer);
begin
  if (FVisibleText) And (Value > 0)
    And (Value < Width - 3 * ReferenceShareEdit) then begin
    MaskEdit.Width := Value;
    LabelPanel.Width := Width - MaskEdit.Width - ReferenceShareEdit;
    SetObjectsInPlace;
  end;
end;

procedure TCustomReference.SetFont(Value : TFont);
begin
  TMaskedit(MaskEdit).Font := Value;
  SetObjectsInPlace;
end;

procedure TCustomReference.SetFontText(Value : TFont);
begin
  FLabel.Font := Value;
  SetObjectsInPlace;
end;

procedure TCustomReference.SetGlyph(Value : TBitmap);
begin
  MaskEdit.BitBtn.Glyph.Assign(Value);
end;

procedure TCustomReference.SetGridLayout(Value : TAutoGridLayout);
begin
  FGridLayout.Assign(Value);
end;

procedure TCustomReference.SetKeyField(Value : String);
begin
  If(FKeyFieldName <> Value) then begin
    FCanUseQuery := False;
    FKeyFieldName := Value;
    ListLinkActiveChanged;
  end;
end;

procedure TCustomReference.SetLabelColor(Value : TColor);
begin
  LabelPanel.Color := Value;
  Color := Value;
end;

procedure TCustomReference.SetNumGlyphs(Value : Integer);
begin
  MaskEdit.BitBtn.NumGlyphs := Value;
end;

procedure TCustomReference.SetPatternText(Value : String);
begin
  if(Value <> FPatternText) then begin
    FPatternText := Value;
    RefreshText;
  end;
end;

procedure TCustomReference.SetReferencePanel(Value : TReferencePanel);
begin
  if(FReferencePanel <> Value) then
    FReferencePanel := Value;
end;

procedure TCustomReference.SetRepository(Value : TAutoRepository);
begin
  FGridLayout.Repository := Value;
end;

procedure TCustomReference.SetText(Value : String);
Var
  V : Variant;
begin
  MaskEdit.Text := Value;
  if Not (csLoading in ComponentState) then begin
    if(Length(MaskEdit.Text) > 0) then
      V := GetDataTypedValue(variant(MaskEdit.Text))
    else V := Null;  
    FindByKeyField(V, False);
  end;
end;

procedure TCustomReference.SetVisibleText(Value : Boolean);
begin
  if(FVisibleText) And Not (Value) And Not (csLoading in ComponentState) then
    Width := MaskEdit.Width;
  if (Value) And Not(FVisibleText) And Not (csLoading in ComponentState) then begin
    FVisibleText := Value;
    Width := Width + 150;
  end else begin
    FVisibleText := Value;
    SetObjectsInPlace;
  end;
end;

procedure TCustomReference.SetWinHeight(Value : Integer);
begin
  if(Value > 0) then
    FWinHeight := Value
end;

procedure TCustomReference.SetWinWidth(Value : Integer);
begin
  if(Value >= 160) then
    FWinWidth := Value
end;

procedure TCustomReference.BitBtnClick(Sender : TObject);
Var
  V : Variant;
begin
  V := Null;
  if(Length(MaskEdit.Text) > 0) then
    V  := GetDataTypedValue(MaskEdit.Text);
  FindByKeyFieldInList(V);
  if PopupReference(FGridLayout, FReferencePanel, FReferencePanelAlign,
     Repository, FWinWidth, FWinHeight)
  And (FKeyField <> Nil) then
    MaskEdit.Text := FKeyField.AsString;
  GotoKeyFieldValue;
end;

procedure TCustomReference.InitQuery;
Var
 i, j : Integer;
 St : String;
begin
  FDataBaseName := '';
  if(FListLink.DataSet <> Nil) then begin
    if(FListLink.DataSet is TTable) then
       FDataBaseName := TTable(FListLink.DataSet).DataBaseName;
    if(FListLink.DataSet is TQuery) then
      FDataBaseName := TQuery(FListLink.DataSet).DataBaseName;

    if Not (csLoading in ComponentState)  then begin
      if(FListLink.DataSet is TTable) And
      (Length(TTable(FListLink.DataSet).TableName) > 0) then
         TableName := TTable(FListLink.DataSet).TableName;

       if(FListLink.DataSet is TQuery) And (Length(FTableName) = 0) then
         for i := 0 to TQuery(FListLink.DataSet).SQL.Count - 1 do begin
           j := Pos('FROM', UPPERCASE(TQuery(FListLink.DataSet).SQL[i]));
           if(j > 0) then begin
             St := Copy(TQuery(FListLink.DataSet).SQL[i], j + 4, 1000);
             j := 1;
             while (j <= Length(St)) And (St[j] = ' ') do Inc(j);
             St := Copy(St, j, 1000);
             while (j <= Length(St)) And (St[j] <> ' ') do Inc(j);
             TableName := UPPERCASE(Copy(St, 1, j));
             break;
           end;
         end;
    end;
  end;
end;

procedure TCustomReference.ListLinkActiveChanged;
begin
  FCanUseQuery := False;
  FKeyField := nil;
  FAssignField := Nil;
  InitQuery;
  if FListLink.Active and (FKeyFieldName <> '') then begin
    FKeyField := FListLink.DataSet.FindField(FKeyFieldName);
    FAssignField := FListLink.DataSet.FindField(FAssignFieldName);
    GotoKeyFieldValue;
    RefreshText;
  end;
end;