Brush.Style:=bsClear; sorunu (transparanlık) (Halloldu!)

Delphi'de kod yazma ile ilgili sorularınızı bu foruma yazabilirsiniz.
Kullanıcı avatarı
CemErgun
Üye
Mesajlar: 91
Kayıt: 05 May 2009 11:31
Konum: antalya

Re: Brush.Style:=bsClear; sorunu (transparanlık) (Hallolmadı:( )

Mesaj gönderen CemErgun »

yaw anlatamıyorum ben:S imagede sorunum yok png resmimi koyuyorum fıstık gibi arkası falan görünüyor sorun o değil ben form background'ının görünmesini istemiyorum. anlatabildim mi :S
procedure TForm1.FormCreate(Sender: TObject);
begin
halt;
end;
Kullanıcı avatarı
CiTiZEN
Üye
Mesajlar: 1163
Kayıt: 06 Oca 2008 04:15

Re: Brush.Style:=bsClear; sorunu (transparanlık) (Hallolmadı:( )

Mesaj gönderen CiTiZEN »

Kod: Tümünü seç

Function Form_Transparent(Form: TForm; Transparent: Boolean): Boolean;
Var
   AControl: TControl;
   A, Margin, X, Y, CtlX, CtlY: Integer;
   FullRgn, ClientRgn, CtlRgn: THandle;
Begin
With Form Do
If Transparent Then
   Begin
   Margin   := (Width - ClientWidth) div 2;
   FullRgn  := CreateRectRgn(0, 0, Width, Height);
   X        := Margin;
   Y        := Height - ClientHeight - Margin;
   ClientRgn:= CreateRectRgn(X, Y, X + ClientWidth, Y + ClientHeight);
   CombineRgn(FullRgn, FullRgn, ClientRgn, RGN_DIFF);

   For A:= 0 To ControlCount - 1 Do
       Begin
       AControl:= Controls[A];
       If (AControl Is TWinControl) Or (AControl Is TGraphicControl) Then
          With AControl Do
               Begin
               If Visible Then
                  Begin
                  CtlX  := X + Left;
                  CtlY  := Y + Top;
                  CtlRgn:= CreateRectRgn(CtlX, CtlY, CtlX + Width, CtlY + Height);
                  CombineRgn(FullRgn, FullRgn, CtlRgn, RGN_OR);
                  End;
               End;
       End;

   SetWindowRgn(Handle, FullRgn, True);
   End
Else
   Begin
   FullRgn:= CreateRectRgn(0, 0, Width, Height);
   CombineRgn(FullRgn, FullRgn, FullRgn, RGN_COPY);
   SetWindowRgn(Handle, FullRgn, True);
   End;

Result:= Transparent;
End;

kullanımı

procedure TForm1.BitBtn1Click(Sender: TObject);
begin
Form_Transparent(Form1,True);
end;
viewtopic.php?f=19&t=4961

yukardaki link te @csyasar ın yazmış olduğu kodların orijinal sayfası var hoş koddan başka bişe yok ama olsun, birde bu şekilde dene

kolay gelsin.
UWESIS CORPORATION
Kullanıcı avatarı
CiTiZEN
Üye
Mesajlar: 1163
Kayıt: 06 Oca 2008 04:15

Re: Brush.Style:=bsClear; sorunu (transparanlık) (Hallolmadı:( )

Mesaj gönderen CiTiZEN »

eğer bu şekilde de olmazsa bi kaç seçenek daha var sonucu burada yayınlarsın

kolay gelsin
UWESIS CORPORATION
Kullanıcı avatarı
CemErgun
Üye
Mesajlar: 91
Kayıt: 05 May 2009 11:31
Konum: antalya

Re: Brush.Style:=bsClear; sorunu (transparanlık) (Hallolmadı:( )

Mesaj gönderen CemErgun »

buseferde png imagemin arkası görünmüyorrrrrrrrrrrrrrrrrr ay çıldırcam:D
procedure TForm1.FormCreate(Sender: TObject);
begin
halt;
end;
Kullanıcı avatarı
CiTiZEN
Üye
Mesajlar: 1163
Kayıt: 06 Oca 2008 04:15

Re: Brush.Style:=bsClear; sorunu (transparanlık) (Hallolmadı:( )

Mesaj gönderen CiTiZEN »

e biraz çıldırmazsan programmer olamazsın :) aşagıdaki yöntemleride bir dene ben denedim sonuçları yazıyorum (kullandığım sistemler win vista ultimate , codegear rad studio delphi 2007)

Kod: Tümünü seç

1-
  SetWindowLong(Form1.Handle, GWL_EXSTYLE,
  (GetWindowLong(Form1.Handle, GWL_EXSTYLE) or WS_EX_TRANSPARENT));

sonuç-oldukça dengesiz davrandı 

Kod: Tümünü seç

2-
  private
    { Private declarations }
    FullRgn, ClientRgn, CtlRgn: THandle;
    
procedure MakeTransparent;
    
procedure UndoTransparent;
  end;
{...}
implementation
{...}

procedure TForm1.MakeTransparent;
var
  AControl: TControl;
  A, Margin, X, Y, CtlX, CtlY: Integer;
begin
  Margin    := (Width - ClientWidth) div 2;
  FullRgn   := CreateRectRgn(0, 0, Width, Height);
  X         := Margin;
  Y         := Height - ClientHeight - Margin;
  ClientRgn := CreateRectRgn(X, Y, X + ClientWidth, Y + ClientHeight);
  CombineRgn(FullRgn, FullRgn, ClientRgn, RGN_DIFF);
  for A := 0 to ControlCount - 1 do
  begin
    AControl := Controls[A];
    if (AControl is TWinControl) or (AControl is TGraphicControl) then with AControl do
      begin
        if Visible then
        begin
          CtlX   := X + Left;
          CtlY   := Y + Top;
          CtlRgn := CreateRectRgn(CtlX, CtlY, CtlX + Width, CtlY + Height);
          CombineRgn(FullRgn, FullRgn, CtlRgn, RGN_OR);
        end;
      end;
  end;
  SetWindowRgn(Handle, FullRgn, True);
end;

procedure TForm1.UndoTransparent;
begin
  FullRgn := CreateRectRgn(0, 0, Width, Height);
  CombineRgn(FullRgn, FullRgn, FullRgn, RGN_COPY);
  SetWindowRgn(Handle, FullRgn, True);
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  MakeTransparent
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  UndoTransparent
end; 

sonuç-png istediğin gibi değil

Kod: Tümünü seç

3-

procedure SetTransparentForm(AHandle : THandle; AValue : byte = 0);
var
  Info: TOSVersionInfo;
  SetLayeredWindowAttributes: TSetLayeredWindowAttributes;
begin
  //Check Windows version
  Info.dwOSVersionInfoSize := SizeOf(Info);
  GetVersionEx(Info);
  if (Info.dwPlatformId = VER_PLATFORM_WIN32_NT) and
  (Info.dwMajorVersion >= 5) then
    begin
      SetLayeredWindowAttributes := GetProcAddress(GetModulehandle(user32), 'SetLayeredWindowAttributes');
       if Assigned(SetLayeredWindowAttributes) then
        begin
         SetWindowLong(AHandle, GWL_EXSTYLE, GetWindowLong(AHandle, GWL_EXSTYLE) or WS_EX_LAYERED);
         //Make form transparent
         SetLayeredWindowAttributes(AHandle, 0, AValue, LWA_ALPHA);
       end;
    end;
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
SetTransparentForm(Handle, 100);
end;

sonuç-bu kodlarla oluşturulan form kararlı çalışıyor istediğin gibi olabilir üstelik handle, 100 olan yeri isteğine göre ayarlayabilirsin ne kadar istersen o kadar şeffaflaştırıyor ama işin kötü yanı alphablend özelliği gibi çalışması yani formun border ı sistem butonları vs. hepsi birden şeffaflaşıyor eğer formun styleını none yaparım önemsiz dersen bi dene derim
kolay gelsin

Not:Kodların Hepsi Alıntıdır...
UWESIS CORPORATION
Kullanıcı avatarı
CemErgun
Üye
Mesajlar: 91
Kayıt: 05 May 2009 11:31
Konum: antalya

Re: Brush.Style:=bsClear; sorunu (transparanlık) (Hallolmadı:( )

Mesaj gönderen CemErgun »

citizen yardımlarından dolayı teşekkür ederim tammmm istediğim gibi olmasada gayet hoş oldu çok saol! :alsana: :bravo:
procedure TForm1.FormCreate(Sender: TObject);
begin
halt;
end;
Cevapla