Графика в TStringGrid

← →
KLEVO (2005-03-10 18:21) [0]

Как мне заместо значения выводить графику в TStringGrid ?

← →
XP (2005-03-10 18:31) [1]

TDrawGrid или/и OnDrawCell

← →
KLEVO (2005-03-12 09:32) [2]

Ну нужно именно StringGrid , и есть примеры использования OnDrawCell ?

← →
begin...end © (2005-03-12 09:45) [3]

> KLEVO (12.03.05 09:32) [2]

Да, в Сети есть очень много примеров.

← →
Viktop (2005-03-12 11:55) [4]

unit Unit1;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, Grids, ExtCtrls, StdCtrls, ImgList, Menus, ActnList;

type
TMyGrid = class(TStringGrid)
end;

TForm1 = class(TForm)
Image1: TImage;
Image2: TImage;
StringGrid1: TStringGrid;
procedure StringGrid1DrawCell(Sender: TObject; ACol, ARow: Integer; Rect: TRect; State: TGridDrawState);
procedure StringGrid1DragOver(Sender, Source: TObject; X, Y: Integer; State: TDragState; var Accept: Boolean);
procedure StringGrid1DragDrop(Sender, Source: TObject; X, Y: Integer);
procedure Timer1Timer(Sender: TObject);
procedure Button1Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure GridImageCopyExecute(Sender: TObject);
procedure GridImageCutExecute(Sender: TObject);
procedure GridImageInfoExecute(Sender: TObject);
procedure StringGrid1MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
procedure GridActionsUpdate(Sender: TObject);
procedure GridImagePasteUpdate(Sender: TObject);
procedure GridImagePasteExecute(Sender: TObject);
procedure StringGrid1MouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
private
fObjPointer: TObject;
fHintCell: TPoint;
public
{ Public declarations }
end;

var
Form1: TForm1;

implementation

uses Unit2;

{$R *.dfm}

procedure TForm1.StringGrid1DrawCell(Sender: TObject; ACol, ARow: Integer; Rect: TRect; State: TGridDrawState);
var
S: string;
DC: HDC;
oldFont: HFont;
begin // >>>>>>>>>>
with TStringGrid(Sender) do
begin
DC := GetDC(Handle);
oldFont := SelectObject(DC, Canvas.Font.Handle);

if (gdFixed in State) then
begin // Text
if (ACol = 0) and (ARow > 0) then // TopCells
Str(ARow, S)
else if (ARow = 0) and (ACol > 0) then // LeftCells
Str(ACol, S)
else
S := "";
// Draw Border
Inc(Rect.Right, 1);
Inc(Rect.Bottom, 1);
SetBkColor(DC, GetSysColor(Color_BtnFace));
Canvas.Brush.Color := GetSysColor(Color_BtnFace);
FillRect(DC, Rect, Canvas.Brush.Handle);
DrawText(DC, PChar(s), Length(s), Rect, DT_SingleLine or DT_Center or DT_VCenter);
DrawEdge(DC, Rect, BDR_RaisedInner, BF_Rect);
end

else

begin
if (Objects[ACol, ARow] = nil) then
begin
s := "Пусто...";
end
else
begin
if TImage(Objects[ACol, ARow]).Picture.Graphic.Empty then
s := "Рисунок пустой ...";
end;
if Length(s) > 0 then
begin
if (gdSelected in State) then
begin
SetBkColor(DC, GetSysColor(Color_HighLight));
Canvas.Brush.Color := GetSysColor(Color_HighLight);
end
else
begin
SetBkColor(DC, GetSysColor(Color_Window));
Canvas.Brush.Color := GetSysColor(Color_Window);
end;
SetTextColor(DC, $009A9A9A);
FillRect(DC, Rect, Canvas.Brush.Handle);
DrawText(DC, PChar(s), Length(s), Rect, DT_SingleLine or DT_Center or DT_VCenter);
end
else
begin
Canvas.StretchDraw(Rect, TImage(Objects[ACol, ARow]).Picture.Graphic);
end;
if (gdSelected in State) then
DrawFocusRect(DC, Rect);
end;
SelectObject(DC, oldFont);
ReleaseDC(Handle, DC);
end;
end;

procedure TForm1.StringGrid1DragOver(Sender, Source: TObject; X, Y: Integer; State: TDragState; var Accept: Boolean);
var
cX: Integer;
cY: Integer;
begin
inherited;
with TStringGrid(Sender) do
begin
MouseToCell(X, Y, cX, cY);
Accept := (Source is TImage) and (cX >= FixedCols) and (cY >= FixedRows);
end;
end;

procedure TForm1.StringGrid1DragDrop(Sender, Source: TObject; X, Y: Integer);
var
cX: Integer;
cY: Integer;
begin
inherited;
with TStringGrid(Sender) do
begin
MouseToCell(X, Y, cX, cY);
Objects[cX, cY] := Source;
TMyGrid(Sender).FocusCell(cX, cY, False);
SetFocus;
end;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
fObjPointer := nil;
FillChar(fHintCell, SizeOf(TPoint), 0);
end;

procedure TForm1.StringGrid1MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
var
sbPoint: TPoint;
begin
with TMyGrid(Sender) do
begin
MouseToCell(X, Y, sbPoint.X, sbPoint.Y);
if (ssRight in Shift) and (sbPoint.X >= FixedCols)
and (sbPoint.Y >= FixedRows) then
begin
FocusCell(sbPoint.X, sbPoint.Y, False);
end;
end;
end;

end.

Графика в TStringGrid Найти похожие ветки