通过HH8WilEdit学习WIL 文件编码 2 程序大体结构

标签：编码 begin Wil end FlickerFreePaintBox1 HH8WilEdit WIL Enabled True

unit main;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls, SUIForm, SUIButton, StdCtrls, SUIEdit, SUIImagePanel,
  SUIGroupBox, Grids, ExtDlgs, SUIDlg, mywil, jpeg, FFPBox;

type
  TFormMain = class(TForm)
    suiForm1: TsuiForm;
    suiImagePanel1: TsuiImagePanel;
    suiImagePanel2: TsuiImagePanel;
    Label1: TLabel;
    EditFileName: TsuiEdit;
    suiButton1: TsuiButton;
    btnup: TsuiButton;
    btndown: TsuiButton;
    btndelete: TsuiButton;
    btnjump: TsuiButton;
    btnautoplay: TsuiButton;
    btnstop: TsuiButton;
    btninput: TsuiButton;
    btnout: TsuiButton;
    btnadd: TsuiButton;
    btncreate: TsuiButton;
    btnallinput: TsuiButton;
    btnallout: TsuiButton;
    suiGroupBox1: TsuiGroupBox;
    suiGroupBox2: TsuiGroupBox;
    Label2: TLabel;
    Label3: TLabel;
    btnx: TsuiButton;
    btny: TsuiButton;
    Label4: TLabel;
    LabelType: TLabel;
    LabelSize: TLabel;
    LabelY: TLabel;
    LabelIndex: TLabel;
    LabelX: TLabel;
    rb50: TsuiRadioButton;
    rb100: TsuiRadioButton;
    rb200: TsuiRadioButton;
    rb400: TsuiRadioButton;
    rb800: TsuiRadioButton;
    rbauto: TsuiRadioButton;
    chcbxTransparent: TsuiCheckBox;
    chcbxJump: TsuiCheckBox;
    chcbxXY: TsuiCheckBox;
    chcbxCoordinate: TsuiCheckBox;
    suiPanel1: TsuiPanel;
    DrawGrid1: TDrawGrid;
    Splitter1: TSplitter;
    ScrollBox1: TScrollBox;
    Image1: TImage;
    suiImagePanel3: TsuiImagePanel;
    suiInputDialog1: TsuiInputDialog;
    suiMessageDialog1: TsuiMessageDialog;
    SaveDialog1: TSaveDialog;
    OpenPictureDialog1: TOpenPictureDialog;
    SavePictureDialog1: TSavePictureDialog;
    OpenDialog1: TOpenDialog;
    FlickerFreePaintBox1: TFlickerFreePaintBox;
    function ExtractRecord(ResType, ResName, ResNewName: string): Boolean;
    procedure FormCreate(Sender: TObject);
    procedure FormPaint(Sender: TObject);
    procedure FlickerFreePaintBox1Paint(Sender: TObject; Canvas: TCanvas);
    procedure DrawGrid1DrawCell(Sender: TObject; ACol, ARow: Integer;
      Rect: TRect; State: TGridDrawState);
    procedure FillInfo(Index: Integer);
    procedure ShowErrMessage(msg: string);
    procedure ShowMessage(msg: string);
    procedure btnxClick(Sender: TObject);
    procedure btnyClick(Sender: TObject);
    procedure suiButton1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  FormMain: TFormMain;
  MainBitMap: TBitmap;
  BmpIndex, BmapWidth, BmpHeight: Integer;
  BmpX, BmpY: Integer;
  BmpZoom: Real;
  BmpTransparent: Boolean;
  Wil: TWil;
  Stop: Boolean;

implementation

{$R *.dfm}

//uses outpic, addpic, newpic, delpic, addone;

function TFormMain.ExtractRecord(ResType, ResName, ResNewName: string): Boolean;
var
  Res: TResourceStream;

  Str: string[60];   //没有用上?
  s: TFileStream;    // 没有用上？
           //返回的什么？

begin
  Res := TResourceStream.Create(HInstance, ResName, PChar(ResType));
  Res.SaveToFile(ResNewName);
  Res.Free;

end;

procedure TFormMain.FormCreate(Sender: TObject);
begin
  Wil :=  TWIL.Create(Self); //这里为什么用SELFC参数？
end;

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

procedure TFormMain.FlickerFreePaintBox1Paint(Sender: TObject;
  Canvas: TCanvas);
var
  BitMap: TBitmap;
begin
 { if MainBitMap = nil then
    Canvas.Refresh
  else
    Canvas.Draw(0, 0, MainBitMap);
  }
  if Wil.Stream <> nil then      //显示
  begin
    Wil.DrawZoom(Canvas, BmpX, BmpY, BmpIndex, BmpZoom, BmpTransparent, False);
  end;

  if chcbxCoordinate.Checked then    //显示 坐标线？
  begin
    Canvas.Pen.Style := psDot;
    
    Canvas.MoveTo(0, FlickerFreePaintBox1.Height div 2);
    Canvas.LineTo(FlickerFreePaintBox1.Width, FlickerFreePaintBox1.Height div 2);
    Canvas.MoveTo(FlickerFreePaintBox1.Width div 2, 0);
    Canvas.LineTo(FlickerFreePaintBox1.Width div 2, FlickerFreePaintBox1.Height);
  end;
