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;



    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.