Delphi 自己收藏

[KeyWord:Delphi,Ado,Access]
[
 ado.ConnectionString:='DBQ=DBpath'+';DRIVER={Microsoft Access Driver (*.mdb)};Uid=Admin;pwd=_C1b9B6G!6'
]
[KeyWord:Delphi,TStream,FileReadWrite]
[
  procedure TForm1.btnReadFileClick(Sender: TObject);
var
  FileStream:TfileStream;
  MyWriter:TWriter;
  i:integer;
  strPath:string;
begin
  strPath:='d:/test.txt';
  FileStream:=TfileStream.Create(strPath,fmOpenWrite);
  MyWriter:=Twriter.Create(fileStream,1024) ;
  MyWriter.WriteListBegin;
  for i:=0 to memo1.Lines.Count-1 do
    myWriter.WriteString(trim(memo1.Lines[i])+chr(13)+chr(10) );
  MyWriter.WriteListEnd;
  FileStream.Seek(0,sofrombeginning);
  Mywriter.Free;
  FileStream.Free;
  ShowMessage('ok');  
 
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  FileStream:TfileStream;
  MyReader:TReader;
  i:integer;
  strPath:string;
begin
  strPath:='d:/test.txt';
  FileStream:=TfileStream.Create(strPath,fmOpenRead);
  MyReader:=TReader.Create(fileStream,1024);
  memo1.Lines.Clear; 
  Myreader.ReadListBegin ;
  while not MyReader.EndOfList  do
    begin
    memo1.Lines.Add(MyReader.ReadString);
    end;
   myReader.ReadListEnd;
   MyReader.Free;
   FileStream.Free;
   ShowMessage('okok');
end;

procedure TForm1.btnReadPicClick(Sender: TObject);
Var
  Source,TarGet:TfileStream;
  MyFileSize:integer;
  strFN,strFN2:string;
begin
  strFN:='d:/logo.jpg';
  strFN2:='d:/test.dat';
  Source:=TfileStream.Create(strFN,fmOpenRead);
  TarGet:=TfileStream.Create(strFN2,fmOpenWrite);
  TarGet.Seek(0,sofromEnd);
  TarGet.CopyFrom(source,0);
  MyFileSize:=Source.Size;
  TarGet.WriteBuffer(MyfileSize,sizeof(MyfileSize));
  TarGet.Free;
  Source.Free;
  ShowMessage('ok');
end;

procedure TForm1.WritePicClick(Sender: TObject);
  Var
  Source,TarGet,f:TfileStream;
  MyFileSize,iSize:integer;
 
  strFN,strFN2,strFN3:string;
begin
  strFN:='d:/1.dat';
  strFN2:='d:/test.dat';
  strFN3:='d:/LOGO.JPG';
  f:=TFileStream.Create(strFN3,fmOpenRead);
  iSize:=f.Size;
  Source:=TfileStream.Create(strFN2,fmOpenRead);
  TarGet:=TfileStream.Create(strFN,fmOpenWrite);
  TarGet.Seek(iSize,soFromBeginning);
  TarGet.CopyFrom(source,iSize);
  TarGet.WriteBuffer(iSize,sizeof(iSize));
  TarGet.Free;
  Source.Free;
  ShowMessage('ok');
 
end;
]
[KeyWord:Delphi,Dll,CreateUse]
[
  { Create Dll}
 library ProjDll;
 uses
  SysUtils,
  Classes,Dialogs;
  {$R *.res}
 function functionname():type;stdcall;
  begin
 end;
 procedure procedurename():type;stdcall;
  begin
 end;

 exports
   functionname;
  procedurename;

   begin

   end.
  {Use Dll}
   procedure procedurename():type;
  type
    Tfname:=function():type;stdcall;
   Tpname:=procedure():type;stdcall;
  var
    H:Thandle;
   fname:Tfname;
  begin
    H:=LoadLibrary('dllname');
   @fname:=GetProcAddress(H,'fname');
   //User fname
   FreeLibrary(H)
   

   end;
]
[KeyWord:Delphi,Api,RunProgram]
[
   ShellExecute();
]
[KeyWord:Delphi,Word,Doc]
[
  Unit:Word2000, OleServer;
 component :
 WordApp: TWordApplication;
  WordDoc: TWordDocument;
  WordApp.Documents.open()
 WordDoc.ConnectTo(WordApp.Documents.Item(DocInx));
 WordApp.Visible:=true;
  WordDoc.Tables.Item(1).Cell(4,1).range.text:='你好科学';  
  WordDoc.Tables.Item(1).Rows.Add(emptyparam);
  finally
  if Assigned(WordDoc) then                         
  begin
      WordDoc.Close;
      WordDoc.Disconnect;
      WordDoc.Free;
      WordDoc := nil;
  end;
 if Assigned(WordApp) then                       
      WordApp.Quit;
      WordApp.Disconnect;
      WordApp.Free;
      WordApp := nil;
  end;

]
[KeyWord:Delphi,Excel,xls]
[
    Unit:Excel2000, OleServer,comobj;
  var
  sheet,XLApp,workbook : variant;
  iRow,MaxRow,i:integer;
  begin
  //screen.Cursor:=crHourGlass; 

    //创建对象
    XLApp:=createOleObject('Excel.Application');
    XLApp.displayAlerts:=false;
    XLApp.ScreenUpdating:=false;
    XLApp.WorkBooks.Add('d:/Book1.xls');
    workbook := XLApp.workbooks[1];
    sheet:=workbook.worksheets[1];
    XLApp.ActiveCell.SpecialCells(xlLastCell).Select;
    maxRow:=XLApp.ActiveCell.Row;
    ShowMessage(intTostr(maxrow));
    for i:=2 to maxRow do
       ShowMessage(sheet.cells[i,1]);
  end;

]
[KeyWord:Display,MH]
[
function GetDisplayFrequency: Integer;
var
  DeviceMode: TDeviceMode;
// 这个函数返回的显示刷新率是以Hz为单位的
begin
  EnumDisplaySettings(nil, Cardinal(-1), DeviceMode);
  Result := DeviceMode.dmDisplayFrequency;
end;

]
[KeyWord:Mouse,Notitle,Max,Min]
[

const
SC_DRAGMOVE:Longint=$F012;
begin
ReleaseCapture;
SendMessage(Handle,WM_SYSCOMMAND,SC_DRAGMOVE,0);
]
[KeyWord:File,TextFile,AssignFile,Append]
[
 //Open a file,Append content
 procedure WriteErrInfo(strErrInfo:string);
var strFileName:string ;
    F:TextFile;
begin
   strFileName:=ExtractFilePath(application.ExeName)+'ErrLog.txt';
   AssignFile(F,strFileName);
   Append(F);
   WriteLn(F,strErrInfo);
   Close(F);
end;
]
[KeyWord:GetCount,Letter]
[
//return Count ,strMark in strV
//must Give strV,strMark
function GetMarkCount(strV,strMark:string):integer;
var i,count:integer;
begin
   i:=pos(strMark,strV);
   Count:=0;
   while i<>0 do begin
      Delete(strV,1,i);
      i:=pos(strMark,strV);
      count:=count+1;
   end;
   Result:=Count;
end;
]
[KeyWord:array,Mark,Split]
[
//Split strV to array
//strV the splited string;
//strMark the spliting mark
//aryTemp the Value
//Can Use 'GetMarkCount()' firstly
//then use SetLength() difine array;
//put aryTemp into procedure
procedure SplitToAry(strV,strmark:string;var aryTemp:array of string);
var pos1,i:integer;
    aryLen:integer;
begin
   //先赋值为空
  //ShowMessage(intTostr(high(aryTemp)));
   for i:=0 to high(aryTemp) do
       aryTemp[i]:='';

   //取得第一分割符的位置
   pos1:=pos(strMark,strV);
   //第一个元素的值
   //strmark为中文字符
   aryTemp[0]:=Copy(strV,1,pos1+1);
   //为strmark为中文字符
   //aryTemp[0]:=Copy(strV,1,pos1-1);
   i:=1;
   //如果有分割符号则删除前面的字符
   //当i大于数组下标则退出循环
   //如果分割符不是最后一个字符
   //则把最后的字符串存入最后一个元素
   while pos1<>0 do begin
       //strMark为中文字符
       delete(strV,1,pos1+1);
       //为E文字符
       //delete(strV,1,pos1+1);
       strV:=trim(strV);
       pos1:=pos(strmark,strV);
       if i>high(aryTemp) then
          break;
       //strmark为中文字符
       if copy(strV,1,pos1+1)<>'' then begin
         aryTemp[i]:=Copy(strV,1,pos1+1);
         i:=i+1;
       end;
       //strmark为E文字符
       {
      
        if copy(strV,1,pos1-1)<>'' then begin
         aryTemp[i]:=Copy(strV,1,pos1-1);
         i:=i+1;
       end;
       }

   end;
  if strV<>'' then
      aryTemp[high(aryTemp)]:=strV;
 
end;

 

]
[KeyWord:Close,Message,SendMessage,exe]
[
 SendMessage(Handle,WM_CLOSE,0,0);
]
[KeyWord:Api,Exe,Window]
[
 FindWindowEx()
 //Find a window of exe
 FindWindow()
 //same
 WinExec();
 //Run a  exe programer
 windows.SetParent()
 //set a window into another window for son window
 SetWindowpos()
 // play a window in position

]
[KeyWor:pointer,^,@,Address]
[
 var p:^integer //p is a pointer pionted  integer
     x:integer;
begin
   p:=@x //Get x's Address ,give it to p
   p^:=100
   //x=100

end;

]
[KeyWord:display,HZ,Screen,EnumDisplaySettings,
 ChangeDisplaySettings
]
[
 procedure TForm1.Button1Click(Sender: TObject);
var
   lpDevMode: TDeviceMode;
begin
    //改回原来的设置
  EnumDisplaySettings(nil, Cardinal(-1),lpDevMode);
    lpDevmode.dmPelsWidth:=x;
    lpDevmode.dmPelsHeight:=y;
    lpDevMode.dmDisplayFrequency:=displayHZ;
    ChangeDisplaySettings(lpDevMode,0);
end;

procedure TForm1.FormCreate(Sender: TObject);
var
  DeviceMode: TDeviceMode;
// 这个函数返回的显示刷新率是以Hz为单位的
begin
  //取得原来的分辨率,刷新率
  EnumDisplaySettings(nil, Cardinal(-1), DeviceMode);
  DisplayHZ := DeviceMode.dmDisplayFrequency;
  x:=Screen.Width;
  y:=Screen.Height;
end;

procedure TForm1.FormShow(Sender: TObject);
var
   lpDevMode: TDeviceMode;
begin
   //改变改变分辨率
   lpDevmode.dmFields:=DM_PELSWIDTH or DM_PELSHEIGHT;
   lpdevmode.dmPelsWidth:=800;
   lpdevmode.dmPelsHeight:=600;
   ChangeDisplaySettings(lpDevMode,0)
end;
]
[KeyWord:Delphi,Dll,Filter,IIS,IIS Apllcation
 GetFilterVersion,HttpFilterProc
 ]
