The GDI plus TextureBrush renders The brush from the origin of the Graphics canvas that it is drawing to, so if you fill a rectange with a textured brush starting at 10,10 then the brush appears offset.
To ensure the top left corner of the image you have used in your texture brush starts at the same place onthe rectangle you are filling we need to set the brushes translation Transformation to the top left corner of the rectange to fill.
e.g
ABrush := TGPTextureBrush.Create(AImage,WrapModeTile);
ABrush.TranslateTransform(x,y);
AGraphics.FillRectangle(ABrush,x,y,width,height);
ABrush.free;
Tag: Delphi
In the create of the Form, set the form and the page controls DoubleBuffered to True.
DoubleBuffered := True;
Pages.DoubleBuffered := True;
It is possible to hide the applications mainform from the taskbar or put other forms in your application on the task bar by simply changing the create params as the form is constructed.
Override the Form’s CreateParams and add one of the following to either remove or add to the taskbar
to Show in the taskbar
procedure TForm.CreateParams(var Params: TCreateParams);
begin
ExStyle := ExStyle or WS_EX_APPWINDOW;
end;
to remove from the taskbar
procedure TForm.CreateParams(var Params: TCreateParams);
begin
ExStyle := ExStyle and not WS_EX_APPWINDOW;
end;
So, you’re changing your packages and splitting them up nicely into a runtime and design time package. You create a new Component Registration unit and add a register procedure, compile it all up and the register procedure never gets called and the components are not registered……
Oh, how many times has this happened to me ?
I finally worked out what was wrong. Not being a copy and paste guy, I typed in the register procedure and didn’t capitalise the ‘R’. Therefore the entry point to the DLL is never found ! Oh those case-sensitive C programmers have a lot to answer for.
Please ensure the procedure Register is the correct case 🙂
The WM_SYSCOMMAND Message gives us various options for manipulating windows and replicating user input, but there are some undocumented parameters that are very useful.
The MSDN Documentation provides various usefull valid parameters that can be passed in the WParam of the message.
These are as follows:
- SC_CLOSE – Closes the window.
- SC_CONTEXTHELP – Changes the cursor to a question mark with a pointer. If the user then clicks a control in the dialog box, the control receives a WM_HELP message.
- SC_DEFAULT – Selects the default item; the user double-clicked the window menu.
- SC_HOTKEY – Activates the window associated with the application-specified hot key. The lParam parameter identifies the window to activate.
- SC_HSCROLL – Scrolls horizontally.
- SC_KEYMENU – Retrieves the window menu as a result of a keystroke. For more information, see the Remarks section.
- SC_MAXIMIZE – Maximizes the window.
- SC_MINIMIZE – Minimizes the window.
- SC_MONITORPOWER – Sets the state of the display. This command supports devices that have power-saving features, such as a battery-powered personal computer.
The lParam parameter can have the following values:
1 – the display is going to low power
2 – the display is being shut off - SC_MOUSEMENU – Retrieves the window menu as a result of a mouse click.
- SC_MOVE – Moves the window.
- SC_NEXTWINDOW – Moves to the next window.
- SC_PREVWINDOW – Moves to the previous window.
- SC_RESTORE – Restores the window to its normal position and size.
- SC_SCREENSAVE – Executes the screen saver application specified in the [boot] section of the System.ini file.
- SC_SIZE – Sizes the window.
- SC_TASKLIST – Activates the Start menu.
- SC_VSCROLL – Scrolls vertically.
In addition there are some undocumented constants that can be used as well.
- SC_DragMove = $F012;
Will start a Drag operation to move the window. This is similar tot he effect you get when you drag the caption of a winodw, however using this in the mouse down on a form, instantly gives you a form that can be dragged by clicking anywhere. - SC_DRAGSIZE_N = $F003;
Starts a resize operation on the top edge of the form. The window then supports either keyboard or mouse resizing. - SC_DRAGSIZE_S = $F006;
Starts a resize operation on the bottom edge of the form. The window then supports either keyboard or mouse resizing. - SC_DRAGSIZE_E = $F002;
Starts a resize operation on the right edge of the form. The window then supports either keyboard or mouse resizing. - SC_DRAGSIZE_W = $F001;
Starts a resize operation on the left edge of the form. The window then supports either keyboard or mouse resizing. - SC_DRAGSIZE_NW = $F004;
Starts a resize operation on the Top left corner of the form. The window then supports either keyboard or mouse resizing. - SC_DRAGSIZE_NE = $F005;
Starts a resize operation on the top right corner of the form. The window then supports either keyboard or mouse resizing. - SC_DRAGSIZE_SW = $F007;
Starts a resize operation on the bottom left corner of the form. The window then supports either keyboard or mouse resizing. - SC_DRAGSIZE_SE = $F008;
Starts a resize operation on the bottom right corner of the form. The window then supports either keyboard or mouse resizing.
To use these constants we simply send a perform message to the window we wish to work with.
e.g.
AFormMouseDown(…)
begin
ReleaseCapture; // releases the capture of mouse events for this form
Perform(WM_SYSCOMMAND,SC_DragMove,0); // send the drag move message
end;
It is important to use the release capture method to tell windows not to send the mouse messages to the form that has just received the mouse down.
So, you're changing your packages and splitting them up nicely into a runtime and
design time package. You create a new Component Registration unit and add
a register procedure, compile it all up and the register procedure never gets called
and the components are not registered……
Oh, how many times has this happened to me ?
I finally worked out what was wrong. Not being a copy and paste guy, I typed
in the register procedure and didn't capitalise the 'R'. Therefore the entry
point to the DLL is never found ! Oh those case-sensitive C programmers have
a lot to answer for.
Please ensure the procedure Register is the correct case 🙂
The following code provides a routine for combining an image and a mask image into
an image with Alpha information.
The routine uses the GDI+ bitmap's Lockbits method to provide fast access to the
image data.
This routine is available in the GDIPExtensions unit which is part of GDI+ Controls.
function CombineImageMask(Bitmap: TGPBitmap; Mask: TGPBitmap; var AlphaRGBImage: TGPBitmap): boolean; var w, h: cardinal; x, y: cardinal; obmd: TBitmapData; bbmd: TBitmapData; mbmd: TBitmapData; r: TGPRect; oImageStart: PByteArray; opixelpos: integer; oPixel: pARGB; bImageStart : PByteArray; bpixelpos: integer; bPixel: pARGB; mImageStart: PByteArray; mpixelpos : integer; mPixel: pARGB; alphalevel: cardinal; begin AlphaRGBImage := nil; if not assigned(Bitmap) then raise EImageProcessError.create('No Bitmap assigned'); if not assigned(Mask) then raise EImageProcessError.create('No Mask assigned'); if (Bitmap.GetWidth = 0) or (Bitmap.GetHeight = 0) then raise EImageProcessError.create('Height and width of image must be greater than zero'); if (Bitmap.GetWidth <> Mask.GetWidth) or (Bitmap.GetHeight <> Mask.GetWidth) then raise EImageProcessError.create('The hieght and width of both the image and mask should be the same'); w := Bitmap.GetWidth; h := Bitmap.GetHeight; AlphaRGBImage := TGPBitmap.Create(w, h, PixelFormat32bppARGB); r := MakeRect(0, 0, integer(w), integer(h)); bitmap.LockBits(r, ImageLockModeRead, PixelFormat32bppRGB, bbmd); mask.LockBits(r, ImageLockModeRead, PixelFormat32bppRGB, mbmd); AlphaRGBImage.LockBits(r, ImageLockModeWrite, PixelFormat32bppARGB, obmd); bImageStart := bbmd.Scan0; mImageStart := mbmd.Scan0; oImageStart := obmd.Scan0; for y := 0 to obmd.Height - 1 do begin for x := 0 to obmd.Width - 1 do begin opixelpos := (y * cardinal(obmd.Stride)) + (x * 4); oPixel := @oImageStart[oPixelPos]; bpixelpos := (y * cardinal(bbmd.Stride)) + (x * 4); bPixel := @bImageStart[bPixelPos]; mpixelpos := (y * cardinal(mbmd.Stride)) + (x * 4); mPixel := @mImageStart[mPixelPos]; oPixel^ := bPixel^ and not ALPHA_MASK; // copy rgb across alphalevel := (((mpixel^ and $FF0000) shr 16) + ((mpixel^ and $00FF00) shr 8) + (mpixel^ and $0000FF)) div 3; oPixel^ := ((alphalevel and $FF) shl ALPHA_SHIFT) or oPixel^; end; end; AlphaRGBImage.UnlockBits(obmd); bitmap.UnlockBits(bbmd); mask.UnlockBits(mbmd); result := true; end;
The following code provides a routine for fading out an area of an image.
The routine uses the GDI+ bitmap's Lockbits method to provide fast access to the
image data.
It takes an Image and a Rectangle to fade out as parameters, A Fade Direction which
can be up, down, left or right and a fade type. Currently this is can only
be linear, but alternative fade types could be implemented for example to provide
a circular fade.
This routine is available in the GDIPExtensions unit which is part of GDI+ Controls.
type TFadeDirection = (fdUp, fdDown, fdLeft, fdRight); TFadeType = (ftLinear); EImageProcessError = exception; function FadeOut(Image : TGPBitmap; ARect :TGPRect; Direction : TFadeDirection; FadeType : TFadeType) : boolean; var x,y : integer; bmd : TBitmapData; ImageStart : integer; pixelpos : integer; Pixel : pARGB; AlphaChange : Double; CurrentAlpha, NewAlpha : Cardinal; begin if not assigned(Image) then raise EImageProcessError.create('No Image assigned'); if (Image.GetWidth = 0) or (Image.GetHeight = 0) then raise EImageProcessError.create('Height and width of image must be greater than zero'); if (Arect.Width = 0) or (ARect.Height = 0) then raise EImageProcessError.create('Height and width of Rectangle must be greater than zero'); Image.LockBits(Arect, ImageLockModeWrite, PixelFormat32bppARGB, bmd); assert(bmd.PixelFormat = PixelFormat32bppARGB); ImageStart := integer(bmd.Scan0); for y := 0 to bmd.Height do begin AlphaChange := 1; case FadeType of ftLinear : begin case Direction of fdDown : AlphaChange := 1-(y + 1) / ARect.Height; fdUp : AlphaChange := (y + 1) / ARect.Height; end; end; end; for x := 0 to bmd.Width do begin case FadeType of ftLinear : begin case Direction of fdLeft : AlphaChange := (x + 1) / ARect.Width; fdRight : AlphaChange := 1-(x + 1) / ARect.Width; end; end; end; Pixel := pARGB(ptr(ImageStart + (y * bmd.stride) +(x*4))); CurrentAlpha := (Pixel^ and ALPHA_MASK) shr ALPHA_SHIFT; NewAlpha := trunc(CurrentAlpha * AlphaChange); Pixel^ := (NewAlpha shl ALPHA_SHIFT) or (Pixel^ and not ALPHA_MASK); end; end; Image.UnlockBits(bmd); result := true; end;
This article was posted on Delphi 3000, and looked
so usefull for future reference I thought I'd post a copy.
Please note this article was authored by Mike Heydon
(mheydon at pgbison.co.za).
n article #4388 Radikal Q3 demonstrates how to set
the IP Address,Subnet and Gateway of a network card by EXECUTING NETSH.EXE with
parameters. This example shows how to do it via the WMI API OLE Classes. If IP ADDRESS
is NULLSTR or 'DHCP' then the IP Address is set by DHCP else a STATIC IP Address
is set.
Parameters are ..
AIpAddress – If Null String or 'DHCP' then DHCP is ENABLED else STATIC
IP is set.
AGateWay – [Optional] If Omitted then GATEWAY is left unchanged.
SubnetMask – [Optional] If Omited then default = '255.255.255.0'.
Examples
if SetIpConfig('196.11.175.221') = 0 then … // Set STATIC IP
if SetIpConfig('') = 0 then .. // Set to DHCP
if SetupConfig('dhcp') = 0 then … // Same as above
if SetIpConfig('196.11.175.221','196.11.175.1') = 0 then .. // STATIC + GATEWAY
**** THERE IS HOWEVER ONE PROBLEM I HAVE ******
**** AND HOPE SOMEONE OUT THERE CAN HELP ******
When setting the adapter to DHCP ALL Mapped drives and printers work correctly as
expected.
When setting the adapter to STATIC IP, the IP changes successfully but any mapped
devices (drives,printers etc.) won't work. Trying to access a mapped drives gives
error saying the "local device is already in use'. I don't know if you have to call
some sort of network mapping refresh call or something to notify that a static IP
address has changed ? Anyone out there have any ideas ?
Also shown is SetDnsServers() whereby the DNS Primary and Alternate Servsers may
be specified. If the function is called with Null String for APrimaryDNS then the
DNS list is cleared.
There are many things you can do once you get the oNetAdapter Object.
See
http://msdn.microsoft.com/library/default.asp?url=/library/en-us/wmisdk/wmi/wmi_tasks__networking.asp
for the help on the SDK.
uses ComObj, ActiveX, UrlMon; // ====================================================================== // SetIpConfig() // Set IPAddress, Gateway and Subnetmask via WMI // Arguments ... // AIpAddress - If Null String or 'DHCP' then DHCP is ENABLED // else STATIC IP is set. // AGateWay - [Optional] If Omitted then GATEWAY is left unchanged. // SubnetMask - [Optional] If Omited then default = '255.255.255.0'. // // SetDnsServers() // Set DNS Servers via WMI // Arguments ... // APrimaryDNS - If Null String then DNS Server List is CLEARED. // AAlternateDNS - [Optional] // // Return Values ... // 0 Successful completion, no reboot required. // 1 Successful completion, reboot required. // -1 Unknown OLE Error // 64 Method not supported on this platform. // 65 Unknown failure. // 66 Invalid subnet mask. // 67 An error occurred while processing an instance that was returned. // 68 Invalid input parameter. // 69 More than five gateways specified. // 70 Invalid IP address. // 71 Invalid gateway IP address. // 72 An error occurred while accessing the registry for the info. // 73 Invalid domain name. // 74 Invalid host name. // 75 No primary or secondary WINS server defined. // 76 Invalid file. // 77 Invalid system path. // 78 File copy failed. // 79 Invalid security parameter. // 80 Unable to configure TCP/IP service. // 81 Unable to configure DHCP service. // 82 Unable to renew DHCP lease. // 83 Unable to release DHCP lease. // 84 IP not enabled on adapter. // 85 IPX not enabled on adapter. // 86 Frame/network number bounds error. // 87 Invalid frame type. // 88 Invalid network number. // 89 Duplicate network number. // 90 Parameter out of bounds. // 91 Access denied. // 92 Out of memory. // 93 Already exists. // 94 Path, file, or object not found. // 95 Unable to notify service. // 96 Unable to notify DNS service. // 97 Interface not configurable. // 98 Not all DHCP leases could be released or renewed. // 100 DHCP not enabled on adapter. // ====================================================================== // ================================================================== // IP Address,Gateway and Subnet Mask // EnableStatic takes array of string as a parameter // for the Addresses. You may wish to rewrite this using // array of string as parameter for multiple IP Addresses. // I only have use for 1 IP address and Gateway in our application // but it's nice to be able to expand it for other users. // ================================================================== function SetIpConfig(const AIpAddress : string; const AGateWay : string = ''; const ASubnetMask : string = '') : integer; var Retvar : integer; oBindObj : IDispatch; oNetAdapters,oNetAdapter, oIpAddress,oGateWay, oWMIService,oSubnetMask : OleVariant; i,iValue : longword; oEnum : IEnumvariant; oCtx : IBindCtx; oMk : IMoniker; sFileObj : widestring; begin Retvar := 0; sFileObj := 'winmgmts:.rootcimv2'; // Create OLE [IN} Parameters oIpAddress := VarArrayCreate([1,1],varOleStr); oIpAddress[1] := AIpAddress; oGateWay := VarArrayCreate([1,1],varOleStr); oGateWay[1] := AGateWay; oSubnetMask := VarArrayCreate([1,1],varOleStr); if ASubnetMask = '' then oSubnetMask[1] := '255.255.255.0' else oSubnetMask[1] := ASubnetMask; // Connect to WMI - Emulate API GetObject() OleCheck(CreateBindCtx(0,oCtx)); OleCheck(MkParseDisplayNameEx(oCtx,PWideChar(sFileObj),i,oMk)); OleCheck(oMk.BindToObject(oCtx,nil,IUnknown,oBindObj)); oWMIService := oBindObj; oNetAdapters := oWMIService.ExecQuery('Select * from ' + 'Win32_NetworkAdapterConfiguration ' + 'where IPEnabled=TRUE'); oEnum := IUnknown(oNetAdapters._NewEnum) as IEnumVariant; while oEnum.Next(1,oNetAdapter,iValue) = 0 do begin try // Set by DHCP ? (Gateway and Subnet ignored) if (AIpAddress = '') or SameText(AIpAddress,'DHCP') then Retvar := oNetAdapter.EnableDHCP // Set via STATIC ? else begin Retvar := oNetAdapter.EnableStatic(oIpAddress,oSubnetMask); // Change Gateway ? if (Retvar = 0) and (AGateWay <> '') then Retvar := oNetAdapter.SetGateways(oGateway); // *** This is where we need some sort of *** // *** Network Mapped Resource Refresh *** end; except Retvar := -1; end; oNetAdapter := Unassigned; end; oGateWay := Unassigned; oSubnetMask := Unassigned; oIpAddress := Unassigned; oNetAdapters := Unassigned; oWMIService := Unassigned; Result := Retvar; end; // ==================================================== // Set DNS Servers // Instead of Primary and Alternate you may wish // to rewrite this using array of string as the // parameters as SetDNSServerSearchOrder will take // a list of many DNS addresses. I only have use for // Primary and Alternate. // ==================================================== function SetDnsServers(const APrimaryDNS : string; const AAlternateDNS : string = '') : integer; var Retvar : integer; oBindObj : IDispatch; oNetAdapters,oNetAdapter, oDnsAddr,oWMIService : OleVariant; i,iValue,iSize : longword; oEnum : IEnumvariant; oCtx : IBindCtx; oMk : IMoniker; sFileObj : widestring; begin Retvar := 0; sFileObj := 'winmgmts:.rootcimv2'; iSize := 0; if APrimaryDNS <> '' then inc(iSize); if AAlternateDNS <> '' then inc(iSize); // Create OLE [IN} Parameters if iSize > 0 then begin oDnsAddr := VarArrayCreate([1,iSize],varOleStr); oDnsAddr[1] := APrimaryDNS; if iSize > 1 then oDnsAddr[2] := AAlternateDNS; end; // Connect to WMI - Emulate API GetObject() OleCheck(CreateBindCtx(0,oCtx)); OleCheck(MkParseDisplayNameEx(oCtx,PWideChar(sFileObj),i,oMk)); OleCheck(oMk.BindToObject(oCtx,nil,IUnknown,oBindObj)); oWMIService := oBindObj; oNetAdapters := oWMIService.ExecQuery('Select * from ' + 'Win32_NetworkAdapterConfiguration ' + 'where IPEnabled=TRUE'); oEnum := IUnknown(oNetAdapters._NewEnum) as IEnumVariant; while oEnum.Next(1,oNetAdapter,iValue) = 0 do begin try if iSize > 0 then Retvar := oNetAdapter.SetDNSServerSearchOrder(oDnsAddr) else Retvar := oNetAdapter.SetDNSServerSearchOrder(); except Retvar := -1; end; oNetAdapter := Unassigned; end; oDnsAddr := Unassigned; oNetAdapters := Unassigned; oWMIService := Unassigned; Result := Retvar; end; (* ---------------------------------------------------- See the Miscrosoft MSDN Documentation for the Win32_NetworkAdapterConfiguration Class (implemented as oNetAdatper in my examples), There are many more calls besides EnableStatic, EnableDHCP and SetDNBSServerSearchOrder. Some of them are ... DisableIPSec EnableDHCP EnableDNS EnableIPFilterSec EnableIPSec EnableStatic EnableWINS ReleaseDHCPLease ReleaseDHCPLeaseAll RenewDHCPLease RenewDHCPLeaseAll SetArpAlwaysSourceRoute SetArpUseEtherSNAP SetDatabasePath SetDeadGWDetect SetDefaultTTL SetDNSDomain SetDNSServerSearchOrder SetDNSSuffixSearchOrder SetDynamicDNSRegistration SetForwardBufferMemory Specifies SetGateways SetIGMPLevel SetIPConnectionMetric SetIPUseZeroBroadcast SetIPXFrameTypeNetworkPairs SetIPXVirtualNetworkNumber SetKeepAliveInterval SetKeepAliveTime SetNumForwardPackets SetPMTUBHDetect SetPMTUDiscovery SetTcpipNetbios SetTcpMaxConnectRetransmissions SetTcpMaxDataRetransmissions SetTcpNumConnections SetTcpUseRFC1122UrgentPointer SetTcpWindowSize SetWINSServer ------------------------------------------------ *)
If you want to add html pages or images to your dll
or exe in delphi it is a simple matter of adding the pages as resources. This article
covers adding html and image files to the resource, and how to pass infromation
to the html file to make it a bit more dynamic.
Stage 1) How do we add an image or
html document to a exe or dll.
Create a file in the project directory (e.g. called MyProjectRes.rc). The easiest
application to create this in is notepad, you can create it in delphi, but make
sure the extension is .rc.
Choose Project->Add To Project… then change the Files of Type to Resource File
(*.rc), select the .rc file (e.g. MyProjectRes.rc) and choose Open.
In the RC file we can add lines that define the resource to include. These are of
the format :
[Resource Name][Space or Tab][Resource Type][Space or Tab][Filename of resource]
e.g
PICTURE1 GIF ".ImagesMyImage.gif"
Delphi should have automatically added a line into the project source (e.g.
{$R 'HTMLResources.res' 'HTMLResources.rc'}) so when the project is built it will
automatically compile the Resource script file (.rc) into a resource *.res.
You can now access these resources in code by using a TResourceStream or TBitmap.LoadFromResource
for example.
Stage 2) Specifying HTML resources and images.
If we used the above example of a resource (PICTURE1 GIF ".ImagesMyImage.gif")
then we can reference the resource via Internet Explorer as the URL
res://c:program%20filesmydll.dll/GIF/PICTURE1
The Url starts with the res:// followed by the path to the dll or exe with the resource
(using backslash not forward slash) then /[Resource Type]/[Resource Name]
If you wish to add a resource that can be accessed directly with out the need to
specify the Resource Type portion of the URL then you can add it as follows :
Name 2110 DISCARDABLE "path to file"
The type 2110 allows the resource to be referenced at the root of the url e.g.
res://c:program%20filesmydll.dll/Name
The discardable option means that if windows needs memory then this resource can
be release and only reloaded when needed.
Stage 3) Creating a dynamic HTML resource
It is possible, to use the querystring part of a URL to send parameters or information
to the HTML resource. To do this we use a bit of java script to extract the querystring
from the URL.
e.g. I created this Javascript function to extract text between # and ##
function Homepage(){
DocURL=document.location.href;
BeginInfo=DocURL.indexOf("#")+1;
EndInfo=DocURL.indexOf("##");
urlresult=DocURL.substring(BeginInfo,EndInfo);
document.write('' + unescape(urlresult) + "");
}
This is simply called a the the appropriate point to insert the querystring text
there.
Homepage();
I can the use a resource like res://c:program%20filesmydll.dll/error#My Message
to display##
Note in the JavaScript function the use of unesacpe to remove the %20 that IE puts
in instead of the spaces.
Images and other resources can be referenced as relative paths from the dll resource.
e.g
<img xsrc="GIF/ImageUnderGIFType" width="50" height="45"
or
<img xsrc="GIFAtRoot" width="50" height="45">