原文名称:"Powered by Delphi" Logo Images
原文日期:2005-05-24
原文地址:http://delphi.about.com/library/weekly/aa052405a.htm
About Delphi Programming (http://delphi.about.com) 文章中译版及 CodeGear(Borland) Delphi 开发工具相关资讯
begin
ListBox1.Items.Add('First'^I'Second'^I'Third') ;
ListBox1.Items.Add('C1R1'^I'C2R1'^I'C3R1') ;
ListBox1.Items.Add('C1R2'^I'C2R2'^I'C3R2') ;
ListBox1.Items.Add('C1R3'^I'C2R3'^I'C3R3') ;
ListBox1.Items.Add('C1R4'^I'C2R4'^I'C3R4') ;
ListBox1.Items.Add('C1R5'^I'C2R5'^I'C3R5') ;
ListBox1.Items.Add('C1R6'^I'C2R6'^I'C3R6') ;
ListBox1.Items.Add('C1R7'^I'C2R7'^I'C3R7') ;
ListBox1.Items.Add('C1R8'^I'C2R8'^I'C3R8') ;
ListBox1.Items.Add('C1R9'^I'C2R9'^I'C3R9') ;
end;
webBrowser1.Navigate('http://delphi.about.com') ;
webBrowser1.Navigate('about:blank') ;
procedure WBLoadHTML(WebBrowser: TWebBrowser; HTMLCode: string) ;
var
sl: TStringList;
ms: TMemoryStream;
begin
WebBrowser.Navigate('about:blank') ;
while WebBrowser.ReadyState < READYSTATE_INTERACTIVE do
Application.ProcessMessages;
if Assigned(WebBrowser.Document) then
begin
sl := TStringList.Create;
try
ms := TMemoryStream.Create;
try
sl.Text := HTMLCode;
sl.SaveToStream(ms) ;
ms.Seek(0, 0) ;
(WebBrowser.Document as IPersistStreamInit).Load(TStreamAdapter.Create(ms)) ;
finally
ms.Free;
end;
finally
sl.Free;
end;
end;
end;
procedure TForm1.FormCreate(Sender: TObject) ;
var
sHTML : string;
begin
sHTML := 'GOTO' +
'About Delphi Programming';
WBLoadHTML(WebBrowser1,sHTML) ;
end;
function GetComputerNetName: string;
var
buffer: array[0..255] of char;
size: dword;
begin
size := 256;
if GetComputerName(buffer, size) then
Result := buffer
else
Result := ''
end;
Function GetUserFromWindows: string;
Var
UserName : string;
UserNameLen : Dword;
Begin
UserNameLen := 255;
SetLength(userName, UserNameLen) ;
If GetUserName(PChar(UserName), UserNameLen) Then
Result := Copy(UserName,1,UserNameLen - 1)
Else
Result := 'Unknown';
End;
{
Usage:
VersionInformation(ListBox1)
}
{Pads or truncates a String and
Justifies Left if StrJustify=True}
Function StringPad(
InputStr,
FillChar: String;
StrLen: Integer;
StrJustify: Boolean): String;
Var
TempFill: String;
Counter : Integer;
Begin
If Not (Length(InputStr) = StrLen) Then
Begin
If Length(InputStr) > StrLen Then
Begin
InputStr := Copy(InputStr,1,StrLen) ;
End
Else
Begin
TempFill := '';
For Counter := 1 To StrLen-Length(InputStr) Do
Begin
TempFill := TempFill + FillChar;
End;
If StrJustify Then
Begin
{Left Justified}
InputStr := InputStr + TempFill;
End
Else
Begin
{Right Justified}
InputStr := TempFill + InputStr ;
End;
End;
End;
Result := InputStr;
End;
Function VersionInformation(
ListBox : TListBox): Boolean;
const
InfoNum = 11;
InfoStr : array [1..InfoNum] of String =
('CompanyName', 'FileDescription', 'FileVersion',
'InternalName', 'LegalCopyright', 'LegalTradeMarks',
'OriginalFilename', 'ProductName', 'ProductVersion',
'Comments', 'Author') ;
LabelStr : array [1..InfoNum] of String =
('Company Name', 'Description', 'File Version',
'Internal Name', 'Copyright', 'TradeMarks',
'Original File Name', 'Product Name',
'Product Version', 'Comments', 'Author') ;
var
S : String;
n, Len, j : Integer;
Buf : PChar;
Value : PChar;
begin
Try
S := Application.ExeName;
ListBox.Items.Clear;
ListBox.Sorted := True;
ListBox.Font.Name := 'Courier New';
n := GetFileVersionInfoSize(PChar(S),n) ;
If n > 0 Then Begin
Buf := AllocMem(n) ;
ListBox.Items.Add
(StringPad('Size',' ',20,True)+' = '+IntToStr(n)) ;
GetFileVersionInfo(PChar(S),0,n,Buf) ;
For j:=1 To InfoNum Do Begin
If VerQueryValue(Buf,PChar('StringFileInfo\040904E4\'+
InfoStr[j]),Pointer(Value),Len) Then
Begin
Value := PChar(Trim(Value)) ;
If Length(Value) > 0 Then
Begin
ListBox.Items.Add
(StringPad(labelStr,' ',20,True)+' = '+Value) ;
End;
End;
End;
FreeMem(Buf,n) ;
End
Else Begin
ListBox.Items.Add
('No FileVersionInfo found') ;
End;
Result := True;
Except
Result := False;
End;
End;
procedure TForm1.Button1Click(Sender: TObject) ;原文名称:Are we connected to the Internet?
function FuncAvail(_dllname, _funcname: string;
var _p: pointer): boolean;
{return True if _funcname exists in _dllname}
var _lib: tHandle;
begin
Result := false;
if LoadLibrary(PChar(_dllname)) = 0 then exit;
_lib := GetModuleHandle(PChar(_dllname)) ;
if _lib <> 0 then begin
_p := GetProcAddress(_lib, PChar(_funcname)) ;
if _p <> NIL then Result := true;
end;
end;
{
Call SHELL32.DLL for Win < Win98
otherwise call URL.dll
}
{button code:}
var
InetIsOffline : function(dwFlags: DWORD):
BOOL; stdcall;
begin
if FuncAvail('URL.DLL', 'InetIsOffline',
@InetIsOffline) then
if InetIsOffLine(0) = true
then ShowMessage('Not connected')
else ShowMessage('Connected!') ;
end;
{First load it in the OnCreate event of a form):原文名称:Use TTF without Installing
procedure TForm1.FormCreate(Sender: TObject) ;
begin
AddFontResource('c:\FONTS\MyFont.TTF') ;
SendMessage(HWND_BROADCAST, WM_FONTCHANGE, 0, 0) ;
end;
{Before application terminates we must free it:}
procedure TForm1.FormClose
(Sender: TObject; var Action: TCloseAction) ;
begin
RemoveFontResource('C:\FONTS\MyFont.TTF') ;
SendMessage(HWND_BROADCAST, WM_FONTCHANGE, 0, 0) ;
end;
type
TWin32Version = (wvUnknown,
wvWin95,
wvWin98,
wvWinNT,
wvWin2000) ;
function GetWinVersion: TWin32Version;
begin
Result := wvUnknown;
if Win32Platform = VER_PLATFORM_WIN32_WINDOWS then
if (Win32MajorVersion > 4) or
((Win32MajorVersion = 4) and
(Win32MinorVersion > 0)) then
Result := wvWin98
else
Result := wvWin95
else
if Win32MajorVersion <= 4 then
Result := wvWinNT
else
if Win32MajorVersion = 5 then
Result := wvWin2000
end;
uses CommCtrl, ...原文名称:How to Change the Colors of the TProgressBar
...
// Set Background color
ProgressBar1.Brush.Color := clRed;
// Set Bar color
SendMessage(ProgressBar1.Handle, PBM_SETBARCOLOR, 0, clBlue) ;
...
public
procedure WMSysCommand
(var Msg: TWMSysCommand) ;
message WM_SYSCOMMAND;
...
implementation
...
procedure TForm1.WMSysCommand;
begin
if (Msg.CmdType = SC_MINIMIZE) or
(Msg.CmdType = SC_MAXIMIZE) then
MessageBeep(0) ;
DefaultHandler(Msg) ;
end;
procedure TForm1.FormCreate(Sender: TObject) ;
begin
SetWindowLong( Handle,
GWL_STYLE,
GetWindowLong( Handle, GWL_STYLE )
and not WS_CAPTION ) ;
ClientHeight := Height;
end;
var这儿是 XML 结果:
sl : TStringList;
xmlDoc : TXMLDocument;
iNode : IXMLNode;
begin
xmlDoc := TXMLDocument.Create(nil) ;
try
xmlDoc.Active := true;
iNode := xmlDoc.AddChild('leaf') ;
iNode.Attributes['attrib1'] := 'value1';
iNode.Text := 'Node Text';
sl := TStringList.Create;
try
sl.Assign(xmlDoc.XML) ;
sl.Insert(0,'<!DOCTYPE ns:mys SYSTEM "myXML.dtd">') ;
sl.Insert(0,'<?xml version="1.0"?>') ;
sl.SaveToFile('c:\Test.xml') ;
finally
sl.Free;
end;
finally
xmlDoc := nil;
end;
end;
<?xml version="1.0"?>原文名称:How to Create the !DocType and ?XML Elements using TXmlDocument Delphi component
<!DOCTYPE ns:mys SYSTEM "myXML.dtd">
<leaf attrib1="value1">Node Text</leaf>
{Disable:}原文名称:Enable/Disable Desktop icons
EnableWindow(FindWindowEx(FindWindow('Progman', nil), HWND(0), 'ShellDll_DefView', nil), FALSE) ;
{Enable:}
EnableWindow(FindWindowEx(FindWindow('Progman', nil), HWND(0), 'ShellDll_DefView', nil), TRUE) ;
REdit.Perform(EM_LINEFROMCHAR, REdit.SelStart, 0);以上语句将返回行号。同样有一个 Windows 消息(EM_CHARFROMPOS)返回屏幕指标坐标所在的字符位置。查看 Windows 帮助文件可获得此方面的更多信息。注意,这些功能都十分缓慢,不应该在频繁调用的循环内部使用。