[
 //注册版本以及事件信息
function GetFilterVersion(Var pVer:THTTP_FILTER_VERSION):BOOL;stdcal
begin
  pVar.dwFlags:=( SF_NOTIFY_NONSECURE_PORT or
                  SF_NOTIFY_SEND_RAW_DATA or
                  SF_NOTIFY_ORDER_DEFAULT  or
                  SF_NOTIFY_END_OF_REQUEST //$80
                )
//登记处理事件
//安全端口，发送数据，缺身认证,结束请求
pVer.dwFilterVersion:=HTTP_FILTER_REVISION;
//过滤器版本描述
pVer.lpszFilterDesc[0]:='A';perVer.lpszFilterDesc[1]:=#0;
//The location in which to store a short string description
//of the ISAPI filter application
//过滤器的描述
Result:=true;
//返回真
end;

function HttpFilterProc(var pfc:THTTP_FILTER_CONTEXT;
         Notificationtype:DWORD;pvNotification:Pointer
     ):DWORD;stdcall;
var
p:PHTTP_FILTER_RAW_DATA;
//一个PHTTP_FILTER_RAW_DATA型的结构指针
i:integer;
pc:pchar;
begin
  if Notificationtype=SF_NOTIFY_END_OF_REQUEST then
    begin
        //如果时间为结束请求，则存贮上下文信息的指针为空
    pfc.pFilterContext:=nil;
     end
 else begin
     //指向单前事件对应数据的指针
   p:=PHTTP_FILTER_RAW_DATA(Notificationtype);
   // pvInData [in] A pointer to the data buffer (input or output).
   pc:=p^.pvIndata;
   //pfc.pFilterContext
   // A pointer to be used by the filter for any context
   //information that the filter wants to associate with
   //this request. Any memory associated with this request
   //can be safely freed during the SF_NOTIFY_END_OF_NET_SESSION notification.
   case integer(pfc.pFilterContext) of
     0://第一次调用，要检查mime
       begin
         pfc.pFilterContext:=pointer(2);
         //一个指向2的指针
         i:=0;
         //cbInBuffer [in] The size of the buffer pointed to
         //by pvInData.
         Whilte i<p^.cbInBuffer-4-1 do begin
           if (pc[i]='/') and (pc[i+1]='h') and(pc[i+2]='t') and (pc[i+3]='m') then
            begin  
               pfc.pFilterContext:=pointer(1);
               break;
            end;
            inc(i);//i:=i+1
         end;
       end;
      1:begin
          pfc.pFilterContext:=Pointer(3);
          //p^.pvIndata;
          //gb2big(pc,p^.cbInBuffer);
          //p^.pvIndata:=pchar(GB2Big5(p^.pvIndata);
          //转化内码
                  
        end;
      3:begin
          pfc.pFilterContext:=pointer(1);

        end;
    end;
  end;
  Result:=SF_STATUS_REQ_NEXT_NOTIFICATION;
  //总是返回成功，并且如果有其他过滤器的话，还将继续调用
 // The next filter in the notification chain should be called.
end;
]
[KeyWord:SqlServer,Sql,TableName]
[
 //Get table's name
 select name from sysobjects where xtype='u'

]
[KeyWord:Win98,System,sfc]
[
 //sfc command
 //run->sfc
 //can check system file ,then repire it;
 sfc

]
[KeyWord:Delphi,Form]
[
 //透明窗体
 １．新建一个工程;
 ２．在窗口上放置一个Image控件，并调入一个图片，如图 ,
  Image1.Autosize:=True;
 ３．Form1.AutoSize:=True;Form1.OldCreateOrder:=True;
  Form1.TransparentColor:=True; Form1.TransparentColorValue:=ClWhite
 (由于这个图片的边缘是白色的吧);
 ４．好了，运行就能看到一个透明的窗口了，如果将Form1.BorderStyle设置
  成BsNone，就是异形窗口了。

]
[KeyWord:JavaScript,js,select,option]
[
 //alert option's value
   var i=form.select.selectedIndex;
   //for (i;i<form.selecte.length;i++)
   alert(form.selelect.options[i].text)
]
[Keyword:delphi,ini,INI,file,Tstrings]
[
  Unit:inifils
  var
  myIni:TiniFile;
  //strv:String;
  strV:Tstrings;
  begin
  //must Create by the way
  strV:=TStringList.Create ;
  myIni:=Tinifile.Create('D:/myIni.ini');
  //strV:=myIni.ReadString('Server','Address','');
  // myIni.ReadSection('Server',strV);
  //myIni.ReadSections(strV);
  myIni.ReadSectionValues('Server',strV);
  // ShowMessage(strV);
  ShowMessage(strV.Text);
  strV.Free;
  myIni.Free;
  end;

]
[KeyWord:delphi,property,set,get,Set,Get]
[
 unit MyClass;
 
 interface
 
 uses
   Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
   Dialogs, StdCtrls, Menus;

 type
    TmyClass=class
    private
      myValue:string;
      function GetStrcon():string;
      procedure SetStrCon(const Value:string);
    public
       property StrCon: string read GetStrCon write SetStrcon;
 end;
 var
    strC:string;
 
 implementation
 uses unit3;
 
 procedure TmyClass.SetStrCon(const Value:string);
 begin
   myValue:=Value;
 end;
 
 function TmyClass.GetStrcon():string;
 begin
   result:=myValue;
 end;

]
[KeyWord:delphi,format,string]
[
首部  function Format(const Format: string; const Args: array of const): string; $[SysUtils.pas
功能  返回按指定方式格式化一个数组常量的字符形式
说明  这个函数是我在Delphi中用得最多的函数，现在就列举几个例子给你个直观的理解
"%" [索引 ":"] ["-"] [宽度] ["." 摘要] 类型
Format('x=%d', [12]); //'x=12' //最普通
Format('x=%3d', [12]); //'x= 12' //指定宽度
Format('x=%f', [12.0]); //'x=12.00' //浮点数
Format('x=%.3f', [12.0]); //'x=12.000' //指定小数
Format('x=%.*f', [5, 12.0]); //'x=12.00000' //动态配置
Format('x=%.5d', [12]); //'x=00012' //前面补充0
Format('x=%.5x', [12]); //'x=0000C' //十六进制
Format('x=%1:d%0:d', [12, 13]); //'x=1312' //使用索引
Format('x=%p', [nil]); //'x=00000000' //指针
Format('x=%1.1e', [12.0]); //'x=1.2E+001' //科学记数法
Format('x=%%', []); //'x=%' //得到"%"
S := Format('%s%d', [S, I]); //S := S + StrToInt(I); //连接字符串
参考  proceduer SysUtils.FmtStr
例子  Edit1.Text := Format(Edit2.Text, [StrToFloatDef(Edit.3.Text, 0)]);
 

]
[KeyWord:sql,rename,cloumn]
[EXEC sp_rename 'mytable.[id]', 'myid', 'COLUMN']
[KeyWord:sql,delete,table,truncate]
[TRUNCATE TABLE company16400]
[KeyWord:sql,cursor]
[
 declare CursorName cursor For
   Select statement
 
 Open CursorName
 FETCH NEXT FROM CursorName
       INTO @myVaialbe
 
 WHILE @@FETCH_STATUS = 0
   begin
    FETCH NEXT FROM CursorName
       INTO @myVaialbe

 

  end;

]
[sql,proc,procedure,create]
[
 CREATE PROC[DURE] procedure_name [;number]
     [@parameter_name ][OUTPUT] [,_n] ]
     [WITH {RECOMPILE | ENCRYPTION}]
     [FOR REPLICATION]
  AS
 Number是用来对相同名字的过程进行分组的整数。分组是将所有的过程通过drop procedure语句组合到一个分组中。
 @parameter_name指定参数的名称。
 RECOMPILE表示每次执行过程时都要进行编译。
 ENCRYPTION表示过程的文本在“syscomments”表中要加密。
 FOR REPLICATION表示过程不能在提交服务器上执行。
]
[KeyWord:sql,trigger,database,db,sqlserver,create]
[
CREATE TRIGGER
CREATE TRIGGER trig2
ON authors
FOR INSERT, UPDATE
AS
  DECLARE @fax varchar(12)
  SELECT @fax = phone   
  FROM authors
GO
]
[Keyword:Delphi,String,Int,StrToIntDef;]
[
  n=StrToIntDef(String,defalutNumerber);
  //n=StrToIntDef('12345',0)
  //n=12345
  //n=StrToIntDef('ttt',0)
  //n=0

]

