Разные вопросы

Code:

table.first;

row := 0;

grid.rowcount := table.recordCount;

while not table.eof do

begin

for i := 0 to table.fieldCount-1 do

   grid.cells[i,row] := table.fields[i].asString;

inc (row);

table.next;

end;

Code:

if (GetWindowlong(Stringgrid1.Handle, GWL_STYLE) and WS_VSCROLL) <> 0 then

  ShowMessage('Vertical scrollbar is visible!');

if (GetWindowlong(Stringgrid1.Handle, GWL_STYLE) and WS_HSCROLL) <> 0 then

  ShowMessage('Horizontal scrollbar is visible!');

Code:

unit Unit1;

interface

uses

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

Dialogs, Grids;

type

TForm1 = class(TForm)

   StringGrid: TStringGrid;

   procedure FormCreate(Sender: TObject);

   procedure StringGridDrawCell(Sender: TObject; ACol, ARow: Integer;

     Rect: TRect; State: TGridDrawState);

end;

var

Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);

var

C, R: Integer;

begin

for C := 0 to StringGrid.ColCount - 1 do

   for R := 0 to StringGrid.RowCount - 1 do

     StringGrid.Cells[C, R] := 'A very very very long string';

end;

procedure TForm1.StringGridDrawCell(Sender: TObject; ACol, ARow: Integer;

Rect: TRect; State: TGridDrawState);

begin

if not (Sender is TStringGrid) then Exit;

with TStringGrid(Sender) do

begin

   Canvas.FillRect(Rect);

   DrawText(Canvas.Handle, PChar(Cells[ACol, ARow]), -1, Rect, DT_WORDBREAK);

end;

end;

end.

Code:

uses

  {...} Grids;

type

  TForm1 = class(TForm)

    StringGrid1: TStringGrid;

    procedure StringGrid1DrawCell(Sender: TObject; ACol, ARow: Integer;

      Rect: TRect; State: TGridDrawState);

  end;

{...}

implementation

{...}

// Display text vertically in StringGrid cells

// Vertikale Textausgabe in den Zellen eines StringGrid

procedure StringGridRotateTextOut(Grid: TStringGrid; ARow, ACol: Integer; Rect: TRect;

  Schriftart: string; Size: Integer; Color: TColor; Alignment: TAlignment);

var

  lf: TLogFont;

  tf: TFont;

begin

  // if the font is to big, resize it

// wenn Schrift zu gro? dann anpassen

if (Size > Grid.ColWidths[ACol] div 2) then

    Size := Grid.ColWidths[ACol] div 2;

  with Grid.Canvas do

  begin

    // Replace the font

   // Font setzen

   Font.Name := Schriftart;

    Font.Size := Size;

    Font.Color := Color;

    tf := TFont.Create;

    try

      tf.Assign(Font);

      GetObject(tf.Handle, SizeOf(lf), @lf);

      lf.lfEscapement  := 900;

      lf.lfOrientation := 0;

      tf.Handle := CreateFontIndirect(lf);

      Font.Assign(tf);

    finally

      tf.Free;

    end;

    // fill the rectangle

   // Rechteck fullen

   FillRect(Rect);

    // Align text and write it

   // Text nach Ausrichtung ausgeben

   if Alignment = taLeftJustify then

      TextRect(Rect, Rect.Left + 2,Rect.Bottom - 2,Grid.Cells[ACol, ARow]);

    if Alignment = taCenter then

      TextRect(Rect, Rect.Left + Grid.ColWidths[ACol] div 2 - Size +

        Size div 3,Rect.Bottom - 2,Grid.Cells[ACol, ARow]);

    if Alignment = taRightJustify then

      TextRect(Rect, Rect.Right - Size - Size div 2 - 2,Rect.Bottom -

        2,Grid.Cells[ACol, ARow]);

  end;

end;

// 2. Alternative: Display text vertically in StringGrid cells

// 2. Variante: Vertikale Textausgabe in den Zellen eines StringGrid

procedure StringGridRotateTextOut2(Grid:TStringGrid;ARow,ACol:Integer;Rect:TRect;

          Schriftart:String;Size:Integer;Color:TColor;Alignment:TAlignment);

var

    NewFont, OldFont : Integer;

    FontStyle, FontItalic, FontUnderline, FontStrikeout: Integer;

