반응형


TStringGrid에 Excel내용을 복사/붙여넣기

//전체 소스

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;

반응형
반응형