rxlookup.pas

企业端数据申报系统：单位管理模块 单位查询. 业务申报模块 在线数据下载 在线数据上传 在线业务申核 申报业务查询 磁盘数据导出 磁盘数据导入 在线业务模块 在线业务

begin
  Result := inherited ExecuteAction(Action) or ((FDataLink <> nil) and
    FDataLink.ExecuteAction(Action));
end;

function TRxLookupControl.UpdateAction(Action: TBasicAction): Boolean;
begin
  Result := inherited UpdateAction(Action) or ((FDataLink <> nil) and
    FDataLink.UpdateAction(Action));
end;

function TRxLookupControl.UseRightToLeftAlignment: Boolean;
begin
  Result := DBUseRightToLeftAlignment(Self, Field);
end;
{$ENDIF}

function TRxLookupControl.GetBorderSize: Integer;
var
  Params: TCreateParams;
  R: TRect;
begin
  CreateParams(Params);
  SetRect(R, 0, 0, 0, 0);
{$IFDEF WIN32}
  AdjustWindowRectEx(R, Params.Style, False, Params.ExStyle);
{$ELSE}
  AdjustWindowRect(R, Params.Style, False);
  if (csFramed in ControlStyle) and Ctl3D and 
    (Params.Style and WS_BORDER <> 0) then Inc(R.Bottom, 2);
{$ENDIF}
  Result := R.Bottom - R.Top;
end;

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

function TRxLookupControl.GetLookupField: string;
begin
{$IFDEF WIN32}
  if FLookupMode then Result := '' else
{$ENDIF}
  Result := FLookupFieldName;
end;

function TRxLookupControl.GetLookupSource: TDataSource;
begin
{$IFDEF WIN32}
  if FLookupMode then Result := nil else
{$ENDIF}
  Result := FLookupLink.DataSource;
end;

function TRxLookupControl.GetReadOnly: Boolean;
begin
  Result := FDataLink.ReadOnly;
end;

function TRxLookupControl.GetField: TField;
begin
  if Assigned(FDataLink) then Result := FDataField
  else Result := nil;
end;

function TRxLookupControl.DefaultTextHeight: Integer;
var
  DC: HDC;
  SaveFont: HFont;
  Metrics: TTextMetric;
begin
  DC := GetDC(0);
  SaveFont := SelectObject(DC, Font.Handle);
  GetTextMetrics(DC, Metrics);
  SelectObject(DC, SaveFont);
  ReleaseDC(0, DC);
  Result := Metrics.tmHeight;
end;

function TRxLookupControl.GetTextHeight: Integer;
begin
  Result := Max(DefaultTextHeight, FItemHeight);
end;

procedure TRxLookupControl.KeyValueChanged;
begin
end;

procedure TRxLookupControl.DisplayValueChanged;
begin
end;

procedure TRxLookupControl.ListLinkActiveChanged;
var
  DataSet: TDataSet;
{$IFDEF WIN32}
  ResultField: TField;
{$ENDIF}
begin
  FListActive := False;
  FKeyField := nil;
  FDisplayField := nil;
  FListFields.Clear;
  if FLookupLink.Active and (FLookupFieldName <> '') then begin
    CheckNotCircular;
    DataSet := FLookupLink.DataSet;
    FKeyField := DataSet.FieldByName(FLookupFieldName);
{$IFDEF WIN32}
    DataSet.GetFieldList(FListFields, FLookupDisplay);
{$ELSE}
    GetFieldList(DataSet, FListFields, FLookupDisplay);
{$ENDIF}
{$IFDEF WIN32}
    if FLookupMode then begin
      ResultField := DataSet.FieldByName(FDataField.LookupResultField);
      if FListFields.IndexOf(ResultField) < 0 then
        FListFields.Insert(0, ResultField);
      FDisplayField := ResultField;
    end
    else begin
      if FListFields.Count = 0 then FListFields.Add(FKeyField);
      if (FDisplayIndex >= 0) and (FDisplayIndex < FListFields.Count) then
        FDisplayField := FListFields[FDisplayIndex]
      else FDisplayField := FListFields[0];
    end;
{$ELSE}
    if FListFields.Count = 0 then FListFields.Add(FKeyField);
    if (FDisplayIndex >= 0) and (FDisplayIndex < FListFields.Count) then
      FDisplayField := FListFields[FDisplayIndex]
    else FDisplayField := FListFields[0];
{$ENDIF}
    FListActive := True;
  end;
  FLocate.DataSet := FLookupLink.DataSet;
