String Grid ve rapor

[ASE]

Arkadaşlar merhaba
Benim bir string gridim var
İçerisindeki satır ve sütun sayısı değişken
ve benim bu griddeki bilgiyi kağıda aktarmam gerekiyor.
Aklıma hiçbir şey gelmiyor ufak bir ipucu lütfen...
Kolay gelsin...

[husonet]

Merhaba,

İlk önce kullandığımız Unit'e Printers untini ekleyiniz.

Örnek bir kod

Kod: Tümünü seç

type 
  TForm1 = class(TForm) 
    Button1: TButton; 
    StringGrid1: TStringGrid; 
    procedure Button1Click(Sender: TObject); 
    procedure FormCreate(Sender: TObject); 
  private 
    { Private deklerasyonlar }   
  public 
    { Public deklerasyonlar  } 
  end; 

procedure TForm1.FormCreate(Sender: TObject); 
begin 
   
{ stringgrid imizi editing konumuna alalım } 
  StringGrid1.Options := StringGrid1.Options + 
                         [goEditing]; 

   
{ String grid i en iyi yüksekliğe ayarlayalım. } 
  StringGrid1.DefaultRowHeight := 20; 

{ Fixed satırları silelim } 
  StringGrid1.FixedCols := 0; 

{ Kolan sayımızı verelim } 
  StringGrid1.ColCount := 3; 

{Kolon başlıklarını verelim } 

  StringGrid1.Cells[0,0] := 'ADI'; 
  StringGrid1.Cells[1,0] := 'SOY ADI'; 
  StringGrid1.Cells[2,0] := 'SOY MESLEGI ??'; 
end; 



procedure TForm1.Button1Click(Sender: TObject); 
var 
  MyTextFile     : TextFile; 
  tmpStr,OldFont : String; 
  x              : Integer; 
begin 


  { Default yazıcıyı set le } 
  Printer.PrinterIndex := -1; 

{ Yazıcının eski fontunu kaydet. Aman kaybetmiyelim,lazım olacak bu bize } 
  OldFont := Printer.Canvas.Font.Name; 

{ Yazılacak fontu seçelim. Bence bu en iyisi. Bi numara valla, courier. müthiş. }   
Printer.Canvas.Font.Name := 'Courier New'; 

{Şu bizim dosyayı yazıcıya atayalım.} 
  AssignPrn(MyTextFile); 

  try 
{ Textfile ımızı şeydelim } 
    Rewrite(MyTextFile); 

    { Başlıkları formatlayalım ve yazdıralım dosyaya }       
    tmpStr := Format('%-20.20s %-20.20s %-20.20s', 
                     [StringGrid1.Cells[0,0], 
                      StringGrid1.Cells[1,0], 
                      StringGrid1.Cells[2,0]]); 
    Writeln(MyTextFile, tmpStr); 

{ satır ve kolon arasındaki bölücülere ( seperator ) format verelim ve yazsın onları } 

    tmpStr := Format('%-20.20s %-20.20s %-20.20s', 
                     ['--------------------', 
                      '--------------------', 
                      '--------------------']); 
    Writeln(MyTextFile, tmpStr); 

    for x := 1 to StringGrid1.RowCount - 1 do 
    begin 

{ yazılacak satır ve sütunlara format verelim } 
      tmpStr := Format('%-20.20s %-20.20s %-20.20s', 
                       [StringGrid1.Cells[0,x], 
                        StringGrid1.Cells[1,x], 
                        StringGrid1.Cells[2,x]]); 
      Writeln(MyTextFile, tmpStr); 
    end; 
  finally 

{ Dosyamızı kapatalım, üşütmesin } 
    CloseFile(MyTextFile); 

{ Yazıcının eski fontunu eski haline çevirelim} 
    { reset the printers font name } 
    Printer.Canvas.Font.Name := OldFont; 
  end; 
end; 

Kolay Gelsin...

[ASE]

Merhaba.
husonet sağolun kod çok işe yaradı.
Aslında ben hazır kod istemedim sadece bir ip ucu istedim sağolun bir üniti göndermişsiniz ipucundan çok daha fazla işe yaradı.
Şimdi bir iki problem daha var
1. Kağıda yapay yapmayı başaramadım.
2. ben kodun yeni halini aşağıda gönderiyorum Burada kayıt sayısı kadar yeni satır ve sütun oluşturuyorum ancak separator ve boşlukları bu sayılar kadar artırmayı başaramadım.
Bu konuda da ufak bir yardım gelebilirse çok mutlu olcağım.
Herkese kolay gelsin.....

Kod: Tümünü seç

PROCEDURE Tblokaj_f.Button4Click(Sender: TObject);
var
MyTextFile : TextFile;
tmpStr,OldFont : String;
x : Integer;
begin


