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

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

На нашем сайте KnigaRead.com Вы можете абсолютно бесплатно читать книгу онлайн Валентин Озеров, "Советы по Delphi. Версия 1.4.3 от 1.1.2001" бесплатно, без регистрации.
Перейти на страницу:

  procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;

  procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;

  { Protected declarations }

 public

  constructor Create(AOwner : TComponent);override;

  destructor Destroy; override;

  { Public declarations }

 published

  property OnDrawTitle : TOnDrawTitleEvent read FOnDrawTitle write FOnDrawTitle;

  property RealTitleFont : TFont read FRealTitleFont write SetRealTitleFont;

  { Published declarations }

 end;


procedure Register;


implementation


var DrawBitmap : TBitmap;


function Max(X, Y: Integer): Integer;

begin

 Result := Y;

 if X > Y then Result := X;

end;


procedure WriteText(ACanvas: TCanvas; ARect: TRect; DX, DY: Integer; const Text: string; Alignment: TAlignment);

// © Borland function :)

const AlignFlags : array [TAlignment] of Integer =

 ( DT_LEFT or DT_WORDBREAK or DT_EXPANDTABS or DT_NOPREFIX,

 DT_RIGHT or DT_WORDBREAK or DT_EXPANDTABS or DT_NOPREFIX,

 DT_CENTER or DT_WORDBREAK or DT_EXPANDTABS or DT_NOPREFIX );

var

 B, R: TRect;

 I, Left: Integer;

begin

 with DrawBitmap, ARect do { Use offscreen bitmap to eliminate flicker and }

 begin { brush origin tics in painting / scrolling. }

  Width := Max(Width, Right - Left);

  Height := Max(Height, Bottom - Top);

  R := Rect(DX, DY, Right - Left - 1, Bottom - Top - 1);

  B := Rect(0, 0, Right - Left, Bottom - Top);

 end;

 with DrawBitmap.Canvas do begin

  DrawBitmap.Canvas.CopyRect(B, ACanvas, ARect);

  Font := ACanvas.Font;

  Font.Color := ACanvas.Font.Color;

  Brush := ACanvas.Brush;

  SetBkMode(Handle, TRANSPARENT);

  DrawText(Handle, PChar(Text), Length(Text), R, AlignFlags[Alignment]);

 end;

 ACanvas.CopyRect(ARect, DrawBitmap.Canvas, B);

end;


constructor TBitDBGrid.Create(AOwner : TComponent);

begin

 inherited Create(Aowner);

 FRealTitleFont := TFont.Create;

 FResizeFlag := false;

end;


destructor TBitDBGrid.Destroy;

begin

 FRealTitleFont.Free;

 inherited Destroy;

end;


procedure TBitDBGrid.UpdateTitlesHeight;

var

 Loop : integer;

 MaxTextHeight : integer;

 RRect : TRect;

begin

 MaxTextHeight := 0;

 for loop := 0 to Columns.Count - 1 do begin

  RRect := CellRect(0, 0);

  RRect.Right := Columns[Loop].Width;

  RRect.Left := 0;

  Canvas.Font := RealTitleFont;

  MaxTextHeight := Max(MaxTextHeight, DrawText(Canvas.Handle, PChar(Columns[Loop].Title.Caption), Length(Columns[Loop].Title.Caption), RRect, DT_CALCRECT + DT_WORDBREAK));

 end;

 if TitleFont.Height <> - MaxTextHeight then TitleFont.Height := - MaxTextHeight;

end;


procedure TBitDBGrid.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);

begin

 if MouseCoord(X, Y).Y = 0 then FResizeFlag := true;

 inherited MouseDown(Button, Shift, X, Y);

end;


procedure TBitDBGrid.MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);

begin

 inherited MouseUp(Button, Shift, X, Y);

 if FResizeFlag then begin

  FResizeFlag := false;

  UpdateTitlesHeight;

 end;

end;


procedure TBitDBGrid.DrawCell(ACol, ARow: Longint; ARect: TRect; AState: TGridDrawState);

var

 Indicator : TBitmap;

 TitleText : string;

 Al : TAlignment;

