home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Chip 2001 October
/
Chip_2001-10_cd1.bin
/
zkuste
/
delphi
/
kolekce
/
d456
/
DCSLIB25.ZIP
/
DCStringGrid.pas
< prev
next >
Wrap
Pascal/Delphi Source File
|
2001-06-26
|
33KB
|
1,077 lines
{
BUSINESS CONSULTING
s a i n t - p e t e r s b u r g
Components Library for Borland Delphi 4.x, 5.x
Copyright (c) 1998-2000 Alex'EM
}
unit DCStringGrid;
interface
uses
Windows, SysUtils, Messages, Classes, Controls, Forms, StdCtrls, Graphics,
Grids, Menus, CommCtrl, DCChoice, DCKnots, DCStdCtrls, DCDBGrids,
DCEditTools, DCConst, DCData;
const
DFLAG_CHECKED = $1;
DFLAG_CHANGED = $2;
type
PColumnData_tag = ^TColumnData;
TColumnData = record
DataIndex: integer;
Name : string;
Caption : string;
FieldName: string;
LinkName : string;
Comment : string;
DisplayFormat: string;
Alignment: TAlignment;
DataType : TDetailDataType;
EditType : TEditType;
MaxLength: integer;
MaxValue : integer;
Precision: integer;
Digits : integer;
Width : integer;
ItemIndex: integer;
KnotOptions : TKnotOptions;
EditOptions : TEditOptions;
end;
TDCCustomStringGrid = class;
TErrorCodeEvent = procedure (ErrorCode: integer; P: Pointer) of object;
TGetRecordCode = procedure (Sender: TObject; var Code: string) of object;
TInitDataItem = procedure (Sender: TObject; ColumnData: TColumnData;
var RecordItem: TRecordItemData) of object;
TGetDataItem = procedure (Sender: TObject; KnotItem: TKnotItem;
ColumnData: TColumnData; Control: TObject; var Value: string; var ChangeText: boolean) of object;
TSetDataItem = procedure (Sender: TObject; Edit: TDCCustomChoiceEdit;
KnotItem: TKnotItem; ColumnData: TColumnData; var Value: string) of object;
TCheckDataEvent = procedure (Sender: TObject; KnotItem: TKnotItem;
var DataValid: boolean) of object;
TDeleteDataEvent = procedure (Sender: TObject; KnotItem: TKnotItem;
Deleted: TList) of object;
TDCCustomStringGrid = class(TDCCustomTreeGrid)
private
FColumnsData: TList;
FDeleted: TStringList;
FState: TJournalState;
FEditColData: TColumnData;
FOnError: TErrorCodeEvent;
FOnLoadData: TNotifyEvent;
FOnSaveData: TNotifyEvent;
FOnInplaceError: TGetErrorHint;
FOnInplaceKillFocus: TKillFocusEvent;
FOnGetRecordCode: TGetRecordCode;
FOnInitData: TInitDataItem;
FInplaceEdit: Pointer;
FParamCount: integer;
FOnGetDataItem: TGetDataItem;
FOnSetDataItem: TSetDataItem;
FGridImages: TImageList;
FOnCheckData: TCheckDataEvent;
FOnDeleteData: TDeleteDataEvent;
FTreeEnabled: boolean;
function IsUnique(Value: string; ColumnData: TColumnData): boolean;
function DefaultWidth(AEditType: TEditType; ADataType: TDetailDataType;
AMaxLength: integer): integer;
procedure SetState(const Value: TJournalState);
procedure InplaceKillFocus(Sender: TObject; var StayOnControl: Boolean);
procedure SaveDataItem(KnotItem: TKnotItem; Sender: TObject);
procedure SetTreeEnabled(const Value: boolean);
function GetTreeEnabled: boolean;
protected
procedure UpdateRecordCountInfo;
procedure ClearColumnsData;
procedure LoadData; virtual;
procedure SaveData; virtual;
procedure PerformGridMessage(Msg: Cardinal); virtual;
procedure DoInitDataValue(var RecordItem: TRecordItemData; ColumnData: TColumnData); virtual;
function GetRecordCode: string; virtual;
procedure DoInsert(KnotItem: TKnotItem; var Apply: boolean); override;
procedure DoDelete(KnotItem: TKnotItem; var Apply: boolean;
ComponentState: TComponentState); override;
procedure DoUpdate(KnotItem: TKnotItem; var Edit: TDCCustomChoiceEdit;
Column: TKnotColumn); override;
procedure DoSelectCell(Sender: TObject; ACol, ARow: Longint;
var CanSelect: Boolean); override;
procedure DoCreateCellEdit(Column: TKnotColumn;
var Edit: TDCCustomChoiceEdit; var CanCreate: boolean); override;
procedure DoDestroyCellEdit; override;
procedure DoErrorCode(ErrorCode: integer; P: Pointer);
procedure DoInplaceError(Sender: TObject; ErrorCode: integer;
var ErrorHint: string); virtual;
procedure DoCheckCellEdit(Sender: TObject; var isError: boolean;
ColumnData: TColumnData); virtual;
procedure DoDrawColumnCell(Canvas: TCanvas; ARect: TRect; ACol: integer;
AColumn: TKnotColumn; AKnot: TKnotItem; AState: TGridDrawState); override;
procedure GetBookmarkData(KnotItem: TKnotItem; Data:Pointer); override;
procedure GSErrorCode(var Message: TMessage); message GS_ERRORCODE;
property OnError: TErrorCodeEvent read FOnError write FOnError;
property OnLoadData: TNotifyEvent read FOnLoadData write FOnLoadData;
property OnSaveData: TNotifyEvent read FOnSaveData write FOnSaveData;
property OnInplaceError: TGetErrorHint read FOnInplaceError write FOnInplaceError;
property OnInplaceKillFocus: TKillFocusEvent read FOnInplaceKillFocus write FOnInplaceKillFocus;
property State: TJournalState read FState write SetState;
property OnInitData: TInitDataItem read FOnInitData write FOnInitData;
property OnGetRecordCode: TGetRecordCode read FOnGetRecordCode write FOnGetRecordCode;
property OnGetDataItem: TGetDataItem read FOnGetDataItem write FOnGetDataItem;
property OnSetDataItem: TSetDataItem read FOnSetDataItem write FOnSetDataItem;
property TreeEnabled: boolean read FTreeEnabled write SetTreeEnabled default False;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
procedure KeyDown(var Key: Word; Shift: TShiftState); override;
procedure KeyPress(var Key: Char); override;
procedure UpdateGridColumns;
procedure InsertDataItem(EditorMode: boolean = True);
procedure DeleteDataItem;
function GetColumnsData(Name: string; var pColumnData: PColumnData_tag): boolean;
function GetDataItem(KnotItem: TKnotItem; ColumnData: TColumnData;
Sender: TObject; AQuoted: boolean = False): string;
function AddColumn(ADataType: TDetailDataType; AName, ACaption: string): PColumnData_tag;
procedure SetValue(ADataType: TDetailDataType; AText: string;
var ARecordItem: TRecordItemData);
function ValidRecord(KnotItem: TKnotItem): boolean; virtual;
function ValidEditValue: boolean;
procedure Load; virtual;
procedure Save; virtual;
property Deleted: TStringList read FDeleted;
property ColumnsData: TList read FColumnsData;
property ParamCount: integer read FParamCount write FParamCount;
property OnCheckData: TCheckDataEvent read FOnCheckData write FOnCheckData;
property OnDeleteData: TDeleteDataEvent read FOnDeleteData write FOnDeleteData;
end;
TDCStringGrid = class(TDCCustomStringGrid)
public
property Canvas;
property Knots;
property ScrollBars;
property SelectedRows;
property SelectedKnot;
property SelectedIndex;
property Col;
property Row;
property RowCount;
property ColCount;
property FixedRows;
property FixedCols;
property State;
property RowModified;
property Columns;
property GroupBox;
published
property Align;
property Anchors;
property BiDiMode;
property BorderStyle;
property Color;
property Constraints;
property Ctl3D;
property DefaultDrawing;
property DragCursor;
property DragKind;
property DragMode;
property Enabled;
property FixedColor;
property Font;
property Options;
property OptionsEx;
property ParentBiDiMode;
property ParentColor;
property ParentCtl3D;
property ParentFont;
property ParentShowHint;
property PopupMenu;
property ShowHint;
property TabOrder;
property TabStop;
property Visible;
property OnColumnMoved;
property OnDblClick;
property OnDragDrop;
property OnDragOver;
property OnEndDock;
property OnEndDrag;
property OnEnter;
property OnExit;
property OnKeyDown;
property OnKeyPress;
property OnKeyUp;
property OnStartDock;
property OnStartDrag;
property Images;
property DefaultRowHeight;
property OnMouseDown;
property OnMouseMove;
property OnMouseUp;
property OnCellClick;
property OnTitleClick;
property OnClipClick;
property OnDelete;
property OnInsert;
property OnDrawColumnCell;
property OnTreeCellText;
property TreePathWidth;
property OnRowMoved;
property OnSelectCell;
property OnTopLeftChanged;
property OnCreateCellEdit;
property OnDestroyCellEdit;
property OnClipButtonClick;
property OnError;
property OnLoadData;
property OnSaveData;
property OnInplaceError;
property OnInplaceKillFocus;
property OnInitData;
property OnGetRecordCode;
property OnColumnComment;
property PopupTitle;
property OnGetDataItem;
property OnSetDataItem;
property OnSelectKnot;
property OnPaintMessage;
property OnCheckData;
property OnDeleteData;
property TreeEnabled;
property OnExpanded;
property OnCollapsed;
end;
TPrivateChoiceEdit = class(TDCCustomChoiceEdit)
end;
implementation
{ TDCCustomStringGrid }
function TDCCustomStringGrid.AddColumn(ADataType: TDetailDataType;
AName, ACaption: string): PColumnData_tag;
var
pColumnData: PColumnData_tag;
begin
New(pColumnData);
with pColumnData^ do
begin
DataType := ADataType;
Name := AName;
Caption := ACaption;
FieldName := AName;
LinkName := '';
EditType := edEdit;
KnotOptions := [kcShowEdit, kcSizing, kcVisible, kcIndexed];
EditOptions := [eoCanEmpty];
MaxLength := -1;
Precision := -1;
Digits := -1;
ItemIndex := -1;
Width := -1;
DataIndex := FColumnsData.Count;
Alignment := taLeftJustify;
MaxValue := -1;
end;
FColumnsData.Add(pColumnData);
Result := pColumnData;
end;
procedure TDCCustomStringGrid.ClearColumnsData;
var
i: integer;
pColumnData: PColumnData_tag;
begin
for i := 0 to FColumnsData.Count-1 do
begin
pColumnData := FColumnsData.Items[i];
with pColumnData^ do
begin
SetLength(Name, 0);
SetLength(Caption, 0);
SetLength(FieldName, 0);
SetLength(LinkName, 0);
SetLength(LinkName, 0);
SetLength(Comment, 0);
SetLength(DisplayFormat, 0);
end;
FreeMem(pColumnData);
end;
FColumnsData.Clear;
end;
constructor TDCCustomStringGrid.Create(AOwner: TComponent);
begin
inherited;
FTreeEnabled := False;
FColumnsData := TList.Create;
FDeleted := TStringList.Create;
FGridImages := ETGetSystemImages(DCGIM_SMALLICON);
end;
function TDCCustomStringGrid.DefaultWidth(AEditType: TEditType;
ADataType: TDetailDataType; AMaxLength: integer): integer;
const
ADefaultWidth: array[TDetailDataType] of integer =
(8, 0, 12, 8, 20);
//ddInteger, ddDate, ddFloat, ddCurrency, ddString
var
BaseWidth, CharCount: integer;
function GS_TextWidth(Value: string): integer;
begin
Result := GetTextWidth(Canvas.Handle, Value);
end;
begin
if AMaxLength = -1 then
CharCount := ADefaultWidth[ADataType]
else
CharCount := AMaxLength;
case ADataType of
ddInteger : BaseWidth := CharCount * GS_TextWidth('9');
ddFloat : BaseWidth := CharCount * GS_TextWidth('9') + GS_TextWidth(DecimalSeparator);
ddCurrency: BaseWidth := CharCount * GS_TextWidth('9') + GS_TextWidth(DecimalSeparator);
ddString : BaseWidth := CharCount * GS_TextWidth('W');
ddDate : BaseWidth := GS_TextWidth(ShortDateFormat) + 14;
else
BaseWidth := 0;
end;
Result := BaseWidth;
case AEditType of
edEdit :;
edDate :;
edGrid : Result := Result + 14;
edChoice: Result := Result + 14;
edTree : Result := Result + 14;
edCombo : Result := Result + 14;
edCheck : Result := FGridImages.Width + 4;
end;
Result := Result + 4;
end;
procedure TDCCustomStringGrid.DeleteDataItem;
begin
if (FState = jsBrowse) and (Knots.Count > 0) then
DeleteRecords(not(tgConfirmDelete in Options) or False);
end;
destructor TDCCustomStringGrid.Destroy;
begin
ClearColumnsData;
FColumnsData.Free;
FDeleted.Free;
inherited;
end;
procedure TDCCustomStringGrid.DoCreateCellEdit(Column: TKnotColumn;
var Edit: TDCCustomChoiceEdit; var CanCreate: boolean);
var
pColumnData: PColumnData_tag;
AText: string;
begin
State := jsEdit;
inherited DoCreateCellEdit(Column, Edit, CanCreate);
if CanCreate and (Edit <> nil) and GetColumnsData(Column.Name, pColumnData) then
FEditColData := pColumnData^;
if CanCreate and (FState = jsEdit) and not Assigned(Edit) and (Column <> nil) then
begin
if GetColumnsData(Column.Name, pColumnData) then
begin
{Initialize Data}
FEditColData := pColumnData^;
with FEditColData do
begin
case EditType of
edEdit :
begin
case DataType of
ddDate, ddString:
begin
Edit := TDCInplaceChoiceEdit.Create(nil);
with TDCInplaceChoiceEdit(Edit) do
begin
Grid := Self;
Visible:= False;
Parent := Self;
ButtonExist := False;
end;
end;
ddFloat, ddCurrency, ddInteger:
begin
Edit := TDCInplaceFloatEdit.Create(nil);
with TDCInplaceFloatEdit(Edit) do
begin
Grid := Self;
Visible:= False;
Parent := Self;
case FEditColData.DataType of
ddFloat:
DataType.Kind := deFloat;
ddCurrency:
begin
DataType.Kind := deCurrency;
ButtonExist := False;
end;
ddInteger:
begin
DataType.Kind := deInteger;
ButtonExist := False;
end;
end;
DataType.Precision := Precision;
DataType.Digits := Digits;
end;
end;
end;
end;
edDate :
begin
Edit := TDCInplaceDateEdit.Create(nil);
with TDCInplaceDateEdit(Edit) do
begin
Grid := Self;
Visible:= False;
Parent := Self;
end;
end;
edGrid : {!!};
edChoice: {!!};
edTree : {!!};
edCombo : {!!};
edCheck :
begin
if not(kcReadOnly in Column.Options) then
begin
AText := GetDataItem(SelectedKnot, FEditColData, nil);
if IsValidInteger(AText) then
begin
if MaxValue > -1 then
AText := IntToStr(StrToInt(AText) + 1 div MaxValue)
else
AText := IntToStr(StrToInt(AText) + 1);
if Assigned(FOnSetDataItem) then
FOnSetDataItem(Self, nil, SelectedKnot, FEditColData, AText);
Knots.BeginUpdate;
SetValue(FEditColData.DataType, AText,
PRecordData_tag(SelectedKnot.Data)^.Data[FEditColData.DataIndex]);
Knots.EndUpdate;
end;
end;
end;
edInfo : { nothing };
end;
end;
end;
end;
if Assigned(Edit) then
begin
with TPrivateChoiceEdit(Edit) do
begin
PerformCloseUp := True;
CanEmpty := eoCanEmpty in pColumnData^.EditOptions;
OnKillFocus := InplaceKillFocus;
OnGetErrorHint := DoInplaceError;
GetDataItem(SelectedKnot, FEditColData, Edit);
end;
Edit.MaxLength := FEditColData.MaxLength;
end
else
State := jsBrowse;
FInplaceEdit := Edit;
end;
procedure TDCCustomStringGrid.DoDelete(KnotItem: TKnotItem;
var Apply: boolean; ComponentState: TComponentState);
var
pRecordData: PRecordData_tag;
begin
if not((csDestroying in ComponentState) or (KnotItem.Owner.State = ksUpdate)) then
inherited
else
Apply := True;
if Apply and (csDestroying in ComponentState)then
begin
pRecordData := KnotItem.Data;
if (pRecordData <> nil) and (pRecordData^.State<>rsInserted) and
(FState = jsBrowse) and (KnotItem.Owner.State <> ksUpdate)
then begin
if Assigned(FOnDeleteData) then
FOnDeleteData(Self, KnotItem, Pointer(FDeleted))
else
FDeleted.Add(pRecordData^.Code);
end;
Perform(GS_ERRORCODE, 0, ERR_EDIT_NONE);
RDFree(pRecordData);
UpdateRecordCountInfo;
end;
end;
procedure TDCCustomStringGrid.DoErrorCode(ErrorCode: integer; P: Pointer);
begin
if Assigned(FOnError) then FOnError(ErrorCode, P);
end;
procedure TDCCustomStringGrid.DoInplaceError(Sender: TObject;
ErrorCode: integer; var ErrorHint: string);
begin
case ErrorCode of
ERR_EDIT_NEEDUNIQ : ErrorHint := LoadStr(RES_EDIT_ERR_UNIQ);
end;
if Assigned(FOnInplaceError) then
FOnInplaceError(Sender, ErrorCode, ErrorHint);
end;
procedure TDCCustomStringGrid.DoInitDataValue( var RecordItem: TRecordItemData;
ColumnData: TColumnData);
begin
with RecordItem do
begin
DISetFlag(RecordItem, DFLAG_CHECKED, True);
DISetFlag(RecordItem, DFLAG_CHANGED, True);
case ColumnData.DataType of
ddInteger:
DISetValue(RecordItem, daInteger, '0');
ddDate, ddFloat, ddCurrency:
DISetValue(RecordItem, daFloat, '0');
ddString:
DISetValue(RecordItem, daString, '');
end;
if Assigned(FOnInitData) then FOnInitData(Self, ColumnData, RecordItem);
end;
end;
procedure TDCCustomStringGrid.DoInsert(KnotItem: TKnotItem;
var Apply: boolean);
var
pRecordData: PRecordData_tag;
pColumnData: PColumnData_tag;
i: integer;
ACode: string;
begin
inherited;
if not GetTreeEnabled and (KnotItem.Parent.Level <> -1) then Apply := False;
if Apply then
begin
pRecordData := RDCreate(ParamCount);
ACode := GetRecordCode;
RDSetCode(pRecordData, PChar(ACode), Length(ACode));
case FState of
jsLoad : RDSetState(pRecordData, rsNotChanged);
jsBrowse: RDSetState(pRecordData, rsInserted);
end;
for i := 0 to FColumnsData.Count-1 do
begin
pColumnData := FColumnsData.Items[i];
DoInitDataValue(pRecordData^.Data[pColumnData.DataIndex], pColumnData^);
end;
KnotItem.Data := pRecordData;
Perform(GS_ERRORCODE, 0, ERR_EDIT_NONE);
UpdateRecordCountInfo;
end;
end;
procedure TDCCustomStringGrid.DoSelectCell(Sender: TObject; ACol,
ARow: Integer; var CanSelect: Boolean);
begin
if (ARow<>Row) and (Knots.State = ksInsert)
then begin
if not ValidRecord(SelectedKnot) then
CanSelect := False
else
Perform(GS_ERRORCODE, 0, ERR_EDIT_NONE);
end;
inherited;
end;
procedure TDCCustomStringGrid.DoUpdate(KnotItem: TKnotItem;
var Edit: TDCCustomChoiceEdit; Column: TKnotColumn);
begin
with PRecordData_tag(KnotItem.Data)^ do
if State = rsNotChanged then State := rsUpdated;
SaveDataItem(KnotItem, Edit);
end;
function TDCCustomStringGrid.GetColumnsData(Name: string;
var pColumnData: PColumnData_tag): boolean;
var
i: integer;
begin
for i := 0 to FColumnsData.Count-1 do
begin
pColumnData := FColumnsData.Items[i];
if UpperCase(Name) = UpperCase(pColumnData^.Name) then
begin
Result := True;
Exit;
end;
end;
Result := False;
end;
function TDCCustomStringGrid.GetDataItem(KnotItem: TKnotItem;
ColumnData: TColumnData; Sender: TObject; AQuoted: boolean): string;
var
pRecordData: PRecordData_tag;
ChangeText: boolean;
begin
pRecordData := KnotItem.Data;
if pRecordData <> nil then
begin
with ColumnData, pRecordData^.Data[DataIndex] do
begin
case ColumnData.DataType of
ddInteger :
if ColumnData.DisplayFormat <> '' then
Result := Format(ColumnData.DisplayFormat,[Value])
else
Result := IntToStr(Value);
ddDate :
begin
DateToStrY2K(Data, Result);
if AQuoted then Result := Format('''%s''',[Result]);
end;
ddFloat :
if ColumnData.DisplayFormat <> '' then
Result := Format(ColumnData.DisplayFormat,[Data])
else
Result := FloatToStr(Data);
ddCurrency:
if ColumnData.DisplayFormat <> '' then
Result := Format(ColumnData.DisplayFormat,[Data])
else
Result := FloatToStr(Data);
ddString :
begin
Result := DIGetValue(pRecordData^.Data[DataIndex]);
if AQuoted then Result := Format('"%s"',[Result]);
end;
end;
ChangeText := True;
if Assigned(FOnGetDataItem) then
FOnGetDataItem(Self, KnotItem, ColumnData, Sender, Result, ChangeText);
if (Sender <> nil) and ChangeText then TPrivateChoiceEdit(Sender).Text := Result;
end;
end;
end;
function TDCCustomStringGrid.GetRecordCode: string;
begin
if Assigned(FOnGetRecordCode) then
FOnGetRecordCode(Self, Result)
else
Result := STGird_Empty_CODE;
end;
procedure TDCCustomStringGrid.GSErrorCode(var Message: TMessage);
begin
if not(csDestroying in ComponentState) and
(FState <> jsLoad) and (FState <> jsSave) then
with Message do
begin
if WParam = 0 then
DoErrorCode(LParam, nil)
else
DoErrorCode(LParam, Pointer(WParam));
end;
end;
procedure TDCCustomStringGrid.InsertDataItem(EditorMode: boolean);
var
Key: Word;
ACol: integer;
begin
{─εßαΓδσφΦσ φεΓεΘ τα∩Φ±Φ}
if State = jsBrowse then
begin
Row := RowCount-1;
Key := VK_DOWN; KeyDown(Key, []);
Col := FixedCols;
ACol := Col-FixedCols;
while ACol < Columns.Count do
begin
if Columns[ACol].Options*[kcReadOnly,kcShowEdit]=[kcShowEdit]
then begin
Col := ACol+FixedCols;
if EditorMode then ShowEditor;
Break;
end;
Inc(ACol);
end;
end;
end;
function TDCCustomStringGrid.IsUnique(Value: string;
ColumnData: TColumnData): boolean;
var
KnotItem: TKnotItem;
sText: string;
begin
Result := True;
with Knots do
begin
KnotItem := GetFirstVisibleNode;
while KnotItem <> nil do
begin
if KnotItem.KnotID <> SelectedKnot.KnotID then
begin
sText := GetDataItem(KnotItem, ColumnData, nil);
if AnsiUpperCase(sText) = AnsiUpperCase(Value) then
begin
Result := False;
Break;
end;
end;
KnotItem := KnotItem.GetNextVisible;
end;
end;
end;
function TDCCustomStringGrid.ValidRecord(KnotItem: TKnotItem): boolean;
var
pSelectData: PRecordData_tag;
pColumnData: PColumnData_tag;
i: integer;
ItemData: TRecordItemData;
sText: string;
begin
Result := True;
if Assigned(KnotItem) then
pSelectData := KnotItem.Data
else
pSelectData := nil;
if not Assigned(pSelectData) then Exit;
for i := 0 to FColumnsData.Count-1 do
begin
pColumnData := FColumnsData.Items[i];
ItemData := pSelectData^.Data[pColumnData^.DataIndex];
if DIGetFlag(ItemData, DFLAG_CHECKED) = 0 then
begin
if eoUnique in pColumnData^.EditOptions then
begin
sText := GetDataItem(SelectedKnot, pColumnData^, nil);
if (sText <> '') and not IsUnique(sText, pColumnData^) then
begin
Result := False;
Perform(GS_ERRORCODE, Integer(pColumnData), ERR_EDIT_NEEDUNIQ);
Exit;
end;
end;
if not(eoCanEmpty in pColumnData^.EditOptions) then
begin
sText := GetDataItem(SelectedKnot, pColumnData^, nil);
if sText = '' then
begin
Result := False;
Perform(GS_ERRORCODE, Integer(pColumnData), ERR_EDIT_EMPTYVALUE);
Exit;
end;
end;
DISetFlag(ItemData, DFLAG_CHECKED)
end;
if Assigned(FOnCheckData) then FOnCheckData(Self, KnotItem, Result);
end;
end;
procedure TDCCustomStringGrid.KeyDown(var Key: Word; Shift: TShiftState);
begin
inherited;
case Key of
VK_INSERT:
begin
if ssCtrl in Shift then Key := 0;
end;
end
end;
procedure TDCCustomStringGrid.KeyPress(var Key: Char);
begin
inherited;
end;
procedure TDCCustomStringGrid.LoadData;
begin
{╟απ≡≤τΩα Σαφφ√⌡}
if Assigned(FOnLoadData) then FOnLoadData(Self);
end;
procedure TDCCustomStringGrid.SaveData;
begin
{╤ε⌡≡αφσφΦσ Σαφφ√⌡}
if Assigned(FOnSaveData) then FOnSaveData(Self);
end;
procedure TDCCustomStringGrid.SetState(const Value: TJournalState);
begin
if Value <> FState then
begin
FState := Value;
case Value of
jsLoad,
jsSave:
begin
Options := Options - [tgEditing];
Cursor := crHourGlass;
end;
jsBrowse:
begin
Options := Options + [tgEditing];
Cursor := crDefault;
end;
jsEdit:
begin
{}
end;
jsView:
begin
Options := Options - [tgEditing];
Cursor := crDefault;
end;
end;
PerformGridMessage(GS_UPDATE_STATE);
end;
end;
procedure TDCCustomStringGrid.UpdateGridColumns;
var
i: integer;
KnotColumn: TKnotColumn;
pColumnData: PColumnData_tag;
begin
BeginLayout;
Columns.Clear;
for i := 0 to FColumnsData.Count-1 do
begin
pColumnData := FColumnsData.Items[i];
KnotColumn := Columns.Add;
with pColumnData^ do
begin
KnotColumn.Alignment := Alignment;
KnotColumn.Comment := Comment;
KnotColumn.Name := Name;
KnotColumn.Title.Caption := Caption;
KnotColumn.Options := KnotOptions;
if Width = -1 then
KnotColumn.Width := DefaultWidth(EditType, DataType, MaxLength)
else
KnotColumn.Width := Width;
case EditType of
edCheck:
KnotColumn.Options := KnotColumn.Options - [kcSizing];
end;
KnotColumn.ItemIndex := ItemIndex;
KnotColumn.DisplayFormat := DisplayFormat;
end;
end;
EndLayout;
if HandleAllocated then SetScrollRange(Handle, SB_HORZ, 0, 0, True);
end;
procedure TDCCustomStringGrid.PerformGridMessage(Msg: Cardinal);
var
ParentForm: TCustomForm;
begin
if not(csDestroying in ComponentState) then
begin
ParentForm := GetParentForm(Parent);
if Assigned(ParentForm) then ParentForm.Perform(Msg, Integer(Self), 0);
end;
end;
procedure TDCCustomStringGrid.InplaceKillFocus(Sender: TObject;
var StayOnControl: Boolean);
begin
DoCheckCellEdit(Sender, StayOnControl, FEditColData);
end;
procedure TDCCustomStringGrid.DoCheckCellEdit(Sender: TObject;
var isError: boolean; ColumnData: TColumnData);
begin
with TPrivateChoiceEdit(Sender) do
begin
if (Text <> '') or not(CanEmpty) then
begin
if Assigned(FOnInplaceKillFocus) then FOnInplaceKillFocus(Sender, isError);
if not isError then
begin
if not isError and (eoUnique in ColumnData.EditOptions) then
begin
isError := not IsUnique(Text, ColumnData);
if isError then ErrorCode := ERR_EDIT_NEEDUNIQ;
end;
end;
end;
end;
end;
procedure TDCCustomStringGrid.DoDestroyCellEdit;
begin
State := jsBrowse;
FInplaceEdit := nil;
inherited;
end;
procedure TDCCustomStringGrid.SaveDataItem(KnotItem: TKnotItem;
Sender: TObject);
var
AValue: string;
begin
AValue := TPrivateChoiceEdit(Sender).Text;
if Assigned(FOnSetDataItem) then
FOnSetDataItem(Self, TPrivateChoiceEdit(Sender), KnotItem, FEditColData, AValue);
SetValue(FEditColData.DataType, AValue,
PRecordData_tag(KnotItem.Data)^.Data[FEditColData.DataIndex]);
end;
procedure TDCCustomStringGrid.Load;
begin
{╟απ≡≤τΩα Σαφφ√⌡}
State := jsLoad;
Application.ProcessMessages;
LoadData;
if State <> jsView then State := jsBrowse;
end;
procedure TDCCustomStringGrid.Save;
begin
{╤ε⌡≡αφσφΦσ Σαφφ√⌡}
State := jsSave;
Application.ProcessMessages;
SaveData;
if State <> jsView then State := jsBrowse;
end;
procedure TDCCustomStringGrid.SetValue(ADataType: TDetailDataType;
AText: string; var ARecordItem: TRecordItemData);
begin
with ARecordItem do
begin
DISetFlag(ARecordItem, DFLAG_CHECKED);
case ADataType of
ddInteger:
DISetValue(ARecordItem, daInteger, AText);
ddDate, ddFloat, ddCurrency:
DISetValue(ARecordItem, daFloat, AText);
ddString:
DISetValue(ARecordItem, daString, AText);
end;
if FState <> jsLoad then
DISetFlag(ARecordItem, DFLAG_CHANGED)
else
DISetFlag(ARecordItem, DFLAG_CHANGED, True);
end;
end;
procedure TDCCustomStringGrid.DoDrawColumnCell(Canvas: TCanvas;
ARect: TRect; ACol: integer; AColumn: TKnotColumn; AKnot: TKnotItem;
AState: TGridDrawState);
const
AlignFlags : array [TAlignment] of Integer =
( DT_LEFT or DT_NOPREFIX or DT_END_ELLIPSIS or DT_EXPANDTABS,
DT_RIGHT or DT_NOPREFIX or DT_END_ELLIPSIS or DT_EXPANDTABS,
DT_CENTER or DT_NOPREFIX or DT_END_ELLIPSIS or DT_EXPANDTABS );
var
AText, AFormat: string;
pColumnData: PColumnData_tag;
R:TRect;
nIndex: integer;
begin
R := ARect;
if GetColumnsData(AColumn.Name, pColumnData) then
begin
InflateRect(R, -2, -1);
case pColumnData^.EditType of
edCheck:
begin
AText := GetDataItem(AKnot, pColumnData^, nil);
if IsValidInteger(AText) then
begin
case StrToInt(AText) of
0: nIndex := nsiNormalCheck0;
1: nIndex := nsiNormalCheck1;
2: nIndex := nsiNormalCheckX;
else
nIndex := nsiNormalCheck0;
end;
if Focused and (gdSelected in AState) then
AFormat := Format('/is{%d}', [nIndex])
else
AFormat := Format('/im{%d}', [nIndex]);
DrawHighLightText(Canvas, PChar(AFormat), R, 1, DT_CENTER, FGridImages);
end;
end;
else begin
AText := GetDataItem(AKnot, pColumnData^, nil);
DrawText(Canvas.Handle, PChar(AText), Length(AText), R, AlignFlags[AColumn.Alignment]);
end;
end;
end;
inherited;
end;
procedure TDCCustomStringGrid.UpdateRecordCountInfo;
begin
if FState = jsBrowse then PerformGridMessage(GS_UPDATE_RECORDCOUNT);
end;
function TDCCustomStringGrid.ValidEditValue: boolean;
begin
if (State = jsEdit) and Assigned(FInplaceEdit) then
begin
DoCheckCellEdit(TPrivateChoiceEdit(FInplaceEdit), Result, FEditColData);
Perform(GS_ERRORCODE, Integer(@FEditColData),
TPrivateChoiceEdit(FInplaceEdit).ErrorCode);
Result := not Result;
end
else
Result := True;
end;
procedure TDCCustomStringGrid.GetBookmarkData(KnotItem: TKnotItem;
Data: Pointer);
var
AData: string;
begin
AData := '';
if KnotItem.Data <> nil then AData := RDGetCode(KnotItem.Data);
if AData = '' then AData := IntToStr(KnotItem.KnotID);
if KnotItem.Data <> nil then
StrLCopy(PChar(Data), PChar(AData), BookMarkSize-1)
end;
procedure TDCCustomStringGrid.SetTreeEnabled(const Value: boolean);
begin
FTreeEnabled := Value;
end;
function TDCCustomStringGrid.GetTreeEnabled: boolean;
begin
Result := FTreeEnabled or (GroupingEnabled and (GroupBox.Count > 0));
end;
end.