Delphi实现透明窗体
unit unitMain;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls;
type
TForm1 = class(TForm)
Button1: TButton;
Button2: TButton;
Button3: TButton;
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure Button3Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
private
{ Private declarations }
procedure WMGetMinMaxInfo(var msg: TWMGetMinMaxInfo); message WM_GETMINMAXINFO;
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
procedure TForm1.FormCreate(Sender: TObject);
var
FullRgn, ClientRgn, ButtonRgn: THandle;
Margin, X, Y: Integer;
begin
Margin := (Width - ClientWidth) div 2;
FullRgn := CreateRectRgn(0, 0, Width, Height);
X := Margin;
Y := Height - ClientHeight - Margin;
ClientRgn := CreateRectRgn(X, Y, X + ClientWidth, Y + ClientHeight);
CombineRgn(FullRgn, FullRgn, ClientRgn, RGN_DIFF);
X := X + Button1.Left;
Y := Y + Button1.Top;
ButtonRgn := CreateRectRgn(X, Y, X + Button1.Width, Y + Button1.Height);
CombineRgn(FullRgn, FullRgn, ButtonRgn, RGN_OR);
SetWindowRgn(Handle, FullRgn, True);
end;
procedure TForm1.Button1Click(Sender: TObject);
var
lf : TLogFont;
tf : TFont;
begin
with Form1.Canvas do
begin
Font.Name := 'Arial';
Font.Size := 24;
tf := TFont.Create;
try
tf.Assign(Font) ;
GetObject(tf.Handle, sizeof(lf), @lf) ;
lf.lfEscapement := 450;
lf.lfOrientation := 450;
tf.Handle := CreateFontIndirect(lf) ;
Font.Assign(tf) ;
finally
tf.Free;
end;
TextOut(20, Height div 2, 'Rotated Text!') ;
end;
end;
procedure TForm1.WMGetMinMaxInfo(var msg: TWMGetMinMaxInfo);
begin
inherited;
with msg.MinMaxInfo^.ptMaxTrackSize do
begin
X := GetDeviceCaps(Canvas.Handle, HORZRES)
相关文档：
使用Delphi调用WebServices接口的简单应用实例
Delphi从6.0就开始支持Web Services的开发和应用了，本文通过使用Delphi 7.0调用新浪发送短信的Web Service进行短信应用程序开发这一实例详细的介绍在Delphi中如何开发基于Web Services的应用系统。
第一步，准备工作，了解新浪短信Web Service。新浪发送短信的Web Service� ......
function GetFileSizeString(const pFileName: String):String;
var
iFileSize: Int64;
begin
Result := '0';
iFileSize := FileSizeByName(pFileName);
Result := IntToStr(iFileSize);
end;
function WinExecAndWait(strFileName: string; uCmdShow: UINT): DWORD;
var
cAppName: array ......
unit DvsLinkingClass;
interface
uses
Windows, Messages, SysUtils, Classes, Controls, Forms, Dialogs;
type
PRecLinkNode = ^RecLinkNode;
RecLinkNode = record
NodeMsg: String;
Counter: Integer;
Previous: PRecLinkNode;
Next: PRecLinkNode;
end;
TLinkingClass = class
......
Rem Delete Delphi temporary file
Rem ****************************
@echo Delete Delphi temporary file
@dir/w/s *.~*
@echo 以上为当前目录及子目录临时文件,请按任意键确认删除!
@pause
@for /r . %%a in (.) do @if exist "%%a\*.~*" del "%%a\*.~*"
@echo 删除成功!
@pause
Rem ************************* ......