Printer.PrinterIndex := -1;
OldFont := Printer.Canvas.Font.Name;
Printer.Canvas.Font.Name := 'Courier New';
AssignPrn(MyTextFile);
try
Rewrite(MyTextFile);
tmpStr := Format('%-10.12s %-10.12s %-10.12s %-10.12s %-10.12s %-10.12s %-10.12s %-10.12s ',
['|'+Grid1.Cells[0,0],
'|'+Grid1.Cells[1,0],
'|'+Grid1.Cells[2,0],
'|'+Grid1.Cells[3,0],
'|'+Grid1.Cells[4,0],
'|'+Grid1.Cells[5,0],
'|'+Grid1.Cells[6,0],
'|'+Grid1.Cells[7,0]]);
Writeln(MyTextFile, tmpStr);

tmpStr := Format('%-10.12s %-10.12s %-10.12s %-10.12s %-10.12s %-10.12s %-10.12s %-10.12s ',
['------------',
 '-----------',
 '-----------',
 '-----------',
 '-----------',
 '-----------',
 '-----------',
 '-----------']);
Writeln(MyTextFile, tmpStr);

for x := 1 to Grid1.RowCount - 1 do
begin
 
 tmpStr := Format('%-10.12s %-10.12s %-10.12s %-10.12s %-10.12s %-10.12s %-10.12s %-10.12s ',
['|'+Grid1.Cells[0,X],
'|'+Grid1.Cells[1,X],
'|'+Grid1.Cells[2,X],
'|'+Grid1.Cells[3,X],
'|'+Grid1.Cells[4,X],
'|'+Grid1.Cells[5,X],
'|'+Grid1.Cells[6,X],
'|'+Grid1.Cells[7,X]]);
Writeln(MyTextFile, tmpStr);


tmpStr := Format('%-10.12s %-10.12s %-10.12s %-10.12s %-10.12s %-10.12s %-10.12s %-10.12s ',
['------------',
 '-----------',
 '-----------',
 '-----------',
 '-----------',
 '-----------',
 '-----------',
 '-----------']);
Writeln(MyTextFile, tmpStr);
end;
finally
CloseFile(MyTextFile);
Printer.Canvas.Font.Name := OldFont;
end;
end;

[husonet]

Merhaba,

Aşağıdaki adrese bak işine yarayabilecek bir şeyler olabilir.
http://www.code4sale.com/joehecht/PrnUtils-Delphi.htm


Kolay Gelsin...

[ASE]

Sağolun bütün problem istediğim gibi çözüldü.
Yardımlarınız için şağolun
Kolay gelsin.

[husonet]

Probleminizin çözüldüğüne sevindim bu konuda bizi bilgilendirmeniz de çok güzel. Yalnız problemi nasıl hallettiğinizi de yazsarsanız başkalarıda yararlanabilir.

İyi Geceler.

[ASE]

Problem aslında sizin gönderdiğiniz kodla çözülmedi işin doğrusu ancak bana yol gösterme açısından çok işe yaradı. Bu kodla 2 gün uğraştıktan sonra (uygun değişkenleri atayabilmek için) tam olarak olmayacağına karar verdik. Daha sonra Almanyadan bir arkadaş bir pas dosyası gönderdi. Bütün gridi satır ve sütun sayısına bakmadan yatay ve dikey kağıt ayarı yapmamıza imkan veren bir şekilde yazdırmamızı sağladı.
Şu an dosya elimde değil. İnşallah kodları buraya atacağım
Sağolun KOlay gelsin...

[husonet]

Arkadaşınızın göndermiş olduğu Pas dosyası ilgimi çekti sabırsızlıkla bekleyeceğim.


Teşekkür Ederim.

İyi Akşamlar.

[ASE]

Bu kod direk yazıcıya atıyor...

Kod: Tümünü seç

procedure PrintStringGrid(Grid: TStringGrid; Title: string;
  Orientation: TPrinterOrientation);
var
  P, I, J, YPos, XPos, HorzSize, VertSize: Integer;
  AnzSeiten, Seite, Zeilen, HeaderSize, FooterSize, ZeilenSize, FontHeight: Integer;
  mmx, mmy: Extended;
  Footer: string;
