Delphi控件源码

开发平台：
Delphi

SelBackFrm.pas：源码内容
							unit SelBackFrm;
interface
uses
  Windows, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ChatingFrm, ExtCtrls,RealMessengerUnit,MSHtml,ActiveX, ExtDlgs,UrlMon,Global;
type
  TSelBackForm = class(TForm)
    Shape1: TShape;
    Image1: TImage;
    Image2: TImage;
    Image3: TImage;
    Image4: TImage;
    Image5: TImage;
    Image6: TImage;
    ImageCustom: TImage;
    Timer1: TTimer;
    ImgDraw: TImage;
    ImageCancel: TImage;
    OpenPictureDialog1: TOpenPictureDialog;
    procedure FormShow(Sender: TObject);
    procedure FormDeactivate(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure FormCreate(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
    procedure Image1MouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure Image1MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure Image1MouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure Image1Click(Sender: TObject);
    procedure ImageCancelClick(Sender: TObject);
    procedure ImageCustomClick(Sender: TObject);
  private
    ImgIndex,LastImgIndex:Integer;
  public
    ParentForm:TChatingForm;
  end;
var
  SelBackForm: TSelBackForm;
implementation
{$R *.dfm}
{OnShow事件}
procedure TSelBackForm.FormShow(Sender: TObject);
begin
    ImageCustom.Canvas.Pen.Color:=$00781E1D;
    ImageCustom.Canvas.TextOut(4,4,'自定义聊天场景...');
    ImageCancel.Canvas.Pen.Color:=$00781E1D;
    ImageCancel.Canvas.TextOut(4,4,'取消聊天场景');
    SelBackForm.Left:=ParentForm.Left + ParentForm.PnlLeftBottom.Left + ParentForm.ImgSelBack.Left+4;
    SelBackForm.Top:=ParentForm.Top + ParentForm.PnlLeftBottom.Top + ParentForm.ImgSelBack.Top - Height + 3;
end;
{OnDeactivate时关闭窗口}
procedure TSelBackForm.FormDeactivate(Sender: TObject);
begin
  Close;
end;
{onClose事件，释放内存}
procedure TSelBackForm.FormClose(Sender: TObject;
  var Action: TCloseAction);
begin
  Action:=caFree;
  SelBackForm:=nil;
end;
{OnCreate事件,设置DoubleBuffered=True，以防止闪烁}
procedure TSelBackForm.FormCreate(Sender: TObject);
begin
    Self.DoubleBuffered:=True;
    SetWindowLong( Handle, GWL_EXSTYLE,GetWindowLong(Handle, GWL_EXSTYLE) or WS_EX_TOOLWINDOW and not WS_EX_APPWINDOW);
end;
{检查Mouse是否还在指定的范围之内，不在则恢复所有按钮的状态}
procedure TSelBackForm.Timer1Timer(Sender: TObject);
var
   p : TPoint;
begin
   GetCursorPos(p);
   if (P.X < Left) or
      (P.X > Left + Width) or
      (P.Y < Top) or
      (P.Y > Top + Height) then
   begin
      With ImgDraw.Canvas do
      begin
        Pen.Mode :=pmCopy;
        Pen.Style:=psClear;
        Rectangle(0,0,ImgDraw.Width+1,Shape1.Height+1);
      end;
      ImgIndex:=-1;
      LastImgIndex:=-1;
      Timer1.Enabled:=False;
   end;
end;
{MouseMove时使平面的按钮变为凸起状态}
procedure TSelBackForm.Image1MouseMove(Sender: TObject; Shift: TShiftState;
  X, Y: Integer);
var
    Img:TImage;
begin
    Img:=(Sender as TImage);
    ImgIndex:=Img.Tag;
    if ImgIndex=LastImgIndex then exit;
    With ImgDraw.Canvas do
    begin
      Pen.Mode :=pmCopy;
      Pen.Style:=psClear;
      Rectangle(0,0,ImgDraw.Width+1,ImgDraw.Height+1);
      Pen.Style:=psSolid;
      Pen.Width:=1;
      Pen.Color:=$00F5F5F5;
      MoveTo(Img.Left+Img.Width-ImgDraw.Left+2,Img.Top-ImgDraw.Top-2);
      LineTo(PenPos.X-(Img.Width+4),PenPos.Y);
      LineTo(PenPos.X,PenPos.Y+(Img.Height+4));
      Pen.Color:=EndColor;
      LineTo(PenPos.X+Img.Width+4,PenPos.Y);
      LineTo(PenPos.X,PenPos.Y-(Img.Height+4));
      Refresh;
    end;
    LastImgIndex:=ImgIndex;
    Timer1.Enabled:=True;
end;
{模拟按钮按下}
procedure TSelBackForm.Image1MouseDown(Sender: TObject;
  Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
var
    Img:TImage;
begin
    Img:=(Sender as TImage);
    With ImgDraw.Canvas do
    begin
      Pen.Mode :=pmCopy;
      Pen.Style:=psClear;
      Rectangle(0,0,ImgDraw.Width+1,ImgDraw.Height+1);
      Pen.Style:=psSolid;
      Pen.Color:=EndColor;
      Pen.Width:=1;
      MoveTo(Img.Left+Img.Width-ImgDraw.Left+2,Img.Top-ImgDraw.Top-2);
      LineTo(PenPos.X-((Sender as TImage).Width+4),PenPos.Y);
      LineTo(PenPos.X,PenPos.Y+(Img.Height+4));
      Pen.Color:=$00F5F5F5;
      LineTo(PenPos.X+(Sender as TImage).Width+4,PenPos.Y);
      LineTo(PenPos.X,PenPos.Y-(Img.Height+4));
      Refresh;
    end;
    LastImgIndex:=ImgIndex;
    Timer1.Enabled:=False;
    Img.Left:=Img.Left+1;
    Img.Top:=Img.Top+1;
end;
{恢复按钮的状态}
procedure TSelBackForm.Image1MouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
var
    Img:TImage;
begin
    Img:=(Sender as TImage);
    Img.Left:=Img.Left-1;
    Img.Top:=Img.Top-1;
    With ImgDraw.Canvas do
    begin
      Pen.Mode :=pmCopy;
      Pen.Style:=psClear;
      Rectangle(0,0,ImgDraw.Width+1,ImgDraw.Height+1);
      Pen.Style:=psSolid;
      Pen.Color:=$00F5F5F5;
      Pen.Width:=1;
      MoveTo(Img.Left+Img.Width-ImgDraw.Left+2,Img.Top-ImgDraw.Top-2);
      LineTo(PenPos.X-((Sender as TImage).Width+4),PenPos.Y);
      LineTo(PenPos.X,PenPos.Y+(Img.Height+4));
      Pen.Color:=EndColor;
      LineTo(PenPos.X+(Sender as TImage).Width+4,PenPos.Y);
      LineTo(PenPos.X,PenPos.Y-(Img.Height+4));
      Refresh;
    end;
    LastImgIndex:=ImgIndex;
    Timer1.Enabled:=True;
end;
{选择了某个背景}
procedure TSelBackForm.Image1Click(Sender: TObject);
begin
  ParentForm.SetBrowserBg(ResPath+'/Back/'+IntToStr((Sender as TImage).Tag)+'.jpg');
  ParentForm.MsgInput.SetFocus;
end;
{取消背景}
procedure TSelBackForm.ImageCancelClick(Sender: TObject);
begin
  ParentForm.SetBrowserBg('');
  ParentForm.MsgInput.SetFocus;
end;
{自定义背景}
procedure TSelBackForm.ImageCustomClick(Sender: TObject);
begin
  if OpenPictureDialog1.Execute then
  begin
    ParentForm.SetBrowserBg(OpenPictureDialog1.Files.Strings[0]);
    ParentForm.MsgInput.SetFocus;
  end;
end;
end.

						