通过HH8WilEdit学习WIL 文件编码 7 重新编写HH8WilEdit的框架

标签：编码 begin Wil end Sender HH8WilEdit WIL TObject procedure

unit main;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ExtCtrls, Grids, ExtDlgs, mywil, ComCtrls;

type
  TFormMain = class(TForm)
    Panel1: TPanel;
    Label1: TLabel;
    edtFileName: TEdit;
    btnLoadFile: TButton;
    btnUp: TButton;
    btnDown: TButton;
    btnDel: TButton;
    btnJump: TButton;
    btnPlay: TButton;
    btnStop: TButton;
    btnInput: TButton;
    btnOutput: TButton;
    btnAddPic: TButton;
    btnCreate: TButton;
    btnBatchInput: TButton;
    btnBatchOut: TButton;
    GroupBox1: TGroupBox;
    Label2: TLabel;
    btnX: TButton;
    btnY: TButton;
    Label3: TLabel;
    Label4: TLabel;
    GroupBox2: TGroupBox;
    rb50: TRadioButton;
    rb100: TRadioButton;
    rb200: TRadioButton;
    rbAutoZoom: TRadioButton;
    chkTransparent: TCheckBox;
    chkRealXY: TCheckBox;
    chkCoordinate: TCheckBox;
    Panel2: TPanel;
    Panel3: TPanel;
    DrawGrid1: TDrawGrid;
    Panel4: TPanel;
    ScrollBox1: TScrollBox;
    lblType: TLabel;
    lblSize: TLabel;
    lblX: TLabel;
    lblY: TLabel;
    lblIndex: TLabel;
    OpenDialog1: TOpenDialog;
    SaveDialog1: TSaveDialog;
    OpenPictureDialog1: TOpenPictureDialog;
    SavePictureDialog1: TSavePictureDialog;
    pbShow: TPaintBox;
    tmrPlay: TTimer;
    trckbrPlayInteval: TTrackBar;
    chkJump: TCheckBox;
    procedure FormCreate(Sender: TObject);
    procedure FormPaint(Sender: TObject);
    procedure pbShowPaint(Sender: TObject);
    procedure btnLoadFileClick(Sender: TObject);
    procedure DrawGrid1DrawCell(Sender: TObject; ACol, ARow: Integer;
      Rect: TRect; State: TGridDrawState);
    procedure btnPlayClick(Sender: TObject);
    procedure tmrPlayTimer(Sender: TObject);
    procedure btnStopClick(Sender: TObject);
    procedure btnUpClick(Sender: TObject);
    procedure btnDownClick(Sender: TObject);
    procedure trckbrPlayIntevalChange(Sender: TObject);
    procedure btnJumpClick(Sender: TObject);
    procedure btnInputClick(Sender: TObject);
    procedure btnOutputClick(Sender: TObject);
    procedure btnBatchOutClick(Sender: TObject);
    procedure btnDelClick(Sender: TObject);
  private
    { Private declarations }
    procedure FillInfo(Index: Integer);
  public
    { Public declarations }

  end;
const
  PLAYINTERVAL = 20;

var
  FormMain: TFormMain;
  MainBitMap: TBitmap;
  BmpIndex, BmpWidth, BmpHeight: Integer;
  BmpX, BmpY: Integer;
  BmpZoom: Real;
  BmpTransparent, Stop, DrawYes: Boolean;

  Wil: TWIL;



implementation

{$R *.dfm}

uses OutPic;

procedure TFormMain.FormCreate(Sender: TObject);
begin
  Wil := TWIL.Create(self);
  DrawYes := True;
  trckbrPlayInteval.Position := 3;
  BmpIndex := 0;
  tmrPlay.Interval := trckbrPlayInteval.Position *  PLAYINTERVAL;
  pbShow.Width := ScrollBox1.Width - 5;
  pbShow.Height := ScrollBox1.Height - 5;
end;

procedure TFormMain.FormPaint(Sender: TObject);
begin
  pbShow.Refresh;
end;

