validate2.pas

一个经典的读写Excel的控件

    for i := 0 to Sz - 1 do begin
      if pW[i] = 0 then
        Inc(Result);
    end;
    Inc(Result);
  end;
end;

procedure TDataValidation.Include(Col1, Row1, Col2, Row2: integer);
begin
  FAreas.Include(Col1, Row1, Col2, Row2);
end;

function TDataValidation.Intersect(Col1, Row1, Col2, Row2: integer): boolean;
begin
  Result := FAreas.AreaInAreas(Col1, Row1, Col2, Row2);
end;

procedure TDataValidation.LoadFromStream(Stream: TXLSStream; PBuf: PByteArray);
var
  P: PByteArray;
  i,Len: integer;
  Header: TBIFFHeader;

function GetPtrText: WideString;
var
  Len: integer;
begin
  Len := PWord(P)^;
  P := PByteArray(Integer(P) + 2);
  if Len > 0 then begin
    Result := Trim(ByteStrToWideString(P,Len));
    if P[0] = 0 then
      P := PByteArray(Integer(P) + Len + 1)
    else if P[0] = 1 then
      P := PByteArray(Integer(P) + Len * 2 + 1)
    else
      raise Exception.Create('Unhandled string in DV');
  end
  else
    Result := '';
end;

begin
  Stream.ReadHeader(Header);
  if Header.RecID <> BIFFRECID_DV then
    raise Exception.Create('Excpected record missing: DV');
  Stream.Read(Pbuf^,Header.Length);
  P := PBuf;
  FOptions := PInteger(P)^;
  FValidationType := TValidationType(FOptions and $000F);
  FValidationStyle := TValidationStyle((FOptions shr 4) and $0007);
  FValidationOperator := TValidationOperator((FOptions shr 20) and $000F);
  P := PByteArray(Integer(P) + 4);
  FInputTitle := GetPtrText;
  FErrorTitle := GetPtrText;
  FInputMsg := GetPtrText;
  FErrorMsg := GetPtrText;

  Len := PWord(P)^;
  P := PByteArray(Integer(P) + 4);
  SetRawExpression1(P,Len);
  P := PByteArray(Integer(P) + Len);

  Len := PWord(P)^;
  P := PByteArray(Integer(P) + 4);
  SetRawExpression2(P,Len);
  P := PByteArray(Integer(P) + Len);

  Len := PWord(P)^;
  if Len > $0FFF then
    Len := 0;
  P := PByteArray(Integer(P) + 2);
  for i := 0 to Len - 1 do begin
    Areas.Add.SetSize(PWordArray(P)[2],PWordArray(P)[0],PWordArray(P)[3],PWordArray(P)[1]);
    P := PByteArray(Integer(P) + SizeOf(TRecCellArea));
  end;
end;

procedure TDataValidation.Move(Col1, Row1, Col2, Row2, DeltaCol, DeltaRow: integer);
begin
  FAreas.Move(Col1, Row1, Col2, Row2, DeltaCol, DeltaRow);
end;

procedure TDataValidation.Move(DeltaCol, DeltaRow: integer);
begin
  FAreas.Move(DeltaCol, DeltaRow);
end;

procedure TDataValidation.SaveToStream(Stream: TXLSStream; PBuf: PByteArray);
var
  i,L: integer;

function StrSize(S: WideString): integer;
begin
  if S = '' then
    Result := 4
  else
    Result := 2 + 1 + Length(S) * 2;
end;

procedure WriteString(S: WideString);
begin
  if S = '' then
    Stream.WLWord(1)
  else
    Stream.WriteWideString(S);
end;

begin
  L := Sizeof(FOptions) +
       StrSize(FInputTitle) +
       StrSize(FErrorTitle) +
       StrSize(FInputMsg) +
       StrSize(FErrorMsg) +
       FFormula1.Size + 2 + 2 +
       FFormula2.Size + 2 + 2 +
       FAreas.Count * 8 + 2;
  Stream.WriteHeader(BIFFRECID_DV,L);
  if FAssigned then begin
    Inc(FOptions,Integer(FValidationType));
    Inc(FOptions,Integer(FValidationStyle) shl 4);
    if voAllowEmptyCells in FValidationOptions then
      Inc(FOptions,$00000100);
    if voSupressDropDown in FValidationOptions then
      Inc(FOptions,$00000200);
    if voShowPromptBox in FValidationOptions then
      Inc(FOptions,$00040000);
    if voShowErrorBox in FValidationOptions then
      Inc(FOptions,$00080000);
    Inc(FOptions,Integer(FValidationOperator) shl 20);
  end;
  Stream.Write(FOptions,4);
  WriteString(FInputTitle);
  WriteString(FErrorTitle);
  WriteString(FInputMsg);
  WriteString(FErrorMsg);

  Stream.WWord(FFormula1.Size);
  Stream.WWord($0000);
  if FFormula1.Size > 0 then
    Stream.Write(FFormula1.PTGS^,FFormula1.Size);

  Stream.WWord(FFormula2.Size);
  Stream.WWord($0000);
  if FFormula2.Size > 0 then
    Stream.Write(FFormula2.PTGS^,FFormula2.Size);

  Stream.WWord(Areas.Count);
  for i := 0 to Areas.Count - 1 do begin
    Stream.WWord(Areas[i].Row1);
    Stream.WWord(Areas[i].Row2);
    Stream.WWord(Areas[i].Col1);
    Stream.WWord(Areas[i].Col2);
  end;