[keyWord:Delphi,StringGrid,stringgrid]
[
 var
  R: TRect;
  org: TPoint;
begin
  with Sender as TStringgrid do begin
      perform(WM_CANCELMODE, 0, 0);
      R := CellRect(Acol, Arow);
      org := Self.ScreenToClient(ClientToScreen(R.topleft));
      with cmb do begin
        setbounds(org.X, org.Y, r.right - r.left, height);
        itemindex := Items.IndexOf(Cells[acol, arow]);
        Show;
        BringTofront;
        SetFocus;
        DroppedDown := true;
      end;
    end;
 
  TempRect:=StringGrid.CellRect(ACol,ARow);
  TempRect.Left:=TempRect.Left+StringGrid.Left;
  TempRect.Right:=TempRect.Right+StringGrid.Left;
  TempRect.Top:=TempRect.Top+StringGrid.Top;
  TempRect.Bottom:=TempRect.Bottom+StringGrid.Top;
  with Cmb do
  begin
    Left:=TempRect.Left+1;
    Top:=TempRect.Top+1;
    Width:=(TempRect.Right+1)-Left;
    Height:=(TempRect.Bottom+1)-Top;
    Visible:=True;
    SetFocus;
  end;
  

 

]
[ongettext()事件的位置
双击adoquery，出现方框，右键add all fields
然后选择一个field，其事件里有gettext()
写上即可
]
[KeyWord:Delphi,Pic,pic]
[
 ImgImportData.Parent.DoubleBuffered:=true;
]
[KeyWord:Delphi,Resource,Res]
[
//Create Tmyrc.rc
BG RCDATA "BG.JPG"
BG_Blue RCDATA "BG_Blue.jpg"
BG_Yellow RCDATA "BG_Yellow.jpg"
//Builder
//brcc32.exe Tmyrc.rc
//Get Tmyrc.res
//In Delphi
{$R *.dfm}
{$R Tmyrc.Res}
var
  S:TStream;
  P:TjpegImage;
begin
  S:=TResourceStream.Create(0,'BG_Yellow',RT_RCDATA);
  P:=TJpegImage.Create;
  p.LoadFromStream(S);
  image1.Picture.Assign(p);
  p.Free;
  S.Free;

]
[Keyword:Delphi,任务栏,停靠]
[
 Protected
  procedure CreateParams(Var Param:TCreateParams);override;
。
。
。
。

procedure T****Form.CreateParams(Var Param:TCreateParams);
begin
  Inherited CreateParams(Param);
  Param.wndParent:= GetDesktopWindow;
end;

procedure CreateParams(var Params: TCreateParams);override;

procedure TMyForm.CreateParams(var Params: TCreateParams);
begin
  inherited;
  Params.ExStyle := Params.ExStyle or WS_EX_APPWINDOW;
end;

SetWindowLong(Handle,GWL_EXSTYLE,GetWindowLong(Handle,GWL_EXSTYLE) or WS_EX_APPWINDOW);

protected
    procedure CreateParams(Var Params: TCreateParams); override;

procedure TForm1.CreateParams(var Params: TCreateParams);
begin
  inherited;
  Params.WndParent := GetDesktopWindow;
end;

]
[keyWord:Delphi,字符串,匹配]
[
function TfrmCatSearch.IsInclude(strBlank,strV:string):bool;
var
  strMark,strTemp:string;
  blnInclude:bool;
  nPos:integer;
begin
  strMark:=' ';
  nPos:=pos(strMark,strBlank);
  blnInclude:=true;
  while nPos>0 do
   begin
     strTemp:=Copy(strBlank,1,nPos);
     blnInclude:=blnInclude and (pos(trim(strTemp),strV)>0);
     if not blnInclude then
       begin
          result:=false;
        end;
     Delete(strBlank,1,nPos);
     nPos:=pos(strMark,strBlank)
  end;
  if strBlank<>'' then
     result:=blnInclude and (pos(trim(strBlank),strV)>0)
  else
     result:=blnInclude;
end;

]
[delphi,换行，drawtext]
[
  cmb.Canvas.FillRect(Rect);
  DrawText(cmb.Canvas.Handle,pchar(str),-1,Rect,DT_WORDBREAK);
]
[delphi,combobox,stye]
[
  csDropDownList,项目不能写
  csownerDrawVariable ,改变item大小
  DrawItem    item内容
  MeasureItem 设置item高度

]
[delphi,combobox,选择子项目
procedure Tform1.cmbWndProd(var Message:TMessage);
begin
   if Message.Msg=WM_CTLCOLORLISTBOX then
     begin
       nSelect:=SendMessage(cmb.Handle, CB_GETCURSEL, 0, 0);
       if nSelect>0 then
       label1.Caption:=StringReplace(s.Strings[nSelect],'[',
       '['#13#10,[rfReplaceAll]);
     end
   else
     mycmdWndProc(Message);
end;

]
[keyWord:delphi,draw,pic,bmp,stringgrid]
[
   if Arow=0 then
     DrawTitle
  else begin
     strV:=StringGrid.Cells[Acol,Arow];
     bmp:=TbitMap.Create;
     bmp.LoadFromFile('D:/1.bmp');
     StringGrid.Canvas.FillRect(Rect);
     StringGrid.Canvas.Draw(Rect.left,Rect.top,bmp);
     StringGrid.Canvas.Brush.Style:=bsClear;
     StringGrid.Canvas.TextOut(Rect.Left+2,Rect.Top+2,strV);

  end;

]
[keyWord:delphi,透明,richedit,控件]
[
Procedure ClearRichEdit(var Message:TMessage);
form_create
    //Self.RichedtWnd:=Self.RichEdit.WindowProc;
  //Self.RichEdit.WindowProc:=Self.ClearRichEdit;
  //SetWindowLong(RichEdit.Handle, GWL_EXSTYLE,
  //GetWindowLong(RichEdit.Handle,GWL_EXSTYLE) or WS_EX_TRANSPARENT);
procedure TfrmDetail.ClearRichEdit(var Message:TMessage);
begin

     if Message.Msg= WM_ERASEBKGND  then
       Message.Result:=1
   else if (Message.Msg =  CN_CTLCOLORMSGBOX )
           or(Message.Msg = CN_CTLCOLORSTATIC ) then
         begin
             bb:=null;
             Message.result:=bb
         end
    else
      Self.RichedtWnd(Message);

end;

]
[keyword:delphi,中文字符]
[
  strV:=Copy(edit1.Text,3,1);
  if IsDBCSLeadByte(ord(strV[1])) then
     ShowMessage('is')
  else
     showMessage('not is');

]
[keyWord:delphi,QRT,报表，折行]
[
//在数据源上折行
procedure TForm1.ADOTable1EnterpriseGetText(Sender: TField;
  var Text: String; DisplayText: Boolean);
var
  strV:wideString;
begin
  strV:=Sender.DataSet.FieldValues['enterPrise'];
  insert(#13#10,strV,10);
  text:=strV; 

end;

]
[]
[
 $00F4F0F2

判断Grid是否有滚动条？

if (GetWindowlong(Stringgrid1.Handle, GWL_STYLE) and WS_VSCROLL) <> 0 then

ShowMessage('Vertical scrollbar is visible!');

if (GetWindowlong(Stringgrid1.Handle, GWL_STYLE) and WS_HSCROLL) <> 0 then

ShowMessage('Horizontal scrollbar is visible!');
 
 

   StringGrid的AutoSize   
   
...autosize a StringGrid-Column to fit its content?

{1.}

procedure SetGridColumnWidths(Grid: TStringGrid;

const Columns: array of Integer);

{

When you double-Click on a Column-Header the Column

autosizes to fit its content

Bei Doppelklick auf eine fixierte Spalte passt sich

die Spaltenbreite der Textgr?sse an

}

procedure AutoSizeGridColumn(Grid: TStringGrid; column, min, max: Integer);

{ Set for max and min some minimal/maximial Values}

{ Bei max and min kann eine Minimal- resp. Maximalbreite angegeben werden}

var

i: Integer;

temp: Integer;

tempmax: Integer;

begin

tempmax := 0;

for i := 0 to (Grid.RowCount - 1) do

begin

temp := Grid.Canvas.TextWidth(Grid.cells[column, i]);

if temp > tempmax then tempmax := temp;

if tempmax > max then

begin

tempmax := max;

break;

end;

end;

if tempmax < min then tempmax := min;

Grid.ColWidths[column] := tempmax + Grid.GridLineWidth + 3;

end;

procedure TForm1.StringGrid1DblClick(Sender: TObject);

var

P: TPoint;

iColumn, iRow: Longint;

begin

GetCursorPos(P);

with StringGrid1 do

begin

P := ScreenToClient(P);

MouseToCell(P.X, P.Y, iColumn, iRow);

if P.Y < DefaultRowHeight then

AutoSizeGridColumn(StringGrid1, iColumn, 40, 100);

end;

end;

{************************************************}

{2.}

procedure TForm1.Button1Click(Sender: TObject);

{ by P. Below }

const

DEFBORDER = 8;

var

max, temp, i, n: Integer;

begin

with Grid do

begin

Canvas.Font := Font;

for n := Low(Columns) to High(Columns) do

begin

max := 0;

for i := 0 to RowCount - 1 do

begin

temp := Canvas.TextWidth(Cells[Columns[n], i]) + DEFBORDER;

if temp > max then

max := temp;

end; { For }

if max > 0 then

ColWidths[Columns[n]] := max;

end; { For }

end; { With }

end; {SetGridColumnWidths }
 ]
 [keyWord:delphi,file,文件，文件属性]
 [
   try
   nAttr:=FileGetAttr(FileName);
   if (nAttr and faReadOnly)=faReadOnly then
     begin
      FileSetAttr(FileName,0);
      Result:=1;
     end
   else
     Result:=1;
   except
     Application.MessageBox('无法修改只读属性，错误编号 006',pchar(WaringTitle));
     Result:=0;
     exit;
  end;
]
[keyword:delphi,属性；属性应用，设置]
[
 unit TClass;

interface
uses
    Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
    Dialogs;
type
   Ttest=Class
   constructor Create();
   protected
      RCa,Wca:string;
   public
      name:string;
      procedure ChangeT(const Value:string);
      property  Ca:string Read RCa Write ChangeT;
end;
   
implementation
constructor Ttest.Create();
begin
   RCa:='test now';

end;
procedure Ttest.ChangeT(const Value:string);
begin
  RCa:=value+'你好科学';
end;

end.
]
[keyWord:delphi,printscreen,屏蔽截图]
[
    id4: Integer;
    procedure WMHotKey(var Msg: TWMHotKey); message WM_HOTKEY;
procedure TForm1.FormCreate(Sender: TObject);
begin
  
   id4 :=GlobalAddAtom('Hotkey4');
   //function adds a character string to the global atom table and returns a
   //unique value (an atom) identifying the string.
   RegisterHotKey(Handle, id4, 0,VK_SNAPSHOT);
   //function defines a hot key for the current thread.
end;
procedure TForm1.WMHotKey(var Msg: TWMHotKey);
begin
  if Msg.HotKey=id4 then
    ShowMessage('Print Screen was pressed !');
  inherited;
end;
procedure TForm1.FormDestroy(Sender: TObject);
begin
  UnRegisterHotKey(Handle,id4);
end;
]
[keyword:delphi,db,jpg,数据库，图片]
[
var
  S:TMemoryStream;
  jpg:TjpegImage;

begin
  S:=TmemoryStream.Create;
  TBlobField(DS.DataSet.FieldByName('ImgContent')).SaveToStream(S);
  s.Position:=0;
  jpg:=TjpegImage.Create;
  jpg.LoadFromStream(S);
  image1.Picture.Assign(jpg);

 

  Var
  logoFileName,T:string;
  ImgPath:string;
  i:integer;
begin
  T:=edtDir.Text;
  for i:=0 to DS.DataSet.RecordCount-1   do
    begin
      ImgPath:=DS.DataSet.FieldValues['ImgPath'];
      LogoFileName:=T+ImgPath;
      if FileExists(LogoFileName) then
         begin
           DS.DataSet.Edit;
           TBlobField(DS.DataSet.FieldByName('ImgContent')).LoadFromFile(LogoFileName);
           DS.DataSet.Post;
         end;
       DS.DataSet.MoveBy(1);
    end;
    ShowMessage('Over');

 

 

]
[keyword:asp,class]
[
Dim MyToolbox
Set MyToolbox = New CToolbox
Response.Write "UserName: " & MyToolbox.UserName & "<BR>" & vbCrLf
Response.Write "UserPhone: " &  MyToolbox.UserPhone & "<BR>" & vbCrLf
Set MyToolbox = Nothing

Class CToolbox
Private m_conn, m_rs
Private m_username, m_userphone

Public Property Get UserName()
    UserName = m_username
End Property

Public Property Get UserPhone()
    UserPhone = m_userphone
End Property

Private Sub Class_Initialize()
    Set m_conn = Server.CreateObject("ADODB.Connection")
    m_conn.ConnectionString = "Some connection string"
    m_conn.Open
    Set m_rs = Server.CreateObject("ADODB.Recordset")
    Set m_rs.ActiveConnection = m_conn
    m_rs.Open "SELECT * FROM Users WHERE userid = '" &
                        Request.ServerVariables("LOGON_USER") & "'"
    If Not m_rs.EOF Then
        m_username = m_rs.Fields("username")
        m_userphone = m_rs.Fields("userphone")
    End If
End Sub

Private Sub Class_Terminate()
    On Error Resume Next
    m_rs.Close
    Set m_rs = Nothing
    m_conn.Close
    Set m_conn = Nothing
End Sub

End Class

class TUser
 private mUserName,mUserPwd
 'public  UserName,UserPwd
 public property Get UserName()
      UserName=mUserName
 end property
 public property Let UserName(Byval value)
      mUserName=value
  end Property
 private sub Class_Initialize()
    mUserName="aerly"
    'UserPwd="123456"
 end sub

 private sub class_Terminate()
 end sub
 
end Class 
dim aUser
set aUser=new Tuser
aUser.UserName="TTT"
Response.Write("Class a.UserName:"+aUser.UserName)

 

 

]