📄 大富翁论坛-富翁笔记-delphi技巧.mht
字号:
laceAll]));
a:=3Da+1;
end;
wnetcloseenum(enumhandle);
end;
end;
=A1=F3[DELPHI]=BB=F1=C8=A1=C4=B3=D2=BB=BC=C6=CB=E3=BB=FA=C9=CF=B5=C4=B9=B2=
=CF=ED=C4=BF=C2=BC
procedure getsharefolder(const computername:string);
var
errcode,a:integer;
netres:array[0..1023] of netresource;
enumhandle:thandle;
enumentries,buffersize:dword;
s:string;
mylistitems:tlistitems;
mylistitem:tlistitem;
mystrings:tstringlist;
begin
with netres[0] do begin
dwscope :=3DRESOURCE_GLOBALNET;
dwtype :=3DRESOURCETYPE_DISK;
dwdisplaytype :=3DRESOURCEDISPLAYTYPE_SHARE;
dwusage :=3DRESOURCEUSAGE_CONTAINER;
lplocalname :=3Dnil;
lpremotename :=3Dpchar(computername);
lpcomment :=3Dnil;
lpprovider :=3Dnil;
end; // =BB=F1=C8=A1=B8=F9=BD=E1=B5=E3
errcode:=3Dwnetopenenum(RESOURCE_GLOBALNET,RESOURCETYPE_DISK,RESOURCEUSAG=
E_CONTAINER,@netres[0],enumhandle);
if errcode=3DNO_ERROR then
begin
EnumEntries:=3D1024;
BufferSize:=3DSizeOf(NetRes);
ErrCode:=3DWNetEnumResource(EnumHandle,EnumEntries,@NetRes[0],BufferSize)=
;
end;
wnetcloseenum(enumhandle);
a:=3D0;
mylistitems:=3Dcontrolcenter.lstfile.Items ;
mylistitems.Clear ;
while (string(netres[a].lpprovider)<>'') and (errcode=3DNO_ERROR) =
do
begin
with mylistitems do
begin
mylistitem:=3Dadd;
mylistitem.ImageIndex :=3D4;
mylistitem.Caption :=3Dextractfilename(netres[a].lpremotename);
end;
a:=3Da+1;
end;
end;
=A1=F3[DELPHI]=B5=C3=B5=BD=D3=B2=C5=CC=D0=F2=C1=D0=BA=C5
var SerialNum : pdword; a, b : dword; Buffer : array [0..255] of char;=20
begin=20
if GetVolumeInformation('c:\', Buffer, SizeOf(Buffer), SerialNum, a, b, =
nil, 0) then Label1.Caption :=3D IntToStr(SerialNum^);=20
end; =20
2004-3-7 21:41:06 =20
=B7=A2=B1=ED=C6=C0=D3=EF&raquo;&raquo;&raquo; =20
2004-3-7 21:41:53 =
=A3=C4=A3=C5=A3=CC=A3=D0=A3=C9=BE=AD=D1=E9=D7=DC=BD=E12http://expert.csdn=
.net/Expert/topic/2058/2058112.xml?temp=3D6.928653E-02
http://expert.csdn.net/Expert/topic/2000/2000460.xml?temp=3D.219021
----------------------------------------------------------------------
Q: =
=D4=F5=C3=B4=C0=B4=B8=C4=B1=E4ListBox=B5=C4=D7=D6=CC=E5=C4=D8=A3=BF=BE=CD=
=D0=DE=B8=C4=C6=E4=D6=D0=B5=C4=D2=BB=D0=D0=A1=A3
A: =CF=C8=B0=D1ListBox1.Style =C9=E8=B3=C9lbOwnerDrawFixed=20
=C8=BB=BA=F3=D4=DA OnDrawItem =
=CA=C2=BC=FE=CF=C2=D0=B4=CF=C2=C8=E7=CF=C2=B4=FA=C2=EB
procedure TForm1.ListBox1DrawItem(Control: TWinControl; Index: Integer;
Rect: TRect; State: TOwnerDrawState);
var
Offset: Integer;
begin
Offset :=3D 2;
with (Control as TListBox).Canvas do begin
FillRect(Rect);
if Index =3D 2 then begin
Font.Name :=3D 'Fixedsys';
Font.Color :=3D clRed;
Font.Size :=3D 12;
end else begin
Font.Name :=3D 'Arial';
Font.Color :=3D clBlack;
Font.Size :=3D 8;
end;
if odSelected in State then begin
Font.Color :=3D clWhite;
end;
TextOut(Rect.Left + Offset, Rect.Top, (Control as =
TListBox).Items[Index]);
end;
end;
----------------------------------------
Q=A3=BA=D4=F5=C3=B4=D4=DARichEdit=C0=EF=C3=E6=B2=E5=C8=EB=CD=BC=C6=AC=A3=BF=
A: =
=C7=EB=B5=BD=D5=E2=C0=EF=C0=B4=BF=B4=BF=B4=BB=E1=D5=D2=B5=BD=B4=F0=B0=B8
http://www.undu.com/Articles/991107c.html
----------------------------------------------
Q=A3=BA=D4=F5=C3=B4=B2=C5=C4=DC=C4=BF=C2=BC=C4=D8=A3=BF
A=A3=BA=CE=D2=C0=B4=A1=A3
uses ShellAPI;
procedure DeleteFiles(Source: string);
var
FO: TShFileOpStruct;
begin
FillChar(FO,SizeOf(FO),#0);
FO.Wnd :=3D Form1.Handle;
FO.wFunc :=3D FO_DELETE;
FO.pFrom :=3D PChar(Source);
ShFileOperation(FO);
end;
procedure EmptyDirectory(Path: String);
begin
if DirectoryExists(Path) then
begin
DeleteFiles(Path+'\*');
end
else
ForceDirectories(Path);
end;
--------------------------------------------------
Q:=C8=E7=BA=CE=D3=B3=C9=E4=CD=F8=C2=E7=C7=FD=B6=AF=C6=F7=A3=BF
=B1=C8=C8=E7=CE=D2=D2=AA=B0=D1\\Server\sys=D3=B3=C9=E4=CE=AAF=C5=CC=A1=A3=
=CE=D2=D0=E8=D2=AA=D2=BB=B8=F6=BA=AF=CA=FD=B1=C8=C8=E7
=B8=F8=B3=F6=CA=E4=C8=EB=B2=CE=CA=FD=CE=AA\\server\sys\home\bruno=B8=F8=CE=
=D2=B5=C4=B7=B5=BB=D8=D6=B5=CA=C7F:\home\bruno
A=A3=BA
Function UNCToDrive(UNCPath: STring): STring;
var
DriveNum: Integer;
DriveChar: Char;
DriveBits: set of 0..25;
StartSTr,TestStr: STring;
begin
result :=3D UNCPath;
StartSTr :=3D UNCPath;
Integer(DriveBits) :=3D GetLogicalDrives;
for DriveNum :=3D 0 to 25 do
begin
if (DriveNum in DriveBits) then begin
DriveChar :=3D Char(DriveNum + Ord('A'));
TestSTr :=3D ExpandUNCFileName(DriveChar+':\');
If TEstStr <> '' then
If Pos(Uppercase(TestSTr),Uppercase(STartSTr)) > 0 then
begin
Delete(StartSTr,1,Length(TestSTr));
result :=3D DriveChar+':\'+StartSTr;
break;
end;
end;
end;
end;
---------------------------------------------------------
Q=A3=BA=CE=D2=D3=D0=D2=BB=D0=A9=CC=D8=CA=E2=D3=EF=D1=D4=B5=C4=D7=D6=CC=E5=
=C0=B4=D3=C3=A3=AC=CB=FC=C3=C7=B4=E6=B4=A2=D4=DA=CE=D2=B5=C4EXE=CE=C4=BC=FE=
=C0=EF=A3=AC=B5=AB=CA=C7=C1=BD=B5=E3=A1=A3
* =CE=D2=B2=BB=CF=EB=B7=C5=B5=BDfont=CE=C4=BC=FE=BC=D0=C0=EF
* =
=CE=D2=B2=BB=CF=EB=B4=D3EXE=CE=C4=BC=FE=C0=EF=C3=E6=CC=E1=C8=A1=B3=F6=C0=B4=
=C8=E7=B9=FB=BF=C9=C4=DC=A3=AC=C7=EB=B8=E6=CB=DF=CE=D2=A1=A3
=D2=F2=CE=AA=A3=AC=CE=D2=B5=C4=D7=D6=CC=E5=CA=C7=D7=D4=BC=BA=D7=F6=B5=C4=B2=
=BB=CA=C7windows=D7=D4=B4=F8=B5=C4=A3=AC=CE=D2=CF=EB=B1=A3=BB=A4=D7=D4=BC=
=BA=B5=C4=B6=AB=CE=F7=A1=A3
A:=B2=BB=CC=AB=BF=C9=C4=DC=A3=AC=B1=D8=D0=EB=CC=E1=C8=A1=B3=F6=C0=B4=A1=A3=
=C4=E3=BF=C9=D2=D4=CA=B9=D3=C3=D5=E2=B8=F6=B1=A3=BB=A4=B9=FD=B3=CC=C0=B4=B1=
=A3=BB=A4=C4=E3=B5=C4=CE=C4=BC=FE=B2=BB=B1=BB=D0=DE=B8=C4=BA=CD=C9=BE=B3=FD=
=A1=A3
=D4=DAEXE=D6=B4=D0=D0=B5=C4=CA=B1=BA=F2=B0=D1=D7=D6=CC=E5=B7=C5=B5=BD=C1=D9=
=CA=B1=CE=C4=BC=FE=BC=D0=C0=EF=A3=AC=BD=E1=CA=F8=B5=C4=CA=B1=BA=F2=C9=BE=B3=
=FD=CB=FC=A1=A3
function ProtectFile(sFilename : string) : hFile;
var
hf: hFile;
lwHFileSize, lwFilesize: longword;
ofs : TOFStruct;
begin
if FileExists(sFilename) then
begin
hf :=3D OpenFile(pchar(sFilename), ofs, OF_READ or =
OF_WRITE or OF_SHARE_EXCLUSIVE);
if hf <> 0 then
begin
lwFilesize :=3D GetFileSize(hf, @lwHFileSize);
if LockFile(hf, 0, 0, lwFilesize, lwHFilesize) =
then
Result :=3D hf else Result :=3D 0;
end
else Result :=3D 0;
end
else Result :=3D 0;
end;
//..
var
ResS: TResourceStream;
TempPath: array [0..MAX_PATH] of Char;
TempDir: string;
begin
GetTempPath(Sizeof(TempPath), TempPath);
TempDir :=3D StrPas(Path);
ResS :=3D TResourceStream.Create(hInstance, 'SOME_FONT', 'RT_FONT');
ResS.SavetoFile(TempDir+'some_font.ttf');
ResS.Free;
AddFontResource(TempDir+'some_font.ttf');
SendMessage(HWND_BROADCAST, WM_FONTCHANGE, 0, 0);
ProtectFile(TempDir+'some_font.ttf');
end;
-------------------------------------------------------
Q=A3=BA=C8=E7=BA=CE=B5=C3=B5=BD=B5=B1=C7=B0=B5=C4ProgramFiles=B5=C3=C2=B7=
=BE=B6=A3=BF
A=A3=BA=D3=C3=B6=C1=D0=B4=D7=A2=B2=E1=B1=ED=B5=C4=B7=BD=B7=A8=BE=CD=BF=C9=
=D2=D4=D7=F6=B5=BD=A1=A3
=B4=FA=C2=EB=C8=E7=CF=C2=A3=BA
uses registry;
procedure TForm1.Button1Click(Sender: TObject);
var
reg:TRegistry;
begin
reg:=3DTRegistry.Create;
reg.RootKey:=3DHKEY_LOCAL_MACHINE;
if reg.OpenKey('SOFTWARE\Microsoft\Windows\CurrentVersion',false) then
begin
edit1.Text:=3Dreg.ReadString('ProgramFilesDir');
reg.CloseKey;
reg.Free;
end;
end;
--------------------------------------------------------------
Q:=C8=E7=BA=CE=D4=DAJpg=CD=BC=CF=F1=C9=CF=D0=B4=C9=CF=D7=D6=A3=BF
A=A3=BA=D5=E2=C0=EF=D3=D0=B8=F6=B4=FA=C2=EB=A1=A3
hmm, here's a sample with help of Bitmap, you can chance the brush style =
of canvas to bsClear to make the text transparent=20
uses
Jpeg;
procedure TForm1.Button1Click(Sender: TObject);
var
Bmp : TBitmap;
Jpg : TJpegImage;
begin
try
Bmp :=3D TBitmap.Create;
Jpg :=3D TjpegImage.Create;
Jpg.LoadFromFile('c:\img.jpg');
Bmp.Assign(Jpg);
Bmp.Canvas.Brush.Style :=3D bsClear;
Bmp.Canvas.Font.Color :=3D clYellow;
Bmp.Canvas.TextOut(10,10,'Hello World');
Jpg.Assign(Bmp);
Jpg.SaveToFile('c:\img2.jpg');
finally
bmp.Free;
jpg.Free;
end;
end;
----------------------------------------------------
DBGrid=D6=D0=C8=E7=BA=CE=C8=C3=BB=D8=B3=B5=B1=E4=CE=AA=B9=E2=B1=EA=D3=D2=D2=
=C6=B6=AF =A3=BA
procedure TForm1.FormKeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
begin
if key=3DVK_F1 then
begin
DBGrid1.DataSource:=3DDataSource1;
ADOTable1.Active:=3Dtrue;
ADOTable2.Active:=3Dfalse;
end
else if key=3DVK_F2 then
begin
DBGrid1.DataSource:=3DDataSource2;
ADOTable2.Active:=3Dtrue;
ADOTable1.Active:=3Dfalse;
end
end ;
case key of
vk_f11: =20
begin
=20
end;
if edit1.Text=3DADOTable1.FieldByName('no').AsString then
begin
edit2.Text:=3DADOTable1.FieldValues['pname'];
edit3.Text:=3DADOTable1.FieldValues['kroom'];
edit4.Text:=3DADOTable1.FieldValues['dname'];
end=20
DBGrid=D6=D0=C8=E7=BA=CE=C8=C3=BB=D8=B3=B5=B1=E4=CE=AA=B9=E2=B1=EA=D3=D2=D2=
=C6=B6=AF =20
=D4=DAForm.OnKeyPress=CA=C2=BC=FE=D6=D0=D0=B4=C8=E7=CF=C2=B4=FA=C2=EB=A3=BA=
if Key =3D #13 then=20
if ActiveControl =3D DBGrid1 then begin=20
TDBGrid(ActiveControl).SelectedIndex :=3D =
TDBGrid(ActiveControl).SelectedIndex + 1;=20
Key :=3D #0;=20
end;=20
=D3=D02=B5=E3=D0=E8=D2=AA=D7=A2=D2=E2=A3=BA
1.=B5=B1=B9=E2=B1=EA=B4=EF=B5=BDDBGird=D7=EE=D3=D2=C1=D0=B5=C4=CA=B1=BA=F2=
=A3=AC=D4=D9=B0=B4=BB=D8=B3=B5=A3=AC=B9=E2=B1=EA=BB=B9=BB=E1=CD=A3=C1=F4=D4=
=DA=D4=AD=B5=D8=A1=A3
2.Key :=3D =
#0=D2=BB=BE=E4=C8=C3=B9=E2=B1=EA=D2=C6=B6=AF=B5=BD=CF=C2=D2=BB=C1=D0=D2=D4=
=BA=F3=B4=A6=D3=DA=E4=AF=C0=C0=D7=B4=CC=AC=A3=AC=C8=E7=B9=FB=C8=A5=B5=F4=D5=
=E2=D0=D0=B4=FA=C2=EB=B9=E2=B1=EA=D2=C6=B6=AF=B5=BD=CF=C2=D2=BB=C1=D0=D2=D4=
=BA=F3=BD=AB=B4=A6=D3=DA=B1=E0=BC=AD=D7=B4=CC=AC=A1=A3 =20
-----------------------------------------------------------------
Q=A3=BA=D4=F5=C3=B4=D3=C3delphi=D0=DE=B8=C4=CE=C4=BC=FE=B5=C4=CA=B1=BC=E4=
=C4=D8=A3=BF
=D4=DAwindows=CF=C2=A3=AC=CA=F4=D0=D4=C0=EF=C3=E6=D3=D0=C8=FD=B8=F6=C8=D5=
=C6=F0=A3=AC=B4=B4=BD=A8=A3=AC=D0=DE=B8=C4=A3=AC=B4=E6=B4=A2=A1=A3=CE=D2=D4=
=F5=C3=B4=C0=B4=D0=DE=B8=C4=B0=A1=A3=BF
A=A3=BAHere is the excerpt from the Jedi Code Library. If it is not =
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -