📄 main.~pas
字号:
edit1.Color:=clMenuHighlight;
edit2.Color:=clMenuHighlight;
edit3.Color:=clMenuHighlight;
edit4.Color:=clMenuHighlight;
end;
end;
end;
end;
procedure TForm1.Button1Click(Sender: TObject);
var tmpWILINFO,tmp:PWILFILEIMAGEINFO;
bOk:boolean;
I:Integer;
begin
if fOpen.Count > 0 then
begin
NEW(tmpWILINFO);
if not checkbox3.Checked then
try
tmpWILINFO^.shPX:=STRTOINT(edit1.Text);
tmpWILINFO^.shPY:=STRTOINT(edit2.Text);
tmpWILINFO^.shShadowPX:=STRTOINT(edit3.Text);
tmpWILINFO^.shShadowPY:=STRTOINT(edit4.Text);
tmpWILINFO^.dwImageLength:=mImgLen;
tmpWILINFO^.shWidth:=mWidth;
tmpWILINFO^.shHeight:=mHigh;
tmpWILINFO^.bShadow:=mShadow;
bOk:=fOpen.Modify(crPos,tmpWILINFO);
finally
dispose(tmpWILINFO);
end
else
begin
for I:=0 to fOpen.Count - 1 do
begin
tmp:=fOpen.InfoOfImage[I];
if tmp<>nil then
begin
tmp.shPX:=0;
tmp.shPY:=0;
tmp.bShadow:=chr(0);
tmp.shShadowPX:=0;
tmp.shShadowPY:=0;
fOpen.Modify(I,tmp);
dispose(tmp);
end;
end;
end;
end;
end;
procedure TForm1.EI3WIL1Click(Sender: TObject);
var tpe:byte;
Pname:string;
begin
SD.Filter:='EI3-WIL-FILE (*.Wix)|*.wix';
SD.FileName:=OD.FileName;
if SD.Execute then
begin
Pname:=SD.FileName;
if Pname[Length(Pname)-3]<>'.' then Pname:=Pname+'.WIX';
fOpen.SaveToFile(Pname,EI3);
tpe:=fOpen.LoadFromFile(Pname);
if tpe = EI3 then
begin
TSEI.Visible:=TRUE;
TSGT.Visible:=FALSE;
end
else
begin
TSEI.Visible:=FALSE;
TSGT.Visible:=TRUE;
end;
SB.Panels.Items[0].Text:=' '+Pname;
end;
end;
procedure TForm1.GT3WIL1Click(Sender: TObject);
var tpe:byte;
Pname:string;
begin
SD.Filter:='GT3-WIL-FILE (*.Wix)|*.wix';
if SD.Execute then
begin
Pname:=SD.FileName;
if Pname[Length(Pname)-3]<>'.' then Pname:=Pname+'.WIX';
fOpen.SaveToFile(SD.FileName+'.WIX',GT3);
tpe:=fOpen.LoadFromFile(Pname);
if tpe = EI3 then
begin
TSEI.Visible:=TRUE;
TSGT.Visible:=FALSE;
end
else
begin
TSEI.Visible:=FALSE;
TSGT.Visible:=TRUE;
end;
SB.Panels.Items[0].Text:=' '+Pname;
end;
end;
procedure TForm1.N4Click(Sender: TObject);
begin
if Opfile<>'' then fOpen.SaveToFile(Opfile,0);
end;
procedure TForm1.N24BitBMP2Click(Sender: TObject);
var Pname:string;
begin
SD.Filter:='16位位图 (*.bmp)|*.bmp';
if SD.Execute then
begin
Pname:=SD.FileName;
if Pname[Length(Pname)-3]<>'.' then Pname:=Pname+'.bmp';
fOpen.ImageSaveToBmp(crPos,Pname);
end;
end;
procedure TForm1.Button5Click(Sender: TObject);
var tBitMap:HBITMAP;
tmp:TStream;
begin
tmp:=TStream.Create;
tBitMap:=CreateBitMap(250,250,1,16,nil);
IMG.Picture.Bitmap.Handle:=tBitMap;
end;
procedure TForm1.KEN2Click(Sender: TObject);
var Pname:string;
begin
SD.Filter:='专用资源文件 (*.TPE)|*.TPE';
if SD.Execute then
begin
Pname:=SD.FileName;
if Pname[Length(Pname)-3]<>'.' then Pname:=Pname+'.TPE';
fOpen.ImageSaveToSeq(crPos,1,Pname);
end;
end;
procedure TForm1.CheckBox1Click(Sender: TObject);
begin
if ((CheckBox1.Checked) and (fOpen.Count > 0)) then
begin
T1.Enabled:=TRUE;
end
else
begin
T1.Enabled:=FALSE;
end;
end;
procedure TForm1.T1Timer(Sender: TObject);
begin
if CheckBox2.Checked then Button3.Click
else Button4.Click;
if ((CrPos=0) or (CrPos=fOpen.Count - 1) or (cRpOS=fOpen.GetNextValidImageIndex(crPos))) then
begin
CheckBox1.Checked:=FALSE;
T1.Enabled:=False;
end;
end;
procedure TForm1.N9Click(Sender: TObject);
var tId:DWORD;
begin
if fOpen.Count > 0 then
begin
ImOrOut:=0;
DL.Edit4.Text:=IntToStr(crPos);
DL.BG.Caption:='导出信息设置';
DL.Show;
end;
end;
procedure TForm1.N8Click(Sender: TObject);
var Pname:string;
tId:DWORD;
begin
if fOpen.Count > 0 then
begin
OD.Filter:='专用资源文件 (*.TPE)|*.TPE';
if OD.Execute then
begin
b3:=Button3.Handle;
b4:=Button4.Handle;
Infseq:=Od.FileName;
ImOrOut:=1;
o_Pos:=crPos;
bImp:=False;
DL.Edit4.Text:=IntToStr(crPos);
DL.BG.Caption:='导入信息设置';
DL.Show;
ResetEvent(hEvent);
CloseHandle(CreateThread(
nil,0,
@TForm1.ImThreadProc,nil,0,tId
));
end;
end;
end;
procedure TForm1.KEN1Click(Sender: TObject);
var Pname:string;
aBitMap:TBITMAP;
begin
OD.Filter:='专用资源文件 (*.TPE)|*.TPE';
if OD.Execute then
begin
Pname:=OD.FileName;
if fOpen.ImportFromSeq(crPos,1,Pname) then
begin
if crPos=0 then
begin
IMG.Picture.Bitmap.FreeImage;
aBitMap:=fOpen.IndexOfBitMap[crPos];
if aBitMap <> nil then begin
IMG.Picture.Bitmap:=aBitMap;
IMG.Repaint;
IMG.Refresh;
end;
end
else
begin
edit7.Text:=IntToStr(crPos);
crPos:=0;
Button4.Click;
end;
end;
end;
end;
procedure TForm1.N12Click(Sender: TObject);
var Pname:string;
begin
if fOpen.Count > 0 then
begin
OD.Filter:='专用资源文件 (*.TPE)|*.TPE';
if OD.Execute then
begin
Pname:=OD.FileName;
if fOpen.ImportFromSeq(fOpen.Count,1,Pname) then
begin
mImage := fOpen.Count;
crPos:= fOpen.Count - 2;
edit7.Text:=IntToStr(fOpen.Count - 1);
Button4.Click;
end;
end;
end;
end;
procedure TForm1.N11Click(Sender: TObject);
begin
close;
end;
function SaveMemToFile(fP:Pointer;size:DWORD;const fstr:string):DWORD;
var hfstr,hMap:Cardinal;
hMem:Pointer;
begin
ReSult:=0;
hfstr:=CreateFile(
pchar(fstr),
GENERIC_READ + GENERIC_WRITE,
FILE_SHARE_WRITE or FILE_SHARE_READ,
0,
OPEN_ALWAYS,
FILE_ATTRIBUTE_NORMAL,
0
);
if hfstr<>INVALID_HANDLE_VALUE then
begin
SetFilePointer(hfstr,size,0,FILE_BEGIN);
SetEndOfFile(hfstr);
hMap:=CreateFileMapping(hfstr,nil,PAGE_READWRITE,0,0,nil);
if hMap<>0 then
begin
hMem:=MapViewOfFile(hMap,FILE_MAP_READ or FILE_MAP_WRITE,0,0,0);
if hMem<>nil then
begin
CopyMemory(hMem,fP,size);
UnmapViewOfFile(hMem);
end;
CloseHandle(hMap);
end;
CloseHandle(hfstr);
end;
end;
function LoadFileToMem(var fP:Pointer;const fstr:string):DWORD;
var hfstr,hMap:Cardinal;
hMem:Pointer;
begin
hfstr:=CreateFile(
pchar(fstr),
GENERIC_READ OR GENERIC_WRITE,
FILE_SHARE_WRITE or FILE_SHARE_READ,
0,
OPEN_EXISTING,
FILE_ATTRIBUTE_NORMAL,
0
);
if hfstr<>INVALID_HANDLE_VALUE then
begin
hMap:=CreateFileMapping(hfstr,nil,PAGE_READWRITE,0,0,nil);
if hMap<>0 then
begin
hMem:=MapViewOfFile(hMap,FILE_MAP_WRITE OR FILE_MAP_READ,0,0,0);
if hMem<>nil then
begin
ReSult:=GetFileSize(hfstr,0);
GetMem(fP,ReSult);
CopyMemory(fP,hMem,ReSult);
UnmapViewOfFile(hMem);
end;
CloseHandle(hMap);
end;
CloseHandle(hfstr);
end;
end;
procedure TForm1.N16Click(Sender: TObject);
var buf:Pointer;
ptmp,ptmp2:DWORD;
bfWidth,bfHight:WORD;
I:INTEGER;
A:array[0..255] of BYTE;
B:array[0..255] of smallint;
C:array[0..255] of Integer;
bfIndex:Byte;
bfTitlecs:WORD;
fz,nCount:DWORD;
bObj1Ani,bObj2Ani:Byte;
wObj1: WORD;
wObj2: WORD;
begin
if OD2.Execute then
begin
nCount:=0;
fz:=LoadFileToMem(buf,OD2.FileName);
bfWidth:=PDWORD(DWORD(buf)+22)^;
bfHight:=PDWORD(DWORD(buf)+24)^;
for I:=0 to bfWidth*(bfHight div 4)-1 do
begin
ptmp:=$1c+ DWORD(buf) + I*3;
bfIndex:=PByte(ptmp)^;
bfTitlecs:=PWORD(ptmp+1)^;
if ((bfIndex>=$2D) and (bfIndex<=$37) and (bfTitlecs<>65535)) then
begin
if ((bfIndex<>$31) and (bfIndex<>$32)) then
begin
bfIndex:=bfIndex-$2D;
bfTitlecs:=bfTitlecs+Value[bfIndex];
PByte(ptmp)^:=bfIndex;
PWORD(ptmp+1)^:=bfTitlecs;
end;
end;
end;
for I:=0 to bfWidth*bfHight-1 do
begin
ptmp2:=$1c + DWORD(buf) + bfWidth*(bfHight div 4)*3+14*I;
bfIndex:=Pbyte(ptmp2+4)^;
if ((bfIndex>=$2D) and (bfIndex<=$37)) then
begin
bfIndex:=bfIndex-$2D;
Pbyte(ptmp2+4)^:=bfIndex;
PWord(ptmp2+5)^:=PWord(ptmp2+5)^+Value[bfIndex];
end;
bfIndex:=Pbyte(ptmp2+3)^;
if ((bfIndex>=$2D) and (bfIndex<=$37)) then
begin
bfIndex:=bfIndex-$2D;
Pbyte(ptmp2+3)^:=bfIndex;
PWord(ptmp2+7)^:=PWord(ptmp2+7)^+Value[bfIndex];
end;
end;
SaveMemToFile(buf,fz,Od2.FileName);
freemem(buf);
end;
end;
end.
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -