unit Unit1;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
Dialogs, Grids, StdCtrls,
Clipbrd; //추가
type
TForm1 = class(TForm)
StringGrid1: TStringGrid;
procedure StringGrid1KeyUp(Sender: TObject; var Key: Word;
Shift: TShiftState);
private
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
type TPGrid = class(TStringGrid);
procedure TForm1.StringGrid1KeyUp(Sender: TObject; var Key: Word;
Shift: TShiftState);
const cRETURN1 = #$D;
cRETURN2 = #$A;
cTAB = #9;
var
Value: string;
Str: string;
i, iCol, iRow: Integer;
begin
Edit1.Text:= IntToStr(Key);
if (Shift = [ssCtrl]) and (Key = 67) then //Copy
begin
Str:= '';
with StringGrid1 do
for i:= 1 to ColCount - 1 do
Str:= Str + Cells[i,Row] + cTAB;
Str:= Copy(Str,1,Length(Str)-1);
Clipboard.Open;
Clipboard.AsText:= Str;
Clipboard.Close;
end else
if (Shift = [ssCtrl]) and (Key = 86) then //Paste
begin
Clipboard.Open;
if not Clipboard.HasFormat(CF_Text) then Exit;
Value := Clipboard.AsText;
Clipboard.Close;
with TPGrid(StringGrid1) do
begin
iCol:= Col;
iRow:= Row;
Cells[iCol, iRow]:= '';
for i:= 1 to Length(Value) do begin
if Copy(Value,i,1) = cRETURN1 then Continue;
if Copy(Value,i,1) = cRETURN2 then begin
iCol:= Col;
Inc(iRow);
if i < Length(Value) then Cells[iCol, iRow]:= '';
Continue;
end;
if Copy(Value,i,1) = cTAB then begin
Inc(iCol);
if i < Length(Value) then Cells[iCol, iRow]:= '';
Continue;
end;
Cells[iCol,iRow]:= Cells[iCol,iRow] + Copy(Value,i,1);
end;
if RowCount - 1 < iRow then RowCount:= iRow;
if InplaceEditor = nil then Exit;
InplaceEditor.Text:= Cells[Col, Row];
InplaceEditor.SelStart:= Length(Cells[Col, Row]);
Edit1.Text:= InplaceEditor.Text;
end;
end;
end;
end.
| TStringGrid에서 TCheckBox사용하기 |
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
Dialogs, Grids, StdCtrls;
type
TForm1 = class(TForm)
StringGrid1: TStringGrid;
procedure StringGrid1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure StringGrid1MouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure StringGrid1DrawCell(Sender: TObject; ACol, ARow: Integer;
Rect: TRect; State: TGridDrawState);
procedure FormCreate(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
procedure DrawCheck(ACanvas: TCanvas; ARect: TRect; AColor: TColor; EditStyle: word; Flag: string);
var iDR:integer;
begin
if Trim(Flag) = '' then Exit;
with ACanvas do
begin
case EditStyle of
1: begin //esCheckBox
case Flag[1] of
'1': iDR:= DFCS_BUTTONCHECK or DFCS_BUTTON3STATE;
'2': iDR:= DFCS_BUTTONCHECK or DFCS_CHECKED;
'3': iDR:= DFCS_BUTTONCHECK or DFCS_BUTTON3STATE or DFCS_INACTIVE;
'4': iDR:= DFCS_BUTTONCHECK or DFCS_BUTTON3STATE or DFCS_INACTIVE or DFCS_CHECKED;
else iDR:= DFCS_BUTTONCHECK or DFCS_BUTTON3STATE;
end;
end;
2: begin //esRadioButton
case Flag[1] of
'1': iDR:= DFCS_BUTTONRADIO;
'2': iDR:= DFCS_BUTTONRADIO or DFCS_CHECKED;
'3': iDR:= DFCS_BUTTONRADIO or DFCS_INACTIVE;
'4': iDR:= DFCS_BUTTONRADIO or DFCS_CHECKED or DFCS_INACTIVE;
else iDR:= DFCS_BUTTONRADIO;
end;
end;
else Exit;
end;
ACanvas.Brush.Color:= AColor;
ACanvas.FillRect(ARect);
InflateRect(ARect,-((ARect.Right - ARect.Left -14) shr 1),-((ARect.Bottom - ARect.Top -14) shr 1)); //DFCS_MONO
DrawFrameControl(Handle, ARect, DFC_BUTTON, iDR);
end;
end;
var ACol,ARow: Integer;
procedure TForm1.StringGrid1MouseDown(Sender: TObject;
Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
if Button = mbLeft Then
StringGrid1.MouseToCell(X, Y, ACol, ARow);
end;
procedure TForm1.StringGrid1MouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
var iCol,iRow: Integer;
begin
if Button = mbLeft Then
with StringGrid1 do
begin
MouseToCell(X, Y, iCol, iRow);
if (ACol = 1) and (ARow > 0) and (ACol = iCol) and (ARow = iRow) then
Cells[ACol, ARow]:= IntToStr(StrToIntDef(Cells[ACol, ARow],0) mod 2 + 1);
end;
end;
procedure TForm1.StringGrid1DrawCell(Sender: TObject; ACol, ARow: Integer;
Rect: TRect; State: TGridDrawState);
begin
if (ACol = 1) and (ARow > 0) then
with StringGrid1 do DrawCheck(Canvas,Rect, Color,1, Cells[ACol, ARow]);
end;
procedure TForm1.FormCreate(Sender: TObject);
var i: integer;
begin
with StringGrid1 do
for i:= 1 to RowCount - 1 do
Cells[1,i]:= '1';
end;
end.
TStringGrid에서 Sort기능
//Sort함수 PGrid = 정렬한 TStringGrid, aCol = 정렬한 Col값
procedure Sort(PGrid: TStringGrid; aCol: LongInt);
procedure QuickSort(PGrid: TPGrid; aCol, iLo, iHi: LongInt);
var Lo, Hi: LongInt;
Mid: string;
begin
with PGrid do
begin
Lo := iLo;
Hi := iHi;
Mid:= Cells[aCol,(Lo + Hi) div 2];
repeat
while Cells[aCol, Lo] < Mid do Inc(Lo);
while Cells[aCol, Hi] > Mid do Dec(Hi);
if Lo <= Hi then
begin
RowMoved(Lo, Hi);
//Lo번째 로우(Row)를 Hi번째 로우로 이동한다.
if Hi <> Lo then
RowMoved(Hi-1, Lo);
Inc(Lo);Dec(Hi);
end;
until Lo > Hi;
if Hi > iLo then
QuickSort(PGrid, aCol, iLo, Hi);
if Lo < iHi then
QuickSort(PGrid, aCol, Lo, iHi);
end;
end;
사용 예) QuickSort(TPGrid(PGrid), aCol, 1, PGrid.RowCount);
TStringGrid에서 포커스색상 지우기
//DrawCell이벤트에서 처리
with (Sender as TStringGrid), (Sender as TStringGrid).Canvas do
begin
if (ACol >= FixedCols) and (ARow >= FixedRows) then begin
Brush.Color:= (Sender as TStringGrid).Color;
FillRect(Rect);
TextOut(Rect.Left, Rect.Top, Cells[ACol, ARow]);
end;
end;
StringGrid에 두줄 사용
--서론 --
델마당에 질문이 있기에 제가 대답하고 발행합니다.
StringGrid를 사용하다보면 타이틀을 두줄로 표시해야하는 경우가 있습니다.
그런 경우는 OnDrawCell이벤트에서 TRect값을 받아서 위치를 변경하여 처리하면 됩니다.
--내용 --
procedure TForm1.StringGrid1DrawCell(Sender: TObject; ACol, ARow: Integer;
Rect: TRect; State: TGridDrawState);
var
ipos: integer;
begin
with TStringGrid(Sender), TStringGrid(Sender).Canvas do
if Pos('@',Cells[ACol,ARow]) > 0 then begin //@는 구분자로 사용됩
ipos:= Pos('@',Cells[ACol,ARow]);
FillRect(Rect);
TextOut(Rect.Left+ 3, Rect.Top+3, copy(Cells[ACol,ARow], 1, ipos - 1));
TextOut(Rect.Left+ 3, Rect.Top+20, copy(Cells[ACol,ARow],ipos + 1, Length(Cells[ACol,ARow])));
end;
end;
StringGrid관련 함수들
type TRowGrid = class(TStringGrid) end;
procedure InsertRow(Sender:TStringGrid);
begin
with TRowGrid(Sender) do
begin
RowMoved(RowCount, Row);
RowCount:= RowCount + 1;
end;
end;
procedure DeleteRow(Sender:TStringGrid);
begin
with TRowGrid(Sender) do
begin
Rows[Row].Clear;
RowMoved(Row, RowCount);
if (FixedRows + 1) < RowCount then
RowCount:= RowCount - 1;
end;
end;
procedure ClearData(Sender:TStringGrid);
var i: integer;
begin
with Sender do
begin
for i:= 1 to RowCount - 1 do
Rows[i].Clear;
RowCount:= 2;
end;
end;
procedure WriteText(ACanvas: TCanvas; ARect: TRect; Text: string; AFont: TFont; AColor: TColor; Align: TCellAlign);
var Left,Top: Integer;
begin
case Align of
AlLeft : Left := ARect.Left + 2;
AlRight: Left := ARect.Right - ACanvas.TextWidth(Text) - 3;
else
Left := ARect.Left + (ARect.Right - ARect.Left) shr 1
- (ACanvas.TextWidth(Text) shr 1);
end;
Top := ARect.Top + (ARect.Bottom - ARect.Top) shr 1
- (ACanvas.TextHeight(Text) shr 1) + 1;
ACanvas.Brush.Color:= AColor;
ACanvas.Font.Assign(AFont);
ExtTextOut(ACanvas.Handle, Left, Top, ETO_OPAQUE or ETO_CLIPPED, @ARect, PChar(Text), Length(Text), nil);
end;
StringGrid 그림을 표시하기
function GraphicRect(Rect: TRect; Graphic: TGraphic): TRect;
var GRect: TRect;
SrcRatio, DstRatio: double;
H, W: Integer;
begin
GRect:= Rect;
GRect.Left:= GRect.Left+1;
GRect.Top:= GRect.Top+1 ;
GRect.Right:= GRect.Right-1;
GRect.Bottom:= GRect.Bottom-1;
result:= GRect;
if (Graphic.Width < Rect.Right - Rect.Left)
and (Graphic.Height < Rect.Bottom - Rect.Top) then
begin
GRect:= Rect;
GRect.Left:= GRect.Left + ((GRect.Right - GRect.Left) shr 1) - Graphic.Width shr 1;
GRect.Right:= GRect.Left + Graphic.Width;
GRect.Top:= GRect.Top + ((GRect.Bottom - GRect.Top) shr 1) - Graphic.Height shr 1;
GRect.Bottom:= GRect.Top + Graphic.Height;
end else begin
with Graphic do SrcRatio := Width / Height;
with GRect do DstRatio := (Right - Left) / (Bottom - Top);
if SrcRatio > DstRatio
then with GRect do begin
h := trunc((Right - Left) / SrcRatio);
with GRect do begin
Top := (Top + Bottom) div 2 - h div 2;
Bottom := Top + h;
end;
end else
if SrcRatio < DstRatio then begin
with GRect do begin
w := trunc((Bottom - Top) * SrcRatio);
with GRect do begin
Left := (Left + Right) div 2 - w div 2;
Right := Left + w;
end;
end;
end;
end;
result:= GRect;
end;
procedure TForm2.HyperGrid1DrawCell(Sender: TObject; ACol, ARow: Integer;
Rect: TRect; State: TGridDrawState);
var Graphic: TGraphic;
B: TBitMap;
begin
with TStringGrid(Sender) do
if (ACol = 2) and (ARow = 1) then
begin
Graphic:= Image1.Picture.Graphic;
Rect:= GraphicRect(Rect,Graphic);
Canvas.StretchDraw( Rect, Graphic );
end else
if (ACol = 1) and (ARow > 0) then
begin
b:= TBitMap.Create;
try
ImageList1.GetBitmap(StrToIntDef(Cells[ACol,ARow],0),B);
Graphic:= B;
Rect:= GraphicRect(Rect,Graphic);
Canvas.StretchDraw( Rect, Graphic );
finally
b.Free;
end;
end;
end;
procedure TForm2.HyperGrid1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
with HyperGrid1 do begin
if Col = 1 then begin
Cells[1,Row]:= IntToStr((StrToIntDef(Cells[1,Row],0) + 1) mod 2);
end;
end;
end;
dbgrid 에서 drag and drop
// DBGrid 에서 는 MouseDown 이벤트를 그냥 상속하면
// 마우스 이벤트가 발생하지 않는다.
// 아래와 같이 MouseDown 이벤트를 발생시키는
// 새로운 DBGrid 컴포넌트를 만들어야 한다.
-----------------
The MyDBGrid unit
-----------------
unit MyDBGrid;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
Dialogs, Grids, DBGrids;
type
TMyDBGrid = class(TDBGrid)
private
{ Private declarations }
FOnMouseDown: TMouseEvent;
protected
{ Protected declarations }
procedure MouseDown(Button: TMouseButton; Shift: TShiftState;
X, Y: Integer); override;
published
{ Published declarations }
property Row;
property OnMouseDown read FOnMouseDown write FOnMouseDown;
end;
procedure Register;
implementation
procedure TMyDBGrid.MouseDown(Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
if Assigned(FOnMouseDown) then
FOnMouseDown(Self, Button, Shift, X, Y);
inherited MouseDown(Button, Shift, X, Y);
end;
procedure Register;
begin
RegisterComponents('Samples', [TMyDBGrid]);
end;
end.
// 다음은 프로그램 예제이다
---------------
The GridU1 unit
---------------
unit GridU1;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
Dialogs, Db, DBTables, Grids, DBGrids, MyDBGrid, StdCtrls;
type
TForm1 = class(TForm)
MyDBGrid1: TMyDBGrid;
Table1: TTable;
DataSource1: TDataSource;
Table2: TTable;
DataSource2: TDataSource;
MyDBGrid2: TMyDBGrid;
procedure MyDBGrid1MouseDown(Sender: TObject;
Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
procedure MyDBGrid1DragOver(Sender, Source: TObject;
X, Y: Integer; State: TDragState; var Accept: Boolean);
procedure MyDBGrid1DragDrop(Sender, Source: TObject;
X, Y: Integer);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.DFM}
var
SGC : TGridCoord;
procedure TForm1.MyDBGrid1MouseDown(Sender: TObject;
Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
var
DG : TMyDBGrid;
begin
DG := Sender as TMyDBGrid;
SGC := DG.MouseCoord(X,Y);
if (SGC.X > 0) and (SGC.Y > 0) then
(Sender as TMyDBGrid).BeginDrag(False);
end;
procedure TForm1.MyDBGrid1DragOver(Sender, Source: TObject;
X, Y: Integer; State: TDragState; var Accept: Boolean);
var
GC : TGridCoord;
begin
GC := (Sender as TMyDBGrid).MouseCoord(X,Y);
Accept := Source is TMyDBGrid and (GC.X > 0) and (GC.Y > 0);
end;
procedure TForm1.MyDBGrid1DragDrop(Sender, Source: TObject;
X, Y: Integer);
var
DG : TMyDBGrid;
GC : TGridCoord;
CurRow : Integer;
begin
DG := Sender as TMyDBGrid;
GC := DG.MouseCoord(X,Y);
with DG.DataSource.DataSet do begin
with (Source as TMyDBGrid).DataSource.DataSet do
Caption := 'You dragged "'+Fields[SGC.X-1].AsString+'"';
DisableControls;
CurRow := DG.Row;
MoveBy(GC.Y-CurRow);
Caption := Caption+' to "'+Fields[GC.X-1].AsString+'"';
MoveBy(CurRow-GC.Y);
EnableControls;
end;
end;
end.
----- Dfm 파일 -----
object Form1: TForm1
Left = 200
Top = 108
Width = 544
Height = 437
Caption = 'Form1'
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'MS Sans Serif'
Font.Style = []
PixelsPerInch = 96
TextHeight = 13
object MyDBGrid1: TMyDBGrid
Left = 8
Top = 8
Width = 521
Height = 193
DataSource = DataSource1
Row = 1
TabOrder = 0
TitleFont.Charset = DEFAULT_CHARSET
TitleFont.Color = clWindowText
TitleFont.Height = -11
TitleFont.Name = 'MS Sans Serif'
TitleFont.Style = []
OnDragDrop = MyDBGrid1DragDrop
OnDragOver = MyDBGrid1DragOver
OnMouseDown = MyDBGrid1MouseDown
end
object MyDBGrid2: TMyDBGrid
Left = 7
Top = 208
Width = 521
Height = 193
DataSource = DataSource2
Row = 1
TabOrder = 1
TitleFont.Charset = DEFAULT_CHARSET
TitleFont.Color = clWindowText
TitleFont.Height = -11
TitleFont.Name = 'MS Sans Serif'
TitleFont.Style = []
OnDragDrop = MyDBGrid1DragDrop
OnDragOver = MyDBGrid1DragOver
OnMouseDown = MyDBGrid1MouseDown
end
object Table1: TTable
Active = True
DatabaseName = 'DBDEMOS'
TableName = 'ORDERS'
Left = 104
Top = 48
end
object DataSource1: TDataSource
DataSet = Table1
Left = 136
Top = 48
end
object Table2: TTable
Active = True
DatabaseName = 'DBDEMOS'
TableName = 'CUSTOMER'
Left = 104
Top = 240
end
object DataSource2: TDataSource
DataSet = Table2
Left = 136
Top = 240
end
end
dbgrid 에서 cell 모양의 색깔 바꾸기
Procedure TForm1.DBGrid1DrawDataCell(Sender: TObject; const Rect: TRect;
Field: TField; State: TGridDrawState);
begin
If gdFocused in State then
with (Sender as TDBGrid).Canvas do
begin
Brush.Color := clRed;
FillRect(Rect);
TextOut(Rect.Left, Rect.Top, Field.AsString);
end;
end;
화면에 보여기는 DBGrid내용을 처리하기
var i: integer;
begin
with TDrawGrid(DBGrid1), DBGrid1.DataSource.DataSet do
begin
while TopRow < Row do Prior;
for i:= TopRow to RowCount - 1 do
begin
Memo1.Lines.Add(FieldByName('CD_DTL').AsString);
if i < RowCount - 1 then
Next;
end;
end;
end;
21_CryptLib.zip
