全國最多中醫師線上諮詢網站-台灣中醫網
發文 回覆 瀏覽次數:1146
推到 Plurk!
推到 Facebook!

怎麼把這個程式寫成一個 自定procedure?

 
mayday741130
一般會員


發表:11
回覆:8
積分:3
註冊:2006-07-22

發送簡訊給我
#1 引用回覆 回覆 發表時間:2006-08-29 17:05:40 IP:210.70.xxx.xxx 未訂閱

unit tpdf1;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, Spin, Buttons, ExtCtrls, ComCtrls, PDF;

type
TForm1 = class(TForm)
StatusBar1: TStatusBar;
Panel1: TPanel;
Panel2: TPanel;
Splitter1: TSplitter;
StaticText1: TStaticText;
StaticText2: TStaticText;
BitBtn1: TBitBtn;
Memo1: TMemo;
OpenDialog1: TOpenDialog;
SaveDialog1: TSaveDialog;
CheckBox1: TCheckBox;
CheckBox2: TCheckBox;
PDFDocument1: TPDFDocument;
procedure FormCreate(Sender: TObject);
procedure StaticText1Click(Sender: TObject);
procedure StaticText2Click(Sender: TObject);
procedure BitBtn1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;
Line: integer;
Ofile,Sfile: string;
MyPDF: TPDFDocument;

implementation

{$R *.dfm}

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

procedure TForm1.StaticText1Click(Sender: TObject);
begin
OpenDialog1.Filter := 'Text files (*.txt)|*.txt|All files (*.*)|*.*';
//OpenDialog1.FilterIndex := 2; { start the dialog showing all files }
if OpenDialog1.Execute then begin
Ofile := OpenDialog1.FileName;
StaticText1.Caption := Ofile;
Memo1.Lines.LoadFromFile(Ofile);
Line := Memo1.Lines.Count;
StatusBar1.Panels[0].Text:= IntToStr(Line) ' 行';
StatusBar1.Panels[1].Text := Ofile;
end;
end;

procedure TForm1.StaticText2Click(Sender: TObject);
var i:integer;
begin
SaveDialog1.Filter := 'PDF files (*.pdf)|*.pdf';
if SaveDialog1.Execute then begin
Sfile := SaveDialog1.FileName;
if pos('.',Sfile)=0 then Sfile := Sfile '.pdf';
if FileExists(Sfile) then
if MessageDlg('檔案存在是否覆蓋? Y/N', mtConfirmation, [mbYes, mbNo], 0) = mrNo then exit;
StaticText2.Caption := Sfile;
BitBtn1.Enabled := true;
StatusBar1.Panels[0].Text:='尚未存檔';
StatusBar1.Panels[1].Text := Sfile;
end;
end;

procedure TForm1.BitBtn1Click(Sender: TObject);
var i,j,top,row:integer;
begin
top := 3;
if CheckBox1.Checked then row := 79
else row := 81;
j := top;
try
MyPDF := TPDFDocument.Create(nil);
try
MyPDF.FileName := Sfile;
MyPDF.DocumentInfo.Title := 'gcleectcedutw';
MyPDF.AutoLaunch := CheckBox2.Checked;
MyPDF.Compression := ctFlate;
MyPDF.BeginDoc;
for i:=0 to Line-1 do begin
with MyPDF.CurrentPage do begin
BeginText;
SetActiveFont('Arial', [], 8, CHINESEBIG5_CHARSET);
TextOut(20, (10*j), 0, Memo1.Lines[i]);
inc(j);
if (j mod row = 0) or (i=(Line-1)) then begin
j := top;
SetActiveFont('Arial', [], 10, CHINESEBIG5_CHARSET);
if CheckBox1.Checked then TextOut(280, 800, 0, 'page ' IntToStr(Mypdf.PageCount));
if (i<(Line-1)) then Mypdf.Newpage;
end;
EndText;
end;
end;
try
MyPDF.EndDoc;
except on Exception do begin
MyPDF.Abort;
raise;
end;
end;
finally
MyPDF.Free;
end;
except on E: Exception do
Writeln(E.message);
end;
BitBtn1.Enabled := false;
StatusBar1.Panels[0].Text:='儲檔完畢';
end;

end.

-------------------------------------------------------------------

怎麼把這個程式寫成一個 自定procedure????

------
小LO
g9221712
高階會員


發表:145
回覆:344
積分:162
註冊:2006-07-06

發送簡訊給我
#2 引用回覆 回覆 發表時間:2006-08-30 01:12:09 IP:220.134.xxx.xxx 未訂閱
不要只有貼上程式碼?說明的一下你要的核心部份,大家好一起討論!小弟淺見!
------
「人們所以覺得寂寞,是因為他們會築牆,卻不會搭橋。」
程式寫的越久,卻發現自己越來越不會寫程式!
系統時間:2024-06-02 12:41:46
聯絡我們 | Delphi K.Top討論版
本站聲明
1. 本論壇為無營利行為之開放平台,所有文章都是由網友自行張貼,如牽涉到法律糾紛一切與本站無關。
2. 假如網友發表之內容涉及侵權,而損及您的利益,請立即通知版主刪除。
3. 請勿批評中華民國元首及政府或批評各政黨,是藍是綠本站無權干涉,但這裡不是政治性論壇!