Книги Онлайн 📖 » Компьютеры и Интернет » Программирование » Советы по Delphi. Версия 1.4.3 от 1.1.2001 - Валентин Озеров

0/0

Советы по Delphi. Версия 1.4.3 от 1.1.2001 - Валентин Озеров

Дата:20.06.2024
Категория: Компьютеры и Интернет / Программирование
Название: Советы по Delphi. Версия 1.4.3 от 1.1.2001
Автор: Валентин Озеров
Просмотров:5
Комментариев:0

Уважаемые читатели!

Тут можно читать бесплатно Советы по Delphi. Версия 1.4.3 от 1.1.2001 - Валентин Озеров. Жанр: Программирование. Так же Вы можете читать полную версию (весь текст) онлайн книги без регистрации и SMS на сайте Knigi-online.info (книги онлайн) или прочесть краткое содержание, описание, предисловие (аннотацию) от автора и ознакомиться с отзывами (комментариями) о произведении.

Описание онлайн-книги Советы по Delphi. Версия 1.4.3 от 1.1.2001 - Валентин Озеров:

…начиная с 1001. Смотрите другие файлы…

Читем онлайн Советы по Delphi. Версия 1.4.3 от 1.1.2001 - Валентин Озеров

Шрифт:

Интервал:

Закладка:

Сделать

1 ... 67 68 69 70 71 72 73 74 75 ... 123

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 := 'Вы перетащили «'+Fields[SGC.X-1].AsString+'"';

DisableControls;

CurRow := DG.Row;

MoveBy(GC.Y-CurRow);

Caption := Caption+' в «'+Fields[GC.X-1].AsString+'"';

MoveBy(CurRow-GC.Y);

EnableControls;

end;

end.

Форма GridU1

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 = clWindowTextTitle

Font.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: TTableActive = 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

Как заставить DBGrid сортировать данные по щелчку на заголовке столбца?

Nomadic советует:

Кyсочек кода, чтобы повесить на clickable столбец RxGrid, показывающий RxQuery с определенным макросом %Order. Работать не бyдет (без модyлей), но в качестве идеи может быть полезен.

unit vgRXutil;

interface

uses SysUtils, Classes, DB, DBTables, rxLookup, RxQuery;

{ TrxDBLookup }

procedure RefreshRXLookup(Lookup: TrxLookupControl);

procedure RefreshRXLookupLookupSource(Lookup: TrxLookupControl);

function RxLookupValueInteger(Lookup: TrxLookupControl): Integer;

{ TRxQuery }

{ Applicatable to SQL's without SELECT * syntax }

{ Inserts FieldName into first position in '%Order' macro and refreshes query }

procedure HandleOrderMacro(Query: TRxQuery; Field: TField);

{ Sets '%Order' macro, if defined, and refreshes query }

procedure InsertOrderBy(Query: TRxQuery; NewOrder: String);

{ Converts list of order fields if defined and refreshes query }

procedure UpdateOrderFields(Query: TQuery; OrderFields: TStrings);

implementation

uses vgUtils, vgDBUtl, vgBDEUtl;

{ TrxDBLookup refresh }

type TRXLookupControlHack = class(TrxLookupControl)

property DataSource;

property LookupSource;

property Value;

property EmptyValue;

end;

procedure RefreshRXLookup(Lookup: TrxLookupControl);

var SaveField: String;

begin

with TRXLookupControlHack(Lookup) do begin

SaveField := DataField;

DataField := '';

DataField := SaveField;

end;

procedure RefreshRXLookupLookupSource(Lookup: TrxLookupControl);

var SaveField: String;

begin

with TRXLookupControlHack(Lookup) do begin

SaveField := LookupDisplay;

LookupDisplay := '';

LookupDisplay := SaveField;

end;

function RxLookupValueInteger(Lookup: TrxLookupControl): Integer;

begin

with TRXLookupControlHack(Lookup) do try

if Value <> EmptyValue then Result := StrToInt(Value)

else Result := 0;

except

Result := 0;

end;

procedure InsertOrderBy(Query: TRxQuery; NewOrder: String);

var

Param: TParam;

OldActive: Boolean;

OldOrder: String;

Bmk: TPKBookMark;

begin

Param := FindParam(Query.Macros, 'Order');

if not Assigned(Param) then Exit;

OldOrder := Param.AsString;

if OldOrder <> NewOrder then begin

OldActive := Query.Active;

if OldActive then Bmk := GetPKBookmark(Query, '');

try

Query.Close;

Param.AsString := NewOrder;

try

Query.Prepare;

except

Param.AsString := OldOrder;

end;

Query.Active := OldActive;

if OldActive then SetToPKBookMark(Query, Bmk);

finally

if OldActive then FreePKBookmark(Bmk);

end;

procedure UpdateOrderFields(Query: TQuery; OrderFields: TStrings);

var NewOrderFields: TStrings;

procedure AddOrderField(S: String);

begin

if NewOrderFields.IndexOf(S) < 0 then NewOrderFields.Add(S);

end;

var

I, J: Integer;

Field: TField;

FieldDef: TFieldDef;

S: String;

begin

NewOrderFields := TStringList.Create;

with Query do try

for I := 0 to OrderFields.Count - 1 do begin

S := OrderFields[I];

Field := FindField(S);

if Assigned(Field) and (Field.FieldNo > 0) then AddOrderField(IntToStr(Field.FieldNo))

else try

J := StrToInt(S);

if J < FieldDefs.Count then AddOrderField(IntToStr(J));

except

end;

OrderFields.Assign(NewOrderFields);

finally

NewOrderFields.Free;

end;

procedure HandleOrderMacro(Query: TRxQuery; Field: TField);

var

Param: TParam;

Tmp, OldOrder, NewOrder: String;

I: Integer;

C: Char;

TmpField: TField;

OrderFields: TStrings;

begin

Param := FindParam(Query.Macros, 'Order');

if not Assigned(Param) or Field.Calculated or Field.Lookup then Exit;

1 ... 67 68 69 70 71 72 73 74 75 ... 123

На этой странице вы можете бесплатно читать книгу Советы по Delphi. Версия 1.4.3 от 1.1.2001 - Валентин Озеров бесплатно.

Похожие на Советы по Delphi. Версия 1.4.3 от 1.1.2001 - Валентин Озеров книги

Основы объектно-ориентированного программирования - Бертран Мейер - Прочая околокомпьтерная литература
HR-брендинг. Как стать лучшим работодателем в России - Нина Осовицкая - Маркетинг, PR, реклама
Аквариум. (Новое издание, исправленное и переработанное) - Виктор Суворов (Резун) - Шпионский детектив
Как учить чужой язык? - Антон Хрипко - Справочники
Концептуальное проектирование сложных решений - Андрей Теслинов - Психология, личное

Советы по Delphi. Версия 1.4.3 от 1.1.2001 - Валентин Озеров

Оставить комментарий