common.~pas

双色球分析软件

unit Common;

interface

uses
    Windows,
    Messages,
    SysUtils,
    Variants,
    Classes,
    Graphics,
    Controls,
    Forms,
    Dialogs,
    StdCtrls,
    ExtCtrls,
    ComCtrls,
    ADODB,
    DB,
    ButtonExCtl,
    Grids,
    jpeg;
//////定义一些常用的函数///////////
   ///定义建立不规则窗体区域的函数////
   ////wMask:为窗体上的图片////wColor:为图片外的颜色;THandle:为控件
   Function  CreateRegion(wMask:TBitmap;wColor:TColor;hControl:THandle):HRGN;
   Procedure ShowPloyForm(Bmp:TBitmap;hControl:THandle);
   Procedure CloseForm(Handle:THandle);////关闭窗口////
   //Procedure CreateForm(Frm:TForm);//////动态建立窗体///
   //procedure CreateGridTitle(ctrl:TControl);
   ////字符串替换/////
   ////说明：在字符串s中用字符串sub1来替换sub2
   Function ReplaceSubString(sub1,sub2,s:string):string;
   //////去掉最后一次出现的字符串/////
   ////说明:去掉字符串s中最后出现的sub1字符串////
   Function DeleteLastSubString(sub1,s:string):string;
   ////// 判断子串在字符串中是否存在////
   ////说明:判断子串sub1在字符串s中是否存在
   Function isSubstring(sub1,s:string):boolean;
///////////////////////////////////
var
   s_EndId:string;
   s_BeginID:string;
implementation

///实现建立区域的定义///
Function CreateRegion(wMask:TBitmap;wColor:TColor;hControl:THandle): HRGN;
var
  dc, dc_c: HDC;
  rgn: HRGN;
  x, y: integer;
  coord: TPoint;
  line: boolean;
  color: TColor;
begin
  dc := GetWindowDC(hControl);
  dc_c := CreateCompatibleDC(dc);
  SelectObject(dc_c, wMask.Handle);
  BeginPath(dc);
  for x:=0 to wMask.Width-1 do
  begin
    line := false;
    for y:=0 to wMask.Height-1 do
    begin
      color := GetPixel(dc_c, x, y);
      if not (color = wColor) then
      begin
        if not line then
        begin
          line := true;
          coord.x := x;
          coord.y := y;
        end;
      end;
      if (color = wColor) or (y=wMask.Height-1) then
      begin
        if line then
        begin
          line := false;
          MoveToEx(dc, coord.x, coord.y, nil);
          LineTo(dc, coord.x, y);
          LineTo(dc, coord.x+1 , y);
          LineTo(dc, coord.x+1 , coord.y);
          CloseFigure(dc);
        end;
      end;
    end;
  end;
  EndPath(dc);
  rgn := PathToRegion(dc);
  ReleaseDC(hControl, dc);
  Result := rgn;
end;
////实现区域形状的显示///
procedure ShowPloyForm(bmp:Tbitmap;Hcontrol:Thandle);
var
   w1:Tbitmap;
   w2:Tcolor;
   Rgn:Hrgn;
begin
   w1:=TBitmap.Create;
   w1.Assign(bmp);
   w2:=w1.Canvas.Pixels[0,0];
   rgn := CreateRegion(w1,w2,hcontrol);
   if rgn<>0 then
   begin
      SetWindowRgn(Hcontrol, rgn, true);
   end;
   w1.Free;
end;
//////实现关闭窗口////////
Procedure CloseForm(Handle:Thandle);
begin
    DefWindowProc(handle,WM_SYSCOMMAND,SC_CLOSE,0);
end;
 ////字符串替换,用字串sub2替换sub1///
Function ReplaceSubString(sub1,sub2,s:string):string;
var
  strLength:integer;
begin
   while Pos(sub1, s) > 0 do
   begin
    //S[Pos(' ', S)] := '0';
    strLength:=length(sub1);
    delete(s,pos(sub1,s),strLength);
    insert(sub2,s,pos(sub1,s));
    //delete(s,
   end;
   result:=s;
end;
////删除最后一次出现的子字符串////
Function DeleteLastSubString(sub1,s:string):string;
var
  srcLength:integer;
  subLength:integer;
begin
    srcLength:=Length(s);
    //showmessage(inttostr(srclength));
    subLength:=Length(sub1);
     //showmessage(inttostr(sublength));

    result:=copy(s,1,srcLength-subLength);
end;
////// 判断子串在字符串中是否存在////
Function isSubstring(sub1,s:string):boolean;
begin
    if pos(sub1,s)>0 then
    begin
       result:=true;
    end
    else
       result:=false;
end;

/////////////////////
end./////定义类结束