开通博客赚积分
发布资源赚积分
分类

源码开发语言/平台
当前位置：首页 > 源码/资料 > Delphi控件源码 > 查看源码
SelColorFrm.pas
资源名称：qqdelphiprog.rar　[点击查看]
上传用户：hylc_2004
上传日期：2014-01-23
资源大小：46800k
文件大小：8k
源码类别：

Delphi控件源码

开发平台：

Delphi

SelColorFrm.pas：源码内容
  1. unit SelColorFrm;
  3. interface
  5. uses
  6.   Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  7.   Dialogs, ExtCtrls,RealMessengerUnit,MSHtml,ActiveX, ExtDlgs,UrlMon,Global,ChatingFrm,Registry;
  9. type
  10.   TSelColorForm = class(TForm)
  11.     ImgDraw: TImage;
  12.     ImageCustom: TImage;
  13.     Image1: TImage;
  14.     Image2: TImage;
  15.     Image4: TImage;
  16.     Image5: TImage;
  17.     Image3: TImage;
  18.     Image6: TImage;
  19.     Image7: TImage;
  20.     Image9: TImage;
  21.     Image10: TImage;
  22.     Image11: TImage;
  23.     Image12: TImage;
  24.     Image14: TImage;
  25.     Shape1: TShape;
  26.     Timer1: TTimer;
  27.     ColorDialog1: TColorDialog;
  28.     ImageDefault: TImage;
  29.     procedure FormClose(Sender: TObject; var Action: TCloseAction);
  30.     procedure FormDeactivate(Sender: TObject);
  31.     procedure FormCreate(Sender: TObject);
  32.     procedure FormShow(Sender: TObject);
  33.     procedure Image1MouseDown(Sender: TObject; Button: TMouseButton;
  34.       Shift: TShiftState; X, Y: Integer);
  35.     procedure Image1MouseUp(Sender: TObject; Button: TMouseButton;
  36.       Shift: TShiftState; X, Y: Integer);
  37.     procedure Timer1Timer(Sender: TObject);
  38.     procedure Image1Click(Sender: TObject);
  39.     procedure ImageCustomClick(Sender: TObject);
  40.     procedure ImageDefaultClick(Sender: TObject);
  41.     procedure Image1MouseMove(Sender: TObject; Shift: TShiftState; X,
  42.       Y: Integer);
  43.   private
  44.     ImgIndex,LastImgIndex:Integer;
  45.   public
  46.     ParentForm:TChatingForm;
  47.   end;
  49. var
  50.   SelColorForm: TSelColorForm;
  52. implementation
  54. {$R *.dfm}
  56. {onClose事件，释放内存}
  57. procedure TSelColorForm.FormClose(Sender: TObject;
  58.   var Action: TCloseAction);
  59. begin
  60.   Action:=caFree;
  61.   SelColorForm:=nil;
  62. end;
  64. {OnDeactivate时关闭窗口}
  65. procedure TSelColorForm.FormDeactivate(Sender: TObject);
  66. begin
  67.   Close;
  68. end;
  70. {OnCreate事件,设置DoubleBuffered=True，以防止闪烁}
  71. procedure TSelColorForm.FormCreate(Sender: TObject);
  72. begin
  73.     Self.DoubleBuffered:=True;
  74.     SetWindowLong( Handle, GWL_EXSTYLE,GetWindowLong(Handle, GWL_EXSTYLE) or WS_EX_TOOLWINDOW and not WS_EX_APPWINDOW);
  75. end;
  77. {OnShow事件，显示系统提供的N种基本颜色}
  78. procedure TSelColorForm.FormShow(Sender: TObject);
  79. begin
  80.     Image1.Canvas.Brush.Color:=$00d2d2d2;
  81.     Image1.Canvas.Rectangle(0,0,Image1.Width,Image1.Height);
  82.     Image2.Canvas.Brush.Color:=$00EFD0C1;
  83.     Image2.Canvas.Rectangle(0,0,Image2.Width,Image2.Height);
  84.     Image3.Canvas.Brush.Color:=$00D7C0A7;
  85.     Image3.Canvas.Rectangle(0,0,Image3.Width,Image3.Height);
  86.     Image4.Canvas.Brush.Color:=$00D7B3C4;
  87.     Image4.Canvas.Rectangle(0,0,Image4.Width,Image4.Height);
  88.     Image5.Canvas.Brush.Color:=$00E5A5DB;
  89.     Image5.Canvas.Rectangle(0,0,Image5.Width,Image5.Height);
  90.     Image6.Canvas.Brush.Color:=$00E9B1D4;
  91.     Image6.Canvas.Rectangle(0,0,Image6.Width,Image6.Height);
  92.     Image7.Canvas.Brush.Color:=$00A6DFAB;
  93.     Image7.Canvas.Rectangle(0,0,Image7.Width,Image7.Height);
  94.     Image9.Canvas.Brush.Color:=$00A5D1FF;
  95.     Image9.Canvas.Rectangle(0,0,Image9.Width,Image9.Height);
  96.     Image10.Canvas.Brush.Color:=$00A7C7DD;
  97.     Image10.Canvas.Rectangle(0,0,Image10.Width,Image10.Height);
  98.     Image11.Canvas.Brush.Color:=$00A5C8CA;
  99.     Image11.Canvas.Rectangle(0,0,Image11.Width,Image11.Height);
  100.     Image12.Canvas.Brush.Color:=$00A7A7DF;
  101.     Image12.Canvas.Rectangle(0,0,Image12.Width,Image12.Height);
  102.     Image14.Canvas.Brush.Color:=$00BBCDA5;
  103.     Image14.Canvas.Rectangle(0,0,Image14.Width,Image14.Height);
  105.     ImageCustom.Canvas.Pen.Color:=$00781E1D;
  106.     ImageCustom.Canvas.TextOut(4,4,'更多颜色...');
  107.     ImageDefault.Canvas.Pen.Color:=$00781E1D;
  108.     ImageDefault.Canvas.TextOut(4,4,'取消自定义颜色');
  109.     SelColorForm.Left:=ParentForm.Left + ParentForm.PnlLeftBottom.Left + ParentForm.ImgSelColor.Left+4;
  110.     SelColorForm.Top:=ParentForm.Top + ParentForm.PnlLeftBottom.Top + ParentForm.ImgSelColor.Top - Height + 3;
  111. end;
  113. {模拟按钮按下}
  114. procedure TSelColorForm.Image1MouseDown(Sender: TObject;
  115.   Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
  116. var
  117.     Img:TImage;
  118. begin
  119.     Img:=(Sender as TImage);
  120.     With ImgDraw.Canvas do
  121.     begin
  122.       Pen.Mode :=pmCopy;
  123.       Pen.Style:=psClear;
  124.       Rectangle(0,0,ImgDraw.Width+1,ImgDraw.Height+1);
  126.       Pen.Style:=psSolid;
  127.       Pen.Color:=EndColor;
  128.       Pen.Width:=1;
  129.       MoveTo(Img.Left+Img.Width-ImgDraw.Left+2,Img.Top-ImgDraw.Top-2);
  130.       LineTo(PenPos.X-((Sender as TImage).Width+4),PenPos.Y);
  131.       LineTo(PenPos.X,PenPos.Y+(Img.Height+4));
  132.       Pen.Color:=$00F5F5F5;
  133.       LineTo(PenPos.X+(Sender as TImage).Width+4,PenPos.Y);
  134.       LineTo(PenPos.X,PenPos.Y-(Img.Height+4));
  135.       Refresh;
  136.     end;
  137.     LastImgIndex:=ImgIndex;
  138.     Timer1.Enabled:=False;
  139.     Img.Left:=Img.Left+1;
  140.     Img.Top:=Img.Top+1;
  141. end;
  143. {恢复按钮的状态}
  144. procedure TSelColorForm.Image1MouseUp(Sender: TObject;
  145.   Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
  146. var
  147.     Img:TImage;
  148. begin
  149.     Img:=(Sender as TImage);
  150.     Img.Left:=Img.Left-1;
  151.     Img.Top:=Img.Top-1;
  152.     With ImgDraw.Canvas do
  153.     begin
  154.       Pen.Mode :=pmCopy;
  155.       Pen.Style:=psClear;
  156.       Rectangle(0,0,ImgDraw.Width+1,ImgDraw.Height+1);
  158.       Pen.Style:=psSolid;
  159.       Pen.Color:=$00F5F5F5;
  160.       Pen.Width:=1;
  161.       MoveTo(Img.Left+Img.Width-ImgDraw.Left+2,Img.Top-ImgDraw.Top-2);
  162.       LineTo(PenPos.X-((Sender as TImage).Width+4),PenPos.Y);
  163.       LineTo(PenPos.X,PenPos.Y+(Img.Height+4));
  164.       Pen.Color:=EndColor;
  165.       LineTo(PenPos.X+(Sender as TImage).Width+4,PenPos.Y);
  166.       LineTo(PenPos.X,PenPos.Y-(Img.Height+4));
  167.       Refresh;
  168.     end;
  169.     LastImgIndex:=ImgIndex;
  170.     Timer1.Enabled:=True;
  171. end;
  173. {检查Mouse是否还在指定的范围之内，不在则恢复所有按钮的状态}
  174. procedure TSelColorForm.Timer1Timer(Sender: TObject);
  175. var
  176.    p : TPoint;
  177. begin
  178.    GetCursorPos(p);
  179.    if (P.X < Left) or
  180.       (P.X > Left + Width) or
  181.       (P.Y < Top) or
  182.       (P.Y > Top + Height) then
  183.    begin
  184.       With ImgDraw.Canvas do
  185.       begin
  186.         Pen.Mode :=pmCopy;
  187.         Pen.Style:=psClear;
  188.         Rectangle(0,0,ImgDraw.Width+1,Shape1.Height+1);
  189.       end;
  190.       ImgIndex:=-1;
  191.       LastImgIndex:=-1;
  192.       Timer1.Enabled:=False;
  193.    end;
  194. end;
  196. {选择了某个颜色}
  197. procedure TSelColorForm.Image1Click(Sender: TObject);
  198. var
  199.   TempReg:TRegistry;
  200. begin
  201.     EndColor:=(Sender as TImage).Canvas.Pixels[1,1];
  202.     ChangeAllColor(EndColor);
  203.     TempReg:=TRegistry.Create;
  204.     try
  205.       TempReg.RootKey:=HKEY_LOCAL_MACHINE;
  206.       if TempReg.OpenKey(AppKey+''+LoginName+'Init', True) then
  207.       begin
  208.         TempReg.WriteString('CustomColor',IntToStr(EndColor));
  209.       end;
  210.     finally
  211.       TempReg.Free;
  212.     end;
  213.     Close;
  214. end;
  216. {打开自定义颜色对话框，以供用户选择更多的颜色}
  217. procedure TSelColorForm.ImageCustomClick(Sender: TObject);
  218. var
  219.   TempReg:TRegistry;
  220. begin
  221.   ColorDialog1.Color:=EndColor;
  222.   if ColorDialog1.Execute then
  223.   begin
  224.     EndColor:=ColorDialog1.Color;
  225.     ChangeAllColor(EndColor);
  226.     TempReg:=TRegistry.Create;
  227.     try
  228.       TempReg.RootKey:=HKEY_LOCAL_MACHINE;
  229.       if TempReg.OpenKey(AppKey+''+LoginName+'Init', True) then
  230.       begin
  231.         TempReg.WriteString('CustomColor',IntToStr(EndColor));
  232.       end;
  233.     finally
  234.       TempReg.Free;
  235.     end;
  236.     Close;
  237.   end;
  238. end;
  240. {取消自定义颜色，显示系统默认颜色}
  241. procedure TSelColorForm.ImageDefaultClick(Sender: TObject);
  242. var
  243.   TempReg:TRegistry;
  244. begin
  245.     EndColor:=DefaultColor;
  246.     ChangeAllColor(EndColor);
  247.     TempReg:=TRegistry.Create;
  248.     try
  249.       TempReg.RootKey:=HKEY_LOCAL_MACHINE;
  250.       if TempReg.OpenKey(AppKey+''+LoginName+'Init', True) then
  251.       begin
  252.         TempReg.WriteString('CustomColor','');
  253.       end;
  254.     finally
  255.       TempReg.Free;
  256.     end;
  257.     Close;
  258. end;
  260. {MouseMove时使平面的按钮变为凸起状态}
  261. procedure TSelColorForm.Image1MouseMove(Sender: TObject;
  262.   Shift: TShiftState; X, Y: Integer);
  263. var
  264.     Img:TImage;
  265. begin
  266.     Img:=(Sender as TImage);
  267.     ImgIndex:=Img.Tag;
  268.     if ImgIndex=LastImgIndex then exit;
  270.     With ImgDraw.Canvas do
  271.     begin
  272.       Pen.Mode :=pmCopy;
  273.       Pen.Style:=psClear;
  274.       Rectangle(0,0,ImgDraw.Width+1,ImgDraw.Height+1);
  276.       Pen.Style:=psSolid;
  277.       Pen.Width:=1;
  278.       Pen.Color:=$00F5F5F5;
  280.       MoveTo(Img.Left+Img.Width-ImgDraw.Left+2,Img.Top-ImgDraw.Top-2);
  281.       LineTo(PenPos.X-(Img.Width+4),PenPos.Y);
  282.       LineTo(PenPos.X,PenPos.Y+(Img.Height+4));
  283.       Pen.Color:=EndColor;
  284.       LineTo(PenPos.X+Img.Width+4,PenPos.Y);
  285.       LineTo(PenPos.X,PenPos.Y-(Img.Height+4));
  287.       Refresh;
  288.     end;
  289.     LastImgIndex:=ImgIndex;
  290.     Timer1.Enabled:=True;
  291. end;
  294. end.