Frage zu verschiebbaren Fenstern

[gauggi]

Hallo!

Ich arbeite gerade an der Gaugg Systemsuite. Nun möchte ich das Programm mit Skins grafisch aufwerten. Ich habe folgenden Code eingefügt, damit das Fenster beweglich ist.

Delphi-Quellcode:

 private
    { Private-Deklarationen }
      procedure WMNCHittest(var Msg: TMessage); message WM_NCHITTEST;
...
procedure TForm1.WMNCHittest(var Msg: TMessage);
begin
  Msg.Result := HTCAPTION;
end;

Nun zum Problem: Ich möchte, dass das Programm transparente Buttons verwendet und deshalb habe ich bei Torry folgende Komponente gefunden:

Delphi-Quellcode:

unit Tranbtn;

interface

uses
  SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
  Forms, StdCtrls, ExtCtrls;

type
  BStyle = (BSnone,BsNormal,BsIe);
  TMTranBtn = class(TGraphicControl)
  private
    FBitMap : TBitmap;
    FOver : Boolean;
    Pushed : boolean;
    Fborder : BStyle;
    BRect : Trect;
    procedure SetBitMap(Value : TBitMap);
    procedure WMLButtonDown(var msg: TWMLButtonDown); message WM_LBUTTONDOWN;
    procedure WMLButtonUp(var msg: TWMLButtonUp); message WM_LBUTTONUP;
    procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;
    function OnGlyphP(X, Y: integer): boolean;
    procedure mouseleave(var msg : tmessage); message cm_mouseleave;
    procedure mousein(var msg : tmessage); message cm_mouseenter;
    Procedure setborderstyle(value:Bstyle);
  protected
    procedure Paint; override;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
  published
    procedure DrawTransparentBitmap (ahdc: HDC; Image: TBitmap; xStart, yStart: Word; TrCol : Tcolor);
    property BitMap : TBitMap read FBitMap write SetBitMap;
    Property OnClick;
    property OnMouseDown;
    property OnMouseMove;
    property OnMouseUp;
    property Visible;
    Property Hint;
    Property ShowHint;
    Property Border : BStyle read fborder write SetBorderStyle;
    Property Caption;
    Property Font;
  end;

procedure Register;

implementation

constructor TMTranBtn.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
Width := 30;
Height := 30;
FBitMap := TBitMap.Create;
ControlStyle := ControlStyle - [csOpaque];
Pushed := false;
Font.name := 'Arial';
Font.size := 9;
Fborder := BsNormal;
end;

destructor TMTranBtn.Destroy;
begin
FBitMap.Free;
inherited Destroy;
end;

procedure TMTranBtn.SetBitMap(Value : TBitMap);
begin
 FBitMap.Assign(Value);
 invalidate;
end;

{this routine come from unit XparBmp of Michael Vincze ([e-mail]), I think it can be
optimized more. Will find time to check it again}
procedure TMTranBtn.DrawTransparentBitmap (ahdc: HDC; Image: TBitmap; xStart, yStart: Word; TrCol : Tcolor);
var
  TransparentColor: TColor;
  cColor          : TColorRef;
  bmAndBack,
  bmAndObject,
  bmAndMem,
  bmSave,
  bmBackOld,
  bmObjectOld,
  bmMemOld,
  bmSaveOld       : HBitmap;
  hdcMem,
  hdcBack,
  hdcObject,
  hdcTemp,
  hdcSave         : HDC;
  ptSize          : TPoint;
begin
TransparentColor := TrCol;
TransparentColor := TransparentColor or $02000000;

hdcTemp := CreateCompatibleDC (ahdc);
SelectObject (hdcTemp, Image.Handle); { select the bitmap }
ptSize.x := Image.Width;
ptSize.y := Image.Height;
DPtoLP (hdcTemp, ptSize, 1);  { convert from device logical points }
hdcBack   := CreateCompatibleDC(ahdc);
hdcObject := CreateCompatibleDC(ahdc);
hdcMem    := CreateCompatibleDC(ahdc);
hdcSave   := CreateCompatibleDC(ahdc);