end;

procedure TFormMain.DrawGrid1DrawCell(Sender: TObject; ACol, ARow: Integer;
  Rect: TRect; State: TGridDrawState);
var
  Index: Integer;
  BitMap: TBitmap;     //未用
  w, h: Integer;
  str: string;
begin
  Index := ARow * 6 + ACol;
  if (Wil.Stream <> nil) and (Index < Wil.ImageCount) then
  begin
    Wil.DrawZoomEx(DrawGrid1.Canvas, Rect, Index, True);
    str := Format('%.5d', [Index]);
    DrawGrid1.Canvas.Brush.Style := bsClear;
    w := DrawGrid1.Canvas.TextWidth(str);
    h := DrawGrid1.Canvas.TextHeight(str);
    DrawGrid1.Canvas.TextOut(Rect.Right - w - 1, Rect.Bottom - h - 1, str);
    if State <> [] then
      FillInfo(Index);

  end;


end;

procedure TFormMain.FillInfo(Index: Integer);
var
  Width1, Height1: Integer;
  Zoom, Zoom1: Real;
begin
  if Wil.Stream <> nil then
  begin
    BmpIndex := Index;
    BmpTransparent := chcbxTransparent.Checked;
    MainBitMap := Wil.Bitmaps[Index];
    Width1 := Wil.Width;
    Height1 := Wil.Height;
    if chcbxJump.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;

    if rbauto.Checked then
    begin
      if (Width1 < FlickerFreePaintBox1.Width) and (Height1 < FlickerFreePaintBox1.Height) then
      begin
        BmpZoom := 1;
        if chcbxXY.Checked then
        begin
          BmpX := FlickerFreePaintBox1.Width div 2 + Wil.px;
          BmpY := FlickerFreePaintBox1.Height div 2 + Wil.py;
        end
        else begin
          BmpX := FlickerFreePaintBox1.Width div 2;
          BmpY := FlickerFreePaintBox1.Height div 2;
        end;
      end
      else begin
        if Width1 > FlickerFreePaintBox1.Width then
          Zoom := Width1 / FlickerFreePaintBox1.Width;
        if Height1 > FlickerFreePaintBox1.Height then
          Zoom1 := Height1 / FlickerFreePaintBox1.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;
      if rb200.Checked then
        BmpZoom := 2;
      if rb400.Checked then
        BmpZoom := 4;
      if rb800.Checked then
        BmpZoom := 8;
      BmpX := 1;
      BmpY := 1;
      FlickerFreePaintBox1.Width := ScrollBox1.Width - 5;
      FlickerFreePaintBox1.Height := ScrollBox1.Height - 5;
      Width1 := Round(Width1 * BmpZoom);
      Height1 := Round(Height1 * BmpZoom);

      if (Width1 < FlickerFreePaintBox1.Width) and (Height1 < FlickerFreePaintBox1.Height) then
      begin
        if chcbxXY.Checked then
        begin
          BmpX := FlickerFreePaintBox1.Width div 2 + Wil.px;
          BmpY := FlickerFreePaintBox1.Height div 2 + Wil.py;
        end
        else begin
          BmpX := (FlickerFreePaintBox1.Width - Width1) div 2;
          BmpX := (FlickerFreePaintBox1.Height - height1) div 2;
        end;
      end
      else begin
        FlickerFreePaintBox1.Width := Width1;
        FlickerFreePaintBox1.Height := Height1;
      end;
    end;

    LabelX.Caption := IntToStr(Wil.px);
    LabelY.Caption := IntToStr(Wil.py);
    LabelSize.Caption := IntToStr(Width1) + '*' + IntToStr(Height1);
    LabelIndex.Caption := IntToStr(Index) + '/' + IntToStr(Wil.ImageCount - 1);

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

    FlickerFreePaintBox1.Refresh;

    if Wil.FileType = 2 then
    begin
      btnallinput.Enabled := False;
      btnallout.Enabled := True;
      btnout.Enabled := True;
      btninput.Enabled := False;
      btnadd.Enabled := False;
      btnup.Enabled := True;
      btnjump.Enabled := True;
      btnstop.Enabled := True;
      btnautoplay.Enabled := True;
      btncreate.Enabled := True;
      btndelete.Enabled := False;
      btnx.Enabled := False;
      btny.Enabled := False;
    end
    else begin
      btnx.Enabled := True;
      btny.Enabled := True;
      btndelete.Enabled := True;
      btnup.Enabled := True;
      btndown.Enabled := True;
      btnjump.Enabled := True;
      btnstop.Enabled := True;
      btnadd.Enabled := True;
      btnallinput.Enabled := True;
      btnallout.Enabled := True;
      btnautoplay.Enabled := True;
      btncreate.Enabled := True;
      btnout.Enabled := True;
      btnstop.Enabled := True;
      btninput.Enabled := True;
    end;

    if Index = (Wil.ImageCount - 1) then
    begin
      btndown.Enabled := False;
      btnup.Enabled := True;
    end;

    if Index = 0 then
    begin
      btnup.Enabled := False;
    end;

    DrawGrid1.Row := BmpIndex div 6;
    DrawGrid1.Col := BmpIndex mod 6;
  end;

