打印本文 打印本文 关闭窗口 关闭窗口
DELPHI基础开发技巧
作者:武汉SEO闵涛  文章来源:敏韬网  点击数3989  更新时间:2009/4/23 18:31:02  文章录入:mintao  责任编辑:mintao
p;   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:如何映射网络驱动器?

比如我要把file://Server/sys映射为F盘。我需要一个函数比如

给出输入参数为file://server/sys/home/bruno给我的返回值是F:\home\bruno

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(''''SOFTWARE\Microsoft\Windows\CurrentVersion'''',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;

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 SetFileTimesHelper(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;


google上的有关delphi得网址:

http://directory.google.com/Top/Computers/Programming/Languages/Delphi/?tc=1

yahoo上有关delphi得网址

http://di

上一页  [1] [2] [3] [4] [5] [6] [7]  下一页

打印本文 打印本文 关闭窗口 关闭窗口