자유롭게 질의 및 응답을 할 수 있는 게시판입니다. 개발자 여러분의 답변이 큰 도움이 됩니다. 
  • 제품설치/등록 오류 문의: 설치/등록 Q&A 이용 (제품 구매 고객 한정)

FM에서 DB올리고 Live Binding으로 String Grid에 뿌렸을데

Grid의 타이틀을 멀티(2줄3줄)로 사용할려고 하는데 어떻게 해야 하는지 난감하네요.

Headerd에 접근이 않되는 것인지? 알려 주세요

 

아래 소스는 VCL의 DBGrid의 Title을 2줄또는 그 이상으로 멀티로 하는 소스인데

이것을 FM에 적용해 보니 에러 떨어지는데 소스라도 좀 FM에 맞게 수정 좀 부탁 합니다.

 

 

 

unit MLDBGrid;


interface

uses Windows, Classes, SysUtils, Controls, Graphics, DBGrids, Db, Grids;

type
  TMultiLineGrid = class(TDBGrid)
    private
      FTitleHeight: Integer;
    protected
      procedure LayoutChanged; override;
      procedure DrawCell(ACol, ARow: Longint; ARect: TRect; AState: TGridDrawState); override;
      procedure SetTitleHeight(Value: Integer);
    public
      constructor Create(AOwner: TComponent); override;
      property Row;
      property Col;
    published
      property TitleHeight: Integer read FTitleHeight write SetTitleHeight;
      property OnMouseMove;
  end;

procedure Register;

implementation

constructor TMultiLineGrid.Create(AOwner: TComponent);
begin
  inherited;
  FTitleHeight:=17;
end;

procedure TMultiLineGrid.SetTitleHeight(Value: Integer);
begin
  if FTitleHeight<>Value then
  begin
    FTitleHeight:=Value;
    LayoutChanged;
  end;
end;

procedure TMultiLineGrid.LayoutChanged;
begin
  inherited;
  if dgTitles in Options then RowHeights[0]:=FTitleHeight;
end;

function BreakStr(ACanvas: TCanvas; StrWidth: Integer; Str: String): TStringList;
const Dividers=' ,.<>:;-*/+"''$#()=';
var i: Integer;
    tmp: String;
    Words: TStringList;
begin
  Words:=TStringList.Create;
  Result:=TStringList.Create;
  tmp:='';
  for i:=1 to Length(Str) do
  begin
    tmp:=tmp+Str[i];
    if Pos(Str[i],Dividers)>0 then begin Words.Add(tmp); tmp:='' end;
  end;
  Words.Add(tmp);
  tmp:='';
  Result.Add(Words[0]);
  for i:=1 to Words.Count-1 do
  begin
    if (ACanvas.TextWidth(Result[Result.Count-1]+Words[i])>StrWidth) then
    begin
      Result[Result.Count-1]:=Trim(Result[Result.Count-1]); //trim the blanks at the line's edges
      Result.Add(Words[i]);
    end
    else
      Result[Result.Count-1]:=Result[Result.Count-1]+Words[i];
  end;
  Words.Free;
end;

procedure TMultiLineGrid.DrawCell(ACol, ARow: Longint; ARect: TRect; AState: TGridDrawState);
var
    MasterCol,Column: TColumn;
    TitleRect: TRect;
    LeftPoint,i, LineHeight: Integer;
    Strs: TStringList;
begin
  if (dgTitles in Options) and (ARow=0) and ((ACol>0) or (not (dgIndicator in Options))) then
  begin
    if dgIndicator in Options then Column:=Columns[ACol-1] else Column:=Columns[ACol];
    TitleRect:=CalcTitleRect(Column, ARow, MasterCol);
    if MasterCol = nil then
    begin
      Canvas.Brush.Color := FixedColor;
      Canvas.FillRect(ARect);
      Exit;
    end;
    Canvas.Font := MasterCol.Title.Font;
    Canvas.Brush.Color := MasterCol.Title.Color;
    Canvas.FillRect(TitleRect);
    Strs:=BreakStr(Canvas,ARect.Right-ARect.Left-4,MasterCol.Title.Caption);
    LineHeight:=Canvas.TextHeight('Wg');
