RtTool/Delphi7/开发档案/马国钢开发代码/ThreeFun/Delphi_二微码/Unit1.pas
2025-01-08 11:55:07 +08:00

204 lines
5.4 KiB
ObjectPascal
Raw Blame History

This file contains ambiguous Unicode characters

This file contains Unicode characters that might be confused with other characters. If you think that this is intentional, you can safely ignore this warning. Use the Escape button to reveal them.

unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ExtCtrls, RM_System, RM_Common, RM_Class,
RM_GridReport;
type
TForm1 = class(TForm)
GroupBox1: TGroupBox;
Edit1: TEdit;
Edit2: TEdit;
Edit3: TEdit;
Edit10: TEdit;
Label1: TLabel;
Label2: TLabel;
Label3: TLabel;
Label4: TLabel;
Memo1: TMemo;
Panel1: TPanel;
Button1: TButton;
Button2: TButton;
Button3: TButton;
Image1: TImage;
OpenDialog1: TOpenDialog;
SaveDialog1: TSaveDialog;
GroupBox2: TGroupBox;
Edit4: TEdit;
Edit5: TEdit;
Edit6: TEdit;
Edit7: TEdit;
Edit8: TEdit;
Edit9: TEdit;
Label5: TLabel;
Label6: TLabel;
Label7: TLabel;
Label8: TLabel;
Label9: TLabel;
Label10: TLabel;
Label11: TLabel;
Button4: TButton;
RM1: TRMGridReport;
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure Button3Click(Sender: TObject);
procedure Button4Click(Sender: TObject);
private
{ Private declarations }
CurrentDir:string;
public
{ Public declarations }
end;
TMakebar = procedure(ucData:pchar;nDataLen:integer;nErrLevel:integer;nMask:integer;nBarEdition:integer;szBmpFileName:pchar;nScale:integer);stdcall;
TMixtext = procedure( szSrcBmpFileName:PChar;szDstBmpFileName:PChar;sztext:PChar;fontsize,txtheight,hmargin,vmargin,txtcntoneline:integer);stdcall;
//TSetColorDepth = procedure( ndepth:integer);stdcall;
//TGetColorDepth = procedure();stdcall;
//(PCHAR ucData, long nDataLen, char* szBmpFileName,
// long nClumn, long , long );
var
Form1: TForm1;
implementation
{$R *.dfm}
procedure TForm1.Button1Click(Sender: TObject);
var
Moudle: THandle;
Makebar:TMakebar;
Mixtext:TMixtext;
//SetColorDepth:TSetColorDepth;
//GetColorDepth:TGetColorDepth;
strsz,StrPt,FilePt:PChar;
Txt,Txt1:String;
begin
Moudle:=LoadLibrary('MakeQRBarcode.dll');
@Makebar:=GetProcAddress(Moudle,'Make');
@Mixtext:=GetProcAddress(Moudle,'MixText');
//@SetColorDepth:=getprocaddress(Moudle, 'SetColorDepth');
//@GetColorDepth:=getprocaddress(Moudle, 'GetColorDepth');
Txt:=Memo1.Lines.Text;
Txt1:=Edit5.Text;
StrPt:=PChar(Txt);
strsz:=PChar(Txt1);
FilePt:=PChar(String('temp.bmp'));
//SetColorDepth(StrToInt(Edit10.Text));
Makebar(StrPt,Length(Txt),StrToInt(Edit2.Text),StrToInt(Edit1.Text),
StrToInt(Edit10.Text),FilePt,StrToInt(Edit3.Text));
//GetColorDepth;
Mixtext( FilePt,FilePt,strsz,StrToInt(Edit6.Text),StrToInt(Edit8.Text),StrToInt(Edit7.Text),StrToInt(Edit9.Text),StrToInt(Edit4.Text));
Image1.Picture.LoadFromFile('temp.bmp');
end;
procedure TForm1.Button2Click(Sender: TObject);
var
Moudle: THandle;
Makebar:TMakebar;
Mixtext:TMixtext;
// SetColorDepth:TSetColorDepth;
// GetColorDepth:TGetColorDepth;
strsz,StrPt,FilePt:PChar;
Txt,Txt1:string;
begin
//CurrentDir := GetCurrentDir();
OpenDialog1.InitialDir := CurrentDir;
//CreateDir(CurrentDir+'\\bmp\\');
if OpenDialog1.Execute then
Memo1.Lines.LoadFromFile(OpenDialog1.FileName)
else
Memo1.Lines.Clear;
Moudle:=LoadLibrary('MakeQRBarcode.dll');
@Makebar:=GetProcAddress(Moudle,'Make');
@Mixtext:=GetProcAddress(Moudle,'MixText');
// @SetColorDepth:=getprocaddress(Moudle, 'SetColorDepth');
// @GetColorDepth:=getprocaddress(Moudle, 'GetColorDepth');
Txt:=Memo1.Lines.Text;
Txt1:=Edit5.Text;
StrPt:=PChar(Txt);
strsz:=PChar(Txt1);
FilePt:=PChar(String('temp.bmp'));
// SetColorDepth(StrToInt(Edit10.Text));
Makebar(StrPt,Length(Txt),StrToInt(Edit2.Text),StrToInt(Edit1.Text),
StrToInt(Edit10.Text),FilePt,StrToInt(Edit3.Text));
// GetColorDepth;
Mixtext( FilePt,FilePt,strsz,StrToInt(Edit6.Text),StrToInt(Edit8.Text),StrToInt(Edit7.Text),StrToInt(Edit9.Text),StrToInt(Edit4.Text));
Image1.Picture.LoadFromFile('temp.bmp');
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
CurrentDir := GetCurrentDir();
end;
procedure TForm1.Button3Click(Sender: TObject);
var
//CurrentDir:string;
NewFile: TFileStream;
OldFile: TFileStream;
PImg:string;
begin
//CurrentDir := GetCurrentDir();
CreateDir(CurrentDir+'\\bmp\\');
SaveDialog1.InitialDir := CurrentDir + '\\bmp\\';
SaveDialog1.FileName := 'barcode.bmp';
SaveDialog1.Filter := 'λͼ<CEBB>ļ<EFBFBD> (*.bmp)|*.bmp|<7C><><EFBFBD><EFBFBD><EFBFBD>ļ<EFBFBD> (*.*)|*.*||';
SaveDialog1.Title := '<27><><EFBFBD><EFBFBD>Ϊ';
if (SaveDialog1.Execute()) then
begin
OldFile := TFileStream.Create(CurrentDir+'\\temp.bmp', fmOpenRead);
try
NewFile := TFileStream.Create(SaveDialog1.FileName, fmCreate);
try
NewFile.CopyFrom(OldFile, OldFile.Size);
finally
FreeAndNil(NewFile);
end;
finally
FreeAndNil(OldFile);
end;
end;
end;
procedure TForm1.Button4Click(Sender: TObject);
var
//CurrentDir:string;
NewFile: TFileStream;
OldFile: TFileStream;
PImg:string;
begin
PImg:='D:\RT2012.bmp';
OldFile := TFileStream.Create(CurrentDir+'\\temp.bmp', fmOpenRead);
try
NewFile := TFileStream.Create(PImg, fmCreate);
try
NewFile.CopyFrom(OldFile, OldFile.Size);
DeleteFile(PImg);
finally
FreeAndNil(NewFile);
end;
finally
FreeAndNil(OldFile);
end;
RMVariables['PImg'] :=trim(PImg);
RM1.LoadFromFile(ExtractFilePath(Application.ExeName) + 'Report\ͼƬ<CDBC><C6AC>ʾ.rmf');
RM1.ShowReport;
end;
end.