各位大大好，小弟想嘗試將全彩圖轉成256色圖形時，發生色盤不對，請問該如何處理才會讓顏色不會偏差太多？ procedure TForm1.SaveAsBmpClick(Sender: TObject); var SysPal : LogPal; sourceRect, destRect: TRect; image2save: TBitmap ; begin image2save := TBitmap.create ; try with image2save do begin Height := Form1.DXDraw1.Height; Width := Form1.DXDraw1.Width; destRect := Rect(0,0,Width, Height); sourceRect := destRect ; image2save.Canvas.CopyRect(destRect, Form1.DXDraw1.surface.Canvas, sourceRect); Form1.DXDraw1.surface.Canvas.Release; // ****** SysPal.lPal.palVersion := $300; SysPal.lPal.palNumEntries := 256; GetSystemPaletteEntries(Form1.DXDraw1.Handle , 0, 256, SysPal.lpal.PalpalEntry); image2save.PixelFormat := pf8bit; image2save.Palette := CreatePalette(Syspal.lpal); end; if SaveDialog1.Execute then begin image2save.SaveToFile(SaveDialog1.FileName); End ; image2save.Free ; ShowMessage('Save OK !!!'); Except ShowMessage('Error') ; End ; end;

引言: 各位大大好，小弟想嘗試將全彩圖轉成256色圖形時，發生色盤不對，請問該如何處理才會讓顏色不會偏差太多？ procedure TForm1.SaveAsBmpClick(Sender: TObject); var SysPal : LogPal; sourceRect, destRect: TRect; image2save: TBitmap ; begin image2save := TBitmap.create ; try with image2save do begin Height := Form1.DXDraw1.Height; Width := Form1.DXDraw1.Width; destRect := Rect(0,0,Width, Height); sourceRect := destRect ; image2save.Canvas.CopyRect(destRect, Form1.DXDraw1.surface.Canvas, sourceRect); Form1.DXDraw1.surface.Canvas.Release; // ****** SysPal.lPal.palVersion := $300; SysPal.lPal.palNumEntries := 256; GetSystemPaletteEntries(Form1.DXDraw1.Handle , 0, 256, SysPal.lpal.PalpalEntry); image2save.PixelFormat := pf8bit; image2save.Palette := CreatePalette(Syspal.lpal); end; if SaveDialog1.Execute then begin image2save.SaveToFile(SaveDialog1.FileName); End ; image2save.Free ; ShowMessage('Save OK !!!'); Except ShowMessage('Error') ; End ; end;

