编译后图标变色?

Question

为application指定一个16*16的真彩图标,编译后图标颜色失真?

Answer 1

?哈....失真多厉害?是不是ICO图标格式?

Answer 2

由双缓冲绘图技术谈起到Delphi源码实现 摘要：双缓冲绘图技术在Delphi中的实现关键字：Delphi,双缓冲,Canvas作者：上海翰博数码科技实业有限公司   沈小云说明：假设读者熟悉VCL 双缓冲绘图也不是什么新技术，简单的说：在绘图实现时不直接绘在窗口上，而是先绘在内存里，再一起“拷贝”至窗口。实现起来也不复杂，创建一兼容HDC,在此兼容HDC上绘图，最后拷贝到窗口HDC就行了。本人前段时间把一C++实现该技术的代码改成了Delphi代码，都是用Win32API写的。今改成了使用Delphi自带的类，试了一下(窗口类Canvas与TImage的Canvas)。实现方式大同小异，但不得不提的是在窗口中直接使用Canvas绘图与TImage.Canvas却不相同。使用TImage.Canvas绘图时，自动使用了双缓冲技术，而窗口的Canvas对像却未实现。怎么回事呢？看一下代码吧，“源码面前没有秘密”! 一．TImage类的CanvasTImage = class(TGraphicControl)...property Canvas: TCanvas read GetCanvas;...function TImage.GetCanvas: TCanvas;var  Bitmap: TBitmap;begin  if Picture.Graphic = nil then  begin    Bitmap := TBitmap.Create;    try      Bitmap.Width := Width;      Bitmap.Height := Height;      Picture.Graphic := Bitmap;    finally      Bitmap.Free;    end;  end;  if Picture.Graphic is TBitmap then    Result := TBitmap(Picture.Graphic).Canvas  else    raise EInvalidOperation.Create(SImageCanvasNeedsBitmap);end; 可知TImage.Canvas来自Bitmap.Canvas，好，那来看看TBitmap.Canvasfunction TBitmap.GetCanvas: TCanvas;begin  if FCanvas = nil then  begin    HandleNeeded;    if FCanvas = nil then    // possible recursion    begin      FCanvas := TBitmapCanvas.Create(Self);      FCanvas.OnChange := Changed;      FCanvas.OnChanging := Changing;    end;  end;  Result := FCanvas;end; 显而易见TBitmap.Canvas = TBitmapCanvas.Create;也就是说TImage.Canvas=TBitmapCanvas.Create.即使用TImage.Canvas绘图时，实际是在TBitmapCanvas上绘图的。让我们再来看看TBitmapCanvas类:   TBitmapCanvas = class(TCanvas)  private    FBitmap: TBitmap;    FOldBitmap: HBITMAP;    FOldPalette: HPALETTE;    procedure FreeContext;  protected    procedure CreateHandle; override;  public    constructor Create(ABitmap: TBitmap);    destructor Destroy; override;  end; 关注一下CreateHandle函数:procedure TBitmapCanvas.CreateHandle;var  H: HBITMAP;begin  if FBitmap <> nil then  begin    Lock;    try      FBitmap.HandleNeeded;      DeselectBitmap(FBitmap.FImage.FHandle);//!!      DeselectBitmap(FBitmap.FImage.FMaskHandle);      FBitmap.PaletteNeeded;      H := CreateCompatibleDC(0);      if FBitmap.FImage.FHandle <> 0 then        FOldBitmap := SelectObject(H, FBitmap.FImage.FHandle) else        FOldBitmap := 0;      if FBitmap.FImage.FPalette <> 0 then      begin        FOldPalette := SelectPalette(H, FBitmap.FImage.FPalette, True);        RealizePalette(H);      end      else        FOldPalette := 0;      Handle := H;      BitmapCanvasList.Add(Self);    finally      Unlock;    end;  end;end; 读起来也不困难，FBitmap是Create构造函数传进来的。而我们应该关注的代码位于斜体部份，也很好理解：创建兼容DC，并选进设备。要的就是这个效果，现在知道为什么使用TImage.Canvas来绘图是使用的双缓冲技术的了吧？那么这个兼容DC是如何从内存“拷贝”到窗口的呢？ 我们使用上面的分析方法，当TImage基类TGraphicControl收到WM_PAINT消息时，将执行下面的代码:procedure TGraphicControl.WMPaint(var Message: TWMPaint);begin  if Message.DC <> 0 then  begin    Canvas.Lock;    try      Canvas.Handle := Message.DC;      try        Paint;      finally        Canvas.Handle := 0;      end;    finally      Canvas.Unlock;    end;  end;end; (在此先仅关注Paint函数) 而TImage覆盖了此Paint虚函数:procedure TImage.Paint;var  Save: Boolean;begin  if csDesigning in ComponentState then    with inherited Canvas do    begin      Pen.Style := psDash;      Brush.Style := bsClear;      Rectangle(0, 0, Width, Height);    end;  Save := FDrawing;  FDrawing := True;  try    with inherited Canvas do//祖先的Canvas      StretchDraw(DestRect, Picture.Graphic);  finally    FDrawing := Save;  end;end;

