You've already forked lazarus-ccr
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@7880 8e941d3f-bd1b-0410-a28a-d453659cc2b4
85 lines
1.7 KiB
ObjectPascal
85 lines
1.7 KiB
ObjectPascal
unit BlankFrmUnit;
|
|
|
|
{$mode objfpc}{$H+}
|
|
|
|
interface
|
|
|
|
uses
|
|
Classes, SysUtils, FileUtil, LResources, Forms, Controls, Graphics, Dialogs,
|
|
ExtCtrls, StdCtrls, ExtDlgs, Clipbrd, printers;
|
|
|
|
type
|
|
|
|
{ TBlankFrm }
|
|
|
|
TBlankFrm = class(TForm)
|
|
SaveBtn: TButton;
|
|
PrintBtn: TButton;
|
|
CloseBtn: TButton;
|
|
OpenPictureDialog1: TOpenPictureDialog;
|
|
Image1: TImage;
|
|
Panel1: TPanel;
|
|
SavePictureDialog1: TSavePictureDialog;
|
|
procedure CloseBtnClick(Sender: TObject);
|
|
procedure FormShow(Sender: TObject);
|
|
procedure PrintBtnClick(Sender: TObject);
|
|
procedure SaveBtnClick(Sender: TObject);
|
|
private
|
|
Bitmap : TBitMap;
|
|
jp: TJpegImage; //Requires the "jpeg" unit added to "uses" clause.
|
|
|
|
{ private declarations }
|
|
public
|
|
{ public declarations }
|
|
end;
|
|
|
|
var
|
|
BlankFrm: TBlankFrm;
|
|
|
|
implementation
|
|
|
|
{ TBlankFrm }
|
|
|
|
procedure TBlankFrm.CloseBtnClick(Sender: TObject);
|
|
begin
|
|
// Bitmap.FreeImage;
|
|
BlankFrm.Hide;
|
|
end;
|
|
|
|
procedure TBlankFrm.FormShow(Sender: TObject);
|
|
begin
|
|
// Image1.Canvas.Clear;
|
|
// Bitmap := GetFormImage;
|
|
// Clipboard.Assign(Bitmap);
|
|
// Image1.Picture.Assign(Clipboard);
|
|
end;
|
|
|
|
procedure TBlankFrm.PrintBtnClick(Sender: TObject);
|
|
var
|
|
r : Trect;
|
|
|
|
begin
|
|
with Printer do
|
|
begin
|
|
Printer.Orientation := poPortrait;
|
|
r := Rect(20,20,printer.pagewidth-20,printer.pageheight div 2 + 20);
|
|
BeginDoc;
|
|
Canvas.StretchDraw(r,Image1.Picture.BitMap);
|
|
EndDoc;
|
|
end;
|
|
end;
|
|
|
|
procedure TBlankFrm.SaveBtnClick(Sender: TObject);
|
|
begin
|
|
if SavePictureDialog1.Execute then
|
|
begin
|
|
Image1.Picture.SaveToFile(SavePictureDialog1.FileName);
|
|
end;
|
|
end;
|
|
|
|
initialization
|
|
{$I blankfrmunit.lrs}
|
|
|
|
end.
|
|
|