begin

 if not ((gdFixed in AState) and ((ARow = 0) and (dgTitles in Options) and (ACol <> 0))) then

  inherited DrawCell(ACol, ARow, ARect, AState)

 else begin

  if DefaultDrawing then begin

   DrawEdge(Canvas.Handle, ARect, BDR_RAISEDINNER, BF_BOTTOMLEFT);

   DrawEdge(Canvas.Handle, ARect, BDR_RAISEDINNER, BF_TOPRIGHT);

   InflateRect(ARect, -1, -1);

   Canvas.Brush.Color := FixedColor;

   Canvas.FillRect(ARect);

  end;

  TitleText := Columns[ACol - 1].Title.Caption;

  if Assigned(OnDrawTitle) then OnDrawTitle(ACol, ARect, TitleText);

  if DefaultDrawing and (TitleText <> '') then begin

   Canvas.Brush.Style := bsClear;

   Canvas.Font := RealTitleFont;

   if ACol > 0 then Al := Columns[ACol - 1].Title.Alignment

   else Al := Columns[0].Title.DefaultAlignment;

   WriteText(Canvas, ARect, 2, 2, TitleText, Al);

  end;

 end;

end;


procedure TBitDBGrid.SetRealTitleFont(Value : TFont);

begin

 FRealTitleFont.Assign(Value);

 Repaint;

end;


procedure Register;

begin

 RegisterComponents('Andre VCL', [TBitDBGrid]);

end;


initialization

 DrawBitmap := TBitmap.Create;

finalization

 DrawBitmap.Free;

end

Несколько таблиц в одном TDBGrid

Delphi 1 

Насколько я знаю, единственное легкое решение заключается в использовании вычисляемых полей.

Для того, чтобы поместить данные из нескольких таблиц в один DBGrid, нужно воспользоваться объектом TQuery. На заметку: используйте TQuery в режиме только для чтения, если вы не можете обеспечить гарантию выполнения некоторых из его руководящих принципов, один из которых – данные могут быть получены только от одной таблицы.

Как сделать так, чтобы в DBGrid напротив некоторых строк можно было бы галочку поставить?

Nomadic советует:

Ну примерно так (лишнее мало-мало порезал, больно много его, но идея видна :) на сервере — тaблицa Advertis.DB, первичный ключ ID — autoincrement. На локальном диске — тaблицa Founds.DB, с полем Advertis: integer, по которому есть индекс, и tblFounds.IndexFieldNames = 'Advertis'.

На гриде:

=== cut ===

procedure TMainForm.dbgWorkDblClick(Sender: TObject);

begin

 TriggerRowSelection;

end;


procedure TMainForm.TriggerRowSelection;

begin

 if dmFile.AdvertisCount <> 0 then begin

  with dmFile do if not tblFounds.FindKey([tblAdvertisID.Value]) then begin

   tblFounds.AppendRecord([tblAdvertisID.Value]);

  end else begin

   tblFounds.Delete;

  end;

  dbgWork.Refresh;

 end;

end;


procedure TMainForm.dbgWorkDrawColumnCell(Sender: TObject; const Rect: TRect; DataCol: Integer; Column: TColumn; State: TGridDrawState);

begin

 if DataCol = 0 then with dmFile, dbgWork.Canvas do begin

  FillRect(Rect); {clear the cell}

  if tblFounds.FindKey([tblAdvertisID.Value]) then begin

   TextOut(Rect.Left, Rect.Top, '?');

  end else begin

   TextOut(Rect.Left, Rect.Top, 'o');

  end;

 end;

end;

=== cut ===

Оказывается, я переопределял рисование гридa, а не вычислял поле. Не помню точно, но кажется, чтобы не перечитывать таблицу на каждый даблклик, а только перерисовать грид.

А колонка для галки в гриде определялась так:

=== cut ===

with dmFile, dbgWork.Columns do begin

 BeginUpdate;

 Clear;

 {check mark}

 nc := Add;

 nc.Width := 14;

 nc.Font.Name := 'Wingdings';

 nc.Font.Size := 11;

 nc.Alignment := taRightJustify;

 nc.Title.Caption := 'y';

 nc.Title.Font.Name := 'Wingdings';

 nc.Title.Font.Size := 10;

 nc.Title.Alignment := taCenter;

 [skip определения остaльных колонок]

 EndUpdate;

end;

=== cut ===

Вроде всё.

Ну, как напечатать/обработать только помеченное, сам разберёшься. У меня там накручено чего-то с фильтрами, думаю, можно проще.

Что касается других способов – можно вместо временной тaблицы попользовать список, массив или in-memory table. 

Как в TDBGrid разрешить только операции UPDATE записей и запретить INSERT/DELETE?

Nomadic советует:

А я делаю так.

На DataSource, к которому прицеплен Grid, вешаю обработчик на событие OnStateChange.

Ниже текст типичного обработчика –

if DBGrid1.DataSource.DataSet.State in [dsEdit, dsInsert] then

DBGrid1.Options := DBGrid1.Options + goRowSelect

Перейти на страницу:
Прокомментировать
Подтвердите что вы не робот:*