Answer 3

抛开枝节，关注两个地方，一是斜体部份的Canvas对像，二是StrectchDraw函数。先看看此Canvas对像，它被显示声明为基类的Canvas对像。不得不提，此Canvas.Handle即句柄的赋值代码：
procedure TGraphicControl.WMPaint(var Message: TWMPaint);
begin
  if Message.DC <> 0 then
  begin
    Canvas.Lock;
    try
      Canvas.Handle := Message.DC;
      try
        Paint;
      finally
        Canvas.Handle := 0;
      end;
    finally
      Canvas.Unlock;
    end;
  end;
end;
是消息传递进来的，这里的DC为此TGraphicControl.Parent的DC。至于如何传递进来的请参考《VCL构架剖析》，在此不费话了。
再看第二个关注点StrectDraw函数:
procedure TCanvas.StretchDraw(const Rect: TRect; Graphic: TGraphic);
begin
  if Graphic <> nil then
  begin
    Changing;
    RequiredState(csAllValid);
    Graphic.Draw(Self, Rect);
    Changed;
  end;
end;
这里的Graphic是什么呢？这里是TBitmap!看看第一块代码。那再看TBitmap.Draw函数吧：
procedure TBitmap.Draw(ACanvas: TCanvas; const Rect: TRect);
var
  OldPalette: HPalette;
  RestorePalette: Boolean;
  DoHalftone: Boolean;
  Pt: TPoint;
  BPP: Integer;
  MaskDC: HDC;
  Save: THandle;
