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: 请到这里来看看会找到答案
http://www.undu.com/Articles/991107c.html ---------------------------------------------- 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文件里面提取出来
如果可能,请告诉我。
因为,我的字体是自己做的不是windows自带的,我想保护自己的东西。
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; ----------------------------------------------------------------------
|
请发表评论