//    Strs:=BreakStr(Canvas,ARect.Right-ARect.Left-4,'asdfgad adsfgdffff gfdfg dfgdfgdg');
    for i:=0 to Strs.Count-1 do
    begin
      case Column.Title.Alignment of
        taLeftJustify:
          LeftPoint:=ARect.Left+2;
        taRightJustify:
          LeftPoint:=ARect.Right-Canvas.TextWidth(Strs[i])-3;
        taCenter:
          LeftPoint:=ARect.Left+(ARect.Right-ARect.Left) shr 1 - (Canvas.TextWidth(Strs[i]) shr 1);
      else
        LeftPoint:=0;
      end;
      Canvas.TextRect(ARect,LeftPoint,ARect.Top+2,Strs[i]);
      ARect.Top:=ARect.Top+LineHeight+2;
    end;
    Strs.Free;
    if [dgRowLines, dgColLines]*Options=[dgRowLines, dgColLines] then
    begin
      DrawEdge(Canvas.Handle, TitleRect, BDR_RAISEDINNER, BF_BOTTOMRIGHT);
      DrawEdge(Canvas.Handle, TitleRect, BDR_RAISEDINNER, BF_TOPLEFT);
    end;
  end
  else inherited;
end;

procedure Register;
begin
  RegisterComponents('Data Controls', [TMultilineGrid]);
end;

end.
번호 제목 글쓴이 날짜 조회 수
공지 [프로그래밍 강의] 2021.6~2021.12 관리자 2015.01.22 15634
공지 유용한 관련 사이트 관리자2 2014.03.20 54464
공지 본 게시판은 개발자 여러분들의 질문과 답변을 공유하는 공간입니다. 관리자 2012.01.10 97828
1158 XE2에서 SFTP를 사용하려고합니다. 링쿠 2016.01.14 392
1157 (Delphi 10) UPX 압축 문제 [1] 김재욱 2016.01.14 381
1156 구글 새 OS 안드로이드 N, 5월 공개대해.. 가을이다 2016.01.13 248
1155 XE2 -> XE10 으로 컴파일만 다시했는데...오류가 납니다. 파란하늘 2016.01.13 96
1154 드래그시 커서,키보드 노출 및 오브젝트 동작에대해서 문의합니다 file 봉봉봉 2016.01.12 157
1153 not enough space 어떻게해결하나요 [2] 봉봉봉 2015.12.30 689
1152 [문의]Datasnap 와 midas 장단점 초보타출 2016.01.12 282
1151 windows 7 , delphi xe5 에서의 LoadLibrary 가 실행되지 않습니다. [1] 쭈니쿤 2016.01.12 728
1150 Installer for OpenWire (368 MB): OpenWire 7.7.0.0 VCL and FireMonkey 32 & 64 bit support for XE7 to 10 Seattle 을 다운로드해서 설치하였으나 컴포넨트가 보이지 않아요 예를 들어 TOOL 파렛트에 OPENWIRESTUDIO 컴포넌트가 보이던데 (유투브동영상 참조) 전화좀 기다립니다 [1] 손오공 2016.01.12 149
1149 XE10 에서 TOOL 파렛트에 openwire studio 컴포넌트를 사용할려면 어찌해야 하죠 [1] 손오공 2016.01.12 109
1148 IBLite 연결 질문~ [2] file 아놀드 2016.01.11 348
1147 DataSnap Server에 메모리 릭이 발생합니다. [5] 델사냥 2016.01.04 414
1146 바코드로부터 입력과 키보드 입력을 어떻게 구분하나요? [1] from5 2016.01.09 1369
1145 TCppWebBrowser 컴포넌트를 폼에 올리면 Access violation 오류가 발생합니다. file 험프리 2016.01.11 283
1144 FDConnection1.Params.Values['Database'] := TPath.Combine(TPath.SharedGetDocumentsPath, 'AAA.db') 가 안됩니다. 어려워 2016.01.09 223
1143 IBLite 연결이 잘 안되네요~ [6] file 아놀드 2016.01.07 272
1142 delphi 10에서 사물인터넷관련 개발 [1] 영감땡감 2016.01.07 279
1141 ## Windows10 최근 업데이트후 TWebbrowser 심각한 문제.. [2] 가을이다 2015.12.31 681
1140 listbox의 multiselect 속성 접근 [2] 라드 2015.12.28 393