procedure TFormMain.pbShowPaint(Sender: TObject);
begin

  if Wil.Stream  <> nil then
  Wil.DrawZoom(pbShow.Canvas, BmpX, BmpY, BmpIndex, BmpZoom, BmpTransparent,False);

  if chkCoordinate.Checked then
  begin
    pbShow.Canvas.Pen.Style := psDot;
    pbShow.canvas.Pen.Color := clBlue;
    pbShow.Canvas.MoveTo(0, pbShow.Height div 2);
    pbShow.Canvas.LineTo(pbShow.Width, pbShow.Height div 2);
    pbShow.Canvas.MoveTo(pbShow.Width div 2, 0);
    pbShow.Canvas.LineTo(pbShow.Width div 2, pbShow.Height);
  end;
end;

procedure TFormMain.btnLoadFileClick(Sender: TObject);
begin
  if OpenDialog1.Execute then
  begin
    edtFileName.Text := OpenDialog1.FileName;
    if FileExists(edtFileName.text) then
    begin
      if Wil.Stream <> nil then
        Wil.Finalize;
      Wil.FileName := edtFileName.Text;
      Wil.Initialize;
      if Wil.Stream = nil then
      begin
        ShowMessage('WIL文件错误');
        Exit;
      end;
      BmpIndex := 0;
      DrawGrid1.RowCount := (Wil.ImageCount div 10) + 1;
      DrawGrid1.Refresh;
      FillInfo(BmpIndex);
    end;
  end;
end;

procedure TFormMain.FillInfo(Index: Integer);
var
  Width1, Height1: Integer;
  Zoom, Zoom1: Real;
begin
  Zoom := 1;
  Zoom1 := 1;
  BmpZoom := 1;
  if Wil.Stream <> nil then
  begin
    BmpIndex := Index;
    BmpTransparent := chkTransparent.Checked;
    MainBitMap := Wil.Bitmaps[Index];
    Width1 := Wil.Width;
    Height1 := Wil.Height;

   if (not Stop) and chkJump.Checked then     //跳过空图片
    begin
      while ((Width1 <= 1) or (Height1 <= 1)) and (BmpIndex < Wil.ImageCount - 1) do
      begin
        Inc(BmpIndex);
        Width1 := Wil.Bitmaps[BmpIndex].Width;
        Height1 := Wil.Bitmaps[BmpIndex].Height;
      end;
    end;
    //      设置BMPX,Y 值，图片在画框中的起始位置
    if rbAutoZoom.Checked then        //自动大小
    begin
      if (Width1 < pbShow.Width) and (Height1 < pbShow.Height) then
      begin
        BmpZoom := 1;       //小于画框图片缩放比例为1
        pbShow.Width := ScrollBox1.Width;
        pbShow.Height := ScrollBox1.Height;
        if chkRealXY.Checked then       //显示坐标线
        begin
          BmpX := pbShow.Width div 2 + Wil.px;  //加上偏移坐标
          BmpY := pbShow.Height div 2 + Wil.py;
        end
        else begin
          BmpX := pbShow.Width div 2;
          BmpY := pbShow.Height div 2;
        end;
      end
      else begin       //图片大于画框，
        pbShow.Width := ScrollBox1.Width;
        pbShow.Height := ScrollBox1.Height;

        if Width1 > pbShow.Width then
          Zoom := Width1 / pbShow.Width;
        if Height1 > pbShow.Height then
          Zoom1 := Height1 / pbShow.Height;
        if Zoom > Zoom1 then      //选择缩小比例大的值
          BmpZoom := Zoom
        else
          BmpZoom := Zoom1;
        BmpX := 1;
        BmpY := 1;
      end;
    end
    else begin        //选择缩放比例
      if rb50.Checked then
        BmpZoom := 0.5;
      if rb100.Checked then
        BmpZoom := 1.0;
      if rb200.Checked then
        BmpZoom := 2.0;

      BmpX := 1;
      BmpY := 1;
      pbShow.Width := ScrollBox1.Width;
      pbShow.Height := ScrollBox1.Height;
      Width1 := Round(Width1 * BmpZoom);    //取整
      Height1 := Round(Height1 * BmpZoom);

      if (Width1 < pbShow.Width) and      //缩放后的图片小于画框
           (Height1 < pbShow.Height) then
      begin
        if chkRealXY.Checked then       //显示坐标线
        begin
          BmpX := pbShow.Width div 2 + Wil.px;
          BmpY := pbShow.Height div 2 + Wil.py;
        end
        else begin
          BmpX := (pbShow.Width - Width1) div 2;
          BmpY := (pbShow.Height - height1) div 2;
        end;
      end
      else begin                   //图片超出设定画框大小的时候将画框大小设为图片大小？
        pbShow.Width := Width1 * 2;
        pbShow.Height := Height1 * 2;

      end;
    end;

    lblX.Caption := IntToStr(Wil.px);
    lblY.Caption := IntToStr(Wil.py);
    lblSize.Caption := IntToStr(Width1) + '*' + IntToStr(Height1);
    //imagecount 是从0开始计算？
    lblIndex.Caption := IntToStr(Index) + '/' + IntToStr(Wil.ImageCount - 1);

    case Wil.FileType of        //4种数据格式？
      0: lblType.Caption := 'MIR2 数据格式（1）';
      1: lblType.Caption := 'MIR2 数据格式（2）';
      2: begin
         if Wil.OffSet = 0 then
           lblType.Caption := 'EI3 数据格式（1）'
         else
           lblType.Caption := 'EI3 数据格式（2）';
      end;
    end;

    pbShow.Refresh;



    if Index = Wil.ImageCount - 1  then
      btnDown.Enabled := False
    else
      btnDown.Enabled := true;



    if Index = 0 then
      btnUp.Enabled := False
    else
      btnUp.Enabled := True;


    DrawGrid1.Row := BmpIndex div 10;    //设置INDEX 下的图片在drawgride中的行列位置
    DrawGrid1.Col := BmpIndex mod 10;
  end;
