pistacer
asked on
application with "sin"
i want do write aplik., wich can be changed thru skins.
I have an solution in VB, but i first would see, if there isnt an easier delphi way.
so i ncluded in my project this:
...
public
...
procedure WMEraseBkgnd(var Message: TWMEraseBkgnd); message wm_EraseBkgnd;
...
end;
...
procedure T_Form1.WMEraseBkgnd(var Message: TWMEraseBkgnd);
var
cs:TCanvas;
bm:tbitmap;
dr,sr:TRect;
begin
bm:= tbitmap.Create;
bm.LoadFromFile('K:\AVS\PR OJEKTY\DEL PHI\calc32 \kalkulack a.bmp');
cs:= TCanvas.Create;
dr := Rect(1,1,350,350);
sr:= Rect(1,1,350,350);
try
cs.handle:= Message.dc;
try
cs.BrushCopy(dr,bm,sr,clbl ack);
// cs.BrushCopy(dr,bm,sr,clwh ite);
finally
cs.handle:=0
end;
finally
cs.Free;
bm.Free;
end;
end;
and there are my problems:
- can i change the shape of the form? to an "not defioned rounded-bizarre-any shape"? (circle, elipse, rounded polygon ...)
- in the form, there can be any "glass" areas (uyou understand what i mean :-)))). i thoughr, that putting black collor in the picture on this areas and specifying clblack in brushcopy function will solve this, but no ...
- is there any way to change the color of an Tbutton object? (if not, i perhabs need to put insteed of each button two images and that could be BIG.)
I have an solution in VB, but i first would see, if there isnt an easier delphi way.
so i ncluded in my project this:
...
public
...
procedure WMEraseBkgnd(var Message: TWMEraseBkgnd); message wm_EraseBkgnd;
...
end;
...
procedure T_Form1.WMEraseBkgnd(var Message: TWMEraseBkgnd);
var
cs:TCanvas;
bm:tbitmap;
dr,sr:TRect;
begin
bm:= tbitmap.Create;
bm.LoadFromFile('K:\AVS\PR
cs:= TCanvas.Create;
dr := Rect(1,1,350,350);
sr:= Rect(1,1,350,350);
try
cs.handle:= Message.dc;
try
cs.BrushCopy(dr,bm,sr,clbl
// cs.BrushCopy(dr,bm,sr,clwh
finally
cs.handle:=0
end;
finally
cs.Free;
bm.Free;
end;
end;
and there are my problems:
- can i change the shape of the form? to an "not defioned rounded-bizarre-any shape"? (circle, elipse, rounded polygon ...)
- in the form, there can be any "glass" areas (uyou understand what i mean :-)))). i thoughr, that putting black collor in the picture on this areas and specifying clblack in brushcopy function will solve this, but no ...
- is there any way to change the color of an Tbutton object? (if not, i perhabs need to put insteed of each button two images and that could be BIG.)
The following example assumes you've got a form with a panel on it.
For the first two questions you'd be interested in the region functions, the example demonstrates that.
For the third, well, you can't. TButton color is a global constant. i suppose you could subclass the button & do all your own drawing, but it would be a lot easier to either get a TButton replacement that supports custom colors, or try a TPanel hack like I've done.
Note, you may have to play with the position of your panel so that it's still visible after the form's been 'Cut up'.
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, ExtCtrls, Buttons, StdCtrls;
type
TForm1 = class(TForm)
Panel1: TPanel;
procedure FormCreate(Sender: TObject);
procedure FormKeyPress(Sender: TObject; var Key: Char);
procedure Panel1MouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure Panel1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
procedure TForm1.FormCreate(Sender: TObject);
var
rgn : HRGN;
begin
rgn := createEllipticRgn(0,0,widt h,height);
combineRgn(
rgn,
rgn,
createRoundRectRgn(
width div 4,
height div 4,
width - (width div 4),
height - (height div 4),
width div 20,
height div 20),
RGN_DIFF);
setWindowRgn(handle,rgn,tr ue);
deleteObject(rgn);
end;
procedure TForm1.FormKeyPress(Sender : TObject; var Key: Char);
begin
application.terminate;
end;
procedure TForm1.Panel1MouseUp(Sende r: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
panel1.BevelInner := bvRaised;
panel1.BevelOuter := bvRaised;
end;
procedure TForm1.Panel1MouseDown(Sen der: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
panel1.BevelInner := bvLowered;
panel1.BevelInner := bvLowered;
end;
end.
GL
Mike
For the first two questions you'd be interested in the region functions, the example demonstrates that.
For the third, well, you can't. TButton color is a global constant. i suppose you could subclass the button & do all your own drawing, but it would be a lot easier to either get a TButton replacement that supports custom colors, or try a TPanel hack like I've done.
Note, you may have to play with the position of your panel so that it's still visible after the form's been 'Cut up'.
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, ExtCtrls, Buttons, StdCtrls;
type
TForm1 = class(TForm)
Panel1: TPanel;
procedure FormCreate(Sender: TObject);
procedure FormKeyPress(Sender: TObject; var Key: Char);
procedure Panel1MouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure Panel1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
procedure TForm1.FormCreate(Sender: TObject);
var
rgn : HRGN;
begin
rgn := createEllipticRgn(0,0,widt
combineRgn(
rgn,
rgn,
createRoundRectRgn(
width div 4,
height div 4,
width - (width div 4),
height - (height div 4),
width div 20,
height div 20),
RGN_DIFF);
setWindowRgn(handle,rgn,tr
deleteObject(rgn);
end;
procedure TForm1.FormKeyPress(Sender
begin
application.terminate;
end;
procedure TForm1.Panel1MouseUp(Sende
Shift: TShiftState; X, Y: Integer);
begin
panel1.BevelInner := bvRaised;
panel1.BevelOuter := bvRaised;
end;
procedure TForm1.Panel1MouseDown(Sen
Shift: TShiftState; X, Y: Integer);
begin
panel1.BevelInner := bvLowered;
panel1.BevelInner := bvLowered;
end;
end.
GL
Mike
hello pistacer, there are several ways to change the color of a button, depending on the button type (TButton, TSpeedButton, TBitButton), a way that I use is to use a bitmap the size of your button and assign that bitmap to the Glyph of that SpeedButton, There can be No Caption in the Object Inspector and the Caption you want has to be drawn on the bitmap.
I have some other ways if you are interested
And edey , it Win32 API help suggests that you do not deleteObject(rgn); until your app is finished using it , so you might put that in TForm1.FormDestroy(Sender: TObject); instead
I have some other ways if you are interested
And edey , it Win32 API help suggests that you do not deleteObject(rgn); until your app is finished using it , so you might put that in TForm1.FormDestroy(Sender:
I looked at your
procedure T_Form1.WMEraseBkgnd(var Message: TWMEraseBkgnd);
And you load the bitmap every time the background is drawn? seems ineffecient when you can just create and load it once.
here is some code I hav used to do that
private
{ Private declarations }
Backgnd1: TBitmap;
procedure WMEraseBkgnd (var Msg : TMessage); message WM_ERASEBKGND;
procedure TAbout.FormCreate(Sender: TObject);
begin
Backgnd1 := TBitmap.Create;
{Backgnd1 is the Form's Background}
Backgnd1.LoadFromResourceN ame(hInsta nce,'BACKG ND');
end;
procedure T_Form1.WMEraseBkGnd(var Msg : TMessage);
begin
{it seems like many delphi users use a
TImage as a forms background, but I have had so many problems (flicker and overdraw) with that, I never use it as background anymore}
BitBlt(Msg.WParam, 0, 0, Width, Height,
Backgnd1.Canvas.Handle, 0, 0, SRCCOPY);
{I did not creat a Canvas and used the API BitBlt}
{this only works well on forms that can NOT be resized}
Msg.Result := 1;
end;
-_--_----_ - - - - - - - - - - - - -
It seems you want the BrushCopy to give you a Form Shape of the NON transparent area of the bitmap (I guess transparent is black?)
For making a region the shape of a Non transparent area in a bitmap, takes alot of code. I have done it and will post the code if you want to see it, let me know.
procedure T_Form1.WMEraseBkgnd(var Message: TWMEraseBkgnd);
And you load the bitmap every time the background is drawn? seems ineffecient when you can just create and load it once.
here is some code I hav used to do that
private
{ Private declarations }
Backgnd1: TBitmap;
procedure WMEraseBkgnd (var Msg : TMessage); message WM_ERASEBKGND;
procedure TAbout.FormCreate(Sender: TObject);
begin
Backgnd1 := TBitmap.Create;
{Backgnd1 is the Form's Background}
Backgnd1.LoadFromResourceN
end;
procedure T_Form1.WMEraseBkGnd(var Msg : TMessage);
begin
{it seems like many delphi users use a
TImage as a forms background, but I have had so many problems (flicker and overdraw) with that, I never use it as background anymore}
BitBlt(Msg.WParam, 0, 0, Width, Height,
Backgnd1.Canvas.Handle, 0, 0, SRCCOPY);
{I did not creat a Canvas and used the API BitBlt}
{this only works well on forms that can NOT be resized}
Msg.Result := 1;
end;
-_--_----_ - - - - - - - - - - - - -
It seems you want the BrushCopy to give you a Form Shape of the NON transparent area of the bitmap (I guess transparent is black?)
For making a region the shape of a Non transparent area in a bitmap, takes alot of code. I have done it and will post the code if you want to see it, let me know.
ASKER
ok,
i will create a new question just for hre colors of the buttons caled "button collors". Slick812, please, describe there yours experiences. it is wery interesting for me.
... and yes, offcourse i am interrested for making a region the shape of a Non transparent area!!
i will create a new question just for hre colors of the buttons caled "button collors". Slick812, please, describe there yours experiences. it is wery interesting for me.
... and yes, offcourse i am interrested for making a region the shape of a Non transparent area!!
ASKER
this i made and it works ok:
-------------------------- ---------- ----------
unit frm_as_img;
interface
uses
windows,
extctrls,
graphics;
const
SWP_NOMOVE:longint = 2;
SWP_NOSIZE:longint = 1;
SWP_NOACTIVATE:longint = 16;
SWP_SHOWWINDOW:longint = 64;
SWP_FLAGS:longint = 19;
RGN_OR:longint = 2;
WM_NCLBUTTONDOWN:longint = -2;
HTCAPTION:longint = -2;
var
sprstatus:integer;
function change_face(picskin:timage ;win:hwnd) :boolean; overload;
function change_face(picskin:tbitma p;win:hwnd ):boolean; overload;
implementation
//function makeregion(picskin:timage) :hrgn;
function makeregion(picskin:tbitmap ):hrgn;
var
x,y,startlinex:longint;
fullregion,lineregion:hrgn ;
transparentcolor:colorref;
infirstregion:boolean;
inlajn:boolean;
idc:hdc;
picheight,picwidth:longint ;
begin
{
idc:= picskin.picture.Bitmap.can vas.Handle ;
picheight:= picskin.picture.Bitmap.hei ght;
picwidth:= picskin.Picture.Bitmap.Wid th;
}
idc:= picskin.Canvas.Handle;
picheight:= picskin.height;
picwidth:= picskin.Width;
infirstregion:= true;
inlajn:= false;
startlinex:= 0;
transparentcolor:= getpixel(idc,0,0);
fullregion:= 0;
for y:= 0 to (picheight - 1)
do begin
for x:= 0 to (picwidth - 1)
do begin
if (getpixel(idc,x,y) = transparentcolor)
or (x = picwidth)
then begin
if inlajn
then begin
inlajn:= false;
lineregion:= createrectrgn(startlinex,y ,x,(y + 1));
if infirstregion
then begin
fullregion:= lineregion;
infirstregion:= false;
end
else begin
combinergn(fullregion,full region,lin eregion,RG N_OR);
deleteobject(lineregion);
end;
end;
end
else begin
if not(inlajn)
then begin
inlajn:= true;
startlinex:= x;
end;
end;;
end;
end;
result:= fullregion;
end;
function change_face(picskin:timage ;win:hwnd) :boolean;
var
wr:hrgn;
begin
wr:= makeregion(picskin.Picture .Bitmap);
result:= (setwindowrgn(win,wr,true) <> 0);
end;
function change_face(picskin:tbitma p;win:hwnd ):boolean;
var
wr:hrgn;
begin
wr:= makeregion(picskin);
result:= (setwindowrgn(win,wr,true) <> 0);
end;
end.
-------------------------- ----------
... in main form must be an image as alClient and call for change_face in onshow method
procedure T_Form1.FormShow(Sender: TObject);
begin
change_face(im,handle);
end;
thanks for sugestions!
--------------------------
unit frm_as_img;
interface
uses
windows,
extctrls,
graphics;
const
SWP_NOMOVE:longint = 2;
SWP_NOSIZE:longint = 1;
SWP_NOACTIVATE:longint = 16;
SWP_SHOWWINDOW:longint = 64;
SWP_FLAGS:longint = 19;
RGN_OR:longint = 2;
WM_NCLBUTTONDOWN:longint = -2;
HTCAPTION:longint = -2;
var
sprstatus:integer;
function change_face(picskin:timage
function change_face(picskin:tbitma
implementation
//function makeregion(picskin:timage)
function makeregion(picskin:tbitmap
var
x,y,startlinex:longint;
fullregion,lineregion:hrgn
transparentcolor:colorref;
infirstregion:boolean;
inlajn:boolean;
idc:hdc;
picheight,picwidth:longint
begin
{
idc:= picskin.picture.Bitmap.can
picheight:= picskin.picture.Bitmap.hei
picwidth:= picskin.Picture.Bitmap.Wid
}
idc:= picskin.Canvas.Handle;
picheight:= picskin.height;
picwidth:= picskin.Width;
infirstregion:= true;
inlajn:= false;
startlinex:= 0;
transparentcolor:= getpixel(idc,0,0);
fullregion:= 0;
for y:= 0 to (picheight - 1)
do begin
for x:= 0 to (picwidth - 1)
do begin
if (getpixel(idc,x,y) = transparentcolor)
or (x = picwidth)
then begin
if inlajn
then begin
inlajn:= false;
lineregion:= createrectrgn(startlinex,y
if infirstregion
then begin
fullregion:= lineregion;
infirstregion:= false;
end
else begin
combinergn(fullregion,full
deleteobject(lineregion);
end;
end;
end
else begin
if not(inlajn)
then begin
inlajn:= true;
startlinex:= x;
end;
end;;
end;
end;
result:= fullregion;
end;
function change_face(picskin:timage
var
wr:hrgn;
begin
wr:= makeregion(picskin.Picture
result:= (setwindowrgn(win,wr,true)
end;
function change_face(picskin:tbitma
var
wr:hrgn;
begin
wr:= makeregion(picskin);
result:= (setwindowrgn(win,wr,true)
end;
end.
--------------------------
... in main form must be an image as alClient and call for change_face in onshow method
procedure T_Form1.FormShow(Sender: TObject);
begin
change_face(im,handle);
end;
thanks for sugestions!
So why are you deleting this question?
GL
Mike
GL
Mike
HI,
To change the shape of your form you must use the functions
CreateEllipticRgn, CreateRoundRectRgn,Combine Rgn
CreateEllipticRgnIndirect, CreatePolygonRgn,
CreatePolyPolygonRgn, CreateRectRgn, CreateRectRgnIndirect,
CombineRgn, SetWindowRgn, as it was already said by Edey.
To change the color of the TBitBtn you must override
the DrawItem method and maybe use the last parameter (itemData) of TDrawItemStruct;
Sincerely,
Nestorua.
To change the shape of your form you must use the functions
CreateEllipticRgn, CreateRoundRectRgn,Combine
CreateEllipticRgnIndirect,
CreatePolyPolygonRgn, CreateRectRgn, CreateRectRgnIndirect,
CombineRgn, SetWindowRgn, as it was already said by Edey.
To change the color of the TBitBtn you must override
the DrawItem method and maybe use the last parameter (itemData) of TDrawItemStruct;
Sincerely,
Nestorua.
ASKER CERTIFIED SOLUTION
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
ASKER
well i tried prewious week to delete this question when i found a kind of solution my way, but there was a problems on the EE server, so it seems not to delete it. it is good, i am glad to see other solution. well, points are yours, Slick812!
ASKER
Slick812, i do not know, if you look here some times more, but i have one philosophical question:
- your system for saving region to file is very interresting and usefull, but:
- when i use regin in my aplpication, i have so or so to load the picture into memory, for repainting of the from.
i load it once into the tbitmap by creation of the form, and draw it manually or load it into the Timage wich has property align alclient and the repainting is done automatically..
so when i have it in the memory, i can make a region fom it, why to load it from the res file too?
or is there any detail i have owerlooked?
- your system for saving region to file is very interresting and usefull, but:
- when i use regin in my aplpication, i have so or so to load the picture into memory, for repainting of the from.
i load it once into the tbitmap by creation of the form, and draw it manually or load it into the Timage wich has property align alclient and the repainting is done automatically..
so when i have it in the memory, i can make a region fom it, why to load it from the res file too?
or is there any detail i have owerlooked?
ASKER