⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 qtdj.~pas

📁 会展条码票务管理、门禁、印刷、现场制证(摄像、登记、印刷)、总控中心、接待管理、展位管理
💻 ~PAS
📖 第 1 页 / 共 2 页
字号:
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 + -