end;

procedure TFormMain.DrawGrid1DrawCell(Sender: TObject; ACol, ARow: Integer;
  Rect: TRect; State: TGridDrawState);
var
  Index, w, h: Integer;
  str : string;
begin
  Index := ARow * 10 + ACol;
  if (Wil.Stream <> nil) and (Index < Wil.ImageCount -1) then
  begin
    Wil.DrawZoomEx(DrawGrid1.Canvas, Rect, Index, True);
    str := Format('%.5d', [Index]);   // 这是给整数指定位数,
    DrawGrid1.Canvas.Brush.Style := bsClear; //画笔方式为清理方式？？
    //DrawGrid1.Canvas.Brush.Color := clBlack;
    w := DrawGrid1.Canvas.TextWidth(str);
    h := DrawGrid1.Canvas.TextHeight(str);
    DrawGrid1.Canvas.TextOut(Rect.Right - w - 1, Rect.Bottom - h - 1, str);
    //DrawGrid1.Canvas.Brush.Style := bsClear;
   // DrawGrid1.Canvas. := clRed;
    //str := Format('%.4d',[ACol]) + ',' + format('%.4d',[arow]);
    //DrawGrid1.Canvas.TextOut(Rect.Left, Rect.Top, str);


    if State <> [] then     //这个是空集合？ SET OF
      FillInfo(Index);
  end;
end;

procedure TFormMain.btnPlayClick(Sender: TObject);
begin
  Stop := False;
  tmrPlay.Enabled := True;
end;

procedure TFormMain.tmrPlayTimer(Sender: TObject);
begin
  if (BmpIndex < Wil.ImageCount - 1) and not Stop then
  begin

    FillInfo(BmpIndex);

    Inc(BmpIndex);

    Application.ProcessMessages;
  end
  else
    tmrPlay.Enabled := False;
end;

procedure TFormMain.btnStopClick(Sender: TObject);
begin
  Stop := True;
end;

