YangOne/GrabBag
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity
GrabBag/SDK/LED/BX-5K 5MK 6K 6K-YY Font card(Contain Voice)220330/TOOL/三基色色图库制作软件/三基色图库程序/.svn/text-base/umain.pas.svn-base

1258 lines
37 KiB
Plaintext
Raw Normal View History

SDK下移除 module & device下的依赖库
2026-07-13 14:42:56 +08:00
unit umain;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, Spin, ExtCtrls, Grids, BaseGrid, AdvGrid, ComCtrls,
ToolWin, Menus, ImgList, math;
type
FontInfoList = record //font<6E><74><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
id: integer;
width: integer;
height: integer;
bmplist: TBitmap;
end;
type
bitmapInfoList = record //bitmap<61><70><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
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;
ToolButton7: TToolButton;
ToolButton8: 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;
procedure FormCreate(Sender: TObject);
procedure SaveProtolFile(count: integer; pFileName: string); //<2F><><EFBFBD><EFBFBD><EFBFBD><EFBFBD>ģ
procedure OpenProtolFile(pfilename: string); //<2F><><EFBFBD><EFBFBD><EFBFBD><EFBFBD>ģ
procedure AnylizeProtol(id, w, h, b: integer; dzstring: string);
procedure SaveBmpProtolFile(count: integer; pFileName: string); //<2F><><EFBFBD><EFBFBD>ͼƬ
procedure OpenBmpProtolFile(pfilename: string); //<2F><><EFBFBD><EFBFBD>ͼƬ
procedure AnylizeBmpProtol(id, w, h, b: integer; dzstring: string); //<2F><><EFBFBD><EFBFBD>ͼƬ
procedure AdvStringGrid2Click(Sender: TObject);
procedure ToolButton7Click(Sender: TObject);
procedure ToolButton8Click(Sender: TObject);
procedure ToolButton10Click(Sender: TObject);
procedure ToolButton11Click(Sender: TObject);
procedure N3Click(Sender: TObject); //ѡ<><D1A1>ģ<EFBFBD><C4A3>ʾ<EFBFBD><CABE><EFBFBD><EFBFBD>
function tohex(s: string): string; //16<31><36><EFBFBD><EFBFBD>ת<EFBFBD><D7AA>Ϊ10<31><30><EFBFBD><EFBFBD>
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);
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=<3D><>״̬ 1=font 2=bitmap
//<2F><>image<67>ķ<EFBFBD>ʽ<EFBFBD><CABD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD>ٶȻ<D9B6><C8BB>ܿ<EFBFBD>
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: 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;
//<2F><>image<67>ķ<EFBFBD>ʽ
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;
//<2F><>СֵӦ<D6B5><D3A6>Ϊ0<CEAA><30><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>ֵ<EFBFBD><D6B5>û<EFBFBD>й̶<D0B9><CCB6><EFBFBD><EFBFBD>ˣ<EFBFBD><CBA3>ж<EFBFBD><D0B6>٣<EFBFBD><D9A3><EFBFBD><EFBFBD>ض<EFBFBD><D8B6><EFBFBD>
const
cConvertStr = #48#49#50#51#52#53#54#55#56#57#65#66#67#68#69#70; //ASCII<49><49>
//#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 := ''; //Ҫ<><D2AA><EFBFBD>ص<EFBFBD><D8B5>ַ<EFBFBD><D6B7><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>ʼ<EFBFBD><CABC>Ψ<EFBFBD><CEA8>
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] //<2F><>cConvertStr<74>ĵ<EFBFBD>һλ
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<><32><EFBFBD><EFBFBD>ת<EFBFBD><D7AA>Ϊ10<31><30><EFBFBD><EFBFBD>
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<31><30><EFBFBD><EFBFBD>ת<EFBFBD><D7AA>Ϊ2<CEAA><32><EFBFBD><EFBFBD>
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^(<28><><EFBFBD><EFBFBD>-1)<29>η<EFBFBD>
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; //<2F><><EFBFBD>ÿ<EFBFBD>ʼ<EFBFBD><CABC>λ<EFBFBD><CEBB>
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); //ÿ<><C3BF>ת<EFBFBD><D7AA><EFBFBD><EFBFBD>ʱ<EFBFBD><CAB1><EFBFBD>ij<EFBFBD><C4B3><EFBFBD>
szSendBuf := szSendBuf + tempbuf;
value1 := value1 + tvalue; //ÿ<>ζ<EFBFBD><CEB6><EFBFBD><EFBFBD>ۻ<EFBFBD><DBBB><EFBFBD><EFBFBD>ݳ<EFBFBD><DDB3><EFBFBD>
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;
ToolButton8.Enabled := false;
ToolButton10.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; //<2F><>ɫ
p2[k * 3 + 1] := 0; //<2F><>ɫ
p2[k * 3] := 0; //<2F><>ɫ
end else
begin
p2[k * 3 + 2] := 255; //<2F><>ɫ
p2[k * 3 + 1] := 0; //<2F><>ɫ
p2[k * 3] := 0; //<2F><>ɫ
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.ToolButton7Click(Sender: TObject);
begin
ToolButton7.Down := not ToolButton7.Down;
if ToolButton7.Down = true then
begin
ToolButton8.Down := False;
ToolButton10.Down := False;
ToolButton11.Down := False;
selcolor := clRed;
end;
end;
procedure TForm1.ToolButton8Click(Sender: TObject);
begin
ToolButton8.Down := not ToolButton8.Down;
if ToolButton8.Down = true then
begin
ToolButton7.Down := False;
ToolButton10.Down := False;
ToolButton11.Down := False;
selcolor := cllime;
end;
end;
procedure TForm1.ToolButton10Click(Sender: TObject);
begin
ToolButton10.Down := not ToolButton10.Down;
if ToolButton10.Down = true then
begin
ToolButton7.Down := False;
ToolButton8.Down := False;
ToolButton11.Down := False;
selcolor := clyellow;
end;
end;
procedure TForm1.ToolButton11Click(Sender: TObject);
begin
ToolButton11.Down := not ToolButton11.Down;
if ToolButton11.Down = true then
begin
ToolButton7.Down := False;
ToolButton8.Down := False;
ToolButton10.Down := False;
selcolor := clblack;
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]); //<2F><><EFBFBD><EFBFBD>
Form3.pRowCount := strtoint(AdvStringGrid2.Cells[4, AdvStringGrid2.Row]); //<2F>߶<EFBFBD>
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]); //<2F><><EFBFBD><EFBFBD>
Form3.pRowCount := strtoint(AdvStringGrid2.Cells[4, AdvStringGrid2.Row]); //<2F>߶<EFBFBD>
//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 //<2F><>ɫ
buf2 := buf2 + Str_IntToBin(strtoint('$' + Copy(sG, m * 2 + 1, 2)), 2 * 4); //FEFF //<2F><>ɫ
end;
//buf1 := V1 + buf1;
//buf2 := V2 + buf2;
//buf1 := Str_IntToBin(strtoint('$' + sR), length(sR) * 4); //FEFF //<2F><>ɫ
//buf2 := Str_IntToBin(strtoint('$' + sG), length(sG) * 4); //FEFF //<2F><>ɫ
p2 := ttbmp.ScanLine[j];
for k := 0 to ttbmp.Width - 1 do
begin
//<2F>Ƚ<EFBFBD><C8BD><EFBFBD><EFBFBD><EFBFBD>ɫ
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; //<2F><>ɫ
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); //<2F><><EFBFBD>ö<EFBFBD>̬<EFBFBD><CCAC><EFBFBD><EFBFBD><EFBFBD>ij<EFBFBD><C4B3><EFBFBD>
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<65><74>ֵ
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;
ToolButton7.Enabled := true;
ToolButton8.Enabled := true;
ToolButton10.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, 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; //<2F><><EFBFBD>ÿ<EFBFBD>ʼ<EFBFBD><CABC>λ<EFBFBD><CEBB>
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);
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';
end;
end;
sR := '';
sG := '';
t := '';
for z1 := 0 to mBmp.height - 1 do //<2F><><EFBFBD><EFBFBD>
begin
for z2 := 0 to mBmp.Width div 8 - 1 do //<2F><><EFBFBD><EFBFBD>
begin
sR := '';
sG := '';
for k := 0 to 7 do
begin
sR := sR + dataR[k + 8 * z2, z1];
sG := sG + dataG[k + 8 * z2, z1];
end;
t := tohex(sR) + tohex(sG);
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); //ÿ<><C3BF>ת<EFBFBD><D7AA><EFBFBD><EFBFBD>ʱ<EFBFBD><CAB1><EFBFBD>ij<EFBFBD><C4B3><EFBFBD>
szSendBuf := szSendBuf + tempbuf;
value1 := value1 + tvalue; //ÿ<>ζ<EFBFBD><CEB6><EFBFBD><EFBFBD>ۻ<EFBFBD><DBBB><EFBFBD><EFBFBD>ݳ<EFBFBD><DDB3><EFBFBD>
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; //ռ<><D5BC>4<EFBFBD><34><EFBFBD>ֽڣ<D6BD><DAA3><EFBFBD><EFBFBD>÷<EFBFBD><C3B7><EFBFBD> 32 λ<>ڴ<EFBFBD><DAB4><EFBFBD><EFBFBD><EFBFBD>
begin
P := PLongint(A); // ָ<><D6B8> A <20>ĵ<EFBFBD>ַ
Dec(P); //P <20><>ַƫ<D6B7><C6AB><EFBFBD><EFBFBD><EFBFBD><EFBFBD> sizeof(A)<29><>ָ<EFBFBD><D6B8><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>鳤<EFBFBD><E9B3A4>
P^ := 0; // <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
Dec(P); // ָ<><D6B8><EFBFBD><EFBFBD><EFBFBD>ü<EFBFBD><C3BC><EFBFBD>
P^ := 0; //<2F><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>ա<EFBFBD>
end;
procedure DynArrayDelete(var A; elSize: Longint; index, Count: Integer);
var
len, MaxDelete: Integer;
P: PLongint; //4 <20><><EFBFBD>ֽڵij<DAB5><C4B3><EFBFBD><EFBFBD><EFBFBD>ָ<EFBFBD><D6B8>
begin
P := PLongint(A); // ȡ<><C8A1> A <20>ĵ<EFBFBD>ַ
if P = nil then
Exit;
{<7B><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>ȫ<EFBFBD><C8AB>ͬ<EFBFBD><CDAC> Dec(P) ; len := P^
<20><>Ϊ Dec(P) = Pchar(P) <20>C 4 ͬ<><CDAC><EFBFBD><EFBFBD><EFBFBD>ƶ<EFBFBD>4 <20>ֽڵ<D6BD>ƫ<EFBFBD><C6AB><EFBFBD><EFBFBD><EFBFBD><EFBFBD>ֻ<EFBFBD><D6BB><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>߰<EFBFBD><DFB0>ֽ<EFBFBD><D6BD><EFBFBD><EFBFBD>ƶ<EFBFBD> }
len := PLongint(PChar(P) - 4)^; // <20><><EFBFBD><EFBFBD><EFBFBD>ij<EFBFBD><C4B3><EFBFBD> <20><>ƫ<EFBFBD><C6AB><EFBFBD><EFBFBD> -4
if index >= len then //Ҫɾ<D2AA><C9BE><EFBFBD><EFBFBD>λ<EFBFBD>ó<EFBFBD><C3B3><EFBFBD><EFBFBD><EFBFBD>Χ<EFBFBD><CEA7><EFBFBD>˳<EFBFBD>
Exit;
MaxDelete := len - index; // <20><><EFBFBD><EFBFBD>ɾ<EFBFBD><C9BE><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
Count := Min(Count, MaxDelete); // ȡ<><C8A1>һ<EFBFBD><D2BB><EFBFBD><EFBFBD>Сֵ
if Count = 0 then // <20><>Ҫ<EFBFBD><D2AA>ɾ<EFBFBD><C9BE>
Exit;
Dec(len, Count); // <20>ƶ<EFBFBD><C6B6><EFBFBD>Ҫɾ<D2AA><C9BE><EFBFBD><EFBFBD>λ<EFBFBD><CEBB>
MoveMemory(PChar(P) + index * elSize, PChar(P) + (index + Count) * elSize, (len - index) * elSize); //<2F>ƶ<EFBFBD><C6B6>ڴ<EFBFBD>
Dec(P); //<2F>Ƴ<EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD>鳤<EFBFBD>ȡ<EFBFBD>λ<EFBFBD><CEBB>
Dec(P); //<2F>Ƴ<EFBFBD><C6B3><EFBFBD><EFBFBD><EFBFBD><EFBFBD>ü<EFBFBD><C3BC><EFBFBD><EFBFBD><EFBFBD> λ<><CEBB>
//<2F><><EFBFBD><EFBFBD><EFBFBD>ٷ<EFBFBD><D9B7><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>ڴ<EFBFBD>,len <20>µij<C2B5><C4B3><EFBFBD>. Sizeof(Longint) * 2 = 2*Dec(P)
ReallocMem(P, len * elSize + Sizeof(Longint) * 2);
Inc(P); // ָ<><D6B8><EFBFBD><EFBFBD><EFBFBD>鳤<EFBFBD><E9B3A4>
P^ := len; // new length
Inc(P); // ָ<><D6B8><EFBFBD><EFBFBD><EFBFBD><EFBFBD>Ԫ<EFBFBD>أ<EFBFBD><D8A3><EFBFBD>ʼ<EFBFBD><CABC>λ<EFBFBD><CEBB>
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
//<2F><><EFBFBD><EFBFBD>paintbox <20>ֿ<EFBFBD><D6BF><EFBFBD>ʾ
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.
Reference in New Issue Copy Permalink