end;

procedure TRxLookupControl.ListLinkDataChanged;
begin
end;

function TRxLookupControl.LocateDisplay: Boolean;
begin
  Result := False;
  try
    Result := Locate(FDisplayField, FDisplayValue, True);
  except
  end;
end;

function TRxLookupControl.LocateKey: Boolean;
begin
  Result := False;
  try
    Result := not ValueIsEmpty(FValue) and Locate(FKeyField, FValue, True);
  except
  end;
end;

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

function TRxLookupControl.SearchText(var AValue: string): Boolean;
begin
  Result := False;
  if (FDisplayField <> nil) then
    if (AValue <> '') and Locate(FDisplayField, AValue, False) then begin
      SelectKeyValue(FKeyField.AsString);
      AValue := Copy(FDisplayField.AsString, 1, Length(AValue));
      Result := True;
    end
    else if AValue = '' then begin
      FLookupLink.DataSet.First;
      SelectKeyValue(FKeyField.AsString);
      AValue := '';
    end;
end;

procedure TRxLookupControl.ProcessSearchKey(Key: Char);
var
  TickCount: Longint;
  S: string;
begin
  S := '';
  if (FDisplayField <> nil) {and (FDisplayField.DataType = ftString)} then
    case Key of
      #9, #27: FSearchText := '';
      Char(VK_BACK), #32..#255:
        if CanModify then begin
          if not FPopup then begin
            TickCount := GetTickCount;
            if TickCount - SearchTickCount > 2000 then FSearchText := '';
            SearchTickCount := TickCount;
          end;
          if (Key = Char(VK_BACK)) then
            S := Copy(FSearchText, 1, Length(FSearchText) - 1)
          else if Length(FSearchText) < 32 then
            S := FSearchText + Key;
          if SearchText(S) or (S = '') then FSearchText := S;
        end;
    end;
end;

procedure TRxLookupControl.ResetField;
begin
  if (FDataLink.DataSource = nil) or
    ((FDataLink.DataSource <> nil) and CanModify) then
  begin
    if (FDataLink.DataSource <> nil) and (FMasterField <> nil) and
      FDataLink.Edit then
    begin
      if FEmptyValue = EmptyStr then FMasterField.Clear
      else FMasterField.AsString := FEmptyValue;
    end;
    FValue := FEmptyValue;
    FDisplayValue := EmptyStr;
    inherited Text := DisplayEmpty;
    Invalidate;
    Click;
  end;
end;

procedure TRxLookupControl.ClearValue;
begin
  SetValueKey(FEmptyValue);
end;

procedure TRxLookupControl.SelectKeyValue(const Value: string);
begin
  if FMasterField <> nil then begin
    if CanModify and FDataLink.Edit then begin
      if FDataField = FMasterField then FDataField.DataSet.Edit;
      FMasterField.AsString := Value;
    end
    else Exit;
  end
  else SetValueKey(Value);
  UpdateDisplayValue;
  Repaint;
  Click;
end;

procedure TRxLookupControl.SetDataFieldName(const Value: string);
begin
  if FDataFieldName <> Value then begin
    FDataFieldName := Value;
    DataLinkActiveChanged;
  end;
end;

procedure TRxLookupControl.SetDataSource(Value: TDataSource);
begin
  FDataLink.DataSource := Value;
{$IFDEF WIN32}
  if Value <> nil then Value.FreeNotification(Self);
{$ENDIF}
end;

procedure TRxLookupControl.SetListStyle(Value: TLookupListStyle);
begin
  if FListStyle <> Value then begin
    FListStyle := Value;
    Invalidate;
  end;
end;

procedure TRxLookupControl.SetFieldsDelim(Value: Char);
begin
  if FFieldsDelim <> Value then begin
    FFieldsDelim := Value;
    if ListStyle = lsDelimited then Invalidate;
  end;
end;

procedure TRxLookupControl.SetLookupField(const Value: string);
begin
{$IFDEF WIN32}
  CheckNotFixed;
{$ENDIF}
  if FLookupFieldName <> Value then begin
    FLookupFieldName := Value;
    ListLinkActiveChanged;
    if FListActive then DataLinkRecordChanged(nil);
  end;
end;

