📄 qtdj.~pas
字号:
unit qtdj;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, DBCtrls, StdCtrls, xpGroupBox, bsSkinCtrls, bsdbctrls, xpBitBtn,
xpButton, RzCmboBx, xpEdit, ExtCtrls, RzPanel, RzSplit, ComCtrls,
xpPages, BusinessSkinForm, xpCombo, BarHL, Barcode, bsSkinGrids,
bsDBGrids, Grids, DBGrids, RzBckgnd, RzDBGrid, DB, ADODB, RzButton,
RzRadChk, RzTabs,printers, bsSkinPrinter, bsDialogs;
type
TqtForm = class(TForm)
bsBusinessSkinForm1: TbsBusinessSkinForm;
xpPageControl1: TxpPageControl;
xpTabSheet1: TxpTabSheet;
RzSplitter1: TRzSplitter;
RzSizePanel2: TRzSizePanel;
RzPanel5: TRzPanel;
Label13: TLabel;
Label17: TLabel;
Label2: TLabel;
Label3: TLabel;
Label4: TLabel;
Image1: TImage;
Bevel1: TBevel;
Label18: TLabel;
Label20: TLabel;
Label19: TLabel;
Label6: TLabel;
Label5: TLabel;
xpEdit1: TxpEdit;
RadioButton2: TRadioButton;
RadioButton1: TRadioButton;
xpButton1: TxpButton;
xpButton2: TxpButton;
xpBitBtn1: TxpBitBtn;
xpBitBtn2: TxpBitBtn;
xpEdit5: TxpEdit;
RzPanel4: TRzPanel;
Label11: TLabel;
Label10: TLabel;
Label9: TLabel;
Label22: TLabel;
Label8: TLabel;
Label7: TLabel;
Label12: TLabel;
Label16: TLabel;
Label15: TLabel;
Label14: TLabel;
Label23: TLabel;
xpEdit2: TxpEdit;
xpEdit3: TxpEdit;
xpEdit4: TxpEdit;
xpEdit6: TxpEdit;
xpEdit7: TxpEdit;
xpEdit8: TxpEdit;
RzPanel3: TRzPanel;
bsSkinDBNavigator2: TbsSkinDBNavigator;
xpTabSheet2: TxpTabSheet;
RzSplitter2: TRzSplitter;
RzSizePanel1: TRzSizePanel;
xpGroupBox1: TxpGroupBox;
CheckBox1: TCheckBox;
xpGroupBox2: TxpGroupBox;
RadioButton5: TRadioButton;
RadioButton3: TRadioButton;
RadioButton4: TRadioButton;
RzPanel2: TRzPanel;
RzPanel1: TRzPanel;
DBImage2: TDBImage;
xpTabSheet3: TxpTabSheet;
xpTabSheet4: TxpTabSheet;
xpTabSheet5: TxpTabSheet;
xpTabSheet6: TxpTabSheet;
xpComboBox1: TxpComboBox;
xpComboBox2: TxpComboBox;
xpComboBox3: TxpComboBox;
xpComboBox4: TxpComboBox;
xpComboBox5: TxpComboBox;
xpComboBox6: TxpComboBox;
xpComboBox7: TxpComboBox;
xpComboBox8: TxpComboBox;
xpComboBox9: TxpComboBox;
Panel1: TPanel;
Barcode1: TBarcode;
DBGrid1: TDBGrid;
RzPanel6: TRzPanel;
RzBackground1: TRzBackground;
zjzl: TADOQuery;
zjzlsc: TDataSource;
zjzlguest_id: TStringField;
zjzlgj: TStringField;
zjzlcename: TStringField;
zjzlguest_name: TStringField;
zjzlxb: TStringField;
zjzltype_name: TStringField;
zjzlphoto: TBlobField;
zjzlmodel: TBlobField;
zjzlsfzz: TWordField;
zjzlifzz: TStringField;
RzRadioButton1: TRzRadioButton;
RzRadioButton2: TRzRadioButton;
RzPageControl1: TRzPageControl;
TabSheet1: TRzTabSheet;
TabSheet2: TRzTabSheet;
TabSheet3: TRzTabSheet;
RzDBGrid1: TRzDBGrid;
RzDBGrid2: TRzDBGrid;
RzDBGrid3: TRzDBGrid;
zjzl2: TADOQuery;
zjzl2sc: TDataSource;
zjzl3: TADOQuery;
zjzl3sc: TDataSource;
zjzl2guest_id: TStringField;
zjzl2gj: TStringField;
zjzl2cename: TStringField;
zjzl2guest_name: TStringField;
zjzl2xb: TStringField;
zjzl2type_name: TStringField;
zjzl2photo: TBlobField;
zjzl2model: TBlobField;
zjzl2sfzz: TWordField;
zjzl2ifzz: TStringField;
zjzl2bh_h: TIntegerField;
zjzl2bh_v: TIntegerField;
zjzl2name_h: TIntegerField;
zjzl2name_v: TIntegerField;
zjzl2ph_h: TIntegerField;
zjzl2ph_v: TIntegerField;
zjzl2countyr_h: TIntegerField;
zjzl2country_v: TIntegerField;
DBImage1: TDBImage;
zjzl3guest_id: TStringField;
zjzl3gj: TStringField;
zjzl3cename: TStringField;
zjzl3guest_name: TStringField;
zjzl3xb: TStringField;
zjzl3type_name: TStringField;
zjzl3photo: TBlobField;
zjzl3model: TBlobField;
zjzl3sfzz: TWordField;
zjzl3ifzz: TStringField;
RzPanel7: TRzPanel;
xpBitBtn5: TxpBitBtn;
xpBitBtn4: TxpBitBtn;
xpBitBtn7: TxpBitBtn;
xpBitBtn6: TxpBitBtn;
xpBitBtn8: TxpBitBtn;
RzCheckBox1: TRzCheckBox;
xpBitBtn3: TxpBitBtn;
PrintDialog: TbsSkinPrintDialog;
xpBitBtn9: TxpBitBtn;
PasswordDialog: TbsSkinPasswordDialog;
dy: TADOCommand;
procedure xpButton1Click(Sender: TObject);
procedure FormActivate(Sender: TObject);
procedure xpComboBox4Change(Sender: TObject);
procedure RadioButton1KeyPress(Sender: TObject; var Key: Char);
procedure xpBitBtn2Click(Sender: TObject);
procedure RadioButton6Click(Sender: TObject);
procedure RadioButton7Click(Sender: TObject);
procedure RzDBGrid1DblClick(Sender: TObject);
procedure xpBitBtn5Click(Sender: TObject);
procedure xpBitBtn4Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure xpBitBtn6Click(Sender: TObject);
procedure xpBitBtn1Click(Sender: TObject);
procedure xpBitBtn7Click(Sender: TObject);
procedure xpBitBtn3Click(Sender: TObject);
procedure RzPanel7DblClick(Sender: TObject);
procedure xpBitBtn9Click(Sender: TObject);
private
{ Private declarations }
function getid(gid:integer):string;
procedure printtoA4(imgid:integer);
procedure makebmp;
function ZoomInOut(m, n: extended):tbitmap;
public
{ Public declarations }
end;
var
qtForm: TqtForm;
gid:integer;
g_id:string;
Abitmap:tbitmap;
img1,img2:timage;
implementation
uses main,a4pagepas;
{$R *.dfm}
procedure tqtform.makeBMP;
var
pdest,psour:hbitmap;
LogFont: TLogFont;
SaveFont: TFont;
Point:TPoint;
mybarcode:tbarcode;//a fly;
begin
//缩放相片
Abitmap:=dbimage1.Picture.Bitmap;
img1.Picture.Bitmap:=zoominout(370,495);
//缩放底片
abitmap:=dbimage2.Picture.Bitmap;
img2.Picture.Bitmap:=zoominout(1014,1416);
psour:=img1.canvas.handle; //源图句柄
pdest:=img2.canvas.handle; //目的图句柄
//贴相片
bitblt(pdest,zjzl2ph_h.Value,zjzl2ph_v.Value,img1.picture.width,img1.picture.Height,psour,0,0,srccopy);
with img2.Canvas do //写字
begin
img2.Canvas.Font.Size:=48;
img2.Canvas.Font.Name:='幼圆';
img2.Canvas.Font.Style:=[fsBold];
img2.Canvas.Font.Color:=clwhite;
SaveFont := TFont.Create;
SaveFont.Assign(img2.Canvas.Font);
GetObject(SaveFont.Handle, sizeof(TLogFont), @LogFont);
with LogFont do
begin
lfEscapement := 0 *10;
lfPitchAndFamily := FIXED_PITCH or FF_DONTCARE;
end;
img2.Canvas.Font.Handle := CreateFontIndirect(LogFont);
SetBkMode(img2.Canvas.Handle, TRANSPARENT);
//写名字
img2.Canvas.TextOut(zjzl2name_h.Value,zjzl2name_v.Value,trim(zjzl2guest_name.Value));
//写国籍
img2.Canvas.TextOut(zjzl2countyr_h.Value,zjzl2country_v.Value,trim(zjzl2gj.Value));
//英文国籍
img2.Canvas.Font.Size:=24;
img2.Canvas.Font.Name:='Arial';
img2.Canvas.TextOut(zjzl2countyr_h.Value-110,zjzl2country_v.Value+80,trim(zjzl2cename.Value));
SaveFont.Free;
end;
//条码处理
MyBarcode:=TBarcode.create(self); {Create TBarcode object!}
With MyBarcode do {Set some default options}
begin
{Set a code as You like}
Bar_Caption:=trim(zjzl2guest_id.Value);
{Set normal Height,
this is default, but for demonstration purposes...}
Bar_HeightPercent:=120;
bar_fontscaling:=110;
{No high density codes,
this is default, but for demonstration purposes...}
Bar_HighDensity:=false;
{Set "Normal width" which is SC2,
this is default, but for demonstration purposes...}
Bar_Modulewidth:=SC9;
{With Laserprinters always use Widthreduce:=false,
this is default, but for demonstration purposes...}
Bar_Widthreduce:=false;
{While printing always use Bar_ZoomSize:=false,
this is default, but for demonstration purposes...}
Bar_ZoomSize:=false;
bar_humanreadable:=true;
bar_fontname:='Arial';
end;
{Find out printing offset on page}
escape(Printer.handle,Getprintingoffset,0,nil,@point);
{Adjust printing offset, so output starts at the
same coordinates on all printers}
SetViewPortOrgEx(Printer.handle,-point.x,point.y,nil);
img2.Picture.Bitmap.Canvas.Font.Name:='Arial';
img2.Canvas.Font.Size:=42;
img2.Canvas.Font.Color:=clBLACK;
MyBarcode.Bar_Codetype:=code128_b;
img1.Free;
img1:=timage.Create(self);
img1.Picture.Bitmap.Height:=3*barcode1.Height;
img1.Picture.Bitmap.Width:=2*barcode1.Width;
MyBarcode.Print(img1.canvas,0,0,@Point);//75,375
// Barcode1.CopyToRect(img1.Canvas,Barcode1.BoundsRect);
abitmap:=img1.Picture.Bitmap;
img1.Picture.Bitmap:=zoominout(500,180);
// img1.Picture.Bitmap.PixelFormat := pf1bit;
psour:=IMG1.canvas.handle; //BARCODE源图句柄
//贴条码
bitblt(pdest,mainform.model2Bh_h.Value,mainform.model2Bh_v.Value,IMG1.picture.width,IMG1.picture.Height,psour,0,0,srccopy);
if checkbox1.Checked=true then img2.Picture.Bitmap.SaveToFile('..\'+trim(zjzl2guest_id.Value)+'.bmp');
end;
function Tqtform.ZoomInOut(m, n: extended):tbitmap;
var
Mybmp: TBitmap;
begin
self.DoubleBuffered := True;
Mybmp := TBitmap.Create;
Mybmp.Width := Trunc(m);
Mybmp.Height := Trunc(n);
SetStretchBltMode(Mybmp.Canvas.Handle, HalfTone);
Stretchblt(Mybmp.Canvas.Handle, 0, 0, Mybmp.Width,Mybmp.Height,abitmap.Canvas.Handle, 0, 0,abitmap.Width,abitmap.Height,SRCCOPY);
Mybmp.PixelFormat := pf24bit;
result:=MyBmp;
// MyBmp.Free;
end;
procedure tqtform.printtoA4(imgid:integer);
begin
if imgid=0 then a4page.QRImage1.Picture.Bitmap:=img2.Picture.Bitmap;
if imgid=1 then a4page.QRImage2.Picture.Bitmap:=img2.Picture.Bitmap;
if imgid=2 then a4page.QRImage3.Picture.Bitmap:=img2.Picture.Bitmap;
if imgid=3 then a4page.QRImage4.Picture.Bitmap:=img2.Picture.Bitmap;
end;
function tqtform.getid(gid:integer):string;
begin
case length(inttostr(gid)) of
1:result:='0000000'+inttostr(gid);
2:result:='000000'+inttostr(gid);
3:result:='00000'+inttostr(gid);
4:result:='0000'+inttostr(gid);
5:result:='000'+inttostr(gid);
6:result:='00'+inttostr(gid);
7:result:='0'+inttostr(gid);
8:result:=inttostr(gid);
else
begin
showmessage('号码太大,请检查!');
result:='';
end;
end;
end;
procedure TqtForm.xpButton1Click(Sender: TObject);
begin
if mainform.oPDialog.Execute then
begin
image1.picture.Bitmap.LoadFromFile(mainform.oPDialog.FileName);
end;
end;
procedure TqtForm.FormActivate(Sender: TObject);
begin
//类型
xpcombobox4.Clear;
xpcombobox4.Text:='请选择人员类型';
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -