자유롭게 질의 및 응답을 할 수 있는 게시판입니다. 개발자 여러분의 답변이 큰 도움이 됩니다.
- 제품설치/등록 오류 문의: 설치/등록 Q&A 이용 (제품 구매 고객 한정)
Firemonkey FM의 Grid의 타이틀을 멀티로 사용할려면?
2013.03.06 22:30
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.
댓글 0
Firemonkey FM의 Grid의 타이틀을 멀티로 사용할려면?
2013.03.06 22:30
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;
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;
begin
inherited;
FTitleHeight:=17;
end;
procedure TMultiLineGrid.SetTitleHeight(Value: Integer);
begin
if FTitleHeight<>Value then
begin
FTitleHeight:=Value;
LayoutChanged;
end;
end;
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;
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;
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;
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;
begin
RegisterComponents('Data Controls', [TMultilineGrid]);
end;
end.
