Jump to content

cgm2k7

Members
  • Content count

    6
  • Joined

  • Last visited

Community Reputation

0 Comum

About cgm2k7

  1. cgm2k7

    Delphi no Windows 10

    helpe-me
  2. Olá bom dia.. Estou aqui de novo precisando de ajuda... Estou com o seguinte problema: Com este código abaixo, Me possibilita arrastar do Explorer e adicionar em um ListBox. uses Winapi.ShellApi; type TMyform = class(TForm) ... protected procedure WMDropFiles(var Message: TWMDropFiles); message WM_DROPFILES; ... end; procedure TMyform.WMDropFiles(var Message: TWMDropFiles); var numfiles: integer; buf: array[0..MAX_PATH] of char; begin numfiles := DragQueryFile(Message.Drop,$FFFFFFFF,nil,0); if numfiles>0 then begin Application.BringToFront; // only open 1 file at a time // - you could open more than 1 file // at a time by looping thru numfiles DragQueryFile(Message.Drop,0,buf,MAX_PATH); { call some method which opens the file - buf gets automatically typecast to a string if necessary } ListBox1.Items.Add(buf); DragFinish(Message.Drop); // clean up end; end; no formCreatte DragAcceptFiles(Handle, true); e no formDestroy DragAcceptFiles(Handle, false); o problema se eu executar o aplicar como administrador, não adiciona no listbox, isso só acontece no windows 10 já no windows 7 ultimate funcionar tudo normal. Será alguém aqui pode da uma ideia do que pode ser ?! Obrigado pela atenção...
  3. cgm2k7

    Help c++Builder hem eum um memo

    Olá pessoal mais uma vez eu aqui pedindo ajuda.. É o seguinte estou desenvolvendo um aplicativo e preciso visualizar os arquivo que usuário está editando em Hex e ASCII, assim com na imagem veja abaixo: Exatamente como na imagem só que em um memo ou qualquer outro componente. Achei este código na net mas não estou conseguido adapta-lo para abrir em um memo. Se alguém pude me ajudar... Agradeço. # include <cstdlib> # include <iostream> # include <iomanip> # include <fstream> # include <ctime> using namespace std; int main ( long argc, char *argv[] ); void handle ( char file_in_name[] ); void timestamp ( void ); int main ( long argc, char *argv[] ) { char file_in_name[80]; int i; bool VERBOSE = true; if ( VERBOSE ) { timestamp ( ); cout << "\n"; cout << "HEXDUMP:\n"; cout << " C++ version\n"; cout << "\n"; cout << " Compiled on " << __DATE__ << " at " << __TIME__ << ".\n"; cout << "\n"; cout << " Produce a hexadecimal dump of a file.\n"; } // // If the input file was not specified, get it now. // if ( argc <= 1 ) { cout << "\n"; cout << "HEXDUMP:\n"; cout << " Please enter the name of a file to be analyzed.\n"; cin.getline ( file_in_name, sizeof ( file_in_name ) ); handle ( file_in_name ); } // // Otherwise, get the file(s) from the argument list. // else { for ( i = 1 ; i < argc ; ++i ) { handle ( argv[i] ); } } if ( VERBOSE ) { cout << "\n"; cout << "HEXDUMP:\n"; cout << " Normal end of execution.\n"; cout << "\n"; timestamp ( ); } system("pause"); return 0; } void handle ( char file_in_name[] ) { long int addr; unsigned char buffer[20]; long int cnt; long int cnt2; ifstream file_in; long n; // // Open the file. // file_in.open ( file_in_name ); if ( !file_in ) { cout << "\n"; cout << "HANDLE - Fatal error!\n"; cout << " Cannot open \"" << file_in_name << "\"\n"; return; } cout << "\n"; cout << "Hexdump of \"" << file_in_name << "\":\n"; cout << "\n"; cout << "Address Hexadecimal values Printable\n"; cout << "------- ----------------------------------------------- -------------\n"; cout << "\n"; // // Dump the file contents. // addr = 0; while ( 1 ) { file_in.read ( ( char * ) buffer, 16 ); cnt = file_in.gcount(); if ( cnt <= 0 ) { break; } // // Print the address in decimal and hexadecimal. // cout << setw(7) << ( int ) addr << " "; addr = addr + 16; // // Print 16 data items, in pairs, in hexadecimal. // cnt2 = 0; for ( n = 0; n < 16; n++ ) { cnt2 = cnt2 + 1; if ( cnt2 <= cnt ) { cout << hex << setw(2) << setfill ( '0' ) << ( int ) buffer[n]; } else { cout << " "; } cout << " "; } cout << setfill ( ' ' ); // // Print the printable characters, or a period if unprintable. // cout << " "; cnt2 = 0; for ( n = 0; n < 16; n++ ) { cnt2 = cnt2 + 1; if ( cnt2 <= cnt ) { if ( buffer[n] < 32 || 126 < buffer[n] ) { cout << '.'; } else { cout << buffer[n]; } } } cout << "\n"; cout << dec; if ( file_in.eof ( ) ) { break; } } file_in.close ( ); return; } void timestamp ( void ) { # define TIME_SIZE 40 static char time_buffer[TIME_SIZE]; const struct tm *tm; size_t len; time_t now; now = time ( NULL ); tm = localtime ( &now ); len = strftime ( time_buffer, TIME_SIZE, "%d %B %Y %I:%M:%S %p", tm ); cout << time_buffer << "\n"; return; # undef TIME_SIZE }
  4. cgm2k7

    nspeedButton[d7]

    Olá pessoal: Andei procurando muito na net um speedbutton que tivesse a opção ImgList não achei resolvi criar um. Adicionei várias outras novidades: Opção GrayScale - > para o botão fica com a cor cinsa quando desabilitado ou com transparente com a opção Opacity. Opções GlyphOver e GlyphDown e também com ImgList. Suporta: Bitmap 32 Bits, mas se estiver instalado o Component TPNGGraphics no seu delphi vai aceitar png também. Estou postando para quem estiver precisando: Previa: https://youtu.be/iiKtrm2zN0w download Install dpk nSpeedButton http://www.mediafire.com/download/oqm3pea1ouy29af/Button2.rar http://www.4shared.com/rar/Fz1C6wTbba/Button2.html se quiser o TPNGGraphics: http://www.mediafire.com/download/ct11e5avx26m0s2/PngGraphics.rar http://www.4shared.com/rar/-hTI0WoGce/PngGraphics.html Se você não Gosta de instar qualquer component em seu delphi pode usar em runtime mesmo: unit Button2; interface uses Windows, Messages, Classes, Controls, Forms, Graphics, StdCtrls, ExtCtrls, CommCtrl, ImgList; type TnRGB = packed record B, G, R: Byte; end; TnRGBA = packed record B, G, R, A: Byte; end; TnColor = record case integer of 0 : (C : TColor); 1 : (R, G, B, A : Byte); 2 : (I : integer); 3 : (nsBGRA : TnRGBA); 4 : (RGB : TnRGB; nMASK : Byte); end; TnColor_ = record case integer of 0 : (C : TColor); 1 : (B, G, R, A : Byte); 2 : (I : integer); 3 : (nBGRA : TnRGBA); 4 : (BGR : TnRGB; nMASK : Byte); end; PRGBAArray = ^TRGBAArray; TRGBAArray = array[0..100000] of TnColor_; TButtonLayout = (blImageLeft, blImageRight, blImageTop, blImageBottom); TButtonState = (bsUp, bsDisabled, bsDown, bsExclusive); TButtonStyle = (bsAutoDetect, bsWin31, bsNew); TNumGlyphs = 1..4; TEnabledImage_e_Glyphs = (bsGrayScale, bsOpacity); TEnabled_IGs = set of TEnabledImage_e_Glyphs; TnSpeedButton = class; TcSpeedButtonActionLink = class(TControlActionLink) protected FClient: TnSpeedButton; procedure AssignClient(AClient: TObject); override; function IsCheckedLinked: Boolean; override; function IsGroupIndexLinked: Boolean; override; procedure SetGroupIndex(Value: Integer); override; procedure SetChecked(Value: Boolean); override; end; TnSpeedButton = class(TGraphicControl) private FOriginal : TBitmap; FOriginalOver : TBitmap; FOriginalDown : TBitmap; FIndexs: array[TButtonState] of Integer; FTransparentColor: TColor; FImageList: TCustomImageList; FGlyphImgList : TImageList; FInternalImageList: TImageList; FImageChangeLink: TChangeLink; FImageIndex: TImageIndex; FDown: Boolean; FDragging: Boolean; FAllowAllUp: Boolean; FLayout: TButtonLayout; FSpacing: Integer; FTransparent: Boolean; FMargin: Integer; FFlat: Boolean; FMouseInControl: Boolean; FEOpacity: integer; FEnabledGrayScale: TEnabled_IGs; FGroupIndex: Integer; FOnChange: TNotifyEvent; FOnMouseLeave, FOnMouseEnter: TNotifyEvent; FOverDraw : Boolean; FOverIndexOver, FOverIndexNormal, FOverIndexDown: Integer; FImgOvSize: Boolean; FImgOvNoFlat: Boolean; function CreateButtonGlyph2(State: TButtonState): Integer; procedure DrawButtonGlyph(Canvas: TCanvas; const GlyphPos: TPoint; State: TButtonState; Transparent, SetGrayScaleAndOpacity: Boolean); procedure DrawButtonImgList(Canvas: TCanvas; const GlyphPos: TPoint; State: TButtonState; Transparent, SetGrayScaleAndOpacity: Boolean); procedure DrawButtonText(Canvas: TCanvas; const Caption: string; TextBounds: TRect; State: TButtonState; BiDiFlags: Longint); procedure CalcButtonLayout(Canvas: TCanvas; const Client: TRect; const Offset: TPoint; const Caption: string; Layout: TButtonLayout; Margin, Spacing: Integer; var GlyphPos: TPoint; var TextBounds: TRect; BiDiFlags: Longint); procedure GlyphChanged(Sender: TObject); procedure UpdateExclusive; procedure SetGlyph(Value: TBitmap); procedure SetGlyphOver(const Value: TBitmap); procedure SetGlyphDown(const Value: TBitmap); procedure SetDown(Value: Boolean); procedure SetFlat(Value: Boolean); procedure SetAllowAllUp(Value: Boolean); procedure SetGroupIndex(Value: Integer); procedure SetLayout(Value: TButtonLayout); procedure SetSpacing(Value: Integer); procedure SetTransparent(Value: Boolean); procedure SetMargin(Value: Integer); procedure UpdateTracking; procedure WMLButtonDblClk(var Message: TWMLButtonDown); message WM_LBUTTONDBLCLK; procedure CMEnabledChanged(var Message: TMessage); message CM_ENABLEDCHANGED; procedure CMButtonPressed(var Message: TMessage); message CM_BUTTONPRESSED; procedure CMDialogChar(var Message: TCMDialogChar); message CM_DIALOGCHAR; procedure CMFontChanged(var Message: TMessage); message CM_FONTCHANGED; procedure CMTextChanged(var Message: TMessage); message CM_TEXTCHANGED; procedure CMSysColorChange(var Message: TMessage); message CM_SYSCOLORCHANGE; procedure CMMouseEnter(var Message: TMessage); message CM_MOUSEENTER; procedure CMMouseLeave(var Message: TMessage); message CM_MOUSELEAVE; procedure SetEnabledGrayScale(const Value: TEnabled_IGs); procedure SetEnabledOpacity(const Value: integer); procedure SetImageIndex(const Value: TImageIndex); procedure SetImages(const Value: TCustomImageList); procedure ImageListChange(Sender: TObject); procedure SetOverDraw(const Value: Boolean); procedure SetImgOvSize(const Value: Boolean); procedure SetImgOvNoFlat(const Value: Boolean); protected FState: TButtonState; procedure ActionChange(Sender: TObject; CheckDefaults: Boolean); override; function GetActionLinkClass: TControlActionLinkClass; override; function GetPalette: HPALETTE; override; procedure Loaded; override; procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override; procedure MouseMove(Shift: TShiftState; X, Y: Integer); override; procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override; procedure Paint; override; property MouseInControl: Boolean read FMouseInControl; public constructor Create(AOwner: TComponent); override; destructor Destroy; override; procedure Click; override; procedure AlphaTransBitmap(Canvas: TCanvas; const PsW, PsH: Integer; const SrcBmp: TBitmap; Enabled_GScale_Opacity: Boolean); function Draw(Canvas: TCanvas; const Client: TRect; const Offset: TPoint; const Caption: string; Layout: TButtonLayout; Margin, Spacing: Integer; State: TButtonState; Transparent, SetGrayScaleAndOpacity: Boolean; BiDiFlags: Longint): TRect; property OnChange: TNotifyEvent read FOnChange write FOnChange; published property Action; property AllowAllUp: Boolean read FAllowAllUp write SetAllowAllUp default False; property Anchors; property BiDiMode; property Constraints; property GroupIndex: Integer read FGroupIndex write SetGroupIndex default 0; property Down: Boolean read FDown write SetDown default False; property Caption; property Enabled; property Flat: Boolean read FFlat write SetFlat default False; property Font; property Glyph: TBitmap read FOriginal write SetGlyph; property GlyphDown: TBitmap read FOriginalDown write SetGlyphDown; property GlyphOver: TBitmap read FOriginalOver write SetGlyphOver; property Layout: TButtonLayout read FLayout write SetLayout default blImageLeft; property Margin: Integer read FMargin write SetMargin default -1; property ParentFont; property ParentShowHint; property ParentBiDiMode; property PopupMenu; property ShowHint; property Spacing: Integer read FSpacing write SetSpacing default 4; property Transparent: Boolean read FTransparent write SetTransparent default True; property Visible; property OnClick; property OnDblClick; property OnMouseDown; property OnMouseMove; property OnMouseUp; property OnMouseEnter : TNotifyEvent read FOnMouseEnter write FOnMouseEnter; property OnMouseLeave : TNotifyEvent read FOnMouseLeave write FOnMouseLeave; property ImgOverDraw : Boolean read FOverDraw write SetOverDraw default false; property ImgOvNoFlatRec : Boolean read FImgOvNoFlat write SetImgOvNoFlat default false; property ImgOvIdxNormal : Integer read FOverIndexNormal write FOverIndexNormal default 0; property ImgOvIdxDown : Integer read FOverIndexDown write FOverIndexDown default 1; property ImgOvIdxOver : Integer read FOverIndexOver write FOverIndexOver default 2; property ImgOvSize: Boolean read FImgOvSize write SetImgOvSize default false; property EnabledGrayScale: TEnabled_IGs read FEnabledGrayScale write SetEnabledGrayScale default [bsGrayScale]; property EnabledOpcValue : integer read FEOpacity write SetEnabledOpacity default 50; //50% de 100 a 1 property ImageList: TCustomImageList read FImageList write SetImages; property ImageIndex: TImageIndex read FImageIndex write SetImageIndex default -1; end; //procedure Register; implementation uses Consts, SysUtils, ActnList, Themes, Math, DateUtils, Types; {procedure Register; begin RegisterComponents('Standard', [TnSpeedButton]); end; } function TnSpeedButton.CreateButtonGlyph2(State: TButtonState): Integer; var TmpImage: TBitmap; IWidth, IHeight: Integer; IRect, ORect: TRect; I: TButtonState; begin Result := FIndexs[State]; if Result <> -1 then Exit; if (FOriginal.Width or FOriginal.Height) = 0 then Exit; IWidth := FOriginal.Width; IHeight := FOriginal.Height; TmpImage := TBitmap.Create; try TmpImage.Width := IWidth; TmpImage.Height := IHeight; FGlyphImgList.Width := TmpImage.Width; FGlyphImgList.Height := TmpImage.Height; IRect := Rect(0, 0, IWidth, IHeight); TmpImage.Canvas.Brush.Color := clBtnFace; TmpImage.Palette := CopyPalette(FOriginal.Palette); I := State; ORect := Rect(Ord(I) * IWidth, 0, (Ord(I) + 1) * IWidth, IHeight); case State of bsUp, bsDown, bsExclusive: begin TmpImage.Canvas.CopyRect(IRect, FOriginal.Canvas, ORect); if FOriginal.TransparentMode = tmFixed then FIndexs[State] := FGlyphImgList.AddMasked(TmpImage, FTransparentColor) else FIndexs[State] := FGlyphImgList.AddMasked(TmpImage, clDefault); if FOriginalOver <> nil then begin TmpImage.Palette := CopyPalette(FOriginalOver.Palette); TmpImage.Canvas.CopyRect(IRect, FOriginalOver.Canvas, ORect); if FOriginalOver.TransparentMode = tmFixed then FIndexs[State] := FGlyphImgList.AddMasked(TmpImage, FTransparentColor) else FIndexs[State] := FGlyphImgList.AddMasked(TmpImage, clDefault); end; if FOriginalDown <> nil then begin TmpImage.Palette := CopyPalette(FOriginalDown.Palette); TmpImage.Canvas.CopyRect(IRect, FOriginalDown.Canvas, ORect); if FOriginalDown.TransparentMode = tmFixed then FIndexs[State] := FGlyphImgList.AddMasked(TmpImage, FTransparentColor) else FIndexs[State] := FGlyphImgList.AddMasked(TmpImage, clDefault); end; end; bsDisabled: begin BitBlt(TmpImage.Canvas.Handle, 0, 0, IWidth, IHeight, FOriginal.Canvas.Handle, 0, 0, SRCCOPY); FIndexs[State] := FGlyphImgList.AddMasked(TmpImage, clDefault); end; end; finally TmpImage.Free; end; Result := FIndexs[State]; FOriginal.Dormant; FOriginalOver.Dormant; FOriginalDown.Dormant; end; procedure TnSpeedButton.DrawButtonGlyph(Canvas: TCanvas; const GlyphPos: TPoint; State: TButtonState; Transparent, SetGrayScaleAndOpacity: Boolean); var R: TRect; bmp : TBitmap; MakeColor : TColor; procedure PreparingBitmap(IndexToInsert: Integer; ImageListToInsert: TCustomImageList); begin Bmp.Width := ImageListToInsert.Width; Bmp.Height := ImageListToInsert.Height; Bmp.PixelFormat := pf32bit; if ImageListToInsert.BkColor <> clNone then MakeColor := ImageListToInsert.BkColor else MakeColor := clFuchsia; Bmp.Canvas.Brush.Color := MakeColor; Bmp.Canvas.FillRect(Rect(0, 0, Bmp.Width, Bmp.Height)); ImageListToInsert.GetBitmap(IndexToInsert, Bmp); end; begin if FOriginal = nil then Exit; if (FOriginal.Width = 0) or (FOriginal.Height = 0) and ((FGlyphImgList = nil) and ((FOverIndexNormal < 0) or (FOverIndexOver < 0) or (FOverIndexDown < 0)) and ((FOverIndexNormal > FGlyphImgList.Count) or (FOverIndexOver > FGlyphImgList.Count) and (FOverIndexDown > FGlyphImgList.Count))) then Exit; CreateButtonGlyph2(State); bmp := TBitmap.Create; if FOverDraw then begin if (FState = bsDown) or (Down) then PreparingBitmap(FOverIndexDown, FGlyphImgList) else if MouseInControl then PreparingBitmap(FOverIndexOver, FGlyphImgList) else PreparingBitmap(FOverIndexNormal, FGlyphImgList) end else PreparingBitmap(FOverIndexNormal, FGlyphImgList); with GlyphPos do begin if ThemeServices.ThemesEnabled then begin R.TopLeft := GlyphPos; R.Right := R.Left + bmp.Width; R.Bottom := R.Top + bmp.Height; AlphaTransBitmap(Canvas, r.Left, r.Top, Bmp, SetGrayScaleAndOpacity); end else if Transparent or (State = bsExclusive) then begin // ImageList_DrawEx(FGlyphImgList.Handle, FOverIndexNormal, Canvas.Handle, X, Y, 0, 0, // clNone, clNone, ILD_Transparent); AlphaTransBitmap(Canvas, GlyphPos.X, GlyphPos.Y, Bmp, SetGrayScaleAndOpacity); end else begin // ImageList_DrawEx(FGlyphImgList.Handle, FOverIndexNormal, Canvas.Handle, X, Y, 0, 0, // ColorToRGB(clBtnFace), clNone, ILD_Normal); AlphaTransBitmap(Canvas, GlyphPos.X, GlyphPos.Y, Bmp, SetGrayScaleAndOpacity); end; FreeAndNil(bmp); end; end; procedure TnSpeedButton.DrawButtonText(Canvas: TCanvas; const Caption: string; TextBounds: TRect; State: TButtonState; BiDiFlags: LongInt); begin with Canvas do begin Brush.Style := bsClear; if State = bsDisabled then begin OffsetRect(TextBounds, 1, 1); Font.Color := clBtnHighlight; DrawText(Handle, PChar(Caption), Length(Caption), TextBounds, DT_CENTER or DT_VCENTER or BiDiFlags); OffsetRect(TextBounds, -1, -1); Font.Color := clGrayText; DrawText(Handle, PChar(Caption), Length(Caption), TextBounds, DT_CENTER or DT_VCENTER or BiDiFlags); end else DrawText(Handle, PChar(Caption), Length(Caption), TextBounds, DT_CENTER or DT_VCENTER or BiDiFlags); end; end; procedure TnSpeedButton.CalcButtonLayout(Canvas: TCanvas; const Client: TRect; const Offset: TPoint; const Caption: string; Layout: TButtonLayout; Margin, Spacing: Integer; var GlyphPos: TPoint; var TextBounds: TRect; BiDiFlags: LongInt); var TextPos: TPoint; ClientSize, GlyphSize, TextSize: TPoint; TotalSize: TPoint; begin if (BiDiFlags and DT_RIGHT) = DT_RIGHT then if Layout = blImageLeft then Layout := blImageRight else if Layout = blImageRight then Layout := blImageLeft; { calculate the item sizes } ClientSize := Point(Client.Right - Client.Left, Client.Bottom - Client.Top); if FOriginal <> nil then GlyphSize := Point(FOriginal.Width, FOriginal.Height) else GlyphSize := Point(0, 0); if Length(Caption) > 0 then begin TextBounds := Rect(0, 0, Client.Right - Client.Left, 0); DrawText(Canvas.Handle, PChar(Caption), Length(Caption), TextBounds, DT_CALCRECT or BiDiFlags); TextSize := Point(TextBounds.Right - TextBounds.Left, TextBounds.Bottom - TextBounds.Top); end else begin TextBounds := Rect(0, 0, 0, 0); TextSize := Point(0,0); end; { If the layout has the glyph on the right or the left, then both the text and the glyph are centered vertically. If the glyph is on the top or the bottom, then both the text and the glyph are centered horizontally.} if Layout in [blImageLeft, blImageRight] then begin GlyphPos.Y := (ClientSize.Y - GlyphSize.Y + 1) div 2; TextPos.Y := (ClientSize.Y - TextSize.Y + 1) div 2; end else begin GlyphPos.X := (ClientSize.X - GlyphSize.X + 1) div 2; TextPos.X := (ClientSize.X - TextSize.X + 1) div 2; end; { if there is no text or no bitmap, then Spacing is irrelevant } if (TextSize.X = 0) or (GlyphSize.X = 0) then Spacing := 0; { adjust Margin and Spacing } if Margin = -1 then begin if Spacing = -1 then begin TotalSize := Point(GlyphSize.X + TextSize.X, GlyphSize.Y + TextSize.Y); if Layout in [blImageLeft, blImageRight] then Margin := (ClientSize.X - TotalSize.X) div 3 else Margin := (ClientSize.Y - TotalSize.Y) div 3; Spacing := Margin; end else begin TotalSize := Point(GlyphSize.X + Spacing + TextSize.X, GlyphSize.Y + Spacing + TextSize.Y); if Layout in [blImageLeft, blImageRight] then Margin := (ClientSize.X - TotalSize.X + 1) div 2 else Margin := (ClientSize.Y - TotalSize.Y + 1) div 2; end; end else begin if Spacing = -1 then begin TotalSize := Point(ClientSize.X - (Margin + GlyphSize.X), ClientSize.Y - (Margin + GlyphSize.Y)); if Layout in [blImageLeft, blImageRight] then Spacing := (TotalSize.X - TextSize.X) div 2 else Spacing := (TotalSize.Y - TextSize.Y) div 2; end; end; case Layout of blImageLeft: begin GlyphPos.X := Margin; TextPos.X := GlyphPos.X + GlyphSize.X + Spacing; end; blImageRight: begin GlyphPos.X := ClientSize.X - Margin - GlyphSize.X; TextPos.X := GlyphPos.X - Spacing - TextSize.X; end; blImageTop: begin GlyphPos.Y := Margin; TextPos.Y := GlyphPos.Y + GlyphSize.Y + Spacing; end; blImageBottom: begin GlyphPos.Y := ClientSize.Y - Margin - GlyphSize.Y; TextPos.Y := GlyphPos.Y - Spacing - TextSize.Y; end; end; { fixup the result variables } with GlyphPos do begin Inc(X, Client.Left + Offset.X); Inc(Y, Client.Top + Offset.Y); end; { Themed text is not shifted, but gets a different color. } if ThemeServices.ThemesEnabled then OffsetRect(TextBounds, TextPos.X + Client.Left, TextPos.Y + Client.Top) else OffsetRect(TextBounds, TextPos.X + Client.Left + Offset.X, TextPos.Y + Client.Top + Offset.Y); end; function TnSpeedButton.Draw(Canvas: TCanvas; const Client: TRect; const Offset: TPoint; const Caption: string; Layout: TButtonLayout; Margin, Spacing: Integer; State: TButtonState; Transparent, SetGrayScaleAndOpacity: Boolean; BiDiFlags: LongInt): TRect; var GlyphPos: TPoint; begin CalcButtonLayout(Canvas, Client, Offset, Caption, Layout, Margin, Spacing, GlyphPos, Result, BiDiFlags); if ((FImageList <> nil) and (FImageIndex >= 0) and (FImageIndex < FImageList.Count)) then DrawButtonImgList(Canvas, GlyphPos, State, Transparent, SetGrayScaleAndOpacity) else DrawButtonGlyph(Canvas, GlyphPos, State, Transparent, SetGrayScaleAndOpacity); DrawButtonText(Canvas, Caption, Result, State, BiDiFlags); end; { TcSpeedButtonActionLink } procedure TcSpeedButtonActionLink.AssignClient(AClient: TObject); begin inherited AssignClient(AClient); FClient := AClient as TnSpeedButton; end; function TcSpeedButtonActionLink.IsCheckedLinked: Boolean; begin Result := inherited IsCheckedLinked and (FClient.GroupIndex <> 0) and FClient.AllowAllUp and (FClient.Down = (Action as TCustomAction).Checked); end; function TcSpeedButtonActionLink.IsGroupIndexLinked: Boolean; begin Result := (FClient is TnSpeedButton) and (TnSpeedButton(FClient).GroupIndex = (Action as TCustomAction).GroupIndex); end; procedure TcSpeedButtonActionLink.SetChecked(Value: Boolean); begin if IsCheckedLinked then TnSpeedButton(FClient).Down := Value; end; procedure TcSpeedButtonActionLink.SetGroupIndex(Value: Integer); begin if IsGroupIndexLinked then TnSpeedButton(FClient).GroupIndex := Value; end; { TnSpeedButton } constructor TnSpeedButton.Create(AOwner: TComponent); var I: TButtonState; begin FGlyphImgList := TImageList.Create(Self); FOriginalOver := TBitmap.Create; FOriginalDown := TBitmap.Create; FOriginal := TBitmap.Create; FOriginal.OnChange := GlyphChanged; FTransparentColor := clOlive; for I := Low(I) to High(I) do FIndexs[I] := -1; inherited Create(AOwner); SetBounds(0, 0, 76, 26); ControlStyle := [csCaptureMouse, csDoubleClicks]; ParentFont := True; Color := clBtnFace; FSpacing := 4; FMargin := -1; FLayout := blImageLeft; FTransparent := True; FEnabledGrayScale := [bsGrayScale]; FEOpacity := 50; //50% de 100 a 1 FImageChangeLink := TChangeLink.Create; FImageChangeLink.OnChange := ImageListChange; FImageIndex := -1; FOverDraw := false; FOverIndexNormal := 0; FOverIndexDown := 1; FOverIndexOver := 2; FImgOvSize := false; end; destructor TnSpeedButton.Destroy; begin FGlyphImgList.Clear; FreeAndNil(FGlyphImgList); FOriginalOver.Free; FOriginalDown.Free; FOriginal.Free; FreeAndNil(FImageChangeLink); if Assigned(FInternalImageList) then FreeAndNil(FInternalImageList); inherited Destroy; Invalidate; end; procedure TnSpeedButton.Paint; const DownStyles: array[Boolean] of Integer = (BDR_RAISEDINNER, BDR_SUNKENOUTER); FillStyles: array[Boolean] of Integer = (BF_MIDDLE, 0); var PaintRect: TRect; DrawFlags: Integer; Offset: TPoint; Button: TThemedButton; ToolButton: TThemedToolBar; Details: TThemedElementDetails; begin if ImgOvSize and (Glyph.Width > 0) and (Glyph.Height > 0) then SetBounds(Left, Top, Glyph.Width, Glyph.Height); if not Enabled then begin FState := bsDisabled; FDragging := False; end else if FState = bsDisabled then if FDown and (GroupIndex <> 0) then FState := bsExclusive else FState := bsUp; Canvas.Font := Self.Font; if ThemeServices.ThemesEnabled then begin PerformEraseBackground(Self, Canvas.Handle); if not Enabled then Button := tbPushButtonDisabled else if FState in [bsDown, bsExclusive] then Button := tbPushButtonPressed else if MouseInControl then Button := tbPushButtonHot else Button := tbPushButtonNormal; ToolButton := ttbToolbarDontCare; if FFlat then begin case Button of tbPushButtonDisabled : Toolbutton := ttbButtonDisabled; tbPushButtonPressed : Toolbutton := ttbButtonPressed; tbPushButtonHot : Toolbutton := ttbButtonHot; tbPushButtonNormal : Toolbutton := ttbButtonNormal; end; end; PaintRect := ClientRect; if ToolButton = ttbToolbarDontCare then begin if not FImgOvNoFlat then begin Details := ThemeServices.GetElementDetails(Button); ThemeServices.DrawElement(Canvas.Handle, Details, PaintRect); PaintRect := ThemeServices.ContentRect(Canvas.Handle, Details, PaintRect); end; end else begin if not FImgOvNoFlat then begin Details := ThemeServices.GetElementDetails(ToolButton); ThemeServices.DrawElement(Canvas.Handle, Details, PaintRect); PaintRect := ThemeServices.ContentRect(Canvas.Handle, Details, PaintRect); end; end; if Button = tbPushButtonPressed then begin // A pressed speed button has a white text. This applies however only to flat buttons. if ToolButton <> ttbToolbarDontCare then Canvas.Font.Color := clHighlightText; Offset := Point(0, 1); end else Offset := Point(0, 0); if ((FImageList <> nil) and (FImageIndex >= 0) and (FImageIndex < FImageList.Count)) then begin Draw(Canvas, PaintRect, Offset, Caption, FLayout, FMargin, FSpacing, FState, Transparent, Enabled, DrawTextBiDiModeFlags(0)); end else Draw(Canvas, PaintRect, Offset, Caption, FLayout, FMargin, FSpacing, FState, Transparent, Enabled, DrawTextBiDiModeFlags(0)); end else //sen theme begin PaintRect := Rect(0, 0, Width, Height); if not FFlat then begin if not FImgOvNoFlat then begin DrawFlags := DFCS_BUTTONPUSH or DFCS_ADJUSTRECT; if FState in [bsDown, bsExclusive] then DrawFlags := DrawFlags or DFCS_PUSHED; DrawFrameControl(Canvas.Handle, PaintRect, DFC_BUTTON, DrawFlags); end; end else //com FFlat begin if (FState in [bsDown, bsExclusive]) or (FMouseInControl and (FState <> bsDisabled)) or (csDesigning in ComponentState) then if not FImgOvNoFlat then DrawEdge(Canvas.Handle, PaintRect, DownStyles[FState in [bsDown, bsExclusive]], FillStyles[Transparent] or BF_RECT) else if not Transparent then begin Canvas.Brush.Color := Color; Canvas.FillRect(PaintRect); end; InflateRect(PaintRect, -1, -1); end; if FState in [bsDown, bsExclusive] then begin if (FState = bsExclusive) and (not FFlat or not FMouseInControl) then begin if not FOverDraw then begin Canvas.Brush.Bitmap := AllocPatternBitmap(clBtnFace, clBtnHighlight); Canvas.FillRect(PaintRect); end; end; Offset.X := 1; Offset.Y := 1; end else begin Offset.X := 0; Offset.Y := 0; end; if ((FImageList <> nil) and (FImageIndex >= 0) and (FImageIndex < FImageList.Count)) then begin if (FImageIndex > -1) and (FImageIndex < FImageList.Count) then begin Glyph.Width := FImageList.Width; Glyph.Height := FImageList.Height; end; Draw(Canvas, PaintRect, Offset, Caption, FLayout, FMargin, FSpacing, FState, Transparent, Enabled, DrawTextBiDiModeFlags(0)); end else Draw(Canvas, PaintRect, Offset, Caption, FLayout, FMargin, FSpacing, FState, Transparent, Enabled, DrawTextBiDiModeFlags(0)); end; end; procedure TnSpeedButton.UpdateTracking; var P: TPoint; begin if FFlat then begin if Enabled then begin GetCursorPos(P); FMouseInControl := not (FindDragTarget(P, True) = Self); if FMouseInControl then Perform(CM_MOUSELEAVE, 0, 0) else Perform(CM_MOUSEENTER, 0, 0); end; end; end; procedure TnSpeedButton.Loaded; var State: TButtonState; begin inherited Loaded; if Enabled then State := bsUp else State := bsDisabled; CreateButtonGlyph2(State); end; procedure TnSpeedButton.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); begin inherited MouseDown(Button, Shift, X, Y); if (Button = mbLeft) and Enabled then begin if not FDown then begin FState := bsDown; Invalidate; end; FDragging := True; end; end; procedure TnSpeedButton.MouseMove(Shift: TShiftState; X, Y: Integer); var NewState: TButtonState; begin inherited MouseMove(Shift, X, Y); if FDragging then begin if not FDown then NewState := bsUp else NewState := bsExclusive; if (X >= 0) and (X < ClientWidth) and (Y >= 0) and (Y <= ClientHeight) then if FDown then NewState := bsExclusive else NewState := bsDown; if NewState <> FState then begin FState := NewState; Invalidate; end; end else if not FMouseInControl then UpdateTracking; end; procedure TnSpeedButton.MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); var DoClick: Boolean; begin inherited MouseUp(Button, Shift, X, Y); if FDragging then begin FDragging := False; DoClick := (X >= 0) and (X < ClientWidth) and (Y >= 0) and (Y <= ClientHeight); if FGroupIndex = 0 then begin { Redraw face in-case mouse is captured } FState := bsUp; FMouseInControl := False; if DoClick and not (FState in [bsExclusive, bsDown]) then Invalidate; end else if DoClick then begin SetDown(not FDown); if FDown then Repaint; end else begin if FDown then FState := bsExclusive; Repaint; end; if DoClick then Click; UpdateTracking; end; end; procedure TnSpeedButton.Click; begin inherited Click; end; function TnSpeedButton.GetPalette: HPALETTE; begin Result := Glyph.Palette; end; function TnSpeedButton.GetActionLinkClass: TControlActionLinkClass; begin Result := TcSpeedButtonActionLink; end; procedure TnSpeedButton.SetGlyph(Value: TBitmap); begin Invalidate; FOriginal.Assign(Value); if (Value <> nil) and (Value.Height > 0) then FTransparentColor := Value.TransparentColor; end; procedure TnSpeedButton.SetGlyphOver(const Value: TBitmap); begin Invalidate; FOriginalOver.Assign(Value); if (Value <> nil) and (Value.Height > 0) then FTransparentColor := Value.TransparentColor; end; procedure TnSpeedButton.SetGlyphDown(const Value: TBitmap); begin Invalidate; FOriginalDown.Assign(Value); if (Value <> nil) and (Value.Height > 0) then FTransparentColor := Value.TransparentColor; end; procedure TnSpeedButton.GlyphChanged(Sender: TObject); begin if (Sender = FOriginal) or (Sender = FOriginalDown) or (Sender = FOriginalOver) then begin FTransparentColor := FOriginal.TransparentColor or FOriginalDown.TransparentColor or FOriginalOver.TransparentColor; Invalidate; if Assigned(FOnChange) then FOnChange(Self); end; Invalidate; end; procedure TnSpeedButton.UpdateExclusive; var Msg: TMessage; begin if (FGroupIndex <> 0) and (Parent <> nil) then begin Msg.Msg := CM_BUTTONPRESSED; Msg.WParam := FGroupIndex; Msg.LParam := Longint(Self); Msg.Result := 0; Parent.Broadcast(Msg); end; end; procedure TnSpeedButton.SetDown(Value: Boolean); begin if FGroupIndex = 0 then Value := False; if Value <> FDown then begin if FDown and (not FAllowAllUp) then Exit; FDown := Value; if Value then begin if FState = bsUp then Invalidate; FState := bsExclusive end else begin FState := bsUp; Repaint; end; if Value then UpdateExclusive; end; end; procedure TnSpeedButton.SetFlat(Value: Boolean); begin if Value <> FFlat then begin FFlat := Value; Invalidate; end; end; procedure TnSpeedButton.SetGroupIndex(Value: Integer); begin if FGroupIndex <> Value then begin FGroupIndex := Value; UpdateExclusive; end; end; procedure TnSpeedButton.SetLayout(Value: TButtonLayout); begin if FLayout <> Value then begin FLayout := Value; Invalidate; end; end; procedure TnSpeedButton.SetMargin(Value: Integer); begin if (Value <> FMargin) and (Value >= -1) then begin FMargin := Value; Invalidate; end; end; procedure TnSpeedButton.SetSpacing(Value: Integer); begin if Value <> FSpacing then begin FSpacing := Value; Invalidate; end; end; procedure TnSpeedButton.SetTransparent(Value: Boolean); begin if Value <> FTransparent then begin FTransparent := Value; if Value then ControlStyle := ControlStyle - [csOpaque] else ControlStyle := ControlStyle + [csOpaque]; Invalidate; end; end; procedure TnSpeedButton.SetAllowAllUp(Value: Boolean); begin if FAllowAllUp <> Value then begin FAllowAllUp := Value; UpdateExclusive; end; end; procedure TnSpeedButton.WMLButtonDblClk(var Message: TWMLButtonDown); begin inherited; if FDown then DblClick; end; procedure TnSpeedButton.CMEnabledChanged(var Message: TMessage); const NewState: array[Boolean] of TButtonState = (bsDisabled, bsUp); begin CreateButtonGlyph2(NewState[Enabled]); UpdateTracking; Repaint; end; procedure TnSpeedButton.CMButtonPressed(var Message: TMessage); var Sender: TnSpeedButton; begin if Message.WParam = FGroupIndex then begin Sender := TnSpeedButton(Message.LParam); if Sender <> Self then begin if Sender.Down and FDown then begin FDown := False; FState := bsUp; if (Action is TCustomAction) then TCustomAction(Action).Checked := False; Invalidate; end; FAllowAllUp := Sender.AllowAllUp; end; end; end; procedure TnSpeedButton.CMDialogChar(var Message: TCMDialogChar); begin with Message do if IsAccel(CharCode, Caption) and Enabled and Visible and (Parent <> nil) and Parent.Showing then begin Click; Result := 1; end else inherited; end; procedure TnSpeedButton.CMFontChanged(var Message: TMessage); begin Invalidate; end; procedure TnSpeedButton.CMTextChanged(var Message: TMessage); begin Invalidate; end; procedure TnSpeedButton.CMSysColorChange(var Message: TMessage); begin Invalidate; end; procedure TnSpeedButton.CMMouseEnter(var Message: TMessage); var NeedRepaint, OnOffThemeServices: Boolean; begin inherited; if Assigned(FOnMouseEnter) then FOnMouseEnter(Self); { Don't draw a border if DragMode <> dmAutomatic since this button is meant to be used as a dock client. } if FOverDraw then OnOffThemeServices := FOverDraw else OnOffThemeServices := ThemeServices.ThemesEnabled; NeedRepaint := FFlat and not FMouseInControl and Enabled and (DragMode <> dmAutomatic) and (GetCapture = 0); { Windows XP introduced hot states also for non-flat buttons. } if (NeedRepaint or OnOffThemeServices) and not (csDesigning in ComponentState) then begin FMouseInControl := True; if Enabled then Repaint; end; end; procedure TnSpeedButton.CMMouseLeave(var Message: TMessage); var NeedRepaint, OnOffThemeServices: Boolean; begin inherited; if Assigned(FOnMouseLeave) then FOnMouseLeave(Self); if FOverDraw then OnOffThemeServices := FOverDraw else OnOffThemeServices := ThemeServices.ThemesEnabled; NeedRepaint := FFlat and FMouseInControl and Enabled and not FDragging; { Windows XP introduced hot states also for non-flat buttons. } if NeedRepaint or OnOffThemeServices then begin //if FOverDraw then FMouseInControl := False; if Enabled then Repaint; end; end; procedure TnSpeedButton.ActionChange(Sender: TObject; CheckDefaults: Boolean); procedure CopyImage(ImageList: TCustomImageList; Index: Integer); begin with Glyph do begin Width := ImageList.Width; Height := ImageList.Height; Canvas.Brush.Color := clFuchsia;//! for lack of a better color Canvas.FillRect(Rect(0,0, Width, Height)); ImageList.Draw(Canvas, 0, 0, Index); end; end; begin inherited ActionChange(Sender, CheckDefaults); if Sender is TCustomAction then with TCustomAction(Sender) do begin if CheckDefaults or (Self.GroupIndex = 0) then Self.GroupIndex := GroupIndex; { Copy image from action's imagelist } if (Glyph.Empty) and (ActionList <> nil) and (ActionList.Images <> nil) and (ImageIndex >= 0) and (ImageIndex < ActionList.Images.Count) then CopyImage(ActionList.Images, ImageIndex); end; end; procedure TnSpeedButton.AlphaTransBitmap(Canvas: TCanvas; const PsW, PsH: Integer; const SrcBmp: TBitmap; Enabled_GScale_Opacity: Boolean); var TmpDstBmp: TBitmap; w,h : Integer; aR1 : TRect; //===Opacidade bitmap e tom cinza Bitmap============================ function nGrayScaleOpacity(Bmp: TBitmap): TBitmap; var ScanL, SA : PRGBAArray; x, Y, w, h : integer; begin if (FEnabledGrayScale = [bsGrayScale]) or (FEnabledGrayScale = [bsGrayScale, bsOpacity]) then begin h := Bmp.Height - 1; w := Bmp.Width - 1; for Y := 0 to h do begin SA := Bmp.scanline[Y]; for x := 0 to w do begin SA[x].R := (SA[x].R + SA[x].G + SA[x].B) div 3; SA[x].G := SA[x].R; SA[x].B := SA[x].R; end; end; end; if (FEnabledGrayScale = [bsOpacity]) or (FEnabledGrayScale = [bsOpacity, bsGrayScale]) then begin for Y := 0 to Bmp.Height - 1 do begin ScanL := Bmp.ScanLine[Y]; for X := 0 to Bmp.Width - 1 do ScanL[X].A := (ScanL[X].A * FEOpacity) div 100; end; end; Result := Bmp; end; //==================================================================== //Criar Bitmap Virtual 32 Btis function CreateBmpV32(const Width, Height : integer) : TBitmap; begin Result := TBitmap.Create; Result.PixelFormat := pf32bit; Result.HandleType := bmDIB; Result.Width := Width; Result.Height := Height; end; // converte canal alpha! procedure ConvertAlphaChannelBmp32b(R1, R2 : TRect; const BmpDst, BmpSrc : TBitmap); var S1 : PRGBAArray; S2 : PRGBAArray; X, Y, h, w, sX1, sX2: Integer; Col_ : TnColor_; begin if BmpSrc = nil then Exit; BmpSrc.PixelFormat := pf32Bit; h := Min((R1.Bottom - R1.Top),(R2.Bottom - R2.Top)); h := Min(h, BmpDst.Height - R1.Top); h := Min(h, BmpSrc.Height - R2.Top) - 1; if h < 0 then Exit; w := Min((R1.Right - R1.Left), (R2.Right - R2.Left)); w := Min(w, BmpDst.Width - R1.Left); w := Min(w, BmpSrc.Width - R2.Left); if w < 0 then Exit; w := Min(w, BmpDst.Width - R1.Left); w := Min(w, BmpSrc.Width - R2.Left) - 1; for Y := 0 to h do begin S1 := BmpDst.ScanLine[R1.Top + Y]; S2 := BmpSrc.ScanLine[R2.Top + Y]; sX1 := R1.Left; sX2 := R2.Left; for X := 0 to w do begin Col_ := S2[sX2]; if Col_.C <> clFuchsia then begin S1[sX1].R := (((S2[sX2].R - S1[sX1].R) * S2[sX2].A + S1[sX1].R shl 8) shr 8) and MaxByte; S1[sX1].G := (((S2[sX2].G - S1[sX1].G) * S2[sX2].A + S1[sX1].G shl 8) shr 8) and MaxByte; S1[sX1].B := (((S2[sX2].B - S1[sX1].B) * S2[sX2].A + S1[sX1].B shl 8) shr 8) and MaxByte; end; inc(sX1); inc(sX2); end; end; end; //Inicio da Funcção no Bitmap begin aR1:= Rect(0, 0, SrcBmp.Width, SrcBmp.Height); w := aR1.Right - aR1.Left; h := aR1.Bottom - aR1.Top; TmpDstBmp := CreateBmpV32(w, h); if not Enabled_GScale_Opacity then nGrayScaleOpacity(SrcBmp); if not ((w = SrcBmp.Width) or (h = SrcBmp.Height)) then Exit; try SrcBmp.PixelFormat := pf32bit; SrcBmp.Width := w; SrcBmp.Height := h; BitBlt(TmpDstBmp.Canvas.Handle, 0, 0, w, h, Canvas.Handle, PsW, PsH, SRCCOPY); ConvertAlphaChannelBmp32b(Classes.Rect(0, 0, w, h), Classes.Rect(0, 0, w, h), TmpDstBmp, SrcBmp); BitBlt(Canvas.Handle, PsW, PsH, TmpDstBmp.Width, TmpDstBmp.Height, TmpDstBmp.Canvas.Handle, 0, 0, SRCCOPY); finally FreeAndNil(TmpDstBmp); end; end; procedure TnSpeedButton.SetEnabledGrayScale(const Value: TEnabled_IGs); begin if not Enabled then begin if EnabledGrayScale <> Value then FEnabledGrayScale := Value; Invalidate; end; end; procedure TnSpeedButton.SetEnabledOpacity(const Value: integer); begin if not Enabled then begin if FEOpacity <> Value then begin if Value < 0 then FEOpacity := 0 else if Value > 100 then FEOpacity := 100 else FEOpacity := Value; Invalidate; end; end; end; procedure TnSpeedButton.SetImageIndex(const Value: TImageIndex); begin if (FImageIndex <> Value) then begin FImageIndex := Value; if FImageIndex = -1 then begin FOriginal.Assign(nil); Glyph.Assign(nil); end; Invalidate; end; end; procedure TnSpeedButton.SetImages(const Value: TCustomImageList); begin if ImageList <> Value then begin if ImageList <> nil then ImageList.UnRegisterChanges(FImageChangeLink); FImageList := Value; if FImageList <> nil then begin ImageList.RegisterChanges(FImageChangeLink); ImageList.FreeNotification(Self); end; end; end; procedure TnSpeedButton.ImageListChange(Sender: TObject); begin Invalidate; end; procedure TnSpeedButton.DrawButtonImgList(Canvas: TCanvas; const GlyphPos: TPoint; State: TButtonState; Transparent, SetGrayScaleAndOpacity: Boolean); var Bmp : TBitmap; MakeColor : TColor; procedure PreparingBitmap(IndexToInsert: Integer; ImageListToInsert: TCustomImageList); begin Bmp.Width := ImageListToInsert.Width; Bmp.Height := ImageListToInsert.Height; Bmp.PixelFormat := pf32bit; if ImageListToInsert.BkColor <> clNone then MakeColor := ImageListToInsert.BkColor else MakeColor := clFuchsia; Bmp.Canvas.Brush.Color := MakeColor; Bmp.Canvas.FillRect(Rect(0, 0, Bmp.Width, Bmp.Height)); ImageListToInsert.GetBitmap(IndexToInsert, Bmp); end; begin bmp := TBitmap.Create; if FOverDraw then begin if (FState = bsDown) or (Down) then PreparingBitmap(ImgOvIdxDown, FImageList) else if MouseInControl then PreparingBitmap(ImgOvIdxOver, FImageList) else PreparingBitmap(ImgOvIdxNormal, FImageList) end else PreparingBitmap(FImageIndex, FImageList); try AlphaTransBitmap(Canvas, GlyphPos.X, GlyphPos.Y, Bmp, SetGrayScaleAndOpacity); finally FreeAndNil(Bmp); end; end; procedure TnSpeedButton.SetOverDraw(const Value: Boolean); begin if FOverDraw <> Value then begin FOverDraw := Value; if not FFlat then FFlat := true; Flat := FFlat; Invalidate; end; end; procedure TnSpeedButton.SetImgOvSize(const Value: Boolean); begin if FImgOvSize <> Value then begin FImgOvSize := Value; if ImgOvSize and (Glyph.Width > 0) and (Glyph.Height > 0) then SetBounds(Left, Top, Glyph.Width, Glyph.Height); Invalidate; end; end; procedure TnSpeedButton.SetImgOvNoFlat(const Value: Boolean); begin if FImgOvNoFlat <> Value then begin FImgOvNoFlat := Value; Invalidate; end; end; initialization {$IFDEF Pnggraphics} // TPicture.RegisterFileFormat('png','Portable network graphics (TPNGGraphic)', TPNGGraphic); {$ENDIF} finalization {$IFDEF Pnggraphics} //TPicture.UnregisterGraphicClass(TPNGGraphic); {$ENDIF} end.
  5. cgm2k7

    canal alpha icones em delphi 7

    help-me
  6. cgm2k7

    canal alpha icones em delphi 7

    Boa tarde a todos! Estou precisando de ajuda de novo: È o seguinte estou criando um componente para delphi 7 para abrir diretórios tipo o "opendialog" mas para visualizar só diretórios igual o OpenDialog no windowsXP. Já esta quase pronto estou com um probleminha com os ícones, No XP ícones ficam assim: não fica bom. Então coloquei uma função para corrigir o canal_alpha dos ícones. procedure GetAlphaChannelBitmap(Bmp: TBitmap); begin Bmp.Transparent := TRUE; Bmp.Mask(Bmp.TransparentColor); Bmp.PixelFormat:= pf32bit; Bmp.TransparentMode:= tmAuto ; Bmp.TransparentColor := clBtnFace; Bmp.Canvas.Brush.Color := clBtnFace; Bmp.Canvas.FillRect(Rect(0, 0, Bmp.Width, Bmp.Height)); end;Ae ficou lindo perfeito achei que já tinha terminado meu componente kkkkk Mas quando rodei no Windows 7 e 8 e 10 ficaram orriveis alguém pode me ajuda ? sabe alguma função para ajustar o canal-alpha dos ícones corretamente? desde já agradeço pela atenção;
×

Important Information

Ao usar o fórum, você concorda com nossos Terms of Use.