begin

   // if the font is to big, resize it

  // wenn Schrift zu gro? dann anpassen

  If (Size > Grid.ColWidths[ACol] DIV 2) Then

       Size := Grid.ColWidths[ACol] DIV 2;

   with Grid.Canvas do

   begin

       // Set font

      // Font setzen

      If (fsBold IN Font.Style) Then

          FontStyle := FW_BOLD

       Else

          FontStyle := FW_NORMAL;

       If (fsItalic IN Font.Style) Then

          FontItalic := 1

       Else

          FontItalic := 0;

       If (fsUnderline IN Font.Style) Then

          FontUnderline := 1

       Else

          FontUnderline := 0;

       If (fsStrikeOut IN Font.Style) Then

          FontStrikeout:=1

       Else

          FontStrikeout:=0;

       Font.Color := Color;

       NewFont := CreateFont(Size, 0, 900, 0, FontStyle, FontItalic,

                             FontUnderline, FontStrikeout, DEFAULT_CHARSET,

                             OUT_DEFAULT_PRECIS, CLIP_DEFAULT_PRECIS, DEFAULT_QUALITY,

                             DEFAULT_PITCH, PChar(Schriftart));

       OldFont := SelectObject(Handle, NewFont);

       // fill the rectangle

      // Rechteck fullen

      FillRect(Rect);

       // Write text depending on the alignment

      // Text nach Ausrichtung ausgeben

      If Alignment = taLeftJustify Then

          TextRect(Rect,Rect.Left+2,Rect.Bottom-2,Grid.Cells[ACol,ARow]);

       If Alignment = taCenter Then

          TextRect(Rect,Rect.Left+Grid.ColWidths[ACol] DIV 2 - Size + Size DIV 3,

            Rect.Bottom-2,Grid.Cells[ACol,ARow]);

       If Alignment = taRightJustify Then

          TextRect(Rect,Rect.Right-Size - Size DIV 2 - 2,Rect.Bottom-2,Grid.Cells[ACol,ARow]);

       // Recreate reference to the old font

      // Referenz auf alten Font wiederherstellen

      SelectObject(Handle, OldFont);

       // Recreate reference to the new font

      // Referenz auf neuen Font loschen

      DeleteObject(NewFont);

   end;

end;

// Call the method in OnDrawCell

// Methode im OnDrawCell aufrufen

procedure TForm1.StringGrid1DrawCell(Sender: TObject; ACol,

  ARow: Integer; Rect: TRect; State: TGridDrawState);

begin

  // In the second column: Rotate Text by 90° and left align the text

// Text um 90°gedreht ausgeben, linksbundig in der zweiten Spalte

if ACol = 1 then

    StringGridRotateTextOut(StringGrid1, ARow, ACol, Rect, 'ARIAL',

      12,clRed, taLeftJustify);

  // In the third column: Center the text

// Ausgabe zentriert in der dritten Spalte

if ACol = 2 then

    StringGridRotateTextOut(StringGrid1, ARow, ACol, Rect, 'ARIAL', 12, clBlue, taCenter);

  // In all other columns third row: right align the text

// Ausgabe rechtsbundig in den restlichen Spalten

if ACol > 2 then

    StringGridRotateTextOut(StringGrid1, ARow, ACol, Rect, 'ARIAL', 12,clGreen,

      taRightJustify);

end;

end.

Code:

procedure TForm1.Button1Click(Sender: TObject);

var K: Double;

begin

Printer.BeginDoc;

K :=  Printer.Canvas.Font.PixelsPerInch / Canvas.Font.PixelsPerInch*1.2;

PrintStringGrid(StrGrid,

K,  // Коэффициент

200, // отступ от края листа в пихелах по Х

200, // --"-- по Y

200 // отступ снизу

);

Printer.EndDoc;

end;

{----------------------------------------------------------}

unit GrdPrn3;

interface

uses

Windows, Classes, Graphics, Grids, Printers, SysUtils;

const

OrdinaryLineWidth: Integer = 2;

BoldLineWidth: Integer = 4;

procedure PrintStringGrid(Grid: TStringGrid; Scale: Double; LeftMargin,

TopMargin, BottomMargin:

Integer);

function DrawStringGridEx(Grid: TStringGrid; Scale: Double; FromRow,

LeftMargin, TopMargin, Yfloor: Integer; DestCanvas: TCanvas): Integer;

// возвращает номер строки, которая не поместилась до Y = Yfloor

// не проверяет, вылезает ли общая длина таблицы за пределы страницы

// Слишком длинное слово обрежется

implementation

procedure PrintStringGrid(Grid: TStringGrid; Scale: Double; LeftMargin,

TopMargin, BottomMargin: Integer);

var NextRow: Integer;

begin

//Printer.BeginDoc;

