Farben des TMainMenu ändern???

[marky522]

Hallo,

probiers mal damit! Habe es aus dem obigen zusammengebastelt.
Es mach ein Gradient-Menue.


MfG
Mark

Delphi-Quellcode:

procedure gradient(SColor,EColor:TColor;bitmap1:TBitmap);
procedure Drehen90Grad(Bitmap:TBitmap);

var
  Form1: TForm1;

implementation
var
 hand:THandle;
 bitmap1:Tbitmap;
{$R *.dfm}

procedure gradient(SColor,EColor:TColor; bitmap1:TBitmap);
var a,b,sr,sg,sb,er,eg,eb:integer;
    dr,db,dg:double;
    Row :  ^TRGBQuad;
begin
 bitmap1.PixelFormat:=pf32bit;
 sr:=SColor and $000000ff;
 sg:=SColor and $0000ff00; sg := sg shr 8;
 sb:=SColor and $00ff0000; sb := sb shr 16;
 er:=EColor and $000000ff;
 eg:=EColor and $0000ff00; eg := eg shr 8;
 eb:=EColor and $00ff0000; eb := eb shr 16;

 dr:=(sr-er)/bitmap1.Height;
 dg:=(sg-eg)/bitmap1.Height;
 db:=(sb-eb)/bitmap1.Height;

 for a := Bitmap1.Height-1 downto 0 do begin
  row := Bitmap1.Scanline[a];
  for b := 0 to Bitmap1.Width-1 do begin
   row^.rgbred:=trunc(sr-dr*a);
   row^.rgbblue:=trunc(sb-db*a);
   row^.rgbgreen:=trunc(sg-dg*a);
   inc(row);
  end;
 end;
end;

type TMyhelp = array[0..0] of TRGBQuad;

procedure Drehen90Grad(Bitmap:TBitmap);
var P       : PRGBQuad; //^THelpRGB;
    x,y,b,h : Integer;
    RowOut  : ^TMyhelp;
    help    : TBitmap;
BEGIN
   Bitmap.PixelFormat := pf32bit;
   help := TBitmap.Create;
   help.PixelFormat := pf32bit;
   b := bitmap.Height;
   h := bitmap.Width;
   help.Width := b;
   help.height := h;
   for y := 0 to (h-1) do begin
     rowOut := help.ScanLine[y];
     P  := Bitmap.scanline[bitmap.height-1];
     inc(p,y);
     for x := 0 to (b-1) do begin
        rowout[x] := p^;
        inc(p,h);
     end;
   end;
   bitmap.Assign(help);
   help.Free;
end;


procedure TForm1.FormCreate(Sender: TObject);
var mi:TMenuInfo;
begin
 if Assigned(Bitmap1) then Bitmap1.Free;
 Bitmap1:=TBitmap.Create;
 Bitmap1.Width:=21;
 Bitmap1.Height:=Form1.Width;
 gradient(ColortoRGB(clBtnHighlight),ColortoRGB(clBtnFace),bitmap1);
 Drehen90Grad(Bitmap1);

 DeleteObject(hand);
 hand:=createPatternbrush(bitmap1.Handle);
 Fillchar(mi,Sizeof(mi),0);

 mi.cbSize:=sizeof(mi);
 mi.fMask:=MIM_BACKGROUND;
 mi.hbrBack:=hand;
 SetMenuInfo(MainMenu1.Handle,mi);
end;


procedure TForm1.FormCanResize(Sender: TObject; var NewWidth,
  NewHeight: Integer; var Resize: Boolean);
var mi:TMenuInfo;
begin
 if Assigned(Bitmap1) then Bitmap1.Free;
 Bitmap1:=TBitmap.Create;
 Bitmap1.Width:=21;
 Bitmap1.Height:=NewWidth;
 gradient(ColortoRGB(clBtnHighlight),ColortoRGB(clBtnFace),bitmap1);
 Drehen90Grad(Bitmap1);
      
 DeleteObject(hand);
 hand:=createPatternbrush(bitmap1.Handle);
 Fillchar(mi,Sizeof(mi),0);
                  
 mi.cbSize:=sizeof(mi);
 mi.fMask:=MIM_BACKGROUND;
 mi.hbrBack:=hand;
 SetMenuInfo(MainMenu1.Handle,mi);
end;
end.