读书人

xzhifei提供的这段代码怎样成功运行呢

发布时间: 2012-04-10 21:03:56 作者: rapoo

xzhifei提供的这段代码怎样成功运行呢?
在下面这个帖子里xzhifei (饭桶超傻人) 提供了像素滚屏的代码
http://topic.csdn.net/u/20091014/16/670daa3d-9c04-4c4c-b05b-290afde56039.html
但是我没试成功,哪位好人帮我让这段代码成功运行,谢谢哈
我比较菜,希望讲的详细一点

Delphi(Pascal) code
unit Unit1;interfaceuses  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,  Dialogs, ExtCtrls, StdCtrls;type  TForm1 = class(TForm)    Timer1: TTimer;    Image1: TImage;    Label1: TLabel;    Image2: TImage;    procedure Timer1Timer(Sender: TObject);    procedure FormCreate(Sender: TObject);    procedure FormClose(Sender: TObject; var Action: TCloseAction);  private    { Private declarations }    function SetLCDRGN(aRECT: TRECT): HRGN;  public    { Public declarations }  end;var  Form1: TForm1;  RGN: HRGN;  PosX, PosY: Integer;  BackroundBmp, ShowBmp: TBitMap;implementation{$R *.dfm}procedure DrawTransparent(var sBmp: TBitMap; dBmp: TBitMap; PosX, PosY: Integer; TranColor: TColor = -1);type  PRGBTripleArray = ^TRGBTripleArray;  TRGBTripleArray = array[0..32767] of TRGBTriple;  function GetSLColor(pRGB: TRGBTriple): TColor;  begin    Result := RGB(pRGB.rgbtRed, pRGB.rgbtGreen, pRGB.rgbtBlue);  end;var  b, p: PRGBTripleArray;  x, y: Integer;  BaseColor: TColor;begin  sBmp.PixelFormat := pf24Bit;  dBmp.PixelFormat := pf24Bit;  p := dBmp.scanline[0];  if TranColor = -1 then    BaseCOlor := GetSLCOlor(p[0])  else    BaseCOlor := TranColor;  if (PosY > sBmp.Width) or (PosY > sBmp.Height) then    Exit;  for y := 0 to dBmp.Height - 1 do  begin    p := dBmp.scanline[y];    b := sBmp.ScanLine[y + PosY];    for x := 0 to (dBmp.Width - 1) do    begin      if GetSLCOlor(p[x]) <> BaseCOlor then        b[x + PosX] := p[x];    end;  end;end;procedure TForm1.Timer1Timer(Sender: TObject);var  bmp: Tbitmap;begin  SelectClipRgn(Image2.Canvas.Handle, RGN);  PosX := PosX - 1; //移动像素  if PosX < -Image1.Picture.Width then    PosX := 600;  bmp := TBitmap.Create;  bmp.Assign(BackroundBmp);  DrawTransparent(bmp, ShowBmp, PosX, PosY); //合成图像  Image2.Canvas.Draw(0, 0, bmp); //画出效果图  bmp.Free;//  Canvas.Draw(PosX, PosY, Image1.Picture.Graphic);end;procedure TForm1.FormCreate(Sender: TObject);var  s: string;  r: TRect;begin  BackroundBmp := TBitMap.Create;//背景图层  BackroundBmp.Width := 600;  BackroundBmp.Height := 200;  BackroundBmp.Canvas.FillRect(rect(0, 0, BackroundBmp.Width, BackroundBmp.Height));  BackroundBmp.Canvas.Draw(0, 0, Image1.Picture.Graphic);  ShowBmp := TBitMap.Create;//文字图层  ShowBmp.Width := 600;  ShowBmp.Height := 200;  ShowBmp.Canvas.FillRect(rect(0, 0, ShowBmp.Width, ShowBmp.Height));  ShowBmp.Canvas.Font.Name := '隶书';  ShowBmp.Canvas.Font.Size := 60;  ShowBmp.Canvas.Font.Color := clRed;  s := '中华人民共和国';  r := RECT(0, 0, ShowBmp.Width, ShowBmp.Height);  drawtext(ShowBmp.Canvas.Handle, pchar(s), length(s), r,    DT_CENTER or    DT_SINGLELINE or    DT_VCENTER);  //初始化LCD效果区域    RGN := SetLCDRGN(RECT(0, 0, BackroundBmp.Width, BackroundBmp.Height));  PosX := BackroundBmp.Width;  PosY := 0;  Show;//  Update ;//  SelectClipRgn(Canvas.Handle, RGN);//  Canvas.FillRect(RECT(0, 0, BackroundBmp.Width, BackroundBmp.Height));end;function TForm1.SetLCDRGN(aRECT: TRECT): HRGN;var  rTemp, r: HRGN;  x, y: integer;begin  Result := CreateRectRgn(0, 0, 0, 0);  for y := aRECT.Top to aRECT.Bottom do    if (y mod 4) = 0 then      for x := aRECT.Left to aRECT.Right do      begin        if (x mod 4) = 0 then        begin          rTemp := CreateRectRgn(x, y, x + 3, y + 3);          CombineRgn(Result, Result, rTemp, RGN_OR);//          CombineRgn(r, r, rTemp, RGN_XOR);        end;      end;  DeleteObject(rTemp);end;procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);begin  BackroundBmp.Free;  ShowBmp.Free;end;end.


------解决方案--------------------


这段代码没有问题,你需要把相应的组件放置到界面上,并连接相关事件
[解决办法]

探讨
我也测试了,只是“中”字下面少了一横,你们没有这样吗?

读书人网 >.NET

热点推荐