procedure TFormMain.btnUpClick(Sender: TObject);
begin
  if wil.Stream <> nil then
    begin
      Dec(BmpIndex);
      if BmpIndex < 0 then
        BmpIndex := 0;
      FillInfo(BmpIndex);
    end;
end;

procedure TFormMain.btnDownClick(Sender: TObject);
begin
  if Wil.Stream <> nil then
    begin
      Inc(BmpIndex);
      if BmpIndex > Wil.ImageCount  then
        BmpIndex := Wil.ImageCount;
      FillInfo(BmpIndex);
    end;
end;

procedure TFormMain.trckbrPlayIntevalChange(Sender: TObject);
begin
  tmrPlay.Interval := trckbrPlayInteval.Position * PLAYINTERVAL;
end;

procedure TFormMain.btnJumpClick(Sender: TObject);
var
  Index, Code: Integer;
  Str: string;
begin
  if Wil.Stream <> nil then
  begin
    if InputQuery('跳转', '输入图片索引号', Str) then
    begin
       Val(Str, index, Code);
       if (Code = 0) and (index >= 0) and (index <= Wil.ImageCount)  then
         FillInfo(index)
       else
         ShowMessage('图片索引号输入错误');
    end;
  end;
end;

procedure TFormMain.btnInputClick(Sender: TObject);
var
  FileName: string;
  BitMap: TBitmap;
begin
  if OpenPictureDialog1.Execute then
    FileName := OpenPictureDialog1.FileName;

  if FileName <> '' then
  begin
    BitMap := TBitmap.Create;
    try
      BitMap.LoadFromFile(FileName);
      if Wil.ReplaceBitMap(BmpIndex, BitMap) then
        DrawGrid1.Refresh
      else
        ShowMessage('图片导入失败');
    finally
      BitMap.Free;
    end;
  end
  else
    ShowMessage('打开文件错误');
end;

procedure TFormMain.btnOutputClick(Sender: TObject);
var
  FileName: string;
begin
  if Wil.Stream <> nil then
  begin
    SavePictureDialog1.FileName := Format('%.6d.bmp', [BmpIndex]);
    if SavePictureDialog1.Execute then
      FileName := SavePictureDialog1.FileName;
    if FileName <>'' then
    begin
      Wil.Bitmaps[BmpIndex].SaveToFile(FileName);
      ShowMessage('导出图片成功');
    end;
  end;
end;

procedure TFormMain.btnBatchOutClick(Sender: TObject);
begin
  if Wil.Stream <> nil then
  begin
    FormOutPic.edtPicPah.Text :='';
    FormOutPic.edtBeginNum.Text := '0';
    FormOutPic.edtEndNum.Text := IntToStr(Wil.ImageCount -1);
    FormOutPic.ShowModal;
  end;
end;

procedure TFormMain.btnDelClick(Sender: TObject);
var
  Bitmap: TBitmap;
begin
  Bitmap := TBitmap.Create;
  Bitmap.PixelFormat := pf8bit;
  Bitmap.Width := 1;
  Bitmap.Height := 1;
  Bitmap.Canvas.Pixels[0, 0] := 0;
  Wil.ReplaceBitMap(BmpIndex, Bitmap);
  Bitmap.Free;
  Wil.Finalize;
  Wil.Initialize;


  DrawGrid1.Refresh;
  
end;

end.

unit OutPic;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, FileCtrl, ComCtrls;