bmAndBack   := CreateBitmap (ptSize.x, ptSize.y, 1, 1, nil);
bmAndObject := CreateBitmap (ptSize.x, ptSize.y, 1, 1, nil);

bmAndMem    := CreateCompatibleBitmap (ahdc, ptSize.x, ptSize.y);
bmSave      := CreateCompatibleBitmap (ahdc, ptSize.x, ptSize.y);

bmBackOld   := SelectObject (hdcBack, bmAndBack);
bmObjectOld := SelectObject (hdcObject, bmAndObject);
bmMemOld    := SelectObject (hdcMem, bmAndMem);
bmSaveOld   := SelectObject (hdcSave, bmSave);

SetMapMode (hdcTemp, GetMapMode (ahdc));
BitBlt (hdcSave, 0, 0, ptSize.x, ptSize.y, hdcTemp, 0, 0, SRCCOPY);
cColor := SetBkColor (hdcTemp, TransparentColor);
BitBlt (hdcObject, 0, 0, ptSize.x, ptSize.y, hdcTemp, 0, 0, SRCCOPY);

SetBkColor (hdcTemp, cColor);
BitBlt (hdcBack, 0, 0, ptSize.x, ptSize.y, hdcObject, 0, 0, NOTSRCCOPY);

BitBlt (hdcMem, 0, 0, ptSize.x, ptSize.y, ahdc, xStart, yStart, SRCCOPY);
BitBlt (hdcMem, 0, 0, ptSize.x, ptSize.y, hdcObject, 0, 0, SRCAND);
BitBlt (hdcTemp, 0, 0, ptSize.x, ptSize.y, hdcBack, 0, 0, SRCAND);
BitBlt (hdcMem, 0, 0, ptSize.x, ptSize.y, hdcTemp, 0, 0, SRCPAINT);
BitBlt (ahdc, xStart, yStart, ptSize.x, ptSize.y, hdcMem, 0, 0, SRCCOPY);
BitBlt (hdcTemp, 0, 0, ptSize.x, ptSize.y, hdcSave, 0, 0, SRCCOPY);
DeleteObject (SelectObject (hdcBack, bmBackOld));
DeleteObject (SelectObject (hdcObject, bmObjectOld));
DeleteObject (SelectObject (hdcMem, bmMemOld));
DeleteObject (SelectObject (hdcSave, bmSaveOld));
DeleteDC (hdcMem);
DeleteDC (hdcBack);
DeleteDC (hdcObject);
DeleteDC (hdcSave);
DeleteDC (hdcTemp);
end;

procedure TMTranBtn.setborderstyle(value:Bstyle);
begin
if Fborder <> value then
 begin
  Fborder := value;
  Invalidate;
 end;
end;

procedure TMTranBtn.Paint;
var
  ARect: TRect;
  Tmp : TBitMap;
  x,y : integer;
  text : array[0..40] of char;
  Fontheight : integer;