這個主題很有趣喔,站長先試試看再告訴您!` ～～～Delphi K.Top討論區站長～～～

感謝站長，小弟在此說聲謝謝.........

引言: 感謝站長，小弟在此說聲謝謝......... < face="Verdana, Arial, Helvetica"> 試了一下,可否將您的完整程式列出,包含前面的Define? ～～～Delphi K.Top討論區站長～～～

小弟是利用 DELPHIX 裡面的 TDXDRAW 顯示畫型‧ unit DirextX; interface uses Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, DXClass, DIB, DXDraws, StdCtrls, ComCtrls, ExtCtrls; type LogPal = record lpal : TLogPalette; dummy:Array[0..255] of TPaletteEntry; end; type TForm1 = class(TForm) DXDraw1: TDXDraw; DXDIB1: TDXDIB; DXTimer1: TDXTimer; Button1: TButton; TrackBar1: TTrackBar; Label1: TLabel; Label2: TLabel; Edit1: TEdit; Button3: TButton; OpenDialog1: TOpenDialog; Button2: TButton; SaveDialog1: TSaveDialog; CheckBox1: TCheckBox; procedure DXDraw1Initialize(Sender: TObject); procedure DXDraw1RestoreSurface(Sender: TObject); procedure DXDraw1Finalize(Sender: TObject); procedure DXTimer1Timer(Sender: TObject; LagCount: Integer); procedure FormActivate(Sender: TObject); procedure Button1Click(Sender: TObject); procedure FormCreate(Sender: TObject); procedure TrackBar1Change(Sender: TObject); procedure DXDraw1MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); procedure Button3Click(Sender: TObject); procedure Button2Click(Sender: TObject); private { Private declarations } Set_key_color : Integer ; DecX : Boolean ; DecY : Boolean ; Onnormal : Boolean ; Fsurface : TDirectDrawSurface; Procedure MoveXY ; procedure SaveAsBmpClick(Sender: TObject); public { Public declarations } end; var Form1: TForm1; xx,yy : Integer; implementation {$R *.DFM} procedure TForm1.DXDraw1Initialize(Sender: TObject); begin FSurface := TDirectDrawSurface.Create(DXDraw1.DDraw); end; procedure TForm1.DXDraw1RestoreSurface(Sender: TObject); begin FSurface.LoadfromGraphic(DXDIB1.DIB);{將位圖送入抽象表面} end; procedure TForm1.DXDraw1Finalize(Sender: TObject); begin FSurface.Free; FSurface := nil; end; Procedure Tform1.MoveXY ; Begin if Not Form1.CheckBox1.Checked then Exit ; if (Not DecX) And (xx < form1.DXDraw1.Width) and (xx >= 0) then inc(xx, 1) Else DecX := True ; if DecX And (xx > 0) then Dec(xx, 1) Else DecX := False ; if (Not DecY) And (yy < form1.DXDraw1.Height) and (yy >= 0) then inc(yy, 1) Else DecY := True ; if DecY And (yy > 0) then Dec(yy, 1) Else DecY := False ; End ; procedure TForm1.DXTimer1Timer(Sender: TObject; LagCount: Integer); begin if (not DXDraw1.CanDraw) then Exit; // 在繪制之前檢驗是否允許 if not Form1.Onnormal then Exit; DXDraw1.Surface.Fill(0); // 顯示底色 MoveXY ; DXDraw1.Surface.Draw(xx, yy, FSurface.ClientRect , FSurface, True); DXDraw1.Flip; // 將內存中的表面再將映射入實際顯存 end; procedure TForm1.FormActivate(Sender: TObject); begin if Form1.DXDIB1.DIB.Empty then Onnormal := False Else Onnormal := True ; xx :=0; yy :=0; end; procedure TForm1.Button1Click(Sender: TObject); begin if Form1.OpenDialog1.Execute then Begin Try DXDIB1.DIB.Clear ; DXDIB1.DIB.LoadFromFile(Form1.OpenDialog1.FileName) ; FSurface.LoadfromGraphic(DXDIB1.DIB);{將位圖送入抽象表面} Form1.Caption := Form1.OpenDialog1.FileName ; Except ShowMessage('Error ...... '); End ; End ; end; procedure TForm1.FormCreate(Sender: TObject); begin form1.Height := 400 ; form1.Width := 600 ; Form1.DXDraw1.Height := 300 ; Form1.DXDraw1.Width := 300 ; Form1.DXDIB1.DIB.LoadFromFile('Font.BMP') ; Form1.Onnormal := False ; Form1.DXTimer1.Interval := 1000 div (form1.TrackBar1.Position 1) ; end; procedure TForm1.TrackBar1Change(Sender: TObject); begin Form1.Label1.Caption := IntToSTR(form1.TrackBar1.Position) ; if form1.TrackBar1.Position >= 50 then Begin Form1.TrackBar1.SelStart := 50 ; Form1.TrackBar1.SelEnd := form1.TrackBar1.Position ; End Else Begin Form1.TrackBar1.SelStart := form1.TrackBar1.Position ; Form1.TrackBar1.SelEnd := 50 ; End ; if form1.TrackBar1.Position = 0 then Onnormal := false Else Onnormal := True ; Form1.DXTimer1.Interval := 1000 div (form1.TrackBar1.Position 1) ; end; procedure TForm1.DXDraw1MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); begin Set_Key_color := DXDraw1.Surface.Pixels[x,y] ; Form1.Edit1.Text := IntToStr(Set_key_color); Form1.Label2.Caption := 'X =' IntToStr(x) ' / Y =' IntToStr(y) ' / Pixels =' IntToStr(Set_Key_color) ; end; procedure TForm1.Button3Click(Sender: TObject); begin FSurface.TransparentColor := Set_key_color ; end; procedure TForm1.Button2Click(Sender: TObject); begin SaveAsBmpClick(Form1) ; Form1.DXDraw1.UpdatePalette ; end; procedure TForm1.SaveAsBmpClick(Sender: TObject); var SysPal : LogPal; sourceRect, destRect: TRect; image2save: TBitmap ; begin image2save := TBitmap.create ; try with image2save do begin Height := Form1.DXDraw1.Height; Width := Form1.DXDraw1.Width; destRect := Rect(0,0,Width, Height); sourceRect := destRect ; image2save.Canvas.CopyRect(destRect, Form1.DXDraw1.surface.Canvas, sourceRect); Form1.DXDraw1.surface.Canvas.Release; // ****** SysPal.lPal.palVersion := $300; SysPal.lPal.palNumEntries := 256; GetSystemPaletteEntries(Form1.DXDraw1.Handle , 0, 256, SysPal.lpal.PalpalEntry); image2save.PixelFormat := pf8bit; image2save.Palette := CreatePalette(Syspal.lpal); end; if SaveDialog1.Execute then begin image2save.SaveToFile(SaveDialog1.FileName); End ; image2save.Free ; ShowMessage('Save OK !!!'); Except ShowMessage('Error') ; End ; end; end.