Delphi:实现DBGrid的多表头
来源:优易学  2011-10-20 9:58:21   【优易学:中国教育考试门户网】   资料下载   IT书店

 

  function TADBGrid.ExtractSubTitle(LayerTitles: TStrings;
  ACol: Integer): Integer;
  var L, P: Integer;
  SubTitle: string;
  begin
  Result := 0;
  if Assigned(Columns[ACol]) then
  SubTitle := Columns[ACol].Title.Caption
  else Exit;
  if LayerTitles <> nil then LayerTitles.Clear;
  L := 0;
  repeat
  P := Pos(\'|\', SubTitle);
  if P = 0 then
  begin
  if LayerTitles <> nil then LayerTitles.Add(SubTitle);
  end
  else begin
  if LayerTitles <> nil then LayerTitles.Add(Copy(SubTitle, 1, P - 1));
  SubTitle := Copy(SubTitle, P + 1, Length(SubTitle) - P);
  end;
  L := L + 1;
  until P = 0;
  Result := L;
  end;
  procedure TADBGrid.Paint;
  var
  i, MaxLayer, Layer: Integer;
  TM: TTextMetric;
  begin
  if ([csLoading, csDestroying] * ComponentState) <> [] then Exit;
  MaxLayer := 0;
  //获取表头最大层数
  for i := 0 to Columns.Count - 1 do
  begin
  Layer := ExtractSubTitle(nil, i);
  if Layer > MaxLayer then MaxLayer := Layer;
  end;
  SaveFont.Assign(Canvas.Font);
  Canvas.Font.Assign(TitleFont);
  try
  GetTextMetrics(Canvas.Handle, TM);
  //调整DBGrid的标题行高度
  RowHeights[0] := (TM.tmHeight + TM.tmInternalLeading + 3) * MaxLayer;
  finally
  Canvas.Font.Assign(SaveFont);
  end;
  inherited;
  end;
  function TADBGrid.TitleLayerRect(LayerTitles: TStrings; TitleRect: TRect;
  LayerID, ACol: Integer): TRect;

  var
  SubTitle: string;
  i, j: Integer;
  bBrer: Boolean;
  begin
  Result := TitleRect;
  if Assigned(Columns[ACol]) then
  SubTitle := Columns[ACol].Title.Caption
  else Exit;
  ExtractSubTitle(LayerTitles, ACol);
  //联合左边的兄弟列
  for i := ACol - 1 downto 0 do
  begin
  ExtractSubTitle(BrerLayerTitles, i);
  bBrer := False;
  //判断是否为兄弟列
  if (BrerLayerTitles.Count = LayerTitles.Count) then
  begin
  for j := 0 to LayerID do
  begin
  bBrer := BrerLayerTitles[j] = LayerTitles[j];
  if not bBrer then
  Break;
  end;
  end;
  if bBrer then
  begin
  Result.Left := Result.Left - Columns[i].Width;
  if dgColLines in Options then
  Result.Left := Result.Left - 1;
  end
  else Break;
  end;
  //联合右边的兄弟列
  for i := ACol + 1 to Columns.Count - 1 do
  begin
  ExtractSubTitle(BrerLayerTitles, i);
  bBrer := False;
  //判断是否为兄弟列
  if BrerLayerTitles.Count = LayerTitles.Count then
  begin
  for j := 0 to LayerID do
  begin
  bBrer := BrerLayerTitles[j] = LayerTitles[j];
  if not bBrer then
  Break;
  end;
  end;
  if bBrer then
  begin
  Result.Right := Result.Right + Columns[i].Width;
  if dgColLines in Options then
  Result.Right := Result.Right + 1;
  end
  else Break;
  end;
  //调整表头区域
  Result.Top := (RowHeights[0] div LayerTitles.Count) * LayerID;
  Result.Bottom := (RowHeights[0] div LayerTitles.Count) * (LayerID + 1);
  end;
  end.

上一页  [1] [2] 

责任编辑:小草

文章搜索:
 相关文章
热点资讯
资讯快报
热门课程培训