begin
  //Kopfzeile, Fußzeile, Zeilenabstand, Schriftgröße festlegen
  HeaderSize := 100;
  FooterSize := 200;
  ZeilenSize := 36;
  FontHeight := 36;
  //Printer initializieren
  Printer.Orientation := Orientation;
  Printer.Title := Title;
  Printer.BeginDoc;
  //Druck auf mm einstellen
  mmx := GetDeviceCaps(Printer.Canvas.Handle, PHYSICALWIDTH) /
    GetDeviceCaps(Printer.Canvas.Handle, LOGPIXELSX) * 25.4;
  mmy := GetDeviceCaps(Printer.Canvas.Handle, PHYSICALHEIGHT) /
    GetDeviceCaps(Printer.Canvas.Handle, LOGPIXELSY) * 25.4;

  VertSize := Trunc(mmy) * 10;
  HorzSize := Trunc(mmx) * 10;
  SetMapMode(Printer.Canvas.Handle, MM_LOMETRIC);

  //Zeilenanzahl festlegen
  Zeilen := (VertSize - HeaderSize - FooterSize) div ZeilenSize;
  //Seitenanzahl ermitteln
  if Grid.RowCount mod Zeilen <> 0 then
    AnzSeiten := Grid.RowCount div Zeilen + 1
  else
    AnzSeiten := Grid.RowCount div Zeilen;

  Seite := 1;
  //Grid Drucken
  for P := 1 to AnzSeiten do
  begin
    //Kopfzeile
    Printer.Canvas.Font.Height := 48;
    Printer.Canvas.TextOut((HorzSize div 2 - (Printer.Canvas.TextWidth(Title) div 2)),
      -20, Title);
    Printer.Canvas.Pen.Width := 5;
    Printer.Canvas.MoveTo(0, -HeaderSize);
    Printer.Canvas.LineTo(HorzSize, -HeaderSize);
    //Fußzeile
    Printer.Canvas.MoveTo(0, -VertSize + FooterSize);
    Printer.Canvas.LineTo(HorzSize, -VertSize + FooterSize);
    Printer.Canvas.Font.Height := 36;
    Footer := 'Sayfa : ' + IntToStr(Seite) + '    Toplam:' + IntToStr(AnzSeiten);
    Printer.Canvas.TextOut((HorzSize div 2 - (Printer.Canvas.TextWidth(Footer) div 2)),
      -VertSize + 150, Footer);
    //Zeilen drucken
    Printer.Canvas.Font.Height := FontHeight;
    YPos := HeaderSize + 10;
    for I := 1 to Zeilen do
    begin
      if Grid.RowCount >= I + (Seite - 1) * Zeilen then
      begin
        XPos := 0;
        for J := 0 to Grid.ColCount - 1 do
        begin
          Printer.Canvas.TextOut(XPos, -YPos,
            Grid.Cells[J, I + (Seite - 1) * Zeilen - 1]);
          XPos := XPos + Grid.ColWidths[J] * 3;
        end;
        YPos := YPos + ZeilenSize;
      end;
    end;
    //Seite hinzufügen
    Inc(Seite);
    if Seite <= AnzSeiten then Printer.NewPage;
  end;
  Printer.EndDoc;
end;

Bu kod da bir excel sayfası oluşturup griddeki bilgileri excele atıyor

Kod: Tümünü seç

function RefToCell(ARow, ACol: Integer): string;
begin
  Result := Chr(Ord('A') + ACol - 1) + IntToStr(ARow);
end;

function SaveAsExcelFile(AGrid: TStringGrid; ASheetName, AFileName: string): Boolean;
const
  xlWBATWorksheet = -4167;
var
  Row, Col: Integer;
  GridPrevFile: string;
  XLApp, Sheet, Data: OLEVariant;
  i, j: Integer;
begin
  // Prepare Data
  Data := VarArrayCreate([1, AGrid.RowCount, 1, AGrid.ColCount], varVariant);
  for i := 0 to AGrid.ColCount - 1 do
    for j := 0 to AGrid.RowCount - 1 do
      Data[j + 1, i + 1] := AGrid.Cells[i, j];
  // Create Excel-OLE Object
  Result := False;
  XLApp := CreateOleObject('Excel.Application');
  try
    // Hide Excel
    XLApp.Visible := False;
    // Add new Workbook
    XLApp.Workbooks.Add(xlWBatWorkSheet);
    Sheet := XLApp.Workbooks[1].WorkSheets[1];
    Sheet.Name := ASheetName;
    // Fill up the sheet
    Sheet.Range[RefToCell(1, 1), RefToCell(AGrid.RowCount,
      AGrid.ColCount)].Value := Data;
    // Save Excel Worksheet
    try
      XLApp.Workbooks[1].SaveAs(AFileName);
      Result := True;
    except
      // Error ?
    end;
  finally
    // Quit Excel
    if not VarIsEmpty(XLApp) then
    begin
      XLApp.DisplayAlerts := False;
      XLApp.Quit;
      XLAPP := Unassigned;
      Sheet := Unassigned;
    end;
  end;
end;

// Example:

procedure Tblokaj_f.Button6Click(Sender: TObject);
begin
    begin
    if SaveAsExcelFile(Grid1, 'ASE', '..\desktop\ASE.xls)
 then
        end; 
end;

Bazı değişkenler almanca
Vaktimiz olmadığından fazla dokunamadık
İnşallah başkalarınında işine yarar...

[husonet]

Teşekkürler.