end;

procedure TFormMain.ShowErrMessage(msg: string);
begin
  suiMessageDialog1.Caption := '错误';
  suiMessageDialog1.IconType := suiWarning;
  suiMessageDialog1.Text := msg;
  suiMessageDialog1.ShowModal;
end;


procedure TFormMain.ShowMessage(msg: string);
begin
  suiMessageDialog1.Caption := '消息';
  suiMessageDialog1.IconType := suiInformation;
  suiMessageDialog1.Text := msg;
  suiMessageDialog1.ShowModal;
end;

procedure TFormMain.btnxClick(Sender: TObject);
var
  x: SmallInt;
  code: Integer;
begin
  suiInputDialog1.Caption := '更改图片X坐标';
  suiInputDialog1.PromptText := '输入图片X坐标';
  suiInputDialog1.ValueText := '1';
  if suiInputDialog1.ShowModal = mrCancel then
    Exit;
  Val(suiInputDialog1.ValueText, x, code);
  if code > 0 then
  begin
    ShowErrMessage('输入正确的格式');
    Exit;
  end;
  Wil.Changex(BmpIndex, x);
  FillInfo(BmpIndex);
end;

procedure TFormMain.btnyClick(Sender: TObject);
var
  x: SmallInt;
  code: Integer;
begin
  suiInputDialog1.Caption := '更改图片Y坐标';
  suiInputDialog1.PromptText := '输入图片Y坐标';
  suiInputDialog1.ValueText := '1';
  if suiInputDialog1.ShowModal = mrCancel then
    Exit;
  Val(suiInputDialog1.ValueText, x, code);
  if code > 0 then
  begin
    ShowErrMessage('输入正确的格式');
    Exit;
  end;
  Wil.Changey(BmpIndex, x);
  FillInfo(BmpIndex);
end;

procedure TFormMain.suiButton1Click(Sender: TObject);
begin
  if OpenDialog1.Execute then
  begin
    EditFileName.Text := OpenDialog1.FileName;
    if FileExists(EditFileName.Text) then
    begin
      if Wil.Stream <> nil then
        Wil.Finalize;
      Wil.FileName := EditFileName.Text;
      Wil.Initialize;
      if Wil.Stream = nil then
      begin
        ShowErrMessage('WIL文件错误或非WIL文件');
        Exit;
      end;
      BmpIndex := 0;
      DrawGrid1.RowCount := (Wil.ImageCount div 6) + 1;
      DrawGrid1.Refresh;
      FillInfo(BmpIndex);
    end;
  end;
end;

end.

新认识：

1，DIB 的认识，

DelphiX 的组件面板上, 第二个就是 TDXDIB; 

TDXDIB.DIB 是 TDXDIB 的唯一属性(其他是 TComponent 固有的); 

TDXDIB.DIB 属性是一个 TDIB 对象; 

TDIB 和 TBitmap 一样都直接继承自 TGraphic, 是一个图片容器, 它还有个别名: TDIBitmap; 

TDIB 和 TDXDraw.Surface 还有 TDXImageList 中的元素(TPictureCollectionItem)功能都差不多, 不过它更强大. 

使用 TDIB 需要 uses DIB 单元; 
但如果添加了 TDXDIB 组件, DIB 单元会自动添加, 并可以在设计时装载图片.

大概意思就是DIB 是DELPHI的一个组件？

2，安装 只有.PAS 文件 作为控件。

https://www.cnblogs.com/jijm123/p/12783556.html

这里有个链接，开始的3步就可以了，

新 建一个Package项目工程，将PAS 文件放进去就可以了。

这就是一个新的组件了。

解决了FFPBox，PBFolderDialog总报错的BUG。

3，使用MYWIL里面的方法就就能将 WIL文件显示出来 了。

用到了如下的其属性方法。

Wil:=TWil.Create(self); 创建这个WIL 类

Wil.Finalize;
Wil.FileName:=EditFileName.Text; 给它一个文件名
Wil.Initialize; 初始化

Wil.Stream 装入了这个流中？

 Wil.DrawZoomEx(DrawGrid1.Canvas,Rect,index,true); 扩展控制显示？

Wil.DrawZoom(Canvas,Bmpx,Bmpy,BmpINdex,BmpZoom,BmpTran,false); 控制显示？

Wil.ImageCount 图片数量？

Wil.Width

WIl.Height

Wil.Bitmaps[index]

Wil.Bitmaps[Bmpindex].Width;

WIl.Bitmaps[Bmpindex].Height;

WIl.px

Wil.py

 

 WIl.FileType

WIl.OffSet

Wil.Changex(BmpIndex,x);

Wil.Changey(BmpIndex,x);

 

4，程序可以跑起来了，继续完成这个按钮的方法。

学习 多界面的显示程序 MID?

 

标签：编码,begin,Wil,end,FlickerFreePaintBox1,HH8WilEdit,WIL,Enabled,True
From： https://www.cnblogs.com/D7mir/p/17029055.html