?? tntdbgrids.pas
字號:
Field.OnSetText := GridUpdateFieldText;
inherited; // clear modified !
finally
// redirect "set text" to field
if Field <> nil then
Field.OnSetText := OriginalSetText;
// forget original "set text"
OriginalSetText := nil;
end;
end;
{ TTntDBGridColumns }
function TTntDBGridColumns.Add: TTntColumn;
begin
Result := inherited Add as TTntColumn;
end;
function TTntDBGridColumns.GetColumn(Index: Integer): TTntColumn;
begin
Result := inherited Items[Index] as TTntColumn;
end;
procedure TTntDBGridColumns.SetColumn(Index: Integer; const Value: TTntColumn);
begin
inherited Items[Index] := Value;
end;
{ TTntCustomDBGrid }
procedure TTntCustomDBGrid.CreateWindowHandle(const Params: TCreateParams);
begin
CreateUnicodeHandle(Self, Params, '');
end;
type TAccessCustomGrid = class(TCustomGrid);
procedure TTntCustomDBGrid.WMChar(var Msg: TWMChar);
begin
if (goEditing in TAccessCustomGrid(Self).Options)
and (AnsiChar(Msg.CharCode) in [^H, #32..#255]) then begin
RestoreWMCharMsg(TMessage(Msg));
ShowEditorChar(WideChar(Msg.CharCode));
end else
inherited;
end;
procedure TTntCustomDBGrid.ShowEditorChar(Ch: WideChar);
begin
ShowEditor;
if InplaceEditor <> nil then begin
if Win32PlatformIsUnicode then
PostMessageW(InplaceEditor.Handle, WM_CHAR, Word(Ch), 0)
else
PostMessageA(InplaceEditor.Handle, WM_CHAR, Word(Ch), 0);
end;
end;
procedure TTntCustomDBGrid.DefineProperties(Filer: TFiler);
begin
inherited;
TntPersistent_AfterInherited_DefineProperties(Filer, Self);
end;
function TTntCustomDBGrid.IsHintStored: Boolean;
begin
Result := TntControl_IsHintStored(Self);
end;
function TTntCustomDBGrid.GetHint: WideString;
begin
Result := TntControl_GetHint(Self)
end;
procedure TTntCustomDBGrid.SetHint(const Value: WideString);
begin
TntControl_SetHint(Self, Value);
end;
function TTntCustomDBGrid.CreateColumns: TDBGridColumns{TNT-ALLOW TDBGridColumns};
begin
Result := TTntDBGridColumns.Create(Self, TTntColumn);
end;
function TTntCustomDBGrid.GetColumns: TTntDBGridColumns;
begin
Result := inherited Columns as TTntDBGridColumns;
end;
procedure TTntCustomDBGrid.SetColumns(const Value: TTntDBGridColumns);
begin
inherited Columns := Value;
end;
function TTntCustomDBGrid.CreateEditor: TInplaceEdit{TNT-ALLOW TInplaceEdit};
begin
Result := TTntDBGridInplaceEdit.Create(Self);
end;
function TTntCustomDBGrid.CreateDataLink: TGridDataLink;
begin
Result := TTntGridDataLink.Create(Self);
end;
function TTntCustomDBGrid.GetEditText(ACol, ARow: Integer): WideString;
var
Field: TField;
begin
Field := GetColField(RawToDataColumn(ACol));
if Field = nil then
Result := ''
else
Result := GetWideText(Field);
FEditText := Result;
end;
procedure TTntCustomDBGrid.SetEditText(ACol, ARow: Integer; const Value: AnsiString);
begin
if (InplaceEditor as TTntDBGridInplaceEdit).FInDblClick then
FEditText := Value
else
FEditText := (InplaceEditor as TTntDBGridInplaceEdit).Text;
inherited;
end;
//----------------- DRAW CELL PROCS --------------------------------------------------
var
DrawBitmap: TBitmap = nil;
procedure WriteText(ACanvas: TCanvas; ARect: TRect; DX, DY: Integer;
const Text: WideString; Alignment: TAlignment; ARightToLeft: Boolean);
const
AlignFlags : array [TAlignment] of Integer =
( DT_LEFT or DT_WORDBREAK or DT_EXPANDTABS or DT_NOPREFIX,
DT_RIGHT or DT_WORDBREAK or DT_EXPANDTABS or DT_NOPREFIX,
DT_CENTER or DT_WORDBREAK or DT_EXPANDTABS or DT_NOPREFIX );
RTL: array [Boolean] of Integer = (0, DT_RTLREADING);
var
B, R: TRect;
Hold, Left: Integer;
I: TColorRef;
begin
I := ColorToRGB(ACanvas.Brush.Color);
if GetNearestColor(ACanvas.Handle, I) = I then
begin { Use ExtTextOutW for solid colors }
{ In BiDi, because we changed the window origin, the text that does not
change alignment, actually gets its alignment changed. }
if (ACanvas.CanvasOrientation = coRightToLeft) and (not ARightToLeft) then
ChangeBiDiModeAlignment(Alignment);
case Alignment of
taLeftJustify:
Left := ARect.Left + DX;
taRightJustify:
Left := ARect.Right - WideCanvasTextWidth(ACanvas, Text) - 3;
else { taCenter }
Left := ARect.Left + (ARect.Right - ARect.Left) div 2
- (WideCanvasTextWidth(ACanvas, Text) div 2);
end;
WideCanvasTextRect(ACanvas, ARect, Left, ARect.Top + DY, Text);
end
else begin { Use FillRect and Drawtext for dithered colors }
DrawBitmap.Canvas.Lock;
try
with DrawBitmap, ARect do { Use offscreen bitmap to eliminate flicker and }
begin { brush origin tics in painting / scrolling. }
Width := Max(Width, Right - Left);
Height := Max(Height, Bottom - Top);
R := Rect(DX, DY, Right - Left - 1, Bottom - Top - 1);
B := Rect(0, 0, Right - Left, Bottom - Top);
end;
with DrawBitmap.Canvas do
begin
Font := ACanvas.Font;
Font.Color := ACanvas.Font.Color;
Brush := ACanvas.Brush;
Brush.Style := bsSolid;
FillRect(B);
SetBkMode(Handle, TRANSPARENT);
if (ACanvas.CanvasOrientation = coRightToLeft) then
ChangeBiDiModeAlignment(Alignment);
Tnt_DrawTextW(Handle, PWideChar(Text), Length(Text), R,
AlignFlags[Alignment] or RTL[ARightToLeft]);
end;
if (ACanvas.CanvasOrientation = coRightToLeft) then
begin
Hold := ARect.Left;
ARect.Left := ARect.Right;
ARect.Right := Hold;
end;
ACanvas.CopyRect(ARect, DrawBitmap.Canvas, B);
finally
DrawBitmap.Canvas.Unlock;
end;
end;
end;
procedure TTntCustomDBGrid.DefaultDrawDataCell(const Rect: TRect; Field: TField;
State: TGridDrawState);
var
Alignment: TAlignment;
Value: WideString;
begin
Alignment := taLeftJustify;
Value := '';
if Assigned(Field) then
begin
Alignment := Field.Alignment;
Value := GetWideDisplayText(Field);
end;
WriteText(Canvas, Rect, 2, 2, Value, Alignment,
UseRightToLeftAlignmentForField(Field, Alignment));
end;
procedure TTntCustomDBGrid.DefaultDrawColumnCell(const Rect: TRect;
DataCol: Integer; Column: TTntColumn; State: TGridDrawState);
var
Value: WideString;
begin
Value := '';
if Assigned(Column.Field) then
Value := GetWideDisplayText(Column.Field);
WriteText(Canvas, Rect, 2, 2, Value, Column.Alignment,
UseRightToLeftAlignmentForField(Column.Field, Column.Alignment));
end;
procedure TTntCustomDBGrid.DrawCell(ACol, ARow: Longint; ARect: TRect; AState: TGridDrawState);
var
FrameOffs: Byte;
procedure DrawTitleCell(ACol, ARow: Integer; Column: TTntColumn; var AState: TGridDrawState);
const
ScrollArrows: array [Boolean, Boolean] of Integer =
((DFCS_SCROLLRIGHT, DFCS_SCROLLLEFT), (DFCS_SCROLLLEFT, DFCS_SCROLLRIGHT));
var
MasterCol: TColumn{TNT-ALLOW TColumn};
TitleRect, TxtRect, ButtonRect: TRect;
I: Integer;
InBiDiMode: Boolean;
begin
TitleRect := CalcTitleRect(Column, ARow, MasterCol);
if MasterCol = nil then
begin
Canvas.FillRect(ARect);
Exit;
end;
Canvas.Font := MasterCol.Title.Font;
Canvas.Brush.Color := MasterCol.Title.Color;
if [dgRowLines, dgColLines] * Options = [dgRowLines, dgColLines] then
InflateRect(TitleRect, -1, -1);
TxtRect := TitleRect;
I := GetSystemMetrics(SM_CXHSCROLL);
if ((TxtRect.Right - TxtRect.Left) > I) and MasterCol.Expandable then
begin
Dec(TxtRect.Right, I);
ButtonRect := TitleRect;
ButtonRect.Left := TxtRect.Right;
I := SaveDC(Canvas.Handle);
try
Canvas.FillRect(ButtonRect);
InflateRect(ButtonRect, -1, -1);
IntersectClipRect(Canvas.Handle, ButtonRect.Left,
ButtonRect.Top, ButtonRect.Right, ButtonRect.Bottom);
InflateRect(ButtonRect, 1, 1);
{ DrawFrameControl doesn't draw properly when orienatation has changed.
It draws as ExtTextOutW does. }
InBiDiMode := Canvas.CanvasOrientation = coRightToLeft;
if InBiDiMode then { stretch the arrows box }
Inc(ButtonRect.Right, GetSystemMetrics(SM_CXHSCROLL) + 4);
DrawFrameControl(Canvas.Handle, ButtonRect, DFC_SCROLL,
ScrollArrows[InBiDiMode, MasterCol.Expanded] or DFCS_FLAT);
finally
RestoreDC(Canvas.Handle, I);
end;
end;
with (MasterCol.Title as TTntColumnTitle) do
WriteText(Canvas, TxtRect, FrameOffs, FrameOffs, Caption, Alignment, IsRightToLeft);
if [dgRowLines, dgColLines] * Options = [dgRowLines, dgColLines] then
begin
InflateRect(TitleRect, 1, 1);
DrawEdge(Canvas.Handle, TitleRect, BDR_RAISEDINNER, BF_BOTTOMRIGHT);
DrawEdge(Canvas.Handle, TitleRect, BDR_RAISEDINNER, BF_TOPLEFT);
end;
AState := AState - [gdFixed]; // prevent box drawing later
end;
var
OldActive: Integer;
Highlight: Boolean;
Value: WideString;
DrawColumn: TTntColumn;
begin
if csLoading in ComponentState then
begin
Canvas.Brush.Color := Color;
Canvas.FillRect(ARect);
Exit;
end;
if (gdFixed in AState) and (RawToDataColumn(ACol) < 0) then
begin
inherited;
exit;
end;
Dec(ARow, FixedRows);
ACol := RawToDataColumn(ACol);
if (gdFixed in AState) and ([dgRowLines, dgColLines] * Options =
[dgRowLines, dgColLines]) then
begin
InflateRect(ARect, -1, -1);
FrameOffs := 1;
end
else
FrameOffs := 2;
with Canvas do
begin
DrawColumn := Columns[ACol] as TTntColumn;
if not DrawColumn.Showing then Exit;
if not (gdFixed in AState) then
begin
Font := DrawColumn.Font;
Brush.Color := DrawColumn.Color;
end;
if ARow < 0 then
DrawTitleCell(ACol, ARow + FixedRows, DrawColumn, AState)
else if (DataLink = nil) or not DataLink.Active then
FillRect(ARect)
else
begin
Value := '';
OldActive := DataLink.ActiveRecord;
try
DataLink.ActiveRecord := ARow;
if Assigned(DrawColumn.Field) then
Value := GetWideDisplayText(DrawColumn.Field);
Highlight := HighlightCell(ACol, ARow, Value, AState);
if Highlight then
begin
Brush.Color := clHighlight;
Font.Color := clHighlightText;
end;
if not Enabled then
Font.Color := clGrayText;
if DefaultDrawing then
DefaultDrawColumnCell(ARect, ACol, DrawColumn, AState);
if Columns.State = csDefault then
DrawDataCell(ARect, DrawColumn.Field, AState);
DrawColumnCell(ARect, ACol, DrawColumn, AState);
finally
DataLink.ActiveRecord := OldActive;
end;
if DefaultDrawing and (gdSelected in AState)
and ((dgAlwaysShowSelection in Options) or Focused)
and not (csDesigning in ComponentState)
and not (dgRowSelect in Options)
and (UpdateLock = 0)
and (ValidParentForm(Self).ActiveControl = Self) then
Windows.DrawFocusRect(Handle, ARect);
end;
end;
if (gdFixed in AState) and ([dgRowLines, dgColLines] * Options =
[dgRowLines, dgColLines]) then
begin
InflateRect(ARect, 1, 1);
DrawEdge(Canvas.Handle, ARect, BDR_RAISEDINNER, BF_BOTTOMRIGHT);
DrawEdge(Canvas.Handle, ARect, BDR_RAISEDINNER, BF_TOPLEFT);
end;
end;
procedure TTntCustomDBGrid.ActionChange(Sender: TObject; CheckDefaults: Boolean);
begin
TntControl_BeforeInherited_ActionChange(Self, Sender, CheckDefaults);
inherited;
end;
function TTntCustomDBGrid.GetActionLinkClass: TControlActionLinkClass;
begin
Result := TntControl_GetActionLinkClass(Self, inherited GetActionLinkClass);
end;
initialization
DrawBitmap := TBitmap.Create;
finalization
DrawBitmap.Free;
end.
?? 快捷鍵說明
復制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -