PDA

View Full Version : Canvas on TMainMenu and TPopUp List!!



SKy Scripter
06-24-2007, 08:11 AM
uhmm lol, i have no tut but you can look my codes.. i think nobody other then me has used it before put look and learn! XD


4731

ps. make sure you Left click the form too and the popup will come :p



program New;



var
MainForm : TForm;
MainPopUp : TPOPUPMENU; // Pop Up!!
Item : array [1..3] of TMENUITEM;
MainMenu : TMAINMENU;
SubMenu : TMENUITEM;
MenuItem : array [1..3] of TMENUITEM;
Bitmap, NewBMP : integer;
Canvas, NewCanvas : TCanvas;

procedure OnMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
var
px, py : integer;
begin
if (Button = mbRight) then
begin
GetMousePos(px, py);
MainPopUp.POPUP(Px, Py);
end;
end;

procedure OnAdvancedDrawitem(Sender: TObject; ACanvas: TCanvas; ARect: TRect; State: TOwnerDrawState) ;
var
i : integer;
begin
ACanvas.Font.Style := [fsbold];
ACanvas.Font.Name := 'Arial';
ACanvas.Brush.Style := bsClear;
ACanvas.Font.Size := 7;
for i := 0 to 150 do
begin
ACanvas.Pen.Color := 255 * i;
ACanvas.MoveTo(0, i);
ACanvas.LineTo(150, i);
end;
for i := 0 to 34 * 27 do
if (Canvas.Pixels[i mod 34, i div 34] = $FFFFFF) then
Canvas.Pixels[i mod 34, i div 34] := ACanvas.Pixels[i mod 34, 50 + i div 34];
SafeCopyCanvas(Canvas, ACanvas, 0, 0, 34, 27, 0, 50, 34, 27 + 50);
ACanvas.TextOut(25, 50, 'You See My Magic?');
ACanvas.TextOut(40, 70, 'NO?');
end;


procedure OnMeasureItem(Sender: TObject; ACanvas: TCanvas;
var Width, Height: Integer) ;
begin
Height := 50;
Width := 100;
end;


procedure InitForm;
var
i : integer;
begin

MainForm := CreateForm;
MainForm.SetBounds(0, 0, 300, 200);
MainForm.POSITION:= poDesktopCenter;
MainForm.BORDERICONS:= [biMinimize, biSystemMenu];
MainForm.BORDERSTYLE:= bsSingle;
MainForm.Color := 0;
MainForm.Caption := 'Place a pop menu with canvases';
MainForm.Onmousedown := @OnMouseDown;

for i := 1 to 3 do
begin
Item[i]:= TMenuItem.Create(MainForm);
case i of
1 : Item[i].CAPTION:= 'Who The Best?';
2 : Item[i].CAPTION:= 'Im The best!';
end;
end;
Item[3].Onmeasureitem := @OnMeasureItem;
Item[3].Onadvanceddrawitem := @OnAdvancedDrawitem;

SubMenu:= TMenuItem.Create(MainForm);

SubMenu.CAPTION:= 'File';
for i := 1 to 3 do
begin
MenuItem[i]:= TMenuItem.Create(MainForm);
case i of
1 : MenuItem[i].CAPTION:= 'Open';
2 : MenuItem[i].CAPTION:= 'Save';
3 : MenuItem[i].CAPTION:= 'New';
end;
if i = 3 then
begin
MenuItem[i].Bitmap.Width := 15;
MenuItem[i].Bitmap.Height := 18;
SafeCopyCanvas(NewCanvas, MenuItem[i].Bitmap.Canvas, 0, 0, 15, 18, 0, 0, 15, 18);
end;
end;

SubMenu.Bitmap.Width := 34;
SubMenu.Bitmap.Height := 27;
SafeCopyCanvas(Canvas, SubMenu.Bitmap.Canvas, 0, 0, 34, 27, 0, 0, 34, 27);


MainPopUp:= TPopUpMenu.Create(MainForm);
MainPopUp.Ownerdraw := True;

MainMenu := TMAINMENU.Create(MainForm);

for i := 1 to 3 do
MainPopUp.Items.ADD(Item[i]);

for i := 1 to 3 do
SubMenu.ADD(MenuItem[i]);

MainMenu.Items.ADD(SubMenu);

MainForm.ShowModal;
end;

procedure SafeInitForm;
var
v: TVariantArray;
begin
setarraylength(V, 0);
ThreadSafeCall('InitForm', v);
end;


procedure LoadBitmaps;
begin
Bitmap := BitmapFromString(34, 27, 'z78DAED98D10E83200C457F6999C6' +
'CDC7858CFFFFA46534C6ABA5D882222EBB0F3C188DF7E4B65 0F5F' +
'EAFB86EA0EBFB1F8669BD0A97E45F5A5BE3B2FA6F998BDEEE 5CD7' +
'95B178EF5C1B2C4864E1FAFA478A16EA8DFCEBB8E2FE5BA04 0E75' +
'4F7BCFE27A2B5FF67D03BE82C16DEEF980B5D211EA4C23B91 8E88' +
'6AA693DEAF90659D8ACC885C9894862B8F9AD73FEF05DE2F1 20B4' +
'ACA2E9DD7B2066C14F846BE2EB9C6715A352CBA7D6FBD571C C7A2' +
'E78AF58BE47F7E563A837825E8591E4C76AED4892FFB4F4F0 8DA1' +
'316FB9144147D502E577CC7B0F8CF9916E89E1EB42F579AC5 32E9' +
'6D1321CB2BE8082E6967D8F28F35A94DE71E449E39513957A EFF9' +
'9C29A8E445492976EC64EFBCFAF37E42ACF4B66B1F98FE59B 33CF' +
'58F3C274622C35FCEF95175D97D3A9EDBF242F5D3AE7F8B7E 6855' +
'DC36736FC0E6AF38F8D3C39FFDA9FB4A3F501DD2D25B8');

Canvas := GetBitmapCanvas(Bitmap);

NewBMP := BitmapFromString(15, 18, 'z78DAB5945D8EC3200C84AF448328' +
'F8118C7DFF23AD1D271B5A7E9A95B6449A87403E0F6308F37 7073' +
'A2C44E86A643F529B6DD760A8080F8818EE9019E461F69FB5 C61A' +
'89E091372C1073926A33725027F7F728643CC9A960614E256 F23F' +
'EE1F9CE80832C9E53818A41C88EFD9332B14F4FC9A7FC99DC A681' +
'9A5DDE32491A559C3B885245354A9D77F2B6F0293461495EB 2EA5' +
'72BAAEA9744053068E6037218923BA6B9D52C187637A73AA9 0363' +
'B2CC744CDBBB9107CC60CC4B3F905BE6C8674756B7DACC11B 9D87' +
'CD3A9A1CF37A6D1325D3A21473B512FCC690297CFFD9E78D3 9E9C' +
'B5B7760BE73EDD8AB9DF931579D9A91573EA39E999B7F3396 31E7' +
'9F6CCDBE42381E644BD74AA679EE46107EDCD7FE9977FF9FC 0336' +
'289BF5');

NewCanvas := GetBitmapCanvas(NewBMP);
end;



begin
try
LoadBitmaps;
SafeInitForm;
finally
FreeForm(MainForm)
FreeBitmap(Bitmap);
FreeBitmap(NewBMP);
except
Writeln('ERROR: With Loading');
end;

end.

nielsie95
06-24-2007, 02:21 PM
Nice! I didn't know about the popup :)

SKy Scripter
06-26-2007, 07:09 PM
Thanks, Nielsie95 :)

Aje
06-26-2007, 07:45 PM
Kool thanks, Could this be used within a tabbed form?

Rune Hacker
06-27-2007, 01:13 AM
Kool thanks, Could this be used within a tabbed form?
Best way to figure out is to do it and see if it works :p