وبلاگ شخصی حامد شیرزاد
وبلاگ شخصی حامد شیرزاد
صفحات وبلاگ
نویسنده: حامد شیرزاد - ۱۳٩٠/٧/۱٠

unit Unit1;

 

interface

 

uses

Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,

Dialogs, DB, DBTables, Grids, DBGrids;

 

type

TForm1 = class(TForm)

DBGrid1: TDBGrid;

Table1: TTable;

DataSource1: TDataSource;

procedure DBGrid1CellClick(Column: TColumn);

procedure DBGrid1DrawColumnCell(Sender: TObject; const Rect: TRect;

DataCol: Integer; Column: TColumn; State: TGridDrawState);

procedure DBGrid1ColEnter(Sender: TObject);

procedure DBGrid1ColExit(Sender: TObject);

private

 

FOriginalOptions : TDBGridOptions; { Private declarations }

public

procedure SaveBoolean;

{ Public declarations }

end;

 

var

Form1: TForm1;

 

implementation

 

{$R *.dfm}

 

procedure TForm1.SaveBoolean;

begin

Self.DBGrid1.SelectedField.Dataset.Edit;

Self.DBGrid1.SelectedField.AsBoolean := not Self.DBGrid1.SelectedField.AsBoolean;

Self.DBGrid1.SelectedField.Dataset.Post;

end;

 

procedure TForm1.DBGrid1CellClick(Column: TColumn);

begin

if Self.DBGrid1.SelectedField.DataType = ftBoolean then

SaveBoolean();

end;

 

procedure TForm1.DBGrid1DrawColumnCell(Sender: TObject; const Rect: TRect;

DataCol: Integer; Column: TColumn; State: TGridDrawState);

Const

CtrlState : array[Boolean] of Integer = (DFCS_BUTTONCHECK,

DFCS_BUTTONCHECK or DFCS_CHECKED);

var

CheckBoxRectangle : TRect;

begin

if Column.Field.DataType = ftBoolean then

begin

Self.DBGrid1.Canvas.FillRect(Rect);

CheckBoxRectangle.Left := Rect.Left + 2;

CheckBoxRectangle.Right := Rect.Right - 2;

CheckBoxRectangle.Top := Rect.Top + 2;

CheckBoxRectangle.Bottom := Rect.Bottom - 2;

DrawFrameControl(Self.DBGrid1.Canvas.Handle,

CheckBoxRectangle,

DFC_BUTTON,

CtrlState[Column.Field.AsBoolean]);

end;

end;

procedure TForm1.DBGrid1ColEnter(Sender: TObject);

begin

if Self.DBGrid1.SelectedField.DataType = ftBoolean then

begin

Self.FOriginalOptions := Self.DBGrid1.Options;

Self.DBGrid1.Options := Self.DBGrid1.Options - [dgEditing];

end;

end;

 

procedure TForm1.DBGrid1ColExit(Sender: TObject);

begin

if Self.DBGrid1.SelectedField.DataType = ftBoolean then

Self.DBGrid1.Options := Self.FOriginalOptions;

end;

 

end.

 

اين هم مال فرم

 

object Form1: TForm1

Left = 192

Top = 114

Width = 953

Height = 778

Caption = 'Form1'

Color = clBtnFace

Font.Charset = DEFAULT_CHARSET

Font.Color = clWindowText

Font.Height = -11

Font.Name = 'MS Sans Serif'

Font.Style = []

OldCreateOrder = False

PixelsPerInch = 96

TextHeight = 13

object DBGrid1: TDBGrid

Left = 0

Top = 0

Width = 945

Height = 744

Align = alClient

DataSource = DataSource1

TabOrder = 0

TitleFont.Charset = DEFAULT_CHARSET

TitleFont.Color = clWindowText

TitleFont.Height = -11

TitleFont.Name = 'MS Sans Serif'

TitleFont.Style = []

OnCellClick = DBGrid1CellClick

OnColEnter = DBGrid1ColEnter

OnColExit = DBGrid1ColExit

OnDrawColumnCell = DBGrid1DrawColumnCell

end

object Table1: TTable

Active = True

DatabaseName = 'DBDEMOS'

TableName = 'reservat.db'

Left = 128

Top = 88

end

object DataSource1: TDataSource

DataSet = Table1

Left = 176

Top = 80

end

end

نویسندگان وبلاگ:
مطالب اخیر:
کدهای اضافی کاربر :