type
  TFormOutPic = class(TForm)
    edtPicPah: TEdit;
    btnPicPath: TButton;
    btnStart: TButton;
    btnClose: TButton;
    Label2: TLabel;
    Label3: TLabel;
    edtBeginNum: TEdit;
    edtEndNum: TEdit;
    Label1: TLabel;
    ProgressBar1: TProgressBar;
    chkJumpEmpty: TCheckBox;
    procedure btnPicPathClick(Sender: TObject);
    procedure btnStartClick(Sender: TObject);
    procedure btnCloseClick(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  FormOutPic: TFormOutPic;


implementation

{$R *.dfm}

uses main;
var
  strDirectory: string;

procedure TFormOutPic.btnPicPathClick(Sender: TObject);
var
  strCaption: string;
  wstrRoot : WideString;
begin
  strCaption := '选择导出存放的文件夹';
  wstrRoot := '';
  SelectDirectory(strCaption, wstrRoot, strDirectory);
  edtPicPah.Text := strDirectory;
end;



procedure TFormOutPic.btnStartClick(Sender: TObject);
var
  BeginIndex, EndIndex, Code, i: Integer;
  StringList: TStringList; //用来存放XY偏移量 导出到文件
  begin
  if Wil.Stream = nil then
  begin
    ShowMessage('WIL文件未打开');
    Exit;
  end;
  Val(edtBeginNum.Text, BeginIndex, Code);
  if Code > 0 then
  begin
    ShowMessage('请输入正确的编号');
    edtBeginNum.SetFocus;
    Exit;
  end;
  Val(edtEndNum.Text, EndIndex, Code);
  if Code > 0 then
  begin
    ShowMessage('请输入正确的编号');
    edtEndNum.SetFocus;
    Exit;
  end;

  if BeginIndex < 0 then BeginIndex := 0;
  if EndIndex > Wil.ImageCount then EndIndex := Wil.ImageCount;

  if edtPicPah.Text = '' then
  begin
    ShowMessage('请输入导入的路径');
    btnPicPath.SetFocus;
    Exit;
  end;

  if strDirectory[Length(strDirectory)] <> '\' then
    strDirectory := strDirectory + '\';
  if not DirectoryExists(strDirectory + 'Placements\') then
    MkDir(strDirectory + 'Placements\');

  ProgressBar1.Visible := True;
  ProgressBar1.Max := EndIndex - BeginIndex;
  ProgressBar1.Position := 0;

  StringList := TStringList.Create;
  for i := BeginIndex to EndIndex do
  begin
    Application.ProcessMessages;
    if chkJumpEmpty.Checked then
      begin
        if (Wil.Bitmaps[i].Width > 1) and (Wil.Bitmaps[i].Height > 1) then
        begin
        Wil.Bitmaps[i].SaveToFile(strDirectory + Format('%6.d.bmp', [i]));
        StringList.Clear;
        StringList.Add(IntToStr(Wil.px));
        StringList.Add(IntToStr(Wil.py));
        StringList.SaveToFile(strDirectory + 'Placements\' +
        format('%6.d.txt', [i]));
        end;
        ProgressBar1.StepIt;
      end
    else
      begin
        Wil.Bitmaps[i].SaveToFile(strDirectory + Format('%6.d.bmp', [i]));
        StringList.Clear;
        StringList.Add(IntToStr(Wil.px));
        StringList.Add(IntToStr(Wil.py));
        StringList.SaveToFile(strDirectory + 'Placements\' +
        format('%6.d.txt', [i]));

        ProgressBar1.StepIt;
      end;


  end;

  ProgressBar1.Visible := False;
  StringList.Free;
  ShowMessage('批量导出图片成功');

  Close;

end;

procedure TFormOutPic.btnCloseClick(Sender: TObject);
begin
  Close;
end;

end.

1，按照之前的想法，去掉界面组件，SUIPACK,

去掉了flickerfreepaintbox ，用的PAINTBOX

PBfolderDialog 组件,用的 FILECTRL

2,增加了播放控制速度

3，批量导入，新建文件，添加图片功能没有写上去了。

4，下一步，学习MYWIL源程序，

之前有点认识错误，以为DIB 单元是 D7 自带的，不是的。

这个是 DELPHI DX7 组件中的单元。

5.WIL文件中的图片应该是10个一组的，将DRAWGRIDS 调整位COW 10，

显示看起来整齐些了

标签：编码,begin,Wil,end,Sender,HH8WilEdit,WIL,TObject,procedure
From： https://www.cnblogs.com/D7mir/p/17120963.html

通过HH8WilEdit学习WIL 文件编码 7 重新编写HH8WilEdit的框架

相关文章

赞助商

阅读排行