Einzelnen Beitrag anzeigen

Finki

Registriert seit: 2. Jul 2013
120 Beiträge
 
FreePascal / Lazarus
 
#36

AW: Memo text ausdrucken

  Alt 3. Jul 2013, 14:57
Sodächen hier hammers ja


Delphi-Quellcode:
unit Text_U;


//Scrollen Hinzufügen
//Drucken


{$mode objfpc}{$H+}

interface

uses
Classes, SysUtils, FileUtil, PrintersDlgs, Forms, Controls, Graphics, Dialogs,
StdCtrls, ComCtrls, Buttons, EditBtn, ExtCtrls, PopupNotifier, Printers, Windows,
Menus, Grids;

type

{ TForm1 }

TForm1 = class(TForm)
btn1: TButton;
btnNeu: TSpeedButton;
ColorDialog1: TColorDialog;
Image1: TImage;
Memo: TMemo;
OpenDialog1: TOpenDialog;
btnEinfuegen: TSpeedButton;
OpenDialog2: TOpenDialog;
PopUp: TPopupNotifier;
PrintDialog1: TPrintDialog;
SaveDialog1: TSaveDialog;
btnOeffnen: TSpeedButton;
btnTxtFarbe: TSpeedButton;
btnSave: TSpeedButton;
btnPrint: TSpeedButton;
TabCon: TTabControl;
TBar: TToolBar;
procedure btn1Click(Sender: TObject);
procedure btnEinfuegenClick(Sender: TObject);
procedure btnNeuClick(Sender: TObject);
procedure btnOeffnenClick(Sender: TObject);
procedure btnSaveClick(Sender: TObject);
procedure btnTxtFarbeClick(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure btnPrintClick(Sender: TObject);
procedure TabConChange(Sender: TObject);

private
{ private declarations }
public
procedure Drucken(sl: TStrings);
{ public declarations }
end;

var
Form1: TForm1;
MyDataFile : string ;
MyDataFile2 : string ;
merk : boolean;
Printer: TPrinter;
implementation
uses
  Frage_U;
{$R *.lfm}

{ TForm1 }


//ERSTELLEN

procedure TForm1.FormCreate(Sender: TObject);
begin

merk:=false;

Memo.Caption := '';
Memo.SetBounds(0,TabCon.Height,Form1.Width,Form1.Height-TabCon.Height);
//TabCon
TabCon.SetBounds(0,0,Form1.Width,73);
TBar.SetBounds(0,0,Form1.Width,40);
//btn1
btn1.SetBounds(100,100,50,50);
btn1.Visible:=false;
//btnTxtFarbe
btnTxtFarbe.SetBounds(0,0,75,38);
btnTxtFarbe.Visible:=false;
btnTxtFarbe.Caption:='Farbe';
//btnEinfügen
btnEinfuegen.SetBounds(0,0,75,38);
btnEinfuegen.Visible:=false;
btnEinfuegen.Caption:='Bild';
//btnSave
btnSave.SetBounds(btnNeu.BoundsRect.Right+1,0,75,38);
//btnÖffnen
btnOeffnen.SetBounds(btnSave.BoundsRect.Right+1,0,75,38);
btnOeffnen.Caption:='Öffnen';
//btnPrint
btnPrint.SetBounds(btnOeffnen.BoundsRect.Right+1,0,75,38);
btnPrint.Caption:='Drucken';

end;
//DRUCKEN
procedure TForm1.btnPrintClick(Sender: TObject);
begin

Drucken(Memo.Lines);

end;


procedure TForm1.Drucken(sl: TStrings);
var zeile, x, y: integer;
breite, hoehe, randlinks, randoben: integer;
begin
if PrintDialog1.Execute then
begin
Printer.BeginDoc; //Druckjob beginnen
SetMapMode(Printer.Canvas.Handle, MM_LOMETRIC); //Umstellen auf 1/10 mm
//Schrift-Einstellungen:

Printer.Canvas.Font.Name:='Courier New';
Printer.Canvas.Brush.Color:=clWhite;
Printer.Canvas.Font.Height:=50; //5 mm

//Blattgöße in 1/10 mm ermitteln:
breite:=GetDeviceCaps(Printer.Canvas.Handle, HORZSIZE)*10;
hoehe:=GetDeviceCaps(Printer.Canvas.Handle, VERTSIZE)*10;
randlinks:=60; //0,6 cm
randoben:=150; //1,5 cm
x:=randlinks;
y:=randoben*-1;
for zeile:=0 to sl.Count-1 do
begin
if -y>(hoehe-2*randoben) then
begin
y:=randoben*-1;
Printer.NewPage;
end;
if y=-randoben then
begin
Printer.Canvas.Font.Style:=[fsbold];
Printer.Canvas.TextOut(x, y, 'Seite '+
IntToStr(Printer.PageNumber));
Printer.Canvas.Font.Style:=[];
y:=y-Printer.Canvas.TextHeight(sl[zeile]);
end;
Printer.Canvas.TextOut(x, y, sl[zeile]);
y:=y-Printer.Canvas.TextHeight(sl[zeile]);
end;
Printer.EndDoc;
end;
end;

//LEISTE

procedure TForm1.TabConChange(Sender: TObject);
begin

btnSave.Visible:=false;
btnNeu.Visible:=false;
btnEinfuegen.Visible:=false;
btnOeffnen.Visible:=false;
btnTxtFarbe.Visible:=false;
btnPrint.Visible:=false;

case TabCon.TabIndex of
0: begin
btnNeu.Visible:=true;
btnOeffnen.Visible:=true;
btnSave.Visible:=true;
btnPrint.Visible:=true;
end;
1: begin
btnEinfuegen.Visible:=true;
end;
2: begin
btnTxtFarbe.Visible:=true;
end;
end;
end;

//NEU

procedure TForm1.btnNeuClick(Sender: TObject);
var
Form2: TForm;
begin
//Form2 Erstellen
Form2 := TForm2.Create(Self);
try
//Wenn Memo vorhanden
if merk=false then

begin
Form2.ShowOnTop;
Form2.SetBounds(840-200,525-50,400,100);
Form1.Enabled:=false;
end
//Wenn Memo nicht vorhanden
else
begin
merk:=false;
Memo.Caption := '';
Memo.SetBounds(0,TabCon.Height,Form1.Width,Form1.Height-TabCon.Height);
end;
finally
end;
end;

//ÖFFNEN

procedure TForm1.btnOeffnenClick(Sender: TObject);
begin
//Nur .txt Dateien werden angezeigt
OpenDialog2.Filter := 'Text|*.txt' ;
//Öffnen befehl

if OpenDialog2.Execute then
begin
MyDataFile2 := OpenDialog2.FileName ;
end;

//Memo wird erstellt
Memo.SetBounds(0,Form1.Top-TabCon.BoundsRect.Bottom,Form1.Width,Form1.Height-TabCon.Height);
Memo.Lines.LoadFromFile(MyDataFile2);
merk:=false;
end;

//SAVE

procedure TForm1.btnSaveClick(Sender: TObject);
begin
SaveDialog1.Execute;
Memo.Lines.SaveToFile( Form1.SaveDialog1.Filename + '.txt');
end;

//FARBE

procedure TForm1.btnTxtFarbeClick(Sender: TObject);
begin
ColorDialog1.Execute;
// Memo.Font.Color:=ColorDialog1.Color;
end;

//BILD EINFÜGEN

procedure TForm1.btnEinfuegenClick(Sender: TObject);
var
Image: TImage;
begin
OpenDialog1.Filter := 'Bilder|*.jpg;*.png;*.jpeg;*.bmp' ;
if OpenDialog1.Execute then
begin
MyDataFile := OpenDialog1.FileName ;

Image:=TImage.Create(Self);
Image.Parent := Self;
Image.AutoSize:=true;
Image.Picture.LoadFromFile(MyDataFile);
Image.Enabled:=true;
end;
end;

//NOCH SINNLOSER BUTTON

procedure TForm1.btn1Click(Sender: TObject);
begin

end;

end.


{var
Button: TButton;
begin
Button:=TButton.Create(Self);
Button.Parent := Self;
Button.Caption := 'Alter Titel';
Button.Left := 100;
Button.Top := 100;
Button.OnClick := Button2Click;
end;    }

Delphi-Quellcode:
unit Frage_u;

{$mode objfpc}{$H+}

interface

usesClasses, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, StdCtrls, Buttons, EditBtn, ExtCtrls;
type
{ TForm2 }
TForm2 = class(TForm)btnNein: TSpeedButton;btnJa: TSpeedButton;
procedure btnJaClick(Sender: TObject);
procedure btnNeinClick(Sender: TObject);
procedure FormCreate(Sender: TObject);
private
{ private declarations }
public
{ public declarations }
end;

var
Form2: TForm2;
lblSpeichern: TLabel;

implementation
uses
Text_U;
{$R *.lfm}

{ TForm2 }

procedure TForm2.FormCreate(Sender: TObject);
begin
Form2.SetBounds(840-200,525-50,400,100);
// Form2.SetBounds(840-200,525-50,400,100);
Form2.Caption:='Speichern?';

lblSpeichern:=TLabel.Create(Self);
lblSpeichern.Parent := Self;
lblSpeichern.SetBounds(30,25,350,25);
lblSpeichern.Caption:='Sie hab noch ein Dokument offen. Wollen sie dieses zuerst speichern?';

btnJa.SetBounds(135,60,60,30);
btnJa.Caption:='&Ja';

btnNein.SetBounds(btnJa.BoundsRect.Right+10,60,60,30);
btnNein.Caption:='&Nein';

end;

procedure TForm2.btnNeinClick(Sender: TObject);
begin
// Form1 := TForm1.Can;
Form1.Enabled:=true;
Form1.ShowOnTop;
Close;
// Form2.Visible:=false;

end;

procedure TForm2.btnJaClick(Sender: TObject);
var
var1: integer;
begin

for var1:=1 to 1 do
begin
Form1.SaveDialog1.Execute;
Form1.Memo.Lines.SaveToFile( Form1.SaveDialog1.Filename + '.txt');
merk:=true;
end;

Form1.Memo.Caption:='';
Form1.Enabled:=true;
Form1.ShowOnTop;

merk:=false;
{  Form1.Memo:=TMemo.Create(Self);
Form1.Memo.Parent := Form1;

Form1.Memo.Caption := '';  }

Form1.Memo.SetBounds(0,Form1.TabCon.Height,Form1.Width,Form1.Height-Form1.TabCon.Height);

Close;
end;

end.
  Mit Zitat antworten Zitat