Gennemsigtig Listbox + Memo

LMD Tools der følger med i en Special Edition på Companion CD\'en du fik med Delphi indeholder sådanne transparenne komponenter.

dj> Special edition? Jeg har Delphi 3 fra Alt om Datas cd.

ehh ok så er det ligemeget *GG*, men ellers kan du jo kigge lidt på den her:

Det er kildekoden til en Transperant memo komponent, jeg vil tro du kan anvende næsten den samme kode til en listbox også, du kan ihvertfald prøve det.

//credits for koden:
//    Tim Lawrenz
//    tim@lawrenz.com
//
//    Max Muermann
//    muermann@stud.uni-frankfurt.de
//
//Bemærk at komponenten er BeerWare hvilket i den her sammenhæng betyder at du skal sende de 2
//herrer ovenover 20 pilsnere hvis du vil anvende komponenten til commerciel brug *GG*


unit TrMemo;
{$R-}
interface
uses Messages, Controls, StdCtrls,classes;
const TMWM__SpecialInvalidate=WM_USER+1111;
type
  TTransparentMemo = class(TMemo)
  private
    procedure SpecialInvalidate(var Message:TMessage); message
TMWM__SpecialInvalidate;
    procedure WMHScroll(var Message: TWMHScroll); message WM_HSCROLL;
    procedure WMVScroll(var Message: TWMVScroll); message WM_VSCROLL;
    procedure WMSetText(var Message:TWMSetText); message WM_SETTEXT;
    procedure CNCTLCOLOREDIT(var Message:TWMCTLCOLOREDIT); message
CN_CTLCOLOREDIT;
    procedure WMKeyDown(var Message: TWMKeyDown); message WM_KEYDOWN;
    procedure WMEraseBkgnd(var Message: TWMEraseBkgnd); message WM_ERASEBKGND;
  protected
    procedure CreateParams(var Params: TCreateParams); override;
  public
constructor Create(AOwner: TComponent); override;
  end;
procedure Register;
implementation
uses Windows;
{ TTransparentMemo }
procedure TTransparentMemo.WMHScroll(var Message: TWMHScroll);
begin
  inherited;
  PostMessage(Handle,TMWM__SpecialInvalidate,0,0);
end;
procedure TTransparentMemo.WMVScroll(var Message: TWMVScroll);
begin
  SendMessage(Handle,TMWM__SpecialInvalidate,0,0);
  inherited;
  PostMessage(Handle,TMWM__SpecialInvalidate,0,0);
end;
procedure TTransparentMemo.CNCTLCOLOREDIT(var Message:TWMCTLCOLOREDIT);
begin
  with Message do
    begin
      SetBkMode(ChildDC,TRANSPARENT);
      Result:=GetStockObject(HOLLOW_BRUSH)
    end
end;
procedure TTransparentMemo.WMSetText(var Message:TWMSetText);
begin
  inherited;
  if not (csDesigning in ComponentState) then
    PostMessage(Handle,TMWM__SpecialInvalidate,0,0)
end;
procedure TTransparentMemo.SpecialInvalidate(var Message:TMessage);
var r:TRect;
begin
  if Parent<>nil then
    begin
      r:=ClientRect;
      r.TopLeft:=Parent.ScreenToClient(ClientToScreen(r.TopLeft));
      r.BottomRight:=Parent.ScreenToClient(ClientToScreen(r.BottomRight));
      InvalidateRect(Parent.Handle,@r,true);
      RedrawWindow(Handle,nil,0,RDW_FRAME+RDW_INVALIDATE)
    end;
end;
procedure TTransparentMemo.WMKeyDown(var Message: TWMKeyDown);
begin
  SendMessage(Handle,TMWM__SpecialInvalidate,0,0);
  inherited;
  PostMessage(Handle,TMWM__SpecialInvalidate,0,0);
end;
procedure TTransparentMemo.WMEraseBkgnd(var Message: TWMEraseBkgnd);
begin
  Message.Result:=1
end;

constructor TTransparentMemo.Create(AOwner: TComponent);
begin
inherited;
ControlStyle:=[csCaptureMouse, csDesignInteractive,
csClickEvents,  csSetCaption, csOpaque, csDoubleClicks,
  csReplicatable, csNoStdEvents];
end;

procedure TTransparentMemo.CreateParams(var Params: TCreateParams);
begin
  inherited CreateParams(Params);
  with Params do
  begin
      ExStyle:=ExStyle or WS_EX_TRANSPARENT and not WS_EX_WINDOWEDGE
            and not WS_EX_STATICEDGE and not WS_EX_DLGMODALFRAME and not
          WS_EX_CLIENTEDGE;
  end;
end;
procedure Register;
begin
  RegisterComponents(\'cool!\', [tTransparentMemo]);
end;
end.

humm der står jo meget der....

stik mig en emailaddresse så sender jeg dig komponenten, det er vist nemmere :)

det er sgu fedt med noget kildekode!

jeg har kompileret skidtet og den funger nu mangler jeg bare listboxen.

der er et lille problem med memoen: teksten kan ikke skifte farve den kan udelukkende være sort.

mm.. det skal jeg så ikke lige kunne sige..

jeg synes generelt at de fleste transperante komponenter altid har en hage, eller også virker de ikke ordentligt ..

Jeg søger faktisk selv et ordentligt sæt af transperante versioner af alle standardcomponenterne .. man har vel lov at drømme :P

kan du ikke sende LMD tools til mig? jeg har virkelig brug for en \"gennemsigtig\" listbox. Selvfølgelig kun hvis det ikke strider mod opretsrettigheder. safl@vip.cybercity.dk

Jeg er bange for at det vil være brud på ophavsrettigheder, pga. det er en special version der kun medfølger original version af Delphi. Selve pakken koster nemlig normalt en del penge http://www.lmdtools.com/eindex.htm der kan du se hvad der ellers følger med hvis man køber den fulde version.

Jeg tror måske denne her kan bruges

http://www.delphipages.com/result.cfm?ID=1272

Christian

takker begge to!