if not Printer.Printing then raise Exception.Create('function

PrintStringGrid must be called between Printer.BeginDoc

  and Printer.EndDoc');

NextRow := 0;

repeat

NextRow := DrawStringGridEx(Grid, Scale, NextRow, LeftMargin, TopMargin,

  Printer.PageHeight - BottomMargin, Printer.Canvas);

if NextRow <> -1 then Printer.NewPage;

until NextRow = -1;

//Printer.EndDoc;

end;

function DrawStringGridEx(Grid: TStringGrid; Scale: Double; FromRow,

LeftMargin, TopMargin, Yfloor: Integer; DestCanvas: TCanvas): Integer;

// возвращает номер строки, которая не поместилась до Y = Yfloor

var

i, j, d, TotalPrevH, TotalPrevW, CellH, CellW, LineWidth: Integer;

R: TRect;

s: string;

procedure CorrectCellHeight(ARow: Integer);

// вычисление правильной высоты ячейки с учетом многострочного текста

// Текст рабивается только по словам слишком длинное слово обрубается

var

  i, H: Integer;

  R: TRect;

  s: string;

begin

  R := Rect(0, 0, CellH*2, CellH);

  s := ':)'; // Одинарная высота строки

  CellH := DrawText(DestCanvas.Handle, PChar(s), Length(s), R,

    DT_LEFT or DT_TOP or DT_WORDBREAK or DT_SINGLELINE or

    DT_NOPREFIX or DT_CALCRECT) + 3*d;

  for i := 0 to Grid.ColCount-1 do

  begin

   CellW := Round(Grid.ColWidths[i]*Scale);

   R := Rect(0, 0, CellW, CellH);

   //InflateRect(R, -d, -d);

   R.Left := R.Left+d;

   R.Top := R.Top + d;

   s := Grid.Cells[i, ARow];

   // Вычисление ширины и высоты

   H := DrawText(DestCanvas.Handle, PChar(s), Length(s), R,

    DT_LEFT or DT_TOP or DT_WORDBREAK or DT_NOPREFIX or DT_CALCRECT);

текста

   if CellH < H + 2*d then CellH := H + 2*d;

   // if CellW < R.Right - R.Left then Слишком длинное слово -

   // не помещается в одну строку; Перенос слов не поддерживается

  end;

end;

begin

Result := -1; // все строки уместились между TopMargin и Yfloor

if (FromRow < 0)or(FromRow >= Grid.RowCount) then Exit;

DestCanvas.Brush.Style := bsClear;

DestCanvas.Font := Grid.Font;

//  DestCanvas.Font.Height := Round(Grid.Font.Height*Scale);

DestCanvas.Font.Size := 10;

Grid.Canvas.Font := Grid.Font;

Scale := DestCanvas.TextWidth('test')/Grid.Canvas.TextWidth('test');

d := Round(2*Scale);

TotalPrevH := 0;

for j := 0 to Grid.RowCount-1 do

begin

if (j >= Grid.FixedRows) and (j < FromRow) then Continue;

// Fixed Rows рисуются на каждой странице

TotalPrevW := 0;

CellH := Round(Grid.RowHeights[j]*Scale);

CorrectCellHeight(j);

if TopMargin + TotalPrevH + CellH > YFloor then

begin

  Result := j; // j-я строка не помещается в заданный диапазон

  if Result < Grid.FixedRows then Result := -1;

  // если фиксированные строки не влезают на страницу -

  // это тяж?лый случай...

  Exit;

end;

for i := 0 to Grid.ColCount-1 do

begin

  CellW := Round(Grid.ColWidths[i]*Scale);

  R := Rect(TotalPrevW, TotalPrevH, TotalPrevW + CellW,

    otalPrevH + CellH);

  OffSetRect(R, LeftMargin, TopMargin);

  if (i < Grid.FixedCols)or(j < Grid.FixedRows) then

    LineWidth := BoldLineWidth

  else

    LineWidth := OrdinaryLineWidth;

  DestCanvas.Pen.Width := LineWidth;

  if LineWidth > 0 then

   DestCanvas.Rectangle(R.Left, R.Top, R.Right+1, R.Bottom+1);

  //InflateRect(R, -d, -d);

  R.Left := R.Left+d;

  R.Top := R.Top + d;

  s := Grid.Cells[i, j];

  DrawText(DestCanvas.Handle, PChar(s), Length(s), R,

   DT_LEFT or DT_TOP or DT_WORDBREAK or DT_NOPREFIX);

  TotalPrevW := TotalPrevW + CellW; // Общая ширина всех предыдущих колонок

end;

TotalPrevH := TotalPrevH + CellH;  // Общая высота всех предыдущих строк

end;

end;

end.

Code:

procedure TForm1.DrawGrid1DrawCell(Sender: TObject; Col, Row: Longint;

Rect: TRect; State: TGridDrawState);

var

vRow, vCol: LongInt;

begin

vRow := Row;

vCol := Col;

with Sender as TDrawGrid, Canvas do

begin

   if (vRow = 0) or (vCol = 0) then

     Font.Color := clBlack

   else

     Font.Color := clRed;

   TextRect(Rect, Rect.Left, Rect.Top, Format('(%d,%d)', [vRow, vCol]));

end;

end;

Code:

// Getting a TScrollbar control to Show a proportional thumb:

procedure TForm1.Button1Click(Sender: TObject);

var

  info: TScrollInfo;

begin

  FillChar(info, SizeOf(info), 0);

  with info do

  begin

    cbsize := SizeOf(info);

    fmask  := SIF_PAGE;

    nPage  := ScrollBar1.LargeChange;

  end;

  SetScrollInfo(ScrollBar1.Handle, SB_CTL, info, True);

end;

// Same for a TStringGrid

procedure TForm1.Button1Click(Sender: TObject);

var

  info: TScrollInfo;

begin

  FillChar(info, SizeOf(info), 0);

  with info do

  begin

    cbsize := SizeOf(info);

    fmask  := SIF_ALL;

    GetScrollInfo(StringGrid1.Handle, SB_VERT, info);

    fmask := fmask or SIF_PAGE;

    nPage := 5 * (nmax - nmin) div StringGrid1.RowCount;

    // whatever number of cells you consider a "page"

end;

  SetScrollInfo(StringGrid1.Handle, SB_VERT, info, True);

end;