HeidiSQL/source/printlist.pas

unit printlist;


// -------------------------------------
// Print TListView-Content
// -------------------------------------


interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, printers, comctrls, ExtCtrls;

type
  TprintlistForm = class(TForm)
    ComboBoxPrinters: TComboBox;
    Button1: TButton;
    GroupBox1: TGroupBox;
    Button2: TButton;
    Button3: TButton;
    PrinterSetupDialog1: TPrinterSetupDialog;
    CheckBox1: TCheckBox;
    Image1: TImage;
    procedure FormShow(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure CheckBox1Click(Sender: TObject);
    procedure ComboBoxPrintersChange(Sender: TObject);
  private
    list : TListView;
    title : String;
    { Private declarations }
  public
    { Public declarations }
  end;

  function printlistWindow(AOwner: TComponent): Boolean;

implementation

uses childwin, main;

{$R *.DFM}

{**
  Create form on demand
  @param TComponent Owner of form (should be calling form)
  @return Boolean Form closed using modalresult mrOK
}
function printlistWindow(AOwner: TComponent): Boolean;
var
  f : TprintlistForm;
begin
  f := TprintlistForm.Create(AOwner);
  Result := (f.ShowModal=mrOK);
  FreeAndNil(f);
end;


procedure TprintlistForm.FormShow(Sender: TObject);
var
  i,t : Integer;
  cwin : TMDIChild;
begin
  // show!
  Screen.Cursor := crHourGlass;
  ComboBoxPrinters.Items := Printer.printers;
  ComboBoxPrinters.ItemIndex := Printer.printerIndex;

  cwin := Mainform.ChildWin;

  // which ListView to print?
  case cwin.PageControlMain.ActivePageIndex of
    0 : case cwin.PageControlHost.ActivePageIndex of
//      0 : begin list := cwin.ListVariables; title := 'Server-Variables for ' + cwin.Conn.MysqlParams.Host; end;
      1 : begin list := cwin.ListProcesses; title := 'Processlist for ' + cwin.Conn.MysqlParams.Host; end;
      2 : begin list := cwin.ListCommandStats; title := 'Command-statistics for ' + cwin.Conn.MysqlParams.Host; end;
      end;
    1 : begin list := cwin.ListTables; title := 'Tables-List for Database ' + cwin.ActualDatabase; end;
    2 : begin list := cwin.ListColumns; title := 'Field-List for ' + cwin.ActualDatabase + '/' + cwin.ActualTable; end;
  end;
  caption := 'Print ' + title + '...';

  // delete all CheckBoxes
  for i:=ComponentCount-1 downto 0 do begin
    if Components[i].tag = 1 then
      Components[i].free;
  end;


  // add one CheckBox per list-column
  t := 2;
  CheckBox1.Checked := true;
  for i:=0 to list.Columns.count-1 do begin
    with TCheckBox.Create(self) do begin
      parent := GroupBox1;
      Caption := list.Columns[i].Caption;
      checked := true;
      enabled := false;
      if i mod 2 = 0 then begin
        inc(t);
        left := 16;
      end
      else
        left := 130;
      top := t * 23;
      tag := 1;
    end;
  end;
  Screen.Cursor := crDefault;
end;

procedure TprintlistForm.Button1Click(Sender: TObject);
begin
  Screen.Cursor := crHourglass;
  printerSetupDialog1.Execute;
  ComboBoxPrinters.ItemIndex := Printer.PrinterIndex;
  Screen.Cursor := crDefault;
end;

procedure TprintlistForm.Button2Click(Sender: TObject);
begin
  close;
end;


procedure TprintlistForm.Button3Click(Sender: TObject);
var
  lspace, rspace, i, j, k, limiter, breite, hoehe, colwidth : Integer;
  Cols : TStringList;
  str  : String;
begin
  // print!
  Screen.Cursor := crHourglass;

  Cols := TStringList.Create;
  for i:=0 to list.Columns.Count-1 do begin
    for j:=0 to ComponentCount-1 do if (Components[j].tag = 1) then begin
      if ((Components[j] as TCheckBox).caption = list.columns[i].Caption) and
        ((Components[j] as TCheckBox).checked)
         then
        Cols.add(list.columns[i].Caption);
    end;
  end;

  lspace := 200;
  rspace := 100;
  Printer.Title := APPNAME + ': ' + Title;
  Printer.BeginDoc;

  with Printer.Canvas do begin
    SetMapMode(handle, MM_LOMETRIC);
    Font.Name := 'Arial';
    SetTextAlign(handle, TA_LEFT+TA_TOP);

    // 1/10 mm
    breite := getdeviceCaps(handle, horzsize) * 10;
    hoehe := getdeviceCaps(handle, vertsize) * 10;
    colwidth := (breite - lspace - rspace) div Cols.Count;

    Font.Height := 40;
    Font.Style := [fsBold];
    TextOut(lspace, -100, APPNAME + ': ' + title);
    Font.Height := 30;

    // print columns
    Pen.Color := clWhite;
    Brush.Color := clLtGray;
    Rectangle(lspace, -300, breite - rspace, -350);
    Pen.Color := clBlack;
    MoveTo(lspace, -300);
    LineTo(breite - rspace, -300);
    for i:=0 to Cols.Count-1 do
      TextOut(lspace + i*colwidth, -310, Cols[i]);
    MoveTo(lspace, -350);
    LineTo(breite - rspace, -350);
    Brush.Color := clWhite;
    TextOut(lspace, -(hoehe-50), 'Page ' + inttostr(printer.PageNumber));

    // print lines
    Font.Style := [];
    limiter := 0;
    for i:=0 to list.Items.count-1 do begin
      if ((i-limiter) * 50 + 360 + 100) > hoehe then begin
        printer.NewPage;
        TextOut(lspace, -(hoehe-50), 'Page ' + inttostr(printer.PageNumber));
        limiter := i;
      end;
      MoveTo(lspace, -((i-limiter) * 50 + 365 + font.Height));
      LineTo(breite - rspace, -((i-limiter) * 50 + 365 + font.Height));

      for j:=0 to Cols.count-1 do begin
        for k:=0 to list.columns.count-1 do begin
          if list.columns[k].Caption = Cols[j] then begin
            if k = 0 then
              str := list.Items[i].Caption
            else if list.items[i].subitems.count >= k then
              str := list.items[i].SubItems[k-1]
            else
              str := '';
          end;
        end;
        TextOut(lspace + j*colwidth, -((i - limiter) * 50 + 360), str)
      end;

    end;

  end;
  Printer.EndDoc;
  Screen.Cursor := crDefault;
  close;
end;



procedure TprintlistForm.CheckBox1Click(Sender: TObject);
var i : Integer;
begin
  // toggle checkboxes-enabled
  for i:=ComponentCount-1 downto 0 do begin
    if Components[i].tag = 1 then begin
      (Components[i] as TCheckBox).enabled := not CheckBox1.checked;
      if CheckBox1.checked then
        (Components[i] as TCheckBox).checked := true;
    end;
  end;
end;


procedure TprintlistForm.ComboBoxPrintersChange(Sender: TObject);
begin
  // chose printer
  Screen.Cursor := crHourglass;
  Printer.PrinterIndex := ComboBoxPrinters.ItemIndex;
  Screen.Cursor := crDefault;
end;

end.