end;

procedure TDataValidation.SetExpression1(const Value: WideString);
var
  P: PByteArray;
  Sz: integer;
begin
   GetMem(P,512);
   try
    Sz := TDataValidations(Collection).FFormulaHandler.EncodeFormula(Value,P,512);
    SetRawExpression1(P,Sz);
  finally
    FreeMem(P);
  end;
  FAssigned := True;
end;

procedure TDataValidation.SetExpression2(const Value: WideString);
var
  P: PbyteArray;
  Sz: integer;
begin
  GetMem(P,512);
  try
    Sz := TDataValidations(Collection).FFormulaHandler.EncodeFormula(Value,P,512);
    SetRawExpression2(P,Sz);
  finally
    FreeMem(P);
  end;
  FAssigned := True;
end;

procedure TDataValidation.SetList(Values: array of WideString);
var
  i,Sz: integer;
  pW: PWordArray;
begin
  Sz := 0;
  for i := 0 to High(Values) do
    Inc(Sz,Length(Values[i]));
  if Sz <= 0 then
    Exit;
  // Separator zero.
  Inc(Sz,Length(Values) - 1);
  if Sz > 255 then
    raise Exception.Create('There can be max 255 characthers in a list');
  SetValidationType(vtList);
  // Can propably be any value;
  SetValidationOperator(vopBetween);
  ClearExpr1;
  // ptgStr + Len + Unicode + Size
  FFormula1.Size := 1 + 1 + 1 + Sz * 2;
  GetMem(FFormula1.PTGS,FFormula1.Size);
  FFormula1.PTGS[0] := ptgStr;
  FFormula1.PTGS[1] := Sz;
  FFormula1.PTGS[2] := 1;
  pW := PWordArray(@FFormula1.PTGS[3]);
  for i := 0 to High(Values) do begin
    System.Move(Pointer(Values[i])^,pW^,Length(Values[i]) * 2);
    pW[Length(Values[i])] := 0;
    pW := PWordArray(Integer(pW) + Length(Values[i]) * 2 + 2);
  end;
end;

procedure TDataValidation.SetRawExpression1(Value: PByteArray; Len: integer);
begin
  ClearExpr1;
  FFormula1.Size := Len;
  GetMem(FFormula1.PTGS,FFormula1.Size);
  System.Move(Value^,FFormula1.PTGS^,FFormula1.Size);
end;

procedure TDataValidation.SetRawExpression2(Value: PByteArray; Len: integer);
begin
  ClearExpr2;
  FFormula2.Size := Len;
  GetMem(FFormula2.PTGS,FFormula2.Size);
  System.Move(Value^,FFormula2.PTGS^,FFormula2.Size);
end;

procedure TDataValidation.SetValidationOperator(const Value: TValidationOperator);
begin
  FValidationOperator := Value;
  FAssigned := True;
end;

procedure TDataValidation.SetValidationOptions(const Value: TValidationOptions);
begin
  FValidationOptions := Value;
  FAssigned := True;
end;

procedure TDataValidation.SetValidationStyle(const Value: TValidationStyle);
begin
  FValidationStyle := Value;
  FAssigned := True;
end;

procedure TDataValidation.SetValidationType(const Value: TValidationType);
begin
  FValidationType := Value;
  if Value = vtList then
    FOptions := FOptions or $00000080
  else
    FOptions := FOptions and not $00000080;
  FAssigned := True;
end;

{ TDataValidations }

function TDataValidations.Add: TDataValidation;
begin
  Result := TDataValidation(inherited Add);
end;

constructor TDataValidations.Create(AOwner: TPersistent; FormulaHandler: TFormulaHandler);
begin
  inherited Create(TDataValidation);
  FOwner := AOwner;
  FFormulaHandler := FormulaHandler;
  FRecDVAL.DropDownId := $FFFFFFFF;
end;

function TDataValidations.GetDataValidation(Index: integer): TDataValidation;
begin
  Result := TDataValidation(inherited Items[Index]);
end;

function TDataValidations.GetOwner: TPersistent;
begin
  Result := FOwner;
end;

procedure TDataValidations.LoadFromStream(Stream: TXLSStream; PBuf: PByteArray);
var
  i: integer;
begin
  Move(PBuf^,FRecDVAL,SizeOf(TRecDVAL));
  for i := 0 to Integer(FRecDVAL.DVCount - 1) do
    Add.LoadFromStream(Stream,PBuf);
end;

procedure TDataValidations.SaveToStream(Stream: TXLSStream; PBuf: PByteArray);
var
  i: integer;
begin
  if Count > 0 then begin
    Stream.WriteHeader(BIFFRECID_DVAL,SizeOf(TRecDVAL));
    FRecDVAL.DVCount := Count;
    Stream.Write(FRecDVAL,SizeOf(TRecDVAL));
    for i := 0 to Count - 1 do
      Items[i].SaveToStream(Stream,PBuf);
  end;
end;

end.