begin
  with Rect, FImage do
  begin
    ACanvas.RequiredState(csAllValid);
    PaletteNeeded;
    OldPalette := 0;
    RestorePalette := False;
    if FPalette <> 0 then
    begin
      OldPalette := SelectPalette(ACanvas.FHandle, FPalette, True);
      RealizePalette(ACanvas.FHandle);
      RestorePalette := True;
    end;
    BPP := GetDeviceCaps(ACanvas.FHandle, BITSPIXEL) *
      GetDeviceCaps(ACanvas.FHandle, PLANES);
    DoHalftone := (BPP <= 8) and (BPP < (FDIB.dsbm.bmBitsPixel * FDIB.dsbm.bmPlanes));
    if DoHalftone then
    begin
      GetBrushOrgEx(ACanvas.FHandle, pt);
      SetStretchBltMode(ACanvas.FHandle, HALFTONE);
      SetBrushOrgEx(ACanvas.FHandle, pt.x, pt.y, @pt);
    end else if not Monochrome then
      SetStretchBltMode(ACanvas.Handle, STRETCH_DELETESCANS);
    try
      { Call MaskHandleNeeded prior to creating the canvas handle since
        it causes FreeContext to be called. }
      if Transparent then MaskHandleNeeded;
      Canvas.RequiredState(csAllValid);
      if Transparent then
      begin
        Save := 0;
        MaskDC := 0;
        try
          MaskDC := GDICheck(CreateCompatibleDC(0));
          Save := SelectObject(MaskDC, FMaskHandle);
          TransparentStretchBlt(ACanvas.FHandle, Left, Top, Right - Left,
            Bottom - Top, Canvas.FHandle, 0, 0, FDIB.dsbm.bmWidth,
            FDIB.dsbm.bmHeight, MaskDC, 0, 0);
        finally
          if Save <> 0 then SelectObject(MaskDC, Save);
          if MaskDC <> 0 then DeleteDC(MaskDC);
        end;
      end
      else
        StretchBlt(ACanvas.FHandle, Left, Top, Right - Left, Bottom - Top,
          Canvas.FHandle, 0, 0, FDIB.dsbm.bmWidth,
          FDIB.dsbm.bmHeight, ACanvas.CopyMode);
    finally
      if RestorePalette then
        SelectPalette(ACanvas.FHandle, OldPalette, True);
    end;
  end;
不要再深挖了，斜体部份很明了,功能就是将绘图内容从内存拷贝至窗口。ACanvas.FHandle即上面所说的消息传递进来的HDC。(ACanvas是TImage的祖先TGraphicControl的内部对像,Canvas在此为TBitmapCanvas实例)。
可能有点乱，因为我整理好了之后，再次阅读时，自已也迷糊了，仔细多看两遍吧。再提一下：TGraphicControl.Canvas与TImage.Canvas是两个实例，虽然TImage继承自TGraphicControl。
好了，我们再来看看为何使用窗口Canvas属性进行绘画时，没有使用双缓冲技术吧
二．窗口类的Canvas
其实也不能决对说窗口Canvas没有使用双缓冲技术，它有使用，但有限制。条件是在将窗口TForm.DoubleBuffered设为TRUE的前提下，在Paint事件函数里使用Canvas对像进行绘图动作。下面还是按照上面的方法来找出其中的缘由。先看一下TCustomForm.WMPaint消息处理函数：
procedure TCustomForm.WMPaint(var Message: TWMPaint);
var
  DC: HDC;
  PS: TPaintStruct;
begin
  if not IsIconic(Handle) then
  begin
    ControlState := ControlState + [csCustomPaint];
    inherited;
    ControlState := ControlState - [csCustomPaint];
  end
  else
  begin
    DC := BeginPaint(Handle, PS);
    DrawIcon(DC, 0, 0, GetIconHandle);
    EndPaint(Handle, PS);
  end;
end;
这个简单，基本只用考滤斜体部份代码，即调用基类同名函数，在此要追溯到TWinControl.WMPaint函数：
procedure TWinControl.WMPaint(var Message: TWMPaint);
var
  DC, MemDC: HDC;
  MemBitmap, OldBitmap: HBITMAP;
  PS: TPaintStruct;
begin
  if not FDoubleBuffered or (Message.DC <> 0) then
  begin
    if not (csCustomPaint in ControlState) and (ControlCount = 0) then
      inherited
    else
      PaintHandler(Message);
  end
  else
  begin
    DC := GetDC(0);
    MemBitmap := CreateCompatibleBitmap(DC, ClientRect.Right, ClientRect.Bottom);
    ReleaseDC(0, DC);
    MemDC := CreateCompatibleDC(0);
    OldBitmap := SelectObject(MemDC, MemBitmap);
    try
      DC := BeginPaint(Handle, PS);
      Perform(WM_ERASEBKGND, MemDC, MemDC);
      Message.DC := MemDC;
      WMPaint(Message);
      Message.DC := 0;
      BitBlt(DC, 0, 0, ClientRect.Right, ClientRect.Bottom, MemDC, 0, 0, SRCCOPY);
      EndPaint(Handle, PS);
    finally
      SelectObject(MemDC, OldBitmap);
      DeleteDC(MemDC);
      DeleteObject(MemBitmap);
    end;
  end;