begin
ARect := Rect(0,0,Width,Height);
Canvas.font := font;
FontHeight := Canvas.TextHeight('W');
if not FBitMap.empty then
  begin
  x := (width - FBitMap.width) div 2;
  if caption <> '' then
    y := ((Height - FBitMap.Height- FontHeight) div 2)
  else
   y := ((Height - FBitMap.Height) div 2);
     BRect := rect(x, y, x + FBitMap.width, y + FBitMap.height);
     Tmp := TBitmap.Create;
     Tmp.Height := FBitMap.Height;
     Tmp.Width := FBitMap.Width;
     Tmp.Canvas.CopyRect(ARect, FBitmap.Canvas, ARect);
     if pushed then
      DrawTransparentBitmap( Canvas.Handle, Tmp, x +1, y+1, FBitmap.TransparentColor )
     else
      DrawTransparentBitmap( Canvas.Handle, Tmp, x, y, FBitmap.TransparentColor );
     Tmp.Free;
  end;

  if caption <> '' then
  with Canvas do
  begin
   Brush.Style := bsClear;
   with ARect do
    begin
     if Fbitmap.empty then
       Top := ((Bottom + Top) - FontHeight) shr 1
     else
       top := Brect. bottom;
      Bottom := Top + FontHeight;
      if pushed then
        begin
         top := top + 1;
         left := 2;
        end;
    end;
    StrPCopy(Text, Caption);
    DrawText(Handle, Text, StrLen(Text), ARect, (DT_EXPANDTABS or DT_center));
   end;

 ARect := getclientrect;
 case fborder of
 BsNormal : BEGIN
            if pushed then
                frame3d(canvas, ARect ,clBtnShadow,clBtnHighlight, 1)
            else
                frame3d(canvas, ARect ,clBtnHighlight,clBtnShadow, 1);
            END;
 BsIe :  Begin
         if pushed then
            frame3d(canvas, ARect ,clBtnShadow,clBtnHighlight, 1)
         else
          if Fover then
            frame3d(canvas, ARect ,clBtnHighlight,clBtnShadow, 1);
         end;
 end; { case}
end;


function TMTranBtn.OnGlyphP(X, Y: integer): boolean;
begin
  Result := PtInRect({ClientRect} BRect, Point(X, Y)) and
            (FBitmap.Canvas.Pixels[X, Y] <> FBitmap.TransparentColor);
end;

procedure TMTranBtn.MouseMove(Shift: TShiftState; X, Y: Integer);

begin
  FOver := (fborder = bsnormal) or (fborder = bsie) or  OnGlyphP(X, Y);
  Inherited MouseMove(Shift, X, Y);
end;

procedure TMTranBtn.mouseleave(var msg : tmessage);
var  rc : Trect;
BEGIN
  FOver := false;
  rc := getclientrect;
  if Fborder = bsie then
    INVALIDATE;
END;

procedure TMTranBtn.mousein(var msg : tmessage);
var  rc : Trect;
BEGIN
  FOver := true;
  rc := getclientrect;
  if Fborder = bsie then
    frame3d(canvas, rc ,clBtnHighlight,clBtnShadow, 1);
END;

procedure TMTranBtn.WMLButtonDown;
begin
 inherited;
  Pushed := (fborder = bsnormal) or (fborder = bsie) OR FOver;
  if pushed then
     invalidate;
end;

procedure TMTranBtn.WMLButtonUp;
begin
 inherited;
 if (fborder = bsnormal) or (fborder = bsie) or FOver then
    Pushed := false;
 if Pushed = false then
   invalidate;
end;

procedure Register;
begin
  RegisterComponents('Mik', [TMTranBtn]);
end;

end.

Wie man sehen kann, erbt diese von TGraphikControl. Wenn ich nun diesen "Button" aufs Formular setze, lässt dieser sich nicht anklicken. Wie kann ich es machen, dass dieser anklickbar ist??? Denn die normalen TButtons lassen sich ja anklicken. Muss also an GraphikControl und der Verschiebbarkeit liegen.

Ich hoffe ihr könnt mir helfen.

Danke schonmal

mfg Gaugg Markus

[_frank_]

versuch mal von TCustomControl abzuleiten, denn da hast du dann ein Window-Handle, und es sollte mit dem klick funktionieren, dann ist zwar erstmal die transparenz hin, aber evtl kannst du mit Alphablending-Routinen (SetLayeredWindow oder so ähnlich) den transparenzeffekt hinbekommen oder bräuchtest du regions?
Führt das nicht zum erfolg, musst du wohl auf die klick-position prüfen und ggf. das Click-Event des Buttons manuell aufrufen.

HTH Frank

[SirThornberry]

am einfachsten ist das du WM_NCHITTEST nicht gesondert behandelst und dafür lieber ins OnMouseDown den üblichen Code plazierst um Forms ohne Caption zu plazieren.