Q: 怎么来改变ListBox的字体呢？就修改其中的一行。

A: 先把ListBox1.Style 设成lbOwnerDrawFixed 

然后在 OnDrawItem 事件下写下如下代码

procedure TForm1.ListBox1DrawItem(Control: TWinControl; Index: Integer; 

Rect: TRect; State: TOwnerDrawState); 

var 

Offset: Integer; 

begin 

Offset := 2; 

with (Control as TListBox).Canvas do begin 

FillRect(Rect); 

if Index = 2 then begin 

Font.Name := 'Fixedsys'; 

Font.Color := clRed; 

Font.Size := 12; 

end else begin 

Font.Name := 'Arial'; 

Font.Color := clBlack; 

Font.Size := 8; 

end; 

if odSelected in State then begin 

Font.Color := clWhite; 

end; 

TextOut(Rect.Left + Offset, Rect.Top, (Control as TListBox).Items[Index]); 

end; 

end; 

---------------------------------------- 

Q：怎么在RichEdit里面插入图片？

A: 请到这里来看看会找到答案

---------------------------------------------- 

Q：怎么才能目录呢？

A：我来。

uses ShellAPI;

procedure DeleteFiles(Source: string); 

var 

FO: TShFileOpStruct; 

begin 

FillChar(FO,SizeOf(FO),#0); 

FO.Wnd := Form1.Handle; 

FO.wFunc := FO_Delete; 

FO.pFrom := PChar(Source); 

ShFileOperation(FO); 

end;

procedure EmptyDirectory(Path: String); 

begin 

if DirectoryExists(Path) then 

begin 

DeleteFiles(Path+'*'); 

end 

else 

ForceDirectories(Path); 

end; 

-------------------------------------------------- 

Q:如何映射网络驱动器？

比如我要把Serversys映射为F盘。我需要一个函数比如

给出输入参数为serversyshomebruno给我的返回值是F:homebruno

A：

Function UNCToDrive(UNCPath: STring): STring; 

var 

DriveNum: Integer; 

DriveChar: Char; 

DriveBits: set of 0..25; 

StartSTr,TestStr: STring; 

begin 

result := UNCPath; 

StartSTr := UNCPath; 

Integer(DriveBits) := GetLogicalDrives; 

for DriveNum := 0 to 25 do 

begin 

if (DriveNum in DriveBits) then begin 

DriveChar := Char(DriveNum + ord('A')); 

TestSTr := ExpandUNCFileName(DriveChar+':'); 

If TEstStr <> '' then 

If Pos(Uppercase(TestSTr),Uppercase(STartSTr)) > 0 then 

begin 

Delete(StartSTr,1,Length(TestSTr)); 

result := DriveChar+':'+StartSTr; 

break; 

end; 

end; 

end; 

end; 

--------------------------------------------------------- 

Q：我有一些特殊语言的字体来用，它们存储在我的EXE文件里，但是两点。

* 我不想放到font文件夹里 

* 我不想从EXE文件里面提取出来

如果可能，请告诉我。

因为，我的字体是自己做的不是自带的，我想保护自己的东西。

A:不太可能，必须提取出来。你可以使用这个保护过程来保护你的文件不被修改和删除。

在EXE执行的时候把字体放到临时文件夹里，结束的时候删除它。

function ProtectFile(sFilename : string) : hFile; 

var 

hf: hFile; 

lwHFileSize, lwFilesize: longword; 

ofs : TOFStruct; 

begin 

if FileExists(sFilename) then 

begin 

hf := OpenFile(pchar(sFilename), ofs, OF_READ or OF_WRITE or OF_SHARE_EXCLUSIVE); 

if hf <> 0 then 

begin 

lwFilesize := GetFileSize(hf, @lwHFileSize); 

if LockFile(hf, 0, 0, lwFilesize, lwHFilesize) then 

Result := hf else Result := 0; 

end 

else Result := 0; 

end 

else Result := 0; 

end;

//.. 

var 

ResS: TResourceStream; 

TempPath: array [0..MAX_PATH] of Char; 

TempDir: string; 

begin 

GetTempPath(Sizeof(TempPath), TempPath); 

TempDir := StrPas(Path); 

ResS := 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：如何得到当前的ProgramFiles得路径？

A：用读写注册表的方法就可以做到。

代码如下：

uses registry;

procedure TForm1.Button1Click(Sender: TObject); 

var 

reg:TRegistry; 

begin 

reg:=TRegistry.Create; 

reg.RootKey:=HKEY_LOCAL_MACHINE; 

if reg.OpenKey('SOFTWAREMicrosoftWindowsCurrentVersion',false) then 

begin 

edit1.Text:=reg.ReadString('ProgramFilesDir'); 

reg.CloseKey; 

reg.Free; 

end; 

end; 

-------------------------------------------------------------- 

Q:如何在Jpg图像上写上字？

A：这里有个代码。

hmm, here's a sample with help of Bitmap, you can chance the brush style of canvas to bsClear to make the text transparent

uses 

Jpeg;

procedure TForm1.Button1Click(Sender: TObject); 

var 

Bmp : TBitmap; 

Jpg : TJpegImage; 

begin 

try 

Bmp := TBitmap.Create; 

Jpg := TjpegImage.Create; 

Jpg.LoadFromFile('c:img.jpg'); 

Bmp.Assign(Jpg); 

Bmp.Canvas.Brush.Style := bsClear; 

Bmp.Canvas.Font.Color := clYellow; 

Bmp.Canvas.TextOut(10,10,'Hello World'); 

Jpg.Assign(Bmp); 

Jpg.SaveToFile('c:img2.jpg'); 

finally 

bmp.Free; 

jpg.Free; 

end; 

end; 

---------------------------------------------------- 

DBGrid中如何让回车变为光标右移动 ：

procedure TForm1.FormKeyDown(Sender: TObject; var Key: Word; 

Shift: TShiftState); 

begin 

if key=VK_F1 then 

begin 

DBGrid1.DataSource:=DataSource1; 

ADOTable1.Active:=true; 

ADOTable2.Active:=false; 

end 

else if key=VK_F2 then 

begin 

DBGrid1.DataSource:=DataSource2; 

ADOTable2.Active:=true; 

ADOTable1.Active:=false; 

end 

end ;

case key of 

vk_f11: 

begin

end;

if edit1.Text=ADOTable1.FieldByName('no').AsString then 

begin 

edit2.Text:=ADOTable1.FieldValues['pname']; 

edit3.Text:=ADOTable1.FieldValues['kroom']; 

edit4.Text:=ADOTable1.FieldValues['dname']; 

end

DBGrid中如何让回车变为光标右移动 

在Form.OnKeyPress事件中写如下代码：

if Key = #13 then 

if ActiveControl = DBGrid1 then begin 

TDBGrid(ActiveControl).SelectedIndex := TDBGrid(ActiveControl).SelectedIndex + 1; 

Key := #0; 

end;

有2点需要注意： 

1.当光标达到DBGird最右列的时候，再按回车，光标还会停留在原地。 

2.Key := #0一句让光标移动到下一列以后处于浏览状态，如果去掉这行代码光标移动到下一列以后将处于编辑状态。 

----------------------------------------------------------------- 

Q：怎么用delphi修改文件的时间呢？

在windows下，属性里面有三个日起，创建，修改，存储。我怎么来修改啊？

A：Here is the excerpt from the Jedi Code Library. If it is not complete then get the JCL.

type 

// indicates the file time to set, used by SetFileTimesHelper and SetDirTimesHelper 

TFileTimes = (ftLastAccess, ftLastWrite, ftCreation);

function SetFileTim

esHelper(const FileName: string; const DateTime: TDateTime; Times: TFileTimes): Boolean; 

var 

Handle: THandle; 

FileTime: TFileTime; 

SystemTime: TSystemTime; 

begin 

Result := False; 

Handle := CreateFile(PChar(FileName), GENERIC_WRITE, FILE_SHARE_READ, nil, 

OPEN_EXISTING, 0, 0); 

if Handle <> INVALID_HANDLE_VALUE then 

try 

//SysUtils.DateTimeToSystemTime(DateTimeToLocalDateTime(DateTime), SystemTime); 

SysUtils.DateTimeToSystemTime(DateTime, SystemTime); 

if Windows.SystemTimeToFileTime(SystemTime, FileTime) then 

begin 

case Times of 

ftLastAccess: 

Result := SetFileTime(Handle, nil, @FileTime, nil); 

ftLastWrite: 

Result := SetFileTime(Handle, nil, nil, @FileTime); 

ftCreation: 

Result := SetFileTime(Handle, @FileTime, nil, nil); 

end; 

end; 

finally 

CloseHandle(Handle); 

end; 

end;

//--------------------------------------------------------------------------------------------------

function SetFileLastAccess(const FileName: string; const DateTime: TDateTime): Boolean; 

begin 

Result := SetFileTimesHelper(FileName, DateTime, ftLastAccess); 

end;

//--------------------------------------------------------------------------------------------------

function SetFileLastWrite(const FileName: string; const DateTime: TDateTime): Boolean; 

begin 

Result := SetFileTimesHelper(FileName, DateTime, ftLastWrite); 

end;

//--------------------------------------------------------------------------------------------------

function SetFileCreation(const FileName: string; const DateTime: TDateTime): Boolean; 

begin 

Result := SetFileTimesHelper(FileName, DateTime, ftCreation); 

end; 

----------------------------------------------------------------------