end;

Answer 4

我们先说一下何谓“双缓冲”？它的基本原理就是：先在内存中开辟一块虚拟画布，然后将所有需要画的图形先画在这块“虚拟画布”上，最后在一次性将整块画布画到真正的窗体上。呵呵,看了双缓冲的介绍,感觉把这种技术放在我的下面这个小玩意上真的是大材小用了,呵呵...关于双缓冲的更恰当的例子,可以参考下面这篇文章(下面的文章好像是以c#为例来介绍的)http://www.microsoft.com/china/community/Column/66.mspx今天下午,我们delphi老师教了我们tform组件中的Canvas属性中的几个属性和方法,于是回住处后,就用学的东西搞了个在form上面随机画线的小玩意,纯属娱乐,没想到竟然学到了一个重要的方法.下面是刚开始的时候的一些主要操作步骤:1,首先用delphi建立一个Application,然后在 form 上拖一个Timer ,然后设定timer的intval 为100ms
2,在timer的onTimer函数中假如如下内容
CODE:[Copy to clipboard]        with self.Canvas do
        begin
        Pen.Color := RGB(Byte(RandomRange(0,255)),Byte(RandomRange(0,255)),Byte(RandomRange(0,255)));
        MoveTo(RandomRange(0,self.Width),RandomRange(0,self.Height));
        LineTo(RandomRange(0,self.Width),RandomRange(0,self.Height));
        end;
这样编译运行的时候,就会实现了上面所说的效果了,正当我看着窗口乐的时候,对门的高手过来跟我说,你看看你把窗口最小化,然后再打开,以前化的线就没了,我说,假如将画的所有随机线都保存起来,那么我们不停的让他画下去,岂不是内存要占用光了?高手说,这你就不懂了吧,在windows的GDI编程中有个双缓冲的概念,一般都用在动画的处理上,你可以把这个东西放到你这里来,就是说,先将创建一个位图,然后将随机线画到位图上,再使用form的canvas将位图载进来,这样就可以保存你的所有操作,而且不耗费过多内存了,本想细问此高手细节,可是高手让俺自己查资料.......呜呜.....于是,网上查了些资料,又看了看delphi的帮助文档,俺做出来咧....嘿嘿..以下是主要步骤1,首先用delphi建立一个Application,然后在 form 上拖一个Timer ,然后设定timer的intval 为100ms
2,在form中加一个私有成员变量 bitmap 用来保存我们每一次的随机线
3,在form的oncreate函数中加入以下代码
CODE:[Copy to clipboard]        bitmap := TBitmap.Create;
        with bitmap do
        begin
                Width := self.Width;
                Height := self.Height;
        end;
4,在ontimer函数中加入
CODE:[Copy to clipboard]        with bitmap.Canvas do
        begin
        Pen.Color := RGB(Byte(RandomRange(0,255)),Byte(RandomRange(0,255)),Byte(RandomRange(0,255)));
        MoveTo(RandomRange(0,self.Width),RandomRange(0,self.Height));
        LineTo(RandomRange(0,self.Width),RandomRange(0,self.Height));
        end;
        self.Canvas.Draw(0,0,bitmap);
5,嘿嘿,别忘了在form的ondestroy函数中清除bitmap所占用的资源哦
CODE:[Copy to clipboard]bitmap.FreeImage;

Answer 5

unit Unit1;interfaceuses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls, StdCtrls;type
  TForm1 = class(TForm)
    Timer1: TTimer;
    Memo1: TMemo;
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    Label4: TLabel;
    Label5: TLabel;
    Label6: TLabel;
    procedure Timer1Timer(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure Memo1MouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
  private
    { Private declarations }
  public
    { Public declarations }
  end;var
  Form1: TForm1;
  offscreenDC:HDC;
  ANDMaskBitmap,
  ORMaskBitmap,
  BackgroundBitmap,
  OldBitmap:HBITMAP;
  BallXCoord:integer;implementation{$R *.dfm}procedure TForm1.Timer1Timer(Sender: TObject);
var
   ScreenDC,
   WorkDC:HDC;
   OldBitmap:HBITMAP;
begin
   ScreenDC:=GetDC(0);
   //workDC:=CreateCompatibleDC(GetDC(self.Handle));
   workDC:=CreateCompatibleDC(canvas.Handle);
   BitBlt(ScreenDC,BallXCoord,Form1.Top,40,40,OffscreenDC,0,0,SRCCOPY);
   Inc(BallXCoord);
   if BallXCoord>GetSystemMetrics(SM_CXSCREEN) then
   BallXCoord:=-40;
   BitBlt(OffScreenDC,0,0,40,40,ScreenDC,BallXCoord,Form1.Top,SRCCOPY);
   OldBitmap:=Selectobject(workDC,ANDMaskBitmap);
   BitBlt(ScreenDC,BallXCoord, Form1.Top,40,40,WorkDC,0,0,SRCAND);
   SelectObject(workDC,ORMaskBitmap);
   BitBlt(ScreenDC,BallXCoord,Form1.Top,40,40,WorkDC,0,0,SRCPAINT);
   SelectObject(WorkDC,OldBitmap);
   ReleaseDC(0,ScreenDC);
   DeleteDC(WorkDC);
end;procedure TForm1.FormCreate(Sender: TObject);
var
  TempBrush:HBRUSH;
begin
   OffscreenDC:=CreatecompatibleDC(Canvas.Handle);
   SaveDC(OffscreenDC);
   AndMaskBitmap:=CreateCompatibleBitmap(Canvas.Handle,40,40);
   SelectObject(OffscreenDC,AndMaskBitmap);
   SelectObject(OffscreenDC,GetstockObject(WHITE_BRUSH));
   SelectObject(OffscreenDC,GetStockObject(NULL_PEN));
   Rectangle(OffscreenDC,0,0,41,41);
   ORMaskBitmap:=CreateCompatibleBitmap(Canvas.Handle,40,40);
   SelectObject(OffscreenDC,ORMaskBitmap);
   SelectObject(offscreenDC,GetStockObject(BLACK_BRUSH));
   Rectangle(offscreenDC,0,0,41,41);
   TempBrush:=CreateHatchBrush(HS_DIAGCROSS,clRed);
   selectobject(offscreendc,getstockobject(black_pen));
   selectObject(offscreendc,tempbrush);
   Ellipse(offscreendc,0,0,40,40);
   RestoreDC(offscreendc,-1);
   deleteobject(tempbrush);
   backgroundbitmap:=createcompatiblebitmap(canvas.Handle,40,40);
   selectobject(offscreendc,backgroundbitmap);
   ballxcoord:=-40;
end;procedure TForm1.FormDestroy(Sender: TObject);
begin
  selectobject(offscreendc,oldbitmap);
  deleteobject(backgroundbitmap);
  deleteobject(andmaskbitmap);
  deleteobject(ormaskbitmap);
  deletedc(offscreendc);
end;procedure TForm1.Memo1MouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
var
   Coord:TPoint;
begin
   Label1.Caption:=IntTostr(X)+';'+IntToStr(Y);
   Coord:=Point(X,Y);
   windows.ClientToScreen(Memo1.Handle,Coord);
   Label2.Caption:=IntToStr(Coord.X)+';'+IntToStr(Coord.Y);
   windows.ScreenToClient(self.Handle,Coord);
   Label3.Caption:=IntTostr(coord.X)+';'+IntToStr(coord.Y);
end;end.