1364 lines
39 KiB
Plaintext
1364 lines
39 KiB
Plaintext
unit umain;
|
||
|
||
interface
|
||
|
||
uses
|
||
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
|
||
Dialogs, StdCtrls, Spin, ExtCtrls, Grids, BaseGrid, AdvGrid, ComCtrls,
|
||
ToolWin, Menus, ImgList, math, AdvObj;
|
||
|
||
|
||
type
|
||
FontInfoList = record //font数组内容
|
||
id: integer;
|
||
width: integer;
|
||
height: integer;
|
||
bmplist: TBitmap;
|
||
end;
|
||
|
||
type
|
||
bitmapInfoList = record //bitmap数组内容
|
||
name: string;
|
||
width: integer;
|
||
height: integer;
|
||
bmplist: TBitmap;
|
||
end;
|
||
|
||
type
|
||
TForm1 = class(TForm)
|
||
ScrollBox1: TScrollBox;
|
||
MainMenu1: TMainMenu;
|
||
N1: TMenuItem;
|
||
N2: TMenuItem;
|
||
N3: TMenuItem;
|
||
ToolBar1: TToolBar;
|
||
ToolButton1: TToolButton;
|
||
ToolButton7: TToolButton;
|
||
ToolButton8: TToolButton;
|
||
ToolButton18:TToolButton;
|
||
ImageList1: TImageList;
|
||
ToolButton10: TToolButton;
|
||
ToolButton11: TToolButton;
|
||
OpenDialog1: TOpenDialog;
|
||
SaveDialog1: TSaveDialog;
|
||
AdvStringGrid2: TAdvStringGrid;
|
||
NewFontFile1: TMenuItem;
|
||
Preview1: TMenuItem;
|
||
AllFont1: TMenuItem;
|
||
De1: TMenuItem;
|
||
BitmapLibrary1: TMenuItem;
|
||
OpenBitmapFile1: TMenuItem;
|
||
NewBitampFile1: TMenuItem;
|
||
SaveBitmapFile1: TMenuItem;
|
||
Preview2: TMenuItem;
|
||
AddBitmapFile1: TMenuItem;
|
||
PopupMenu1: TPopupMenu;
|
||
Font1: TMenuItem;
|
||
Bitmap1: TMenuItem;
|
||
Zoom2: TMenuItem;
|
||
N8pixels2: TMenuItem;
|
||
N10pixels2: TMenuItem;
|
||
N14pixels1: TMenuItem;
|
||
OpenDialog2: TOpenDialog;
|
||
RemoveBitmap1: TMenuItem;
|
||
Panel1: TPanel;
|
||
SaveDialog2: TSaveDialog;
|
||
Image1: TImage;
|
||
StatusBar1: TStatusBar;
|
||
ToolButton19: TToolButton;
|
||
ToolButton20: TToolButton;
|
||
Label1: TLabel;
|
||
|
||
|
||
|
||
procedure FormCreate(Sender: TObject);
|
||
procedure SaveProtolFile(count: integer; pFileName: string); //保存字模
|
||
procedure OpenProtolFile(pfilename: string); //打开字模
|
||
procedure AnylizeProtol(id, w, h, b: integer; dzstring: string);
|
||
|
||
procedure SaveBmpProtolFile(count: integer; pFileName: string); //保存图片
|
||
procedure OpenBmpProtolFile(pfilename: string); //打开图片
|
||
procedure AnylizeBmpProtol(id, w, h, b: integer; dzstring: string); //分析图片
|
||
|
||
procedure AdvStringGrid2Click(Sender: TObject);
|
||
procedure ToolButton1Click(Sender: TObject);
|
||
procedure ToolButton7Click(Sender: TObject);
|
||
procedure ToolButton18Click(Sender: TObject);
|
||
procedure ToolButton8Click(Sender: TObject);
|
||
procedure ToolButton10Click(Sender: TObject);
|
||
procedure ToolButton11Click(Sender: TObject);
|
||
procedure ToolButton19Click(Sender: TObject);
|
||
procedure N3Click(Sender: TObject); //选中模显示电阵
|
||
function tohex(s: string): string; //16进制转换为10进制
|
||
function IntConvertHex(A: Integer; Len: Integer): string;
|
||
procedure N2Click(Sender: TObject);
|
||
procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
|
||
procedure AdvStringGrid2DblClick(Sender: TObject);
|
||
procedure advinit;
|
||
procedure advinitbmp;
|
||
procedure NewFontFile1Click(Sender: TObject);
|
||
procedure AllFont1Click(Sender: TObject);
|
||
procedure De1Click(Sender: TObject);
|
||
procedure N8pixels2Click(Sender: TObject);
|
||
procedure N10pixels2Click(Sender: TObject);
|
||
procedure N14pixels1Click(Sender: TObject);
|
||
procedure OpenBitmapFile1Click(Sender: TObject);
|
||
procedure NewBitampFile1Click(Sender: TObject);
|
||
procedure RemoveBitmap1Click(Sender: TObject);
|
||
procedure AddBitmapFile1Click(Sender: TObject);
|
||
procedure bmpopen(w, h, pixels: integer);
|
||
procedure Image1MouseMove(Sender: TObject; Shift: TShiftState; X,
|
||
Y: Integer);
|
||
procedure MouseToColor(X, Y: integer; var Row, Col: integer);
|
||
procedure Image1MouseUp(Sender: TObject; Button: TMouseButton;
|
||
Shift: TShiftState; X, Y: Integer);
|
||
procedure SaveBitmapFile1Click(Sender: TObject);
|
||
procedure BitmapLibrary1Click(Sender: TObject);
|
||
|
||
procedure ToolButton20Click(Sender: TObject); private
|
||
{ Private declarations }
|
||
public
|
||
{ Public declarations }
|
||
fontlist: array[0..255] of FontInfoList;
|
||
// bitmaplist: array[0..255] of bitmapInfoList;
|
||
bitmaplist: array of bitmapInfoList;
|
||
listcount, bmplistcount: integer;
|
||
ttbmp: TBitmap;
|
||
idlist, bmpidlist: TStringList;
|
||
editmode: integer; //0=无状态 1=font 2=bitmap
|
||
|
||
//用image的方式来做 这样速度会很快
|
||
PaletteXOffset, PaletteYOffset: integer;
|
||
PaletteRowCount, PaletteColCount: integer;
|
||
PaletteCellHeight, PaletteCellWidth: integer;
|
||
filebmp: tbitmap;
|
||
oldx1, oldy1, x1, y1: integer;
|
||
newcolor, oldcolor, selcolor: tcolor;
|
||
seldown: boolean;
|
||
pixelsrule: integer;
|
||
////
|
||
dataR, dataG, dataB: array[0..1023, 0..512] of string;
|
||
end;
|
||
|
||
var
|
||
Form1: TForm1;
|
||
|
||
implementation
|
||
uses usetup, umodify, uallpreview;
|
||
|
||
{$R *.dfm}
|
||
|
||
procedure TForm1.FormCreate(Sender: TObject);
|
||
begin
|
||
idlist := TStringList.Create;
|
||
bmpidlist := TStringList.Create;
|
||
advinit;
|
||
|
||
ttbmp := TBitmap.Create;
|
||
ttbmp.PixelFormat := pf24bit;
|
||
|
||
ToolButton11.Down := true;
|
||
editmode := 0;
|
||
|
||
bmplistcount := 0;
|
||
//用image的方式
|
||
filebmp := tbitmap.Create;
|
||
filebmp.PixelFormat := pf24bit;
|
||
filebmp.Width := 96;
|
||
filebmp.height := 96;
|
||
filebmp.Canvas.Brush.Color := clBlack;
|
||
filebmp.Canvas.FillRect(rect(0, 0, filebmp.Width, filebmp.height));
|
||
oldx1 := 0;
|
||
oldy1 := 0;
|
||
x1 := 0;
|
||
y1 := 0;
|
||
oldcolor := clnone;
|
||
newcolor := clnone;
|
||
selcolor := clblack;
|
||
pixelsrule := 8;
|
||
end;
|
||
|
||
function TForm1.IntConvertHex(A: Integer; Len: Integer): string;
|
||
//最小值应该为0，但是最大值就没有固定的了！有多少，返回多少
|
||
const
|
||
cConvertStr = #48#49#50#51#52#53#54#55#56#57#65#66#67#68#69#70; //ASCII码
|
||
//#48='0', #49='1',#50='2',#51='3',#52='4',#53='5'#54='6',#55='7',#56='8',
|
||
//#57='9',#65='A',#66='B',#67='C',#68='D',#69='E',#70='F';
|
||
var
|
||
vTmpStr, vTmpChar: string;
|
||
i, vStrLen: Integer;
|
||
begin
|
||
vTmpStr := ''; //要返回的字符串，初始化唯空
|
||
if A < 0 then A := 0;
|
||
|
||
vTmpChar := '';
|
||
vTmpStr := IntToHex(A, Len); //IntToHex(Value: Integer; Digits: Integer): string;overload;
|
||
vStrLen := Length(vTmpStr);
|
||
for i := 1 to vStrLen do
|
||
begin
|
||
vTmpChar := vTmpChar + Copy(vTmpStr, i, 1); //Copy(S; Index, Count: Integer): string;
|
||
if (vTmpChar[i] in ['0'..'9']) then
|
||
vTmpChar[i] := cConvertStr[StrtoInt(vTmpChar[i]) + 1] //用cConvertStr的第一位
|
||
else if ((vTmpChar[i] = 'A') or (vTmpChar[i] = 'a')) then
|
||
vTmpChar[i] := cConvertStr[11]
|
||
else if ((vTmpChar[i] = 'B') or (vTmpChar[i] = 'b')) then
|
||
vTmpChar[i] := cConvertStr[12]
|
||
else if ((vTmpChar[i] = 'C') or (vTmpChar[i] = 'c')) then
|
||
vTmpChar[i] := cConvertStr[13]
|
||
else if ((vTmpChar[i] = 'D') or (vTmpChar[i] = 'd')) then
|
||
vTmpChar[i] := cConvertStr[14]
|
||
else if ((vTmpChar[i] = 'E') and (vTmpChar[i] = 'e')) then
|
||
vTmpChar[i] := cConvertStr[15]
|
||
else if ((vTmpChar[i] = 'F') and (vTmpChar[i] = 'f')) then
|
||
vTmpChar[i] := cConvertStr[16]
|
||
end;
|
||
Result := vTmpChar;
|
||
end;
|
||
|
||
function TForm1.tohex(s: string): string; //2进制转换为10进制
|
||
begin
|
||
Result := IntConvertHex(
|
||
strtoint(s[1]) * ROUND(Power(2, 3)) +
|
||
strtoint(s[2]) * ROUND(Power(2, 2)) +
|
||
strtoint(s[3]) * ROUND(Power(2, 1)) +
|
||
strtoint(s[4]) * ROUND(Power(2, 0)), 1) +
|
||
IntConvertHex(
|
||
strtoint(s[5]) * ROUND(Power(2, 3)) +
|
||
strtoint(s[6]) * ROUND(Power(2, 2)) +
|
||
strtoint(s[7]) * ROUND(Power(2, 1)) +
|
||
strtoint(s[8]) * ROUND(Power(2, 0)), 1);
|
||
end;
|
||
|
||
function Str_IntToBin(Int: LongInt; Size: Integer): string; //10进制转换为2进制
|
||
var
|
||
i: Integer;
|
||
V: string;
|
||
begin
|
||
if Size < 1 then Exit;
|
||
V := '';
|
||
for i := Size downto 1 do
|
||
begin
|
||
if Int and (1 shl (Size - i)) <> 0 then
|
||
v := '1' + v
|
||
else
|
||
v := '0' + v;
|
||
end;
|
||
Result := V;
|
||
end;
|
||
|
||
function hextoint(s: string): Double;
|
||
begin
|
||
while Length(s) <> 0 do
|
||
begin //2^(长度-1)次方
|
||
if s[1] = '1' then Result := Result + power(2, Length(s) - 1);
|
||
s := Copy(s, 2, Length(s));
|
||
end
|
||
end;
|
||
|
||
procedure TForm1.saveprotolfile(count: integer; pFileName: string);
|
||
var
|
||
szSendBuf, v, buf1, s, tempbuf: string;
|
||
fp: file;
|
||
i, j, w, h, m, n, k: integer;
|
||
mBmp: tbitmap;
|
||
y: tcolor;
|
||
p: PByteArray;
|
||
value1, value2, tvalue, value3: integer;
|
||
begin
|
||
SetLength(szSendBuf, 1);
|
||
szSendBuf[1] := Char(count);
|
||
for i := 2 to (1 + count * 4) do
|
||
szSendBuf := szSendBuf + char(0);
|
||
|
||
value3 := 0;
|
||
value2 := 0; //获得开始的位置
|
||
value1 := 0;
|
||
tvalue := 0;
|
||
mBmp := TBitmap.Create;
|
||
mBmp.PixelFormat := pf24bit;
|
||
for i := 0 to count - 1 do
|
||
begin
|
||
w := fontlist[i].width;
|
||
h := fontlist[i].height;
|
||
if w = 0 then w := 8;
|
||
if w mod 8 > 0 then
|
||
mBmp.Width := w + 8 - w mod 8
|
||
else
|
||
mBmp.Width := w;
|
||
mBmp.Height := h;
|
||
|
||
tempbuf := '';
|
||
tempbuf := tempbuf + Char(mBmp.Width div 8);
|
||
tempbuf := tempbuf + Char(w);
|
||
tempbuf := tempbuf + Char(h);
|
||
mBmp.Canvas.Brush.Color := clBlack;
|
||
mBmp.Canvas.FillRect(rect(0, 0, mBmp.Width, mBmp.Height));
|
||
if fontlist[i].bmplist <> nil then
|
||
mBmp.Canvas.Draw(0, 0, fontlist[i].bmplist);
|
||
|
||
v := '';
|
||
m := 0;
|
||
n := 0;
|
||
|
||
for n := 0 to mBmp.height - 1 do
|
||
begin
|
||
s := '';
|
||
p := mBmp.ScanLine[n];
|
||
for m := 0 to mBmp.Width - 1 do
|
||
begin
|
||
if p[m * 3 + 2] >= 128 then
|
||
s := s + '0' else s := s + '1';
|
||
end;
|
||
for k := 0 to mBmp.Width div 8 - 1 do
|
||
// v := v + IntToHex(round(hextoint(s)),2);//
|
||
// v := v +tohex(s[k * 8 + 1] + s[k * 8 + 2] + s[k * 8 + 3] + s[k * 8 + 4] + s[k * 8 + 5] + s[k * 8 + 6] + s[k * 8 + 7] + s[k * 8 + 8]);
|
||
v := v + tohex(copy(s, k * 8 + 1, 8));
|
||
// v := v + IntToHex(round(hextoint(copy(s, k * 8 + 1, 8))),2);//
|
||
end;
|
||
|
||
for j := 0 to (length(v) div 2 - 1) do
|
||
begin
|
||
buf1 := char(strtoint('$' + copy(v, j * 2 + 1, 2)));
|
||
tempbuf := tempbuf + buf1;
|
||
end;
|
||
|
||
|
||
tvalue := length(tempbuf); //每次转换的时候的长度
|
||
szSendBuf := szSendBuf + tempbuf;
|
||
|
||
value1 := value1 + tvalue; //每次都会累积数据长度
|
||
value2 := tvalue;
|
||
value3 := value1 - value2;
|
||
|
||
szSendBuf[4 * i + 2] := Char(value3 shr 24 and $00FF);
|
||
szSendBuf[4 * i + 3] := Char(value3 shr 16 and $00FF);
|
||
szSendBuf[4 * i + 4] := Char(value3 shr 8 and $00FF);
|
||
szSendBuf[4 * i + 5] := Char(value3 and $00FF);
|
||
end;
|
||
mBmp.Free;
|
||
try
|
||
AssignFile(fp, pFileName);
|
||
Rewrite(fp, 1);
|
||
BlockWrite(fp, szSendBuf[1], Length(szSendBuf));
|
||
finally
|
||
CloseFile(fp);
|
||
end;
|
||
end;
|
||
|
||
procedure TForm1.openprotolfile(pfilename: string);
|
||
var
|
||
n, i, h, j: integer;
|
||
szSendBuf, dzbuf: string;
|
||
fp: file;
|
||
v, tv: TStringList;
|
||
value1, value2, tvalue: integer;
|
||
begin
|
||
editmode := 1;
|
||
advinit;
|
||
szSendBuf := '';
|
||
dzbuf := '';
|
||
value1 := 0;
|
||
value2 := 0;
|
||
tvalue := 0;
|
||
try
|
||
AssignFile(fp, pfilename);
|
||
Reset(fp, 1);
|
||
SetLength(szSendBuf, FileSize(Fp));
|
||
BlockRead(Fp, szSendBuf[1], Length(szSendBuf));
|
||
finally
|
||
CloseFile(fp);
|
||
end;
|
||
|
||
v := TStringList.Create;
|
||
tv := TStringList.Create;
|
||
n := Ord(szSendBuf[1]);
|
||
listcount := n;
|
||
h := 0;
|
||
for i := 0 to n - 1 do
|
||
begin
|
||
value1 := h;
|
||
h := Ord(szSendBuf[4 * i + 2]) shl 24 +
|
||
Ord(szSendBuf[4 * i + 3]) shl 16 +
|
||
Ord(szSendBuf[4 * i + 4]) shl 8 +
|
||
Ord(szSendBuf[4 * i + 5]);
|
||
tvalue := h;
|
||
value2 := tvalue - value1;
|
||
v.Add(inttostr(value2));
|
||
tv.Add(inttostr(tvalue));
|
||
end;
|
||
v.Add(inttostr(length(szSendBuf) - n * 4 - 1 - h));
|
||
for j := 0 to n - 1 do
|
||
begin
|
||
dzbuf := '';
|
||
h := 4 * n + 1 + strtoint(tv.Strings[j]) + 1;
|
||
|
||
fontlist[j].id := j;
|
||
fontlist[j].width := Ord(szSendBuf[h + 1]);
|
||
fontlist[j].height := Ord(szSendBuf[h + 2]);
|
||
|
||
AdvStringGrid2.Cells[2, j + 1] := inttostr(j);
|
||
AdvStringGrid2.Cells[3, j + 1] := inttostr(fontlist[j].width);
|
||
AdvStringGrid2.Cells[4, j + 1] := inttostr(fontlist[j].height);
|
||
|
||
if fontlist[j].bmplist <> nil then
|
||
fontlist[j].bmplist.Free;
|
||
fontlist[j].bmplist := TBitmap.Create;
|
||
fontlist[j].bmplist.PixelFormat := pf24bit;
|
||
fontlist[j].bmplist.Width := fontlist[j].width;
|
||
fontlist[j].bmplist.height := fontlist[j].height;
|
||
fontlist[j].bmplist.Canvas.Brush.Color := clblack;
|
||
fontlist[j].bmplist.Canvas.FillRect(Rect(0, 0, fontlist[j].width, fontlist[j].height));
|
||
//idlist.Strings[j]:=IntToStr(j);
|
||
idlist.Add(chr(j) + '=' + inttostr(j));
|
||
for i := 3 to 3 + fontlist[j].height * Ord(szSendBuf[h]) - 1 do
|
||
dzbuf := dzbuf + szSendBuf[h + i];
|
||
Anylizeprotol(j, Ord(szSendBuf[h]) * 8, fontlist[j].height, Ord(szSendBuf[h]), dzbuf);
|
||
end;
|
||
ToolButton7.Enabled := true;
|
||
ToolButton1.Enabled := true;
|
||
ToolButton18.Enabled := false;
|
||
ToolButton8.Enabled := false;
|
||
ToolButton10.Enabled := false;
|
||
ToolButton11.Enabled := false;
|
||
ToolButton19.Enabled:=False;
|
||
ToolButton20.Enabled:=False;
|
||
v.Free;
|
||
tv.Free;
|
||
end;
|
||
|
||
|
||
procedure TForm1.anylizeprotol(id, w, h, b: integer; dzstring: string);
|
||
var
|
||
buf, z, bbuf: string;
|
||
i, j, k, m: integer;
|
||
p2: PByteArray;
|
||
begin
|
||
ttbmp.width := w;
|
||
ttbmp.Height := h;
|
||
ttbmp.Canvas.Lock;
|
||
ttbmp.Canvas.Brush.Color := clBlack;
|
||
ttbmp.Canvas.FillRect(rect(0, 0, ttbmp.width, ttbmp.Height));
|
||
for j := 0 to ttbmp.height - 1 do
|
||
begin
|
||
z := Copy(dzstring, j * b + 1, b);
|
||
buf := '';
|
||
bbuf := '';
|
||
for i := 1 to Length(z) do
|
||
bbuf := bbuf + IntToHex(Ord(z[i]), 2);
|
||
|
||
buf := Str_IntToBin(strtoint('$' + bbuf), length(bbuf) * 4);
|
||
p2 := ttbmp.ScanLine[j];
|
||
for k := 0 to ttbmp.Width - 1 do
|
||
begin
|
||
if buf[k + 1] = '1' then
|
||
begin
|
||
p2[k * 3 + 2] := 0; //红色
|
||
p2[k * 3 + 1] := 0; //绿色
|
||
p2[k * 3] := 0; //蓝色
|
||
end else
|
||
begin
|
||
p2[k * 3 + 2] := 255; //红色
|
||
p2[k * 3 + 1] := 0; //绿色
|
||
p2[k * 3] := 0; //蓝色
|
||
end;
|
||
end;
|
||
end;
|
||
ttbmp.Canvas.Unlock;
|
||
fontlist[id].bmplist.Canvas.Draw(0, 0, ttbmp);
|
||
end;
|
||
|
||
procedure TForm1.AdvStringGrid2Click(Sender: TObject);
|
||
begin
|
||
if AdvStringGrid2.Row > 0 then
|
||
begin
|
||
if AdvStringGrid2.Cells[2, AdvStringGrid2.Row] <> '' then
|
||
begin
|
||
Image1.Visible := true;
|
||
if editmode = 1 then //font
|
||
begin
|
||
filebmp.Width := fontlist[AdvStringGrid2.Row - 1].width;
|
||
filebmp.height := fontlist[AdvStringGrid2.Row - 1].height;
|
||
filebmp.Canvas.Draw(0, 0, fontlist[AdvStringGrid2.Row - 1].bmplist);
|
||
bmpopen(filebmp.Width, filebmp.height, pixelsrule);
|
||
end else
|
||
if editmode = 2 then //bitmap
|
||
begin
|
||
filebmp.Width := bitmaplist[AdvStringGrid2.Row - 1].width;
|
||
filebmp.height := bitmaplist[AdvStringGrid2.Row - 1].height;
|
||
filebmp.Canvas.Draw(0, 0, bitmaplist[AdvStringGrid2.Row - 1].bmplist);
|
||
bmpopen(filebmp.Width, filebmp.height, pixelsrule);
|
||
end;
|
||
oldcolor := clNone;
|
||
newcolor := clNone;
|
||
end else
|
||
Image1.Visible := false;
|
||
end;
|
||
end;
|
||
procedure TForm1.ToolButton1Click(Sender: TObject);
|
||
begin
|
||
ToolButton1.Down := not ToolButton1.Down;
|
||
if ToolButton1.Down = true then
|
||
begin
|
||
ToolButton7.Down := False;
|
||
ToolButton8.Down := False;
|
||
ToolButton10.Down := False;
|
||
ToolButton11.Down := False;
|
||
ToolButton18.Down := False;
|
||
ToolButton19.Down:=False;
|
||
toolbutton20.down:=False;
|
||
selcolor := clFuchsia;
|
||
end;
|
||
end;
|
||
|
||
procedure TForm1.ToolButton7Click(Sender: TObject);
|
||
begin
|
||
ToolButton7.Down := not ToolButton7.Down;
|
||
if ToolButton7.Down = true then
|
||
begin
|
||
ToolButton1.Down := False;
|
||
ToolButton8.Down := False;
|
||
ToolButton10.Down := False;
|
||
ToolButton11.Down := False;
|
||
ToolButton18.Down := False;
|
||
ToolButton19.Down:=False;
|
||
toolbutton20.down:=False;
|
||
selcolor := clRed;
|
||
end;
|
||
end;
|
||
procedure TForm1.ToolButton18Click(Sender: TObject);
|
||
begin
|
||
ToolButton18.Down := not ToolButton18.Down;
|
||
if ToolButton18.Down = true then
|
||
begin
|
||
ToolButton1.Down := False;
|
||
ToolButton8.Down := False;
|
||
ToolButton10.Down := False;
|
||
ToolButton11.Down := False;
|
||
ToolButton7.Down := False;
|
||
ToolButton19.Down:=False;
|
||
toolbutton20.down:=False;
|
||
selcolor := clBlue;
|
||
end;
|
||
end;
|
||
|
||
procedure TForm1.ToolButton8Click(Sender: TObject);
|
||
begin
|
||
ToolButton8.Down := not ToolButton8.Down;
|
||
if ToolButton8.Down = true then
|
||
begin
|
||
ToolButton1.Down := False;
|
||
ToolButton7.Down := False;
|
||
ToolButton10.Down := False;
|
||
ToolButton11.Down := False;
|
||
ToolButton18.Down := False;
|
||
ToolButton19.Down:=False;
|
||
ToolButton20.down:=False;
|
||
selcolor := cllime;
|
||
end;
|
||
end;
|
||
|
||
procedure TForm1.ToolButton10Click(Sender: TObject);
|
||
begin
|
||
ToolButton10.Down := not ToolButton10.Down;
|
||
if ToolButton10.Down = true then
|
||
begin
|
||
ToolButton1.Down := False;
|
||
ToolButton7.Down := False;
|
||
ToolButton8.Down := False;
|
||
ToolButton11.Down := False;
|
||
ToolButton18.Down := False;
|
||
ToolButton19.Down:=False;
|
||
ToolButton20.Down:=False;
|
||
selcolor := clyellow;
|
||
end;
|
||
end;
|
||
|
||
procedure TForm1.ToolButton11Click(Sender: TObject);
|
||
begin
|
||
ToolButton11.Down := not ToolButton11.Down;
|
||
if ToolButton11.Down = true then
|
||
begin
|
||
ToolButton1.Down := False;
|
||
ToolButton7.Down := False;
|
||
ToolButton8.Down := False;
|
||
ToolButton10.Down := False;
|
||
ToolButton18.Down := False;
|
||
ToolButton19.Down:=False;
|
||
ToolButton20.Down:=False;
|
||
selcolor := clblack;
|
||
end;
|
||
end;
|
||
procedure TForm1.ToolButton19Click(Sender: TObject);
|
||
begin
|
||
ToolButton19.Down := not ToolButton19.Down;
|
||
if ToolButton19.Down = true then
|
||
begin
|
||
ToolButton1.Down := False;
|
||
ToolButton7.down:=False;
|
||
ToolButton8.Down := False;
|
||
ToolButton10.Down := False;
|
||
ToolButton11.Down := False;
|
||
ToolButton18.Down := False;
|
||
ToolButton20.Down:=False;
|
||
selcolor := clAqua;
|
||
end;
|
||
end;
|
||
procedure TForm1.ToolButton20Click(Sender: TObject);
|
||
begin
|
||
ToolButton20.Down := not ToolButton20.Down;
|
||
if ToolButton20.Down = true then
|
||
begin
|
||
ToolButton1.Down := False;
|
||
ToolButton7.Down:=False;
|
||
ToolButton8.Down := False;
|
||
ToolButton10.Down := False;
|
||
ToolButton11.Down := False;
|
||
ToolButton18.Down := False;
|
||
ToolButton19.Down:=False;
|
||
selcolor := clWhite;
|
||
end;
|
||
end;
|
||
|
||
|
||
procedure TForm1.N3Click(Sender: TObject);
|
||
begin
|
||
if SaveDialog1.Execute then
|
||
saveprotolfile(listcount, SaveDialog1.FileName);
|
||
end;
|
||
|
||
procedure TForm1.N2Click(Sender: TObject);
|
||
begin
|
||
if OpenDialog1.Execute then
|
||
Openprotolfile(OpenDialog1.FileName);
|
||
end;
|
||
|
||
procedure TForm1.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
|
||
begin
|
||
if MessageBox(Application.Handle, 'Are You Sure to Exit This Application?', 'Operation Hint', MB_OKCANCEL) = mrOK then
|
||
begin
|
||
Application.Terminate;
|
||
end else
|
||
CanClose := false;
|
||
end;
|
||
|
||
procedure TForm1.AdvStringGrid2DblClick(Sender: TObject);
|
||
begin
|
||
if AdvStringGrid2.Row > 0 then
|
||
begin
|
||
if AdvStringGrid2.Cells[2, AdvStringGrid2.Row] <> '' then
|
||
begin
|
||
Form3.Image1.Visible := false;
|
||
if editmode = 1 then
|
||
begin
|
||
Form3.Caption := 'Modify Font';
|
||
form3.Edit1.Text := '';
|
||
Form3.SpinEdit3.Value := strtoint(AdvStringGrid2.Cells[2, AdvStringGrid2.Row]);
|
||
Form3.SpinEdit1.Value := strtoint(AdvStringGrid2.Cells[3, AdvStringGrid2.Row]);
|
||
Form3.SpinEdit2.Value := strtoint(AdvStringGrid2.Cells[4, AdvStringGrid2.Row]);
|
||
Form3.id := strtoint(AdvStringGrid2.Cells[2, AdvStringGrid2.Row]);
|
||
Form3.dw := strtoint(AdvStringGrid2.Cells[3, AdvStringGrid2.Row]);
|
||
Form3.dh := strtoint(AdvStringGrid2.Cells[4, AdvStringGrid2.Row]);
|
||
Form3.pColCount := strtoint(AdvStringGrid2.Cells[3, AdvStringGrid2.Row]); //宽度
|
||
Form3.pRowCount := strtoint(AdvStringGrid2.Cells[4, AdvStringGrid2.Row]); //高度
|
||
Form3.ShowModal;
|
||
end else
|
||
if editmode = 2 then
|
||
begin
|
||
Form3.Caption := 'Modify Bitmap';
|
||
form3.Edit1.Text := AdvStringGrid2.Cells[2, AdvStringGrid2.Row];
|
||
Form3.SpinEdit3.Value := strtoint(bmpidlist.Values[AdvStringGrid2.Cells[2, AdvStringGrid2.Row]]);
|
||
Form3.SpinEdit1.Value := strtoint(AdvStringGrid2.Cells[3, AdvStringGrid2.Row]);
|
||
Form3.SpinEdit2.Value := strtoint(AdvStringGrid2.Cells[4, AdvStringGrid2.Row]);
|
||
Form3.id := strtoint(bmpidlist.Values[AdvStringGrid2.Cells[2, AdvStringGrid2.Row]]);
|
||
Form3.dw := strtoint(AdvStringGrid2.Cells[3, AdvStringGrid2.Row]);
|
||
Form3.dh := strtoint(AdvStringGrid2.Cells[4, AdvStringGrid2.Row]);
|
||
Form3.pColCount := strtoint(AdvStringGrid2.Cells[3, AdvStringGrid2.Row]); //宽度
|
||
Form3.pRowCount := strtoint(AdvStringGrid2.Cells[4, AdvStringGrid2.Row]); //高度
|
||
//bitmaplist[Form3.SpinEdit3.Value].bmplist.SaveToFile('c:\1.bmp');
|
||
Form3.uclear := false;
|
||
Form3.ShowModal;
|
||
end;
|
||
end;
|
||
end;
|
||
end;
|
||
|
||
procedure TForm1.advinitbmp;
|
||
var
|
||
i: integer;
|
||
begin
|
||
AdvStringGrid2.Clear;
|
||
AdvStringGrid2.Cells[0, 0] := '';
|
||
AdvStringGrid2.ColWidths[0] := 0;
|
||
AdvStringGrid2.Cells[1, 0] := '';
|
||
AdvStringGrid2.ColWidths[1] := 0;
|
||
AdvStringGrid2.Cells[2, 0] := 'Name';
|
||
AdvStringGrid2.ColWidths[2] := 80;
|
||
AdvStringGrid2.Cells[3, 0] := 'Width';
|
||
AdvStringGrid2.ColWidths[3] := 50;
|
||
AdvStringGrid2.Cells[4, 0] := 'Height';
|
||
AdvStringGrid2.ColWidths[4] := 50;
|
||
bmpidlist.Clear;
|
||
AdvStringGrid2.RowCount := 2;
|
||
end;
|
||
|
||
procedure TForm1.advinit;
|
||
var
|
||
i: integer;
|
||
begin
|
||
AdvStringGrid2.Cells[0, 0] := '';
|
||
AdvStringGrid2.ColWidths[0] := 25;
|
||
AdvStringGrid2.Cells[1, 0] := '';
|
||
AdvStringGrid2.ColWidths[1] := 30;
|
||
AdvStringGrid2.Cells[2, 0] := 'Id';
|
||
AdvStringGrid2.ColWidths[2] := 80;
|
||
AdvStringGrid2.Cells[3, 0] := 'Width';
|
||
AdvStringGrid2.ColWidths[3] := 50;
|
||
AdvStringGrid2.Cells[4, 0] := 'Height';
|
||
AdvStringGrid2.ColWidths[4] := 50;
|
||
idlist.Clear;
|
||
AdvStringGrid2.RowCount := 129;
|
||
for i := 0 to 127 do
|
||
begin
|
||
AdvStringGrid2.WideCells[0, i + 1] := chr(i);
|
||
AdvStringGrid2.WideCells[1, i + 1] := inttostr(i);
|
||
end;
|
||
for i := 0 to 255 do
|
||
idlist.Add(chr(i) + '=' + inttostr(i));
|
||
end;
|
||
|
||
procedure TForm1.NewFontFile1Click(Sender: TObject);
|
||
begin
|
||
if MessageBox(Application.Handle, 'Do You Want to Create New Font Library File?', 'Create Hint', MB_OKCANCEL + MB_ICONINFORMATION) = MrOK then
|
||
begin
|
||
AdvStringGrid2.Clear;
|
||
Image1.Visible := false;
|
||
advinit;
|
||
AdvStringGrid2.ColWidths[0] := 25;
|
||
AdvStringGrid2.ColWidths[1] := 30;
|
||
Form2.Caption := 'Font Setup';
|
||
Form2.fontpanel.Visible := true;
|
||
Form2.bitmapPanel.Visible := false;
|
||
Form2.ShowModal;
|
||
end;
|
||
end;
|
||
|
||
procedure TForm1.AllFont1Click(Sender: TObject);
|
||
begin
|
||
if listcount = 0 then exit;
|
||
Form4.Caption := 'All Font Preview';
|
||
Form4.Panelsingal.Visible := false;
|
||
Form4.Panelall.Visible := true;
|
||
Form4.Image1.Visible := false;
|
||
Form4.ShowModal;
|
||
end;
|
||
|
||
procedure TForm1.De1Click(Sender: TObject);
|
||
begin
|
||
if listcount = 0 then exit;
|
||
Form4.Caption := 'Defined Font Preview';
|
||
Form4.Panelsingal.Visible := true;
|
||
Form4.Panelall.Visible := false;
|
||
Form4.Memo1.Lines.Clear;
|
||
Form4.Image1.Visible := false;
|
||
Form4.ShowModal;
|
||
end;
|
||
|
||
procedure TForm1.N8pixels2Click(Sender: TObject);
|
||
begin
|
||
pixelsrule := 8;
|
||
N8pixels2.Default := true;
|
||
AdvStringGrid2Click(sender);
|
||
end;
|
||
|
||
procedure TForm1.N10pixels2Click(Sender: TObject);
|
||
begin
|
||
pixelsrule := 10;
|
||
N10pixels2.Default := true;
|
||
AdvStringGrid2Click(sender);
|
||
end;
|
||
|
||
procedure TForm1.N14pixels1Click(Sender: TObject);
|
||
begin
|
||
pixelsrule := 12;
|
||
N14pixels1.Default := true;
|
||
AdvStringGrid2Click(sender);
|
||
end;
|
||
|
||
procedure TForm1.OpenBitmapFile1Click(Sender: TObject);
|
||
begin
|
||
if OpenDialog2.Execute then
|
||
Openbmpprotolfile(OpenDialog2.FileName);
|
||
end;
|
||
|
||
procedure TForm1.AnylizeBmpProtol(id, w, h, b: integer; dzstring: string);
|
||
var
|
||
buf1, buf2, z: string;
|
||
bbuf1, bbuf2: string;
|
||
i, j, k, m: integer;
|
||
p2: PByteArray;
|
||
sR, sG: string;
|
||
begin
|
||
ttbmp.width := w;
|
||
ttbmp.Height := h;
|
||
ttbmp.Canvas.Lock;
|
||
ttbmp.Canvas.Brush.Color := clBlack;
|
||
ttbmp.Canvas.FillRect(rect(0, 0, ttbmp.width, ttbmp.Height));
|
||
for j := 0 to ttbmp.height - 1 do
|
||
begin
|
||
z := Copy(dzstring, j * b + 1, b);
|
||
buf1 := '';
|
||
buf2 := '';
|
||
sR := '';
|
||
sG := '';
|
||
for i := 1 to Length(z) do
|
||
begin
|
||
if i mod 2 <> 0 then
|
||
sR := sR + IntToHex(Ord(z[i]), 2) else
|
||
sG := sG + IntToHex(Ord(z[i]), 2);
|
||
end;
|
||
|
||
for m := 0 to length(sR) div 2 - 1 do
|
||
begin
|
||
buf1 := buf1 + Str_IntToBin(strtoint('$' + Copy(sR, m * 2 + 1, 2)), 2 * 4); //FEFF //红色
|
||
buf2 := buf2 + Str_IntToBin(strtoint('$' + Copy(sG, m * 2 + 1, 2)), 2 * 4); //FEFF //绿色
|
||
end;
|
||
//buf1 := V1 + buf1;
|
||
//buf2 := V2 + buf2;
|
||
//buf1 := Str_IntToBin(strtoint('$' + sR), length(sR) * 4); //FEFF //红色
|
||
//buf2 := Str_IntToBin(strtoint('$' + sG), length(sG) * 4); //FEFF //绿色
|
||
p2 := ttbmp.ScanLine[j];
|
||
for k := 0 to ttbmp.Width - 1 do
|
||
begin
|
||
//先解析红色
|
||
if buf1[k + 1] = '1' then p2[k * 3 + 2] := 0 else p2[k * 3 + 2] := 255;
|
||
if buf2[k + 1] = '1' then p2[k * 3 + 1] := 0 else p2[k * 3 + 1] := 255;
|
||
p2[k * 3] := 0; //蓝色
|
||
end;
|
||
end;
|
||
ttbmp.Canvas.Unlock;
|
||
bitmaplist[id].bmplist.Canvas.Draw(0, 0, ttbmp);
|
||
end;
|
||
|
||
function HexToString(s: string): string;
|
||
var
|
||
i: Integer;
|
||
begin
|
||
if Length(s) mod 2 <> 0 then Exit;
|
||
SetLength(Result, Length(s) div 2);
|
||
for i := 1 to Length(Result) do
|
||
begin
|
||
if s[i * 2 - 1] in ['0'..'9'] then Result[i] := Chr(Ord(s[i * 2 - 1]) - Ord('0'))
|
||
else if s[i * 2 - 1] in ['A'..'F'] then Result[i] := Chr(Ord(s[i * 2 - 1]) - Ord('A') + 10)
|
||
else Exit; // error!
|
||
Result[i] := Chr(Ord(Result[i]) shl 4);
|
||
if s[i * 2] in ['0'..'9'] then Result[i] := Chr(Ord(Result[i]) + Ord(s[i * 2]) - Ord('0'))
|
||
else if s[i * 2] in ['A'..'F'] then Result[i] := Chr(Ord(Result[i]) + Ord(s[i * 2]) - Ord('A') + 10)
|
||
else Exit; // error!
|
||
end;
|
||
end;
|
||
|
||
procedure TForm1.OpenBmpProtolFile(pfilename: string);
|
||
var
|
||
n, i, h, j: integer;
|
||
szSendBuf, dzbuf, s: string;
|
||
fp: file;
|
||
v, tv: TStringList;
|
||
value1, value2, tvalue: integer;
|
||
begin
|
||
editmode := 2;
|
||
advinitbmp;
|
||
szSendBuf := '';
|
||
s := '';
|
||
dzbuf := '';
|
||
value1 := 0;
|
||
value2 := 0;
|
||
tvalue := 0;
|
||
try
|
||
AssignFile(fp, pfilename);
|
||
Reset(fp, 1);
|
||
SetLength(szSendBuf, FileSize(Fp));
|
||
BlockRead(Fp, szSendBuf[1], Length(szSendBuf));
|
||
finally
|
||
CloseFile(fp);
|
||
end;
|
||
|
||
v := TStringList.Create;
|
||
tv := TStringList.Create;
|
||
// n := Ord(szSendBuf[1]);
|
||
n := Ord(szSendBuf[1]) shl 8 + Ord(szSendBuf[2]);
|
||
AdvStringGrid2.RowCount := n + 1;
|
||
bmplistcount := n;
|
||
setlength(bitmaplist, n); //设置动态数组的长度
|
||
h := 0;
|
||
for i := 0 to n - 1 do
|
||
begin
|
||
value1 := h;
|
||
h := Ord(szSendBuf[12 * i + 11]) shl 24 +
|
||
Ord(szSendBuf[12 * i + 12]) shl 16 +
|
||
Ord(szSendBuf[12 * i + 13]) shl 8 +
|
||
Ord(szSendBuf[12 * i + 14]);
|
||
tvalue := h;
|
||
value2 := tvalue - value1;
|
||
v.Add(inttostr(value2));
|
||
tv.Add(inttostr(tvalue)); //offset的值
|
||
end;
|
||
v.Add(inttostr(length(szSendBuf) - n * 12 - 2 - h));
|
||
for j := 0 to n - 1 do
|
||
begin
|
||
dzbuf := '';
|
||
h := 12 * j + 2;
|
||
|
||
s := '';
|
||
for i := 1 to 8 do
|
||
begin
|
||
if szSendBuf[h + i] <> chr(0) then
|
||
s := s + szSendBuf[h + i] else
|
||
break;
|
||
end;
|
||
h := 12 * n + 2 + strtoint(tv.Strings[j]);
|
||
|
||
bitmaplist[j].name := s;
|
||
bitmaplist[j].width := Ord(szSendBuf[h + 3]) shl 8 + Ord(szSendBuf[h + 4]);
|
||
bitmaplist[j].height := Ord(szSendBuf[h + 5]) shl 8 + Ord(szSendBuf[h + 6]);
|
||
|
||
AdvStringGrid2.Cells[2, j + 1] := s;
|
||
AdvStringGrid2.Cells[3, j + 1] := inttostr(bitmaplist[j].width);
|
||
AdvStringGrid2.Cells[4, j + 1] := inttostr(bitmaplist[j].height);
|
||
|
||
if bitmaplist[j].bmplist <> nil then
|
||
bitmaplist[j].bmplist.Free;
|
||
bitmaplist[j].bmplist := TBitmap.Create;
|
||
bitmaplist[j].bmplist.PixelFormat := pf24bit;
|
||
bitmaplist[j].bmplist.Width := bitmaplist[j].width;
|
||
bitmaplist[j].bmplist.height := bitmaplist[j].height;
|
||
bitmaplist[j].bmplist.Canvas.Brush.Color := clblack;
|
||
bitmaplist[j].bmplist.Canvas.FillRect(Rect(0, 0, bitmaplist[j].width, bitmaplist[j].height));
|
||
bmpidlist.Add(s + '=' + inttostr(j));
|
||
for i := 1 to bitmaplist[j].height * (Ord(szSendBuf[h + 1]) shl 8 + Ord(szSendBuf[h + 2])) * 2 do
|
||
dzbuf := dzbuf + szSendBuf[h + i + 6];
|
||
|
||
AnylizeBmpProtol(j, (Ord(szSendBuf[h + 1]) shl 8 + Ord(szSendBuf[h + 2])) * 8, bitmaplist[j].height,
|
||
(Ord(szSendBuf[h + 1]) shl 8 + Ord(szSendBuf[h + 2])) * 2, dzbuf);
|
||
end;
|
||
ToolButton1.Enabled := true;
|
||
ToolButton7.Enabled := true;
|
||
ToolButton8.Enabled := true;
|
||
ToolButton10.Enabled := true;
|
||
ToolButton18.Enabled := true;
|
||
ToolButton19.Enabled := true;
|
||
ToolButton20.enabled:=True;
|
||
v.Free;
|
||
tv.Free;
|
||
end;
|
||
|
||
procedure TForm1.SaveBmpProtolFile(count: integer; pFileName: string);
|
||
var
|
||
szSendBuf, v, buf1, s, tempbuf, s2: string;
|
||
fp: file;
|
||
i, j, w, h, m, n, k, kk, z1, z2: integer;
|
||
mBmp: tbitmap;
|
||
y: tcolor;
|
||
p: PByteArray;
|
||
value1, value2, tvalue, value3: integer;
|
||
sR, sG, sB, t: string;
|
||
begin
|
||
s2 := '';
|
||
SetLength(szSendBuf, 2);
|
||
szSendBuf[1] := Char(count shr 8 and $00FF);
|
||
szSendBuf[2] := Char(count and $00FF);
|
||
for i := 3 to (2 + count * 12) do
|
||
szSendBuf := szSendBuf + char(0);
|
||
|
||
value3 := 0;
|
||
value2 := 0; //获得开始的位置
|
||
|
||
value1 := 0;
|
||
tvalue := 0;
|
||
mBmp := TBitmap.Create;
|
||
mBmp.PixelFormat := pf24bit;
|
||
for i := 0 to count - 1 do
|
||
begin
|
||
s2 := bitmaplist[i].name;
|
||
w := bitmaplist[i].width;
|
||
h := bitmaplist[i].height;
|
||
if w = 0 then w := 8;
|
||
if w mod 8 > 0 then
|
||
mBmp.Width := w + 8 - w mod 8
|
||
else
|
||
mBmp.Width := w;
|
||
mBmp.Height := h;
|
||
|
||
tempbuf := '';
|
||
tempbuf := tempbuf + Char(mBmp.Width div 8 shr 8 and $00FF);
|
||
tempbuf := tempbuf + Char(mBmp.Width div 8 and $00FF);
|
||
tempbuf := tempbuf + Char(w shr 8 and $00FF);
|
||
tempbuf := tempbuf + Char(w and $00FF);
|
||
tempbuf := tempbuf + Char(h shr 8 and $00FF);
|
||
tempbuf := tempbuf + Char(h and $00FF);
|
||
|
||
mBmp.Canvas.Brush.Color := clBlack;
|
||
mBmp.Canvas.FillRect(rect(0, 0, mBmp.Width, mBmp.Height));
|
||
if bitmaplist[i].bmplist <> nil then
|
||
mBmp.Canvas.Draw(0, 0, bitmaplist[i].bmplist);
|
||
mBmp.SaveToFile('E:\1.bmp');
|
||
v := '';
|
||
m := 0;
|
||
n := 0;
|
||
|
||
for n := 0 to mBmp.height - 1 do
|
||
begin
|
||
s := '';
|
||
p := mBmp.ScanLine[n];
|
||
for m := 0 to mBmp.Width - 1 do
|
||
begin
|
||
if p[m * 3 + 2] >= 128 then
|
||
dataR[m, n] := '0' else dataR[m, n] := '1';
|
||
if p[m * 3 + 1] >= 128 then
|
||
dataG[m, n] := '0' else dataG[m, n] := '1';
|
||
if p[m * 3] >= 128 then
|
||
dataB[m, n] := '0' else dataB[m, n] := '1';
|
||
end;
|
||
end;
|
||
|
||
|
||
sR := '';
|
||
sG := '';
|
||
t := '';
|
||
for z1 := 0 to mBmp.height - 1 do //行数
|
||
begin
|
||
for z2 := 0 to mBmp.Width div 8 - 1 do //列数
|
||
begin
|
||
sR := '';
|
||
sG := '';
|
||
sB := '';
|
||
for k := 0 to 7 do
|
||
begin
|
||
sR := sR + dataR[k + 8 * z2, z1];
|
||
sG := sG + dataG[k + 8 * z2, z1];
|
||
sB := sB + dataB[k + 8 * z2, z1];
|
||
end;
|
||
t := tohex(sR) + tohex(sG) + tohex(sB);
|
||
for j := 0 to length(t) div 2 - 1 do
|
||
begin
|
||
buf1 := char(strtoint('$' + copy(t, j * 2 + 1, 2)));
|
||
tempbuf := tempbuf + buf1;
|
||
end;
|
||
end;
|
||
end;
|
||
|
||
tvalue := length(tempbuf); //每次转换的时候的长度
|
||
szSendBuf := szSendBuf + tempbuf;
|
||
|
||
value1 := value1 + tvalue; //每次都会累积数据长度
|
||
value2 := tvalue;
|
||
value3 := value1 - value2;
|
||
for kk := 1 to length(s2) do
|
||
szSendBuf[12 * i + 2 + kk] := Char(ord(s2[kk]));
|
||
if Length(s2) <> 8 then
|
||
begin
|
||
for kk := length(s2) + 1 to 8 do
|
||
szSendBuf[12 * i + 2 + kk] := chr(0);
|
||
end;
|
||
|
||
szSendBuf[12 * i + 11] := Char(value3 shr 24 and $00FF);
|
||
szSendBuf[12 * i + 12] := Char(value3 shr 16 and $00FF);
|
||
szSendBuf[12 * i + 13] := Char(value3 shr 8 and $00FF);
|
||
szSendBuf[12 * i + 14] := Char(value3 and $00FF);
|
||
end;
|
||
mBmp.Free;
|
||
try
|
||
AssignFile(fp, pFileName);
|
||
Rewrite(fp, 1);
|
||
BlockWrite(fp, szSendBuf[1], Length(szSendBuf));
|
||
finally
|
||
CloseFile(fp);
|
||
end;
|
||
end;
|
||
|
||
procedure TForm1.NewBitampFile1Click(Sender: TObject);
|
||
begin
|
||
if MessageBox(Application.Handle, 'Do You Want to Create New Bitmap Library File?', 'Create Hint', MB_OKCANCEL + MB_ICONINFORMATION) = MrOK then
|
||
begin
|
||
AdvStringGrid2.Clear;
|
||
advinitbmp;
|
||
Image1.Visible := false;
|
||
bmplistcount := 0;
|
||
Form2.Caption := 'Bitmap Setup';
|
||
Form2.fontpanel.Visible := false;
|
||
Form2.bitmapPanel.Visible := true;
|
||
Form2.ShowModal;
|
||
end;
|
||
end;
|
||
|
||
|
||
procedure DynArraySetZero(var A);
|
||
var
|
||
P: PLongint; //占用4个字节，正好符合 32 位内存排列
|
||
begin
|
||
P := PLongint(A); // 指向 A 的地址
|
||
Dec(P); //P 地址偏移量是 sizeof(A)，指向了数组长度
|
||
P^ := 0; // 长度清空
|
||
Dec(P); // 指向引用计数
|
||
P^ := 0; //计数清空。
|
||
end;
|
||
|
||
|
||
procedure DynArrayDelete(var A; elSize: Longint; index, Count: Integer);
|
||
var
|
||
len, MaxDelete: Integer;
|
||
P: PLongint; //4 个字节的长整形指针
|
||
begin
|
||
P := PLongint(A); // 取的 A 的地址
|
||
if P = nil then
|
||
Exit;
|
||
{下面这句完全等同于 Dec(P) ; len := P^
|
||
因为 Dec(P) = Pchar(P) – 4 同样是移动4 字节的偏移量，只不过后者按字节来移动 }
|
||
len := PLongint(PChar(P) - 4)^; // 变量的长度 ，偏移量 -4
|
||
if index >= len then //要删除的位置超出范围，退出
|
||
Exit;
|
||
MaxDelete := len - index; // 最多删除的数量
|
||
Count := Min(Count, MaxDelete); // 取得一个较小值
|
||
if Count = 0 then // 不要求删除
|
||
Exit;
|
||
Dec(len, Count); // 移动到要删除的位置
|
||
MoveMemory(PChar(P) + index * elSize, PChar(P) + (index + Count) * elSize, (len - index) * elSize); //移动内存
|
||
Dec(P); //移出 “数组长度”位置
|
||
Dec(P); //移出“引用计数” 位置
|
||
//重新再分配调整内存,len 新的长度. Sizeof(Longint) * 2 = 2*Dec(P)
|
||
ReallocMem(P, len * elSize + Sizeof(Longint) * 2);
|
||
Inc(P); // 指向数组长度
|
||
P^ := len; // new length
|
||
Inc(P); // 指向数组元素，开始的位置
|
||
PLongint(A) := P;
|
||
end;
|
||
|
||
|
||
procedure TForm1.RemoveBitmap1Click(Sender: TObject);
|
||
var
|
||
id,sel: integer;
|
||
t: bitmapInfoList;
|
||
begin
|
||
if AdvStringGrid2.Row > 0 then
|
||
begin
|
||
if AdvStringGrid2.Cells[2, AdvStringGrid2.Row] <> '' then
|
||
if MessageBox(Application.Handle, 'Do You Want to Delete Selected Bitmap?', 'Operation Hint', MB_OKCANCEL + MB_ICONINFORMATION) = MrOK then
|
||
begin
|
||
sel:= AdvStringGrid2.Row ;
|
||
id := strtoint(bmpidlist.Values[AdvStringGrid2.Cells[2, AdvStringGrid2.Row]]);
|
||
DynArrayDelete(bitmaplist, SIZEoF(bitmaplist[id]), id, 1);
|
||
bmpidlist.Delete(id);
|
||
Form1.bmplistcount := Form1.bmplistcount - 1;
|
||
if Form1.bmplistcount > 0 then
|
||
begin
|
||
AdvStringGrid2.RemoveRowsEx(AdvStringGrid2.Row, 1);
|
||
AdvStringGrid2.Row := sel + 1;
|
||
AdvStringGrid2Click(sender);
|
||
end else
|
||
begin
|
||
advinitbmp;
|
||
AdvStringGrid2.Row := 1;
|
||
AdvStringGrid2Click(sender);
|
||
end;
|
||
end;
|
||
end;
|
||
end;
|
||
|
||
procedure TForm1.AddBitmapFile1Click(Sender: TObject);
|
||
begin
|
||
if editmode = 2 then
|
||
begin
|
||
Form2.Caption := 'Bitmap Setup';
|
||
Form2.fontpanel.Visible := false;
|
||
Form2.bitmapPanel.Visible := true;
|
||
Form2.Edit2.Text := '';
|
||
Form2.ShowModal;
|
||
end;
|
||
end;
|
||
|
||
procedure TForm1.bmpopen(w, h, pixels: integer);
|
||
var
|
||
i, j, x, y: integer;
|
||
p, p2: PByteArray;
|
||
frame: trect;
|
||
bmp: tbitmap;
|
||
r, g: byte;
|
||
begin
|
||
//加入paintbox 分块显示
|
||
Image1.Width := w * pixels + 1;
|
||
Image1.height := h * pixels + 1;
|
||
|
||
bmp := TBitmap.Create;
|
||
bmp.PixelFormat := pf24bit;
|
||
bmp.Width := Image1.Width;
|
||
bmp.height := Image1.height;
|
||
bmp.Canvas.Brush.Color := rgb(64, 64, 64);
|
||
bmp.Canvas.FillRect(Rect(0, 0, bmp.Width, bmp.height));
|
||
PaletteColCount := w;
|
||
PaletteRowCount := h;
|
||
|
||
// Calculate grid cell size
|
||
PaletteCellWidth := pixels;
|
||
PaletteCellHeight := pixels;
|
||
|
||
oldx1 := 0;
|
||
oldy1 := 0;
|
||
x1 := 0;
|
||
y1 := 0;
|
||
|
||
PaletteXOffset := (PaletteColCount * pixels - (PaletteColCount * PaletteCellWidth)) div 2;
|
||
PaletteYOffset := (PaletteRowCount * pixels - (PaletteRowCount * PaletteCellHeight)) div 2;
|
||
y := 0;
|
||
for i := 0 to filebmp.height - 1 do
|
||
begin
|
||
p := filebmp.ScanLine[i];
|
||
x := 0;
|
||
for j := 0 to filebmp.Width - 1 do
|
||
begin
|
||
Frame.Left := x;
|
||
Frame.Right := x + PaletteCellWidth;
|
||
Frame.Top := y;
|
||
Frame.Bottom := y + PaletteCellHeight;
|
||
DrawEdge(bmp.Canvas.Handle, Frame, BDR_SUNKENINNER, BF_ADJUST or BF_LEFT);
|
||
DrawEdge(bmp.Canvas.Handle, Frame, BDR_SUNKENINNER, BF_ADJUST or BF_top);
|
||
if p[j * 3 + 2] >= 128 then
|
||
r := 255 else r := 0;
|
||
if p[j * 3 + 1] >= 128 then
|
||
g := 255 else g := 0;
|
||
bmp.Canvas.Brush.Color := rgb(r, g, 0);
|
||
bmp.Canvas.FillRect(Frame);
|
||
inc(x, PaletteCellWidth);
|
||
end;
|
||
inc(y, PaletteCellHeight);
|
||
end;
|
||
Image1.Picture.Bitmap := bmp;
|
||
bmp.Free;
|
||
end;
|
||
|
||
procedure TForm1.Image1MouseMove(Sender: TObject; Shift: TShiftState; X,
|
||
Y: Integer);
|
||
var
|
||
p: TPoint;
|
||
ColorIndex: integer;
|
||
Row, Col: integer;
|
||
Frame: trect;
|
||
begin
|
||
GetCursorPos(p);
|
||
p := Image1.ScreenToClient(p);
|
||
MouseToColor(p.X, p.Y, Row, Col);
|
||
|
||
if oldcolor <> clnone then
|
||
begin
|
||
Image1.Canvas.Pen.Color := oldcolor;
|
||
Frame.Left := oldx1 + 1;
|
||
Frame.Right := oldx1 + PaletteCellWidth - 1;
|
||
Frame.Top := oldy1 + 1;
|
||
Frame.Bottom := oldy1 + PaletteCellHeight - 1;
|
||
Image1.Canvas.Polyline([Point(Frame.Left, Frame.top),
|
||
Point(Frame.Right, Frame.top),
|
||
Point(Frame.Right, Frame.bottom),
|
||
Point(Frame.left, Frame.bottom),
|
||
Point(Frame.Left, Frame.top)]);
|
||
end;
|
||
x1 := Col * PaletteCellWidth;
|
||
y1 := Row * PaletteCellheight;
|
||
newcolor := Image1.Canvas.Pixels[x1 + 1, y1 + 1];
|
||
|
||
Frame.Left := x1 + 1;
|
||
Frame.Right := x1 + PaletteCellWidth - 1;
|
||
Frame.Top := y1 + 1;
|
||
Frame.Bottom := y1 + PaletteCellHeight - 1;
|
||
Image1.Canvas.Pen.Color := clwhite;
|
||
|
||
Image1.Canvas.Polyline([Point(Frame.Left, Frame.top),
|
||
Point(Frame.Right, Frame.top),
|
||
Point(Frame.Right, Frame.bottom),
|
||
Point(Frame.left, Frame.bottom),
|
||
Point(Frame.Left, Frame.top)]);
|
||
|
||
oldx1 := x1;
|
||
oldy1 := y1;
|
||
oldcolor := newcolor;
|
||
StatusBar1.Panels[0].Text := 'x:' + inttostr(Row);
|
||
StatusBar1.Panels[1].Text := 'y:' + inttostr(col);
|
||
StatusBar1.Panels[3].Text := 'R:' + inttostr(GetRValue(newcolor));
|
||
StatusBar1.Panels[4].Text := 'G:' + inttostr(GetGValue(newcolor));
|
||
StatusBar1.Panels[5].Text := 'B:' + inttostr(GetBValue(newcolor));
|
||
end;
|
||
|
||
procedure TForm1.MouseToColor(X, Y: integer; var Row, Col: integer);
|
||
begin
|
||
if (PaletteCellHeight > 0) and (PaletteCellWidth > 0) and
|
||
(X >= PaletteXOffset) and (Y >= PaletteYOffset) then
|
||
begin
|
||
Row := ((Y - PaletteYOffset) div PaletteCellHeight);
|
||
Col := ((X - PaletteXOffset) div PaletteCellWidth);
|
||
end
|
||
end;
|
||
|
||
procedure TForm1.Image1MouseUp(Sender: TObject; Button: TMouseButton;
|
||
Shift: TShiftState; X, Y: Integer);
|
||
var
|
||
p: TPoint;
|
||
Row, Col: integer;
|
||
Frame: trect;
|
||
xx, yy, v: integer;
|
||
begin
|
||
if PaletteRowCount > 0 then
|
||
begin
|
||
GetCursorPos(p);
|
||
p := Image1.ScreenToClient(p);
|
||
MouseToColor(p.X, p.Y, Row, Col);
|
||
|
||
xx := Col * PaletteCellWidth;
|
||
yy := Row * PaletteCellheight;
|
||
|
||
Frame.Left := xx + 1;
|
||
Frame.Right := xx + PaletteCellWidth - 1;
|
||
Frame.Top := yy + 1;
|
||
Frame.Bottom := yy + PaletteCellHeight - 1;
|
||
Image1.Canvas.Brush.Color := selcolor;
|
||
|
||
Image1.Canvas.FillRect(Frame);
|
||
oldcolor := clnone;
|
||
newcolor := clnone;
|
||
if editmode = 1 then
|
||
begin
|
||
if fontlist[strtoint(AdvStringGrid2.Cells[2, AdvStringGrid2.Row])].bmplist <> nil then
|
||
fontlist[strtoint(AdvStringGrid2.Cells[2, AdvStringGrid2.Row])].bmplist.Canvas.Pixels[Col, row] := selcolor;
|
||
end else
|
||
if editmode = 2 then
|
||
begin
|
||
v := strtoint(bmpidlist.Values[AdvStringGrid2.Cells[2, AdvStringGrid2.Row]]);
|
||
if bitmaplist[v].bmplist <> nil then
|
||
bitmaplist[v].bmplist.Canvas.Pixels[Col, row] := selcolor;
|
||
end;
|
||
end;
|
||
end;
|
||
|
||
procedure TForm1.SaveBitmapFile1Click(Sender: TObject);
|
||
begin
|
||
if bmplistcount > 0 then
|
||
if SaveDialog2.Execute then
|
||
SaveBmpProtolFile(bmplistcount, SaveDialog2.FileName); //
|
||
end;
|
||
|
||
procedure TForm1.BitmapLibrary1Click(Sender: TObject);
|
||
begin
|
||
if editmode = 2 then
|
||
begin
|
||
AddBitmapFile1.Enabled := true;
|
||
RemoveBitmap1.Enabled := true;
|
||
end else
|
||
begin
|
||
AddBitmapFile1.Enabled := false;
|
||
RemoveBitmap1.Enabled := false;
|
||
end;
|
||
end;
|
||
|
||
|
||
|
||
|
||
|
||
|
||
end.
|