通过HH8WilEdit学习WIL 文件编码 10 改编后的程序
对于偏移坐标大的图片显示有问题
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); var rczoom : TRect; WidthZoom, HeightZoom : Integer; str: string; begin if Wil.Stream <> nil then begin WidthZoom := Wil.Width; HeightZoom := Wil.Height; WidthZoom := Round(WidthZoom / BmpZoom); HeightZoom := Round(HeightZoom / BmpZoom); rczoom := Rect(BmpX, BmpY, BmpX + WidthZoom , BmpY + HeightZoom); if not chkTransparent.Checked then begin pbShow.Canvas.Brush.Color := clBlack; pbShow.Canvas.FillRect(rczoom); end; Wil.DrawZoom(pbShow.Canvas, rczoom, BmpIndex); pbShow.Canvas.Brush.Style := bsClear; pbShow.Canvas.TextOut(5, 5, Wil.Title); str := IntToStr(BmpIndex) + '/' + IntToStr(Wil.ImageCount - 1); pbShow.Canvas.TextOut(5,21,str); end; if chkCoordinate.Checked then begin pbShow.Canvas.Pen.Style := psSolid; pbShow.canvas.Pen.Color := clRed; 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 div 2) and (Height1 < pbShow.Height div 2) 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 div 2) then Zoom := Width1 / pbShow.Width * 2; if Height1 > (pbShow.Height div 2) then Zoom1 := Height1 / pbShow.Height * 2; if Zoom > Zoom1 then //选择缩小比例大的值 BmpZoom := Zoom else BmpZoom := Zoom1; 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; end else begin //选择缩放比例 if rb50.Checked then BmpZoom := 2; if rb100.Checked then BmpZoom := 1.0; if rb200.Checked then BmpZoom := 0.5; pbShow.Width := ScrollBox1.Width; pbShow.Height := ScrollBox1.Height; Width1 := Round(Width1 / BmpZoom); //取整 Height1 := Round(Height1 / BmpZoom); if (Width1 < (pbShow.Width div 2)) and //缩放后的图片小于画框 (Height1 < (pbShow.Height div 2)) 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 div 2; BmpY := pbShow.Height div 2; end; end else begin //图片超出设定画框大小的时候将画框大小设为图片大小？ pbShow.Width := Width1 * 2; pbShow.Height := Height1 * 2; 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; 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); lblType.Caption := Wil.Title; 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.DrawZoom(DrawGrid1.Canvas, Rect, Index); 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.
改编的MYWIL单元
unit mywil; interface uses Windows, Classes, Graphics, SysUtils, Dialogs, DIB; type TWMImageHeader = record Title: string[40]; ImageCount: Integer; ColorCount: Integer; PaletteSize: Integer; end; TWMImageInfo = record Width: SmallInt; Height: SmallInt; px: SmallInt; py: SmallInt; bits: PByte; end; TWMIndexHeader = record Title: string[40]; IndexCount: Integer; end; TWMIndexInfo = record Position: Integer; Size: Integer; end; TXY = array[0..65535] of Integer; TWIL = class(TComponent) private FFileName: string; FIndexFile: string; FTitle: string; FImageCount: Integer; FX, FY: TXY; FBitMap: TBitmap; Fpx, Fpy: Integer; FWidth, FHeight: Integer; FOffSet: Integer; procedure LoadIndex(FIndexFile: string); procedure LoadBmpImage(Position: Integer; Index: integer); function FGetImageBitmap(Index: integer): TBitmap; protected lsDib: TDIB; public IndexList: array of Integer; Stream: TFileStream; MainPalette: TRGBQuads; HeaderOfIndex: TWMIndexHeader; property BitMaps[index: Integer]: TBitmap read FGetImageBitmap; property FileName: string read FFileName write FFileName; property ImageCount: Integer read FImageCount; property px: Integer read Fpx write Fpx; property py: Integer read Fpy write Fpy; property OffSet: Integer read FOffSet write FOffSet; property Width: Integer read FWidth write FWidth; property Height: Integer read FHeight write FHeight; property Title: string read FTitle; constructor Create(AOwner: TComponent);override; destructor Destroy;override; procedure Initialize; procedure Finalize; procedure LoadPalette; procedure DrawZoom(Paper: TCanvas; Rec: TRect; Index: Integer); function ChangeX(Index: Integer; x: SmallInt): Boolean; function ChangeY(Index: Integer; y: smallint): Boolean; function AddBitmap(NewBitmap: TBitmap; x, y: SmallInt): Boolean; function AddNullBitmap: Boolean; function ReplaceBitmap(Index: Integer; NewBitmap: TBitmap): Boolean; end; implementation function ExtractFileNameOnly(const fname: string): string; var extpos: Integer; ext, fn: string; begin ext := ExtractFileExt(fname); fn := ExtractFileName(fname); if ext <> '' then begin extpos := Pos(ext, fn); Result := Copy(fn, 1, extpos - 1); end else Result := fn; end; constructor TWIL.Create(AOwner: TComponent); begin inherited Create(AOwner); FFileName := ''; FImageCount := 0; Stream := nil; lsDib := TDIB.Create; lsDib.BitCount := 8; lsDib.PixelFormat.RBitMask := $FF0000; lsDib.PixelFormat.GBitMask := $FF00; lsDib.PixelFormat.BBitMask := $FF; FBitMap := TBitmap.Create; FBitMap.PixelFormat := pf8bit; FBitMap.Width := 1; FBitMap.Height := 1; end; destructor TWIL.Destroy; begin if Stream <> nil then Stream.Free; lsDib.Free; FBitMap.Free; inherited Destroy; end; procedure Register; begin RegisterComponents('TOPDELPHI', [TWIL]); end; procedure TWIL.Initialize; var header: TWMImageHeader; s: PChar; str: string; begin if FFileName = '' then begin raise Exception.Create('FileName not assigned..'); Exit; end; if FileExists(FFileName) then begin if Stream = nil then Stream := TFileStream.Create(FFileName, fmOpenReadWrite or fmShareDenyNone); Stream.Read(header, SizeOf(TWMImageHeader)); FTitle := header.Title; FImageCount := header.ImageCount; { if header.Title <> 'ILIB v1.0-WEMADE Enterainment inc.' then begin Stream.Free; Stream := nil; Exit; end; } if Stream <> nil then begin FIndexFile := ExtractFilePath(FFileName) + ExtractFileNameOnly(FFileName) + '.wix'; LoadIndex(FIndexFile); LoadPalette; end else MessageDlg(FFileName + 'is not a Wil file.', mtWarning, [mbOK], 0); end else MessageDlg(FFileName + 'is not Existing', mtWarning, [mbOK], 0); end; procedure TWIL.Finalize; begin if Stream <> nil then begin Stream.Free; Stream := nil; end; SetLength(IndexList, 0); FOffSet := 0; end; procedure TWIL.LoadPalette; var x: Integer; lplogpal: PMaxLogPalette; begin Stream.Seek(56, 0); Stream.Read(MainPalette, SizeOf(TRgbQuad) * 256); GetMem(lplogpal, SizeOf(TLOGPALETTE) + 255 * SizeOf(TPALETTEENTRY)); lplogpal.palVersion := $0300; lplogpal.palNumEntries := 256; for x := 0 to 255 do begin lplogpal.palPalEntry[x].peRed := MainPalette[x].rgbRed; lplogpal.palPalEntry[x].peGreen := MainPalette[x].rgbGreen; lplogpal.palPalEntry[x].peBlue := MainPalette[x].rgbBlue; end; FBitMap.Palette := CreatePalette(pLogPalette(lplogpal)^); end; procedure TWIL.LoadIndex(FIndexFile: string); var fhandel: Integer; begin if FileExists(FIndexFile) then begin fhandel := FileOpen(FIndexFile, fmOpenRead or fmShareDenyNone); if fhandel > 0 then begin FOffSet := 0; FileRead(fhandel, HeaderOfIndex, SizeOf(TWMIndexHeader)); SetLength(IndexList, HeaderOfIndex.IndexCount + 1); FileRead(fhandel, IndexList[0], 4 * HeaderOfIndex.IndexCount); // ShowMessage(IntToStr(HeaderOfIndex.IndexCount)); end; end; FileClose(fhandel); end; procedure TWIL.LoadBmpImage(Position: Integer; Index: integer); var imginfo: TWMImageInfo; DBits: PByte; begin Stream.Seek(Position, 0); Stream.Read(imginfo, SizeOf(TWMImageInfo) - 4); FX[Index] := imginfo.px; FY[Index] := imginfo.py; lsDib.Width := (((imginfo.Width * 8) + 31) shr 5) * 4; lsDib.Height:= imginfo.Height; lsDib.ColorTable := MainPalette; lsDib.UpdatePalette; lsDib.Canvas.Brush.Color := clBlack; lsDib.Canvas.FillRect(Rect(0, 0, lsDib.Width, lsDib.Height)); DBits := lsDib.PBits; Stream.Read(Dbits^, imginfo.Width * imginfo.Height); if (imginfo.Width > 1000) or (imginfo.Height > 1000) then Exit; FBitMap.Width := lsDib.Width; FBitMap.Height := lsDib.Height; FBitMap.Canvas.Draw(0, 0, lsDib); lsDib.Clear; end; function TWIL.FGetImageBitmap(Index: integer): TBitmap; var position: Integer; begin Result := nil; if (Index < 0) or (Index >= FImageCount) then begin FBitMap.Width := 1; FBitMap.Height := 1; Result := FBitMap; Exit; end; position := IndexList[Index]; LoadBmpImage(position, Index); FWidth := FBitMap.Width; FHeight := FBitMap.Height; Fpx := FX[Index]; Fpy := FY[Index]; Result := FBitMap; end; function TWIL.AddBitmap(NewBitmap: TBitmap; x, y: SmallInt): Boolean; var temp: TFileStream; DBits: PByte; v: SmallInt; offset: Integer; begin Result := False; try lsDib.Width := (((NewBitmap.Width * 8) + 31) shr 5) * 4; lsDib.Height := NewBitmap.Height; if (NewBitmap.Width <= 1) or (NewBitmap.Height <= 1) then begin AddNullBitmap; Result := True; Exit; end; lsDib.ColorTable := MainPalette; lsDib.Canvas.Brush.Color := clBlack; lsDib.Canvas.FillRect(Rect(0, 0, lsDib.Width, lsDib.Height)); lsDib.Canvas.Draw(0, 0, NewBitmap); if Stream <> nil then begin Inc(FImageCount); Stream.Seek(44, 0); Stream.Write(FImageCount, 4); OffSet := Stream.Size; Stream.Seek(0, 2); v := lsDib.Width; Stream.Write(v, 2); v := lsDib.Height; Stream.Write(v, 2); Stream.Write(x, 2); Stream.Write(y, 2); DBits := lsDib.PBits; Stream.Write(DBits^, lsDib.Size); temp := TFileStream.Create(FIndexFile, fmOpenWrite or fmShareDenyNone); temp.Seek(44, 0); temp.Write(FImageCount, 4); temp.Seek(0, 2); temp.Write(offset, 4); temp.Free; end; Result := true; except end; end; function TWIL.AddNullBitmap: Boolean; var temp: TFileStream; offset: Integer; v: SmallInt; vv: Byte; begin Result := False; try if Stream <> nil then begin Inc(FImageCount); Stream.Seek(44, 0); Stream.Write(FImageCount, 4); OffSet := Stream.Size; v := 1; Stream.Write(v, 2); Stream.Write(v, 2); Stream.Write(v, 2); Stream.Write(v, 2); vv := 0; Stream.Write(vv, 1); temp := TFileStream.Create(FIndexFile, fmOpenReadWrite or fmShareDenyNone); temp.Seek(44, 0); temp.Write(FImageCount, 4); temp.Seek(0, 2); temp.Write(offset, 4); temp.Free; end; Result := True; except end; end; function TWIL.ChangeX(Index: Integer; x: SmallInt): Boolean; var size: Integer; begin Result := True; if Stream <> nil then begin size := IndexList[Index]; Stream.Seek(size + 4, 0); Stream.Write(x, 2); end; end; function TWIL.ChangeY(Index: Integer; y: SmallInt): Boolean; var size: Integer; begin Result := True; if Stream <> nil then begin size := IndexList[Index]; Stream.Seek(size + 6, 0); Stream.Write(y, 2); end; end; function TWIL.ReplaceBitmap(Index: Integer; NewBitmap: TBitmap): Boolean; var Width, Height, x, y: SmallInt; temp: TMemoryStream; offset, size, i, WixFileHandle: Integer; DBits: PByte; begin Result := False; try; lsDib.Width := (((NewBitmap.Width * 8) + 31) shr 5) * 4; lsDib.Height := NewBitmap.Height; lsDib.ColorTable := MainPalette; lsDib.UpdatePalette; lsDib.Canvas.Brush.Color := clBlack; lsDib.Canvas.FillRect(Rect(0, 0, lsDib.Width, lsDib.Height)); lsDib.Canvas.Draw(0, 0, NewBitmap); if Stream <> nil then begin offset := IndexList[Index]; Stream.Seek(offset, 0); Stream.Read(Width, 2); Stream.Read(Height, 2); Stream.Read(x, 2); Stream.Read(y, 2); DBits := lsDib.PBits; if (Width = lsDib.Width) and (Height = lsDib.Height) then Stream.Write(DBits^, lsDib.Height * lsDib.Width) else begin size := Stream.Size - (offset + 8 + Width * Height); temp := TMemoryStream.Create; Stream.Seek(0, 0); temp.LoadFromStream(Stream); Stream.Seek(offset, 0); x := lsDib.Width; y := lsDib.Height; Stream.Write(x, 2); Stream.Write(y, 2); Stream.Seek(4, 1); Stream.Write(Dbits^, x * y); temp.Seek(OffSet + 8 + Width * Height, 0); Stream.CopyFrom(temp, size); temp.Free; WixFileHandle := FileOpen(FIndexFile, fmOpenReadWrite); FileSeek(WixFileHandle, 48 + 4 * (Index + 1), 0); for i := index + 1 to ImageCount - 1 do begin offset := IndexList[i] + x * y - Width * Height; IndexList[i] := offset; FileWrite(WixFileHandle, offset, 4); end; FileClose(WixFileHandle); LoadIndex(FIndexFile); end; end; Result := True; except end; end; procedure TWIL.DrawZoom(Paper: TCanvas; Rec: TRect; Index: Integer); var rc, rczoom: TRect; LoadBmp, XpatBmp, LoadZoomBmp, XpatZoomBmp : TBitmap; begin LoadBmp := TBitmap.Create; LoadBmp.Width := BitMaps[index].Width; LoadBmp.Height := BitMaps[index].Height; XpatBmp := TBitmap.Create; XpatBmp.Width := LoadBmp.Width; XpatBmp.Height := LoadBmp.Height; rc := Rect(0, 0, LoadBmp.Width, LoadBmp.Height); LoadBmp.Canvas.CopyRect(rc, BitMaps[index].Canvas, rc); XpatBmp.Canvas.Brush.Color := clWhite; XpatBmp.Canvas.BrushCopy(rc, LoadBmp, rc, clBlack); XpatBmp.Canvas.CopyMode := cmSrcInvert; XpatBmp.Canvas.CopyRect(rc, LoadBmp.Canvas, rc); XpatZoomBmp := TBitmap.Create; XpatZoomBmp.Width := Rec.Right - Rec.Left; XpatZoomBmp.Height := Rec.Bottom - Rec.Top; { if XpatZoomBmp.Width > LoadBmp.Width then XpatZoomBmp.Width := LoadBmp.Width; if XpatZoomBmp.Height > LoadBmp.Height then XpatZoomBmp.Height := LoadBmp.Height; } rczoom := Rect(0, 0, XpatZoomBmp.Width, XpatZoomBmp.Height); XpatZoomBmp.Canvas.StretchDraw(rczoom, XpatBmp); LoadZoomBmp := TBitmap.Create; LoadZoomBmp.Width := XpatZoomBmp .Width; LoadZoomBmp.Height := XpatZoomBmp.Height; LoadZoomBmp.Canvas.StretchDraw(rczoom, LoadBmp); Paper.CopyMode := cmSrcAnd; Paper.CopyRect(Rec, XpatZoomBmp.Canvas, rczoom); Paper.CopyMode := cmSrcPaint; Paper.CopyRect(Rec, LoadZoomBmp.Canvas, rczoom); Paper.CopyMode := cmSrcCopy; LoadZoomBmp.Free; XpatZoomBmp.Free; LoadBmp.Free; XpatBmp.Free; end; end.
unit mywil; interface uses Windows, Classes, Graphics, SysUtils, Dialogs, DIB; type TWMImageHeader = record {去掉了少见的WIL,WIX 文件格式的支持 只定义了现在最常见的，也许是默认了的格式了} Title: string[40]; ImageCount: Integer; ColorCount: Integer; PaletteSize: Integer; end; TWMImageInfo = record Width: SmallInt; Height: SmallInt; px: SmallInt; py: SmallInt; bits: PByte; end; TWMIndexHeader = record Title: string[40]; IndexCount: Integer; end; TWMIndexInfo = record Position: Integer; Size: Integer; end; TXY = array[0..65535] of Integer; TWIL = class(TComponent) private FFileName: string; FIndexFile: string; FTitle: string; FImageCount: Integer; FX, FY: TXY; FBitMap: TBitmap; Fpx, Fpy: Integer; FWidth, FHeight: Integer; FOffSet: Integer; procedure LoadIndex(FIndexFile: string); procedure LoadBmpImage(Position: Integer; Index: integer); function FGetImageBitmap(Index: integer): TBitmap; protected lsDib: TDIB; public IndexList: array of Integer; Stream: TFileStream; MainPalette: TRGBQuads; //256色的必须用到调色板 HeaderOfIndex: TWMIndexHeader; // 这里是属性了 property BitMaps[index: Integer]: TBitmap read FGetImageBitmap; property FileName: string read FFileName write FFileName; property ImageCount: Integer read FImageCount; property px: Integer read Fpx write Fpx; property py: Integer read Fpy write Fpy; property OffSet: Integer read FOffSet write FOffSet; property Width: Integer read FWidth write FWidth; property Height: Integer read FHeight write FHeight; property Title: string read FTitle; //增加了一个属性，用来做WIX文件标志的。 constructor Create(AOwner: TComponent);override; destructor Destroy;override; procedure Initialize; procedure Finalize; procedure LoadPalette; procedure DrawZoom(Paper: TCanvas; Rec: TRect; Index: Integer); // 这个方法被重点改写了。用到了游戏40例里面所学习到的知识 function ChangeX(Index: Integer; x: SmallInt): Boolean; function ChangeY(Index: Integer; y: smallint): Boolean; function AddBitmap(NewBitmap: TBitmap; x, y: SmallInt): Boolean; function AddNullBitmap: Boolean; function ReplaceBitmap(Index: Integer; NewBitmap: TBitmap): Boolean; end; implementation function ExtractFileNameOnly(const fname: string): string; var extpos: Integer; ext, fn: string; begin ext := ExtractFileExt(fname); fn := ExtractFileName(fname); if ext <> '' then begin extpos := Pos(ext, fn); Result := Copy(fn, 1, extpos - 1); end else Result := fn; end; constructor TWIL.Create(AOwner: TComponent); begin inherited Create(AOwner); //调用父类的构建，如果是继承其他的类呢，还可以用什么其它的类呢 FFileName := ''; //继承于TOBJIETC 是不成功的。 FImageCount := 0; Stream := nil; lsDib := TDIB.Create; //DIB lsDib.BitCount := 8; lsDib.PixelFormat.RBitMask := $FF0000; lsDib.PixelFormat.GBitMask := $FF00; lsDib.PixelFormat.BBitMask := $FF; FBitMap := TBitmap.Create; //BMP WIL里面图片存储的DIB 格式，读出来得转换成BMP格式 FBitMap.PixelFormat := pf8bit; //才能在DELHPI的控件中使用。 FBitMap.Width := 1; FBitMap.Height := 1; end; destructor TWIL.Destroy; begin if Stream <> nil then Stream.Free; lsDib.Free; FBitMap.Free; inherited Destroy; end; procedure Register; //这个注册方法可以取消吗？ begin RegisterComponents('TOPDELPHI', [TWIL]); end; procedure TWIL.Initialize; var header: TWMImageHeader; begin if FFileName = '' then begin raise Exception.Create('FileName not assigned..'); Exit; end; if FileExists(FFileName) then begin if Stream = nil then Stream := TFileStream.Create(FFileName, fmOpenReadWrite or fmShareDenyNone); Stream.Read(header, SizeOf(TWMImageHeader)); FTitle := header.Title; FImageCount := header.ImageCount; {这个比较过不去，我在试试。也许是打字错了。} { if header.Title <> 'ILIB v1.0-WEMADE Enterainment inc.' then begin Stream.Free; Stream := nil; Exit; end; } if Stream <> nil then begin FIndexFile := ExtractFilePath(FFileName) + ExtractFileNameOnly(FFileName) + '.wix'; LoadIndex(FIndexFile); LoadPalette; end else MessageDlg(FFileName + 'is not a Wil file.', mtWarning, [mbOK], 0); end else MessageDlg(FFileName + 'is not Existing', mtWarning, [mbOK], 0); end; procedure TWIL.Finalize; begin if Stream <> nil then begin Stream.Free; Stream := nil; end; SetLength(IndexList, 0); FOffSet := 0; end; procedure TWIL.LoadPalette; var x: Integer; lplogpal: PMaxLogPalette; begin Stream.Seek(56, 0); Stream.Read(MainPalette, SizeOf(TRgbQuad) * 256); {调色板的转换，调色板得学习啊} GetMem(lplogpal, SizeOf(TLOGPALETTE) + 255 * SizeOf(TPALETTEENTRY)); lplogpal.palVersion := $0300; lplogpal.palNumEntries := 256; for x := 0 to 255 do begin lplogpal.palPalEntry[x].peRed := MainPalette[x].rgbRed; lplogpal.palPalEntry[x].peGreen := MainPalette[x].rgbGreen; lplogpal.palPalEntry[x].peBlue := MainPalette[x].rgbBlue; end; FBitMap.Palette := CreatePalette(pLogPalette(lplogpal)^); end; procedure TWIL.LoadIndex(FIndexFile: string); var fhandel: Integer; //感觉这个文件句柄 定义的不规范？？？ {对于wix文件，采取了 文件函数 处理的办法，没有用stream的办法} begin {对于WIL 文件是用的stream的办法} if FileExists(FIndexFile) then begin fhandel := FileOpen(FIndexFile, fmOpenRead or fmShareDenyNone); if fhandel > 0 then begin FOffSet := 0; FileRead(fhandel, HeaderOfIndex, SizeOf(TWMIndexHeader)); SetLength(IndexList, HeaderOfIndex.IndexCount + 1); FileRead(fhandel, IndexList[0], 4 * HeaderOfIndex.IndexCount); // ShowMessage(IntToStr(HeaderOfIndex.IndexCount)); end; end; FileClose(fhandel); end; procedure TWIL.LoadBmpImage(Position: Integer; Index: integer); var imginfo: TWMImageInfo; DBits: PByte; begin Stream.Seek(Position, 0); {读取WIL流数据，填写到DIB，再从DIB 拷贝到BMP} Stream.Read(imginfo, SizeOf(TWMImageInfo) - 4); FX[Index] := imginfo.px; FY[Index] := imginfo.py; lsDib.Width := (((imginfo.Width * 8) + 31) shr 5) * 4; lsDib.Height:= imginfo.Height; lsDib.ColorTable := MainPalette; lsDib.UpdatePalette; lsDib.Canvas.Brush.Color := clBlack; lsDib.Canvas.FillRect(Rect(0, 0, lsDib.Width, lsDib.Height)); DBits := lsDib.PBits; Stream.Read(Dbits^, imginfo.Width * imginfo.Height); if (imginfo.Width > 1000) or (imginfo.Height > 1000) then Exit; FBitMap.Width := lsDib.Width; FBitMap.Height := lsDib.Height; FBitMap.Canvas.Draw(0, 0, lsDib); lsDib.Clear; end; function TWIL.FGetImageBitmap(Index: integer): TBitmap; // 图片的读取是用的属性读方法 var //将图片做成了一个属性 position: Integer; begin Result := nil; if (Index < 0) or (Index >= FImageCount) then begin FBitMap.Width := 1; FBitMap.Height := 1; Result := FBitMap; Exit; end; position := IndexList[Index]; LoadBmpImage(position, Index); FWidth := FBitMap.Width; FHeight := FBitMap.Height; Fpx := FX[Index]; Fpy := FY[Index]; Result := FBitMap; end; function TWIL.AddBitmap(NewBitmap: TBitmap; x, y: SmallInt): Boolean; var temp: TFileStream; DBits: PByte; v: SmallInt; offset: Integer; begin Result := False; try lsDib.Width := (((NewBitmap.Width * 8) + 31) shr 5) * 4; lsDib.Height := NewBitmap.Height; if (NewBitmap.Width <= 1) or (NewBitmap.Height <= 1) then begin AddNullBitmap; Result := True; Exit; end; lsDib.ColorTable := MainPalette; {添加图片，从BMP 到 DIB } lsDib.Canvas.Brush.Color := clBlack; lsDib.Canvas.FillRect(Rect(0, 0, lsDib.Width, lsDib.Height)); lsDib.Canvas.Draw(0, 0, NewBitmap); if Stream <> nil then begin {流写入} Inc(FImageCount); Stream.Seek(44, 0); Stream.Write(FImageCount, 4); OffSet := Stream.Size; Stream.Seek(0, 2); v := lsDib.Width; Stream.Write(v, 2); v := lsDib.Height; Stream.Write(v, 2); Stream.Write(x, 2); Stream.Write(y, 2); DBits := lsDib.PBits; Stream.Write(DBits^, lsDib.Size); temp := TFileStream.Create(FIndexFile, fmOpenWrite or fmShareDenyNone); temp.Seek(44, 0); temp.Write(FImageCount, 4); temp.Seek(0, 2); temp.Write(offset, 4); temp.Free; end; Result := true; except end; end; function TWIL.AddNullBitmap: Boolean; var temp: TFileStream; offset: Integer; v: SmallInt; vv: Byte; begin Result := False; try if Stream <> nil then begin Inc(FImageCount); Stream.Seek(44, 0); Stream.Write(FImageCount, 4); OffSet := Stream.Size; v := 1; Stream.Write(v, 2); Stream.Write(v, 2); Stream.Write(v, 2); Stream.Write(v, 2); vv := 0; Stream.Write(vv, 1); temp := TFileStream.Create(FIndexFile, fmOpenReadWrite or fmShareDenyNone); temp.Seek(44, 0); temp.Write(FImageCount, 4); temp.Seek(0, 2); temp.Write(offset, 4); temp.Free; end; Result := True; except end; end; function TWIL.ChangeX(Index: Integer; x: SmallInt): Boolean; var size: Integer; begin Result := True; if Stream <> nil then begin size := IndexList[Index]; Stream.Seek(size + 4, 0); Stream.Write(x, 2); end; end; function TWIL.ChangeY(Index: Integer; y: SmallInt): Boolean; var size: Integer; begin Result := True; if Stream <> nil then begin size := IndexList[Index]; Stream.Seek(size + 6, 0); Stream.Write(y, 2); end; end; function TWIL.ReplaceBitmap(Index: Integer; NewBitmap: TBitmap): Boolean; var Width, Height, x, y: SmallInt; temp: TMemoryStream; offset, size, i, WixFileHandle: Integer; DBits: PByte; begin Result := False; try; lsDib.Width := (((NewBitmap.Width * 8) + 31) shr 5) * 4; lsDib.Height := NewBitmap.Height; lsDib.ColorTable := MainPalette; lsDib.UpdatePalette; lsDib.Canvas.Brush.Color := clBlack; lsDib.Canvas.FillRect(Rect(0, 0, lsDib.Width, lsDib.Height)); lsDib.Canvas.Draw(0, 0, NewBitmap); if Stream <> nil then begin offset := IndexList[Index]; Stream.Seek(offset, 0); Stream.Read(Width, 2); Stream.Read(Height, 2); Stream.Read(x, 2); Stream.Read(y, 2); DBits := lsDib.PBits; if (Width = lsDib.Width) and (Height = lsDib.Height) then Stream.Write(DBits^, lsDib.Height * lsDib.Width) else begin size := Stream.Size - (offset + 8 + Width * Height); temp := TMemoryStream.Create; Stream.Seek(0, 0); {WIL 用的流 } temp.LoadFromStream(Stream); Stream.Seek(offset, 0); x := lsDib.Width; y := lsDib.Height; Stream.Write(x, 2); Stream.Write(y, 2); Stream.Seek(4, 1); Stream.Write(Dbits^, x * y); temp.Seek(OffSet + 8 + Width * Height, 0); Stream.CopyFrom(temp, size); temp.Free; WixFileHandle := FileOpen(FIndexFile, fmOpenReadWrite); {WIX 用的文件函数} FileSeek(WixFileHandle, 48 + 4 * (Index + 1), 0); for i := index + 1 to ImageCount - 1 do begin offset := IndexList[i] + x * y - Width * Height; IndexList[i] := offset; FileWrite(WixFileHandle, offset, 4); end; FileClose(WixFileHandle); LoadIndex(FIndexFile); end; end; Result := True; except end; end; procedure TWIL.DrawZoom(Paper: TCanvas; Rec: TRect; Index: Integer); var rc, rczoom: TRect; {编写的贴图，图片要缩放，需要缩放后的 贴图点阵图和去除用点阵图} LoadBmp, XpatBmp, LoadZoomBmp, XpatZoomBmp : TBitmap; begin LoadBmp := TBitmap.Create; LoadBmp.Width := BitMaps[index].Width; LoadBmp.Height := BitMaps[index].Height; XpatBmp := TBitmap.Create; XpatBmp.Width := LoadBmp.Width; XpatBmp.Height := LoadBmp.Height; rc := Rect(0, 0, LoadBmp.Width, LoadBmp.Height); LoadBmp.Canvas.CopyRect(rc, BitMaps[index].Canvas, rc); //将WIL 中的某单个图片拷贝到LOADBMP中 XpatBmp.Canvas.Brush.Color := clWhite; XpatBmp.Canvas.BrushCopy(rc, LoadBmp, rc, clBlack); XpatBmp.Canvas.CopyMode := cmSrcInvert; XpatBmp.Canvas.CopyRect(rc, LoadBmp.Canvas, rc); //制作去除用点阵图，又称是蒙板，MASK XpatZoomBmp := TBitmap.Create; {这个在drawgrid中是小格子的RECT 在PANTBOX 中是给出的BMPX,Y 加图片宽长} XpatZoomBmp.Width := Rec.Right - Rec.Left; XpatZoomBmp.Height := Rec.Bottom - Rec.Top; rczoom := Rect(0, 0, XpatZoomBmp.Width, XpatZoomBmp.Height); XpatZoomBmp.Canvas.StretchDraw(rczoom, XpatBmp); LoadZoomBmp := TBitmap.Create; LoadZoomBmp.Width := XpatZoomBmp .Width; LoadZoomBmp.Height := XpatZoomBmp.Height; LoadZoomBmp.Canvas.StretchDraw(rczoom, LoadBmp); Paper.CopyMode := cmSrcAnd; Paper.CopyRect(Rec, XpatZoomBmp.Canvas, rczoom); Paper.CopyMode := cmSrcPaint; Paper.CopyRect(Rec, LoadZoomBmp.Canvas, rczoom); Paper.CopyMode := cmSrcCopy; LoadZoomBmp.Free; XpatZoomBmp.Free; LoadBmp.Free; XpatBmp.Free; end; end.
问题
1，这个是什么？？lsDib.Width := (((NewBitMap.Width*8)+31) shr 5) * 4;
实验的数据： 得到最近4的倍数，方便存放4字节？
这个是对BMP格式的要求。
2， 调色板是什么？procedure TWIL.LoadPalette;
在TWIL.AddBitmap TWIL.ReplaceBitMap TWIL.LoadBmpImag中会将lsDib.ColorTable := MainPalette;给DIB 类，
ColorTable: TRGBQuads;
在WIL 文件的56位置，读取Stream.Read (MainPalette, sizeof(TRgbQuad) * 256)
MainPalette: TRgbQuads;
TRGBQuads = array[0..255] of TRGBQuad
TRGBQuad 系统定义
3 TDib.Create文件的建立？
4，TBitMapHeader头文件？用在少见版的WIL 中
5，TWIL继承TComponent，还可以是继承于其它的类吗？
6，lsDib: TDIB; 还是得学习 DIB 这个单元。
浙公网安备 33010602011771号