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

• Название: Советы по Delphi. Версия 1.4.3 от 1.1.2001
• Автор: Валентин Озеров
• Жанр: Программирование

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

---

  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