procedure TRxLookupControl.SetDisplayEmpty(const Value: string);
begin
  if FDisplayEmpty <> Value then begin
    UpdateDisplayEmpty(Value);
    FDisplayEmpty := Value;
    if not (csReading in ComponentState) then Invalidate;
  end;
end;

procedure TRxLookupControl.SetEmptyValue(const Value: string);
begin
  if FEmptyValue <> Value then begin
    if ValueIsEmpty(FValue) then FValue := Value;
    FEmptyValue := Value;
  end;
end;

procedure TRxLookupControl.SetEmptyItemColor(Value: TColor);
begin
  if FEmptyItemColor <> Value then begin
    FEmptyItemColor := Value;
    if not (csReading in ComponentState) and (DisplayEmpty <> '') then
      Invalidate;
  end;
end;

procedure TRxLookupControl.UpdateDisplayEmpty(const Value: string);
begin
end;

procedure TRxLookupControl.SetDisplayValue(const Value: string);
var
  S: string;
begin
  if (FDisplayValue <> Value) and CanModify and (FDataLink.DataSource <> nil) and
    Locate(FDisplayField, Value, True) then
  begin
    S := FValue;
    if FDataLink.Edit then begin
      if FMasterField <> nil then FMasterField.AsString := S
      else FDataField.AsString := S;
    end;
  end
  else if (FDisplayValue <> Value) then begin
    FDisplayValue := Value;
    DisplayValueChanged;
    Change;
  end;
end;

procedure TRxLookupControl.UpdateKeyValue;
begin
  if FMasterField <> nil then FValue := FMasterField.AsString
  else FValue := FEmptyValue;
  KeyValueChanged;
end;

procedure TRxLookupControl.SetValueKey(const Value: string);
begin
  if FValue <> Value then begin
    FValue := Value;
    KeyValueChanged;
  end;
end;

procedure TRxLookupControl.SetValue(const Value: string);
begin
  if (Value <> FValue) then
    if CanModify and (FDataLink.DataSource <> nil) and FDataLink.Edit then
    begin
      if FMasterField <> nil then FMasterField.AsString := Value
      else FDataField.AsString := Value;
    end
    else begin
      SetValueKey(Value);
      Change;
    end;
end;

procedure TRxLookupControl.SetLookupDisplay(const Value: string);
begin
  if FLookupDisplay <> Value then begin
    FLookupDisplay := Value;
    ListLinkActiveChanged;
    if FListActive then DataLinkRecordChanged(nil);
  end;
end;

procedure TRxLookupControl.SetLookupSource(Value: TDataSource);
begin
{$IFDEF WIN32}
  CheckNotFixed;
{$ENDIF}
  FLookupLink.DataSource := Value;
{$IFDEF WIN32}
  if Value <> nil then Value.FreeNotification(Self);
{$ENDIF}
  if Value <> nil then FLocate.DataSet := Value.DataSet
  else FLocate.DataSet := nil;
  if FListActive then DataLinkRecordChanged(nil);
end;

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

function TRxLookupControl.GetItemHeight: Integer;
begin
  Result := {Max(GetTextHeight, FItemHeight);}GetTextHeight;
end;

procedure TRxLookupControl.SetItemHeight(Value: Integer);
begin
  if not (csReading in ComponentState) then
    FItemHeight := Max(DefaultTextHeight, Value)
  else FItemHeight := Value;
  Perform(CM_FONTCHANGED, 0, 0);
end;

function TRxLookupControl.ItemHeightStored: Boolean;
begin
  Result := FItemHeight > DefaultTextHeight;
end;

procedure TRxLookupControl.DrawPicture(Canvas: TCanvas; Rect: TRect;
  Image: TGraphic);
var
  X, Y, SaveIndex: Integer;
{$IFDEF WIN32}
  Ico: HIcon;
  W, H: Integer;
{$ENDIF}
begin
  if Image <> nil then begin
    X := (Rect.Right + Rect.Left - Image.Width) div 2;
    Y := (Rect.Top + Rect.Bottom - Image.Height) div 2;
    SaveIndex := SaveDC(Canvas.Handle);
    try
      IntersectClipRect(Canvas.Handle, Rect.Left, Rect.Top, Rect.Right,
        Rect.Bottom);
      if Image is TBitmap then
        DrawBitmapTransparent(Canvas, X, Y, TBitmap(Image),