uses
StrUtils, Math;
type
TThickness = -1 .. +1;
const
cGBGridList: array [TThickness, TThickness, TThickness, TThickness] of WideString =
(((('┼', '├', '┽'), ('┴', '└', '┵'), ('╁', '┟', '╅')), (('┤', '│', '┥'), ('┘', '↑', '┙'), ('┧', '︾', '┪')),
(('┾', '┝', '┿'), ('┶', '┕', '┷'), ('╆', '┢', '╈'))), ((('┬', '┌', '┭'), ('─', '→', '《'), ('┰', '┎', '┱')),
(('┐', '↓', '┑'), ('←', ' ', '＜'), ('┒', '∨', '┓')), (('┮', '┍', '┯'), ('》', '＞', '━'), ('┲', '┏', '┳'))),
((('╀', '┞', '╃'), ('┸', '┖', '┹'), ('╂', '┠', '╉')), (('┦', '︽', '┩'), ('┚', '∧', '┛'), ('┨', '┃', '┫')),
(('╄', '┡', '╇'), ('┺', '┗', '┻'), ('╊', '┣', '╋'))));
function Iif(mBool: Boolean; mDataA, mDataB: Variant): Variant;
begin
if mBool then
Result := mDataA
else
Result := mDataB;
end;
function StringAlign(mStr: string; mLength: Integer; mAlignment: TAlignment; mBackChar: Char = #32): string;
var
L: Integer;
T: string;
begin
Result := mStr;
L := Length(mStr);
if L >= mLength then
Exit;
T := DupeString(mBackChar, mLength - L);
case mAlignment of
taLeftJustify:
Result := Result + T;
taRightJustify:
Result := T + Result;
taCenter:
begin
L := Length(T) div 2;
Result := Copy(T, 1, L) + Result + Copy(T, L + 1, MaxInt);
end;
end;
end;
function DBGridToGBGrid(mDBGrid: TDBGrid; mStrings: TStrings; mStat: Boolean; mBackChar: Char = #32): Boolean;
var
vHead, vBody, vBottom, T: WideString;
vMaxWidths: array of Integer;
vColumnCount: Integer;
vBookmark: string;
I, J: Integer;
V: TThickness;
begin
Result := False;
if not Assigned(mStrings) then
Exit;
if not Assigned(mDBGrid) then
Exit;
if not Assigned(mDBGrid.DataSource) then
Exit;
if not Assigned(mDBGrid.DataSource.DataSet) then
Exit;
if not mDBGrid.DataSource.DataSet.Active then
Exit;
V := Iif(dgColLines in mDBGrid.Options, -1, 00);
vBookmark := mDBGrid.DataSource.DataSet.Bookmark;
mDBGrid.DataSource.DataSet.DisableControls;
try
vColumnCount := 0;
for I := 0 to mDBGrid.Columns.Count - 1 do
if mDBGrid.Columns[I].Visible then
begin
Inc(vColumnCount);
SetLength(vMaxWidths, vColumnCount);
if dgTitles in mDBGrid.Options then
vMaxWidths[vColumnCount - 1] := Length(mDBGrid.Columns[I].Title.Caption)
else
vMaxWidths[vColumnCount - 1] := 0;
if Odd(vMaxWidths[vColumnCount - 1]) then
Inc(vMaxWidths[vColumnCount - 1]);
end;
if vColumnCount <= 0 then
Exit;
mStrings.Clear;
mDBGrid.DataSource.DataSet.First;
while not mDBGrid.DataSource.DataSet.Eof do
begin
J := 0;
for I := 0 to mDBGrid.Columns.Count do
if mDBGrid.Columns[I].Visible then
begin
vMaxWidths[J] := Max(vMaxWidths[J], Length(mDBGrid.Columns[I].Field.DisplayText));
if Odd(vMaxWidths[J]) then
Inc(vMaxWidths[J]);
Inc(J);
if J >= vColumnCount then
Break;
end;
mDBGrid.DataSource.DataSet.Next;
end;
if mStat then
vHead := cGBGridList[00, +1, 00, +1]
else
vHead := cGBGridList[00, +1, +1, 00];
if mStat then
vBody := cGBGridList[00, -1, 00, -1]
else
vBody := cGBGridList[+1, -1, +1, 00];
if mStat then
vBottom := cGBGridList[00, +1, 00, +1]
else
vBottom := cGBGridList[+1, +1, 00, 00];
for I := 0 to vColumnCount - 1 do
begin
vHead := vHead + DupeString(cGBGridList[00, +1, 00, +1], vMaxWidths[I] div 2);
vBody := vBody + DupeString(cGBGridList[00, -1, 00, -1], vMaxWidths[I] div 2);
vBottom := vBottom + DupeString(cGBGridList[00, +1, 00, +1], vMaxWidths[I] div 2);
if I < vColumnCount - 1 then
begin
vHead := vHead + cGBGridList[00, +1, V, +1];
vBody := vBody + cGBGridList[V, -1, V, -1];
vBottom := vBottom + cGBGridList[V, +1, 00, +1];
end;
end;
if mStat then
vHead := vHead + cGBGridList[00, +1, 00, +1]
else
vHead := vHead + cGBGridList[00, 00, +1, +1];
if mStat then
vBody := vBody + cGBGridList[00, -1, 00, -1]
else
vBody := vBody + cGBGridList[+1, 00, +1, -1];
if mStat then
vBottom := vBottom + cGBGridList[00, +1, 00, +1]
else
vBottom := vBottom + cGBGridList[+1, 00, 00, +1];
mStrings.Add(vHead);
if dgTitles in mDBGrid.Options then
begin
if mStat then
T := cGBGridList[00, 00, 00, 00]
else
T := cGBGridList[+1, 00, +1, 00];
J := 0;
for I := 0 to mDBGrid.Columns.Count - 1 do
if mDBGrid.Columns[I].Visible then
begin
T := T + StringAlign(mDBGrid.Columns[I].Title.Caption, vMaxWidths[J], mDBGrid.Columns[I].Alignment,
mBackChar);
Inc(J);
if J >= vColumnCount then
Break;
T := T + cGBGridList[V, 00, V, 00];
end;
if mStat then
T := T + cGBGridList[00, 00, 00, 00]
else
T := T + cGBGridList[+1, 00, +1, 00];
mStrings.Add(T);
mStrings.Add(vBody);
end;
mDBGrid.DataSource.DataSet.First;
while not mDBGrid.DataSource.DataSet.Eof do
begin
if (dgRowLines in mDBGrid.Options) and (not mDBGrid.DataSource.DataSet.Bof) then
mStrings.Add(vBody);
if mStat then
T := cGBGridList[00, 00, 00, 00]
else
T := cGBGridList[+1, 00, +1, 00];
J := 0;
for I := 0 to mDBGrid.Columns.Count - 1 do
if mDBGrid.Columns[I].Visible then
begin
T := T + StringAlign(mDBGrid.Columns[I].Field.DisplayText, vMaxWidths[J],
mDBGrid.Columns[I].Alignment, mBackChar);
Inc(J);
if J >= vColumnCount then
Break;
T := T + cGBGridList[V, 00, V, 00];
end;
if mStat then
T := T + cGBGridList[00, 00, 00, 00]
else
T := T + cGBGridList[+1, 00, +1, 00];
mStrings.Add(T);
mDBGrid.DataSource.DataSet.Next;
end;
mStrings.Add(vBottom);
finally
mDBGrid.DataSource.DataSet.Bookmark := vBookmark;
mDBGrid.DataSource.DataSet.EnableControls;
vMaxWidths := nil;
end;
Result := True;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
DBGridToGBGrid(DBGrid1, Memo1.Lines, CheckBox1.Checked);
end;
procedure TForm1.MenuItemShowColLinesClick(Sender: TObject);
begin
if TMenuItem(Sender).Checked then
begin
TMenuItem(Sender).Checked := False;
DBGrid1.Options := DBGrid1.Options - [dgColLines];
end
else
begin
TMenuItem(Sender).Checked := True;
DBGrid1.Options := DBGrid1.Options + [dgColLines];
end;
end;
procedure TForm1.MenuItemShowRowLinesClick(Sender: TObject);
begin
if TMenuItem(Sender).Checked then
begin
TMenuItem(Sender).Checked := False;
DBGrid1.Options := DBGrid1.Options - [dgRowLines];
end
else
begin
TMenuItem(Sender).Checked := True;
DBGrid1.Options := DBGrid1.Options + [dgRowLines];
end;
end;
procedure TForm1.MenuItemShowTitlesClick(Sender: TObject);
begin
if TMenuItem(Sender).Checked then
begin
TMenuItem(Sender).Checked := False;
DBGrid1.Options := DBGrid1.Options - [dgTitles];
end
else
begin
TMenuItem(Sender).Checked := True;
DBGrid1.Options := DBGrid1.Options + [dgTitles];
end;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
ADOTable1.Open;
MenuItemShowColLines.Checked := dgColLines in DBGrid1.Options;
MenuItemShowRowLines.Checked := dgRowLines in DBGrid1.Options;
MenuItemShowTitles.Checked := dgTitles in DBGrid1.Options;
end;