Arquivado
Este tópico foi arquivado e está fechado para novas respostas.
Como colocar opção para trocar a senha do formulário principal?
Por
fabio_medeiros, em Delphi
Recommended Posts
-
Conteúdo Similar
-
Por Ilano
Olá pessoal,
Desenvolvi uma aplicação de gerenciamento de banco de dados, onde posso visualizar relacionamentos, localizar campos na base de dados, criar consultas, visualizando os dados num cxGrid e num cxDBPivotGrid1, etc. Agora estou tentando implementar um gauge usando o componente AdvSmoothGauge da TMS, mas como posso utilizá-lo aplicando as consultas desenvolvidas neste gerenciador?
Grato,
Ilano
-
Por FabricioSoul2014
Boa tarde, estou com uma dificuldade na parte de puxar duas informações para outro form, estou utilizando delphi 7, banco paradox onde tenho dois Form um deles chamada Funcionário e nele consta varias informações porém a mais relevante são duas, o nome do dentista e o CRO pois isso será vinculado no outro Form chamado Exame que terá que puxar o nome e junto o Cro, consegui fazer que acontecesse isso, no entanto quando adiciono mais que um dentista também me aparece diversos Cro pois no Form de Exame coloquei combo box onde posso escolher o dentista e nisso deveria puxar o Cro só que só selecionando que dá certo, ou seja posso escolher o Cro de quem eu quiser, alguém teria alguma dica?
2 dúvida
Outra questão seria quando o usuário não preenche as informações como poderia colocar uma caixa de dialogo informando onde ou qual informação faltou preencher, por exemplo nome, sexo em vez daquelas mensagem do delphi de erro.
3 Dúvida
Pelo dbgrid teria como mostrar uma mensagem e sinalizando em vermelho ou qualquer outra cor em destaque quando a data do agendamento estivesse próximo?
4 Dúvida
Tenho um certo problema em relação a quantidade de dígitos ou caracteres no edit pois coloco no meu banco que só pode ir até 11 no cpf por exemplo porém posso colocar 9 e não tem problema, não estou falando em validação somente em quantidade mesmo, pois a maioria das minhas variáveis estão no tipo alpha.
5 Dúvida
A ultima questão seria no login pois já tenho um criado no entanto se eu logar na primeira ok, agora se eu for logar na segunda vez e se eu não digitar nada ele entra normal.
-
Por Ilano
Olá pessoal,
Uso Delphi 7, e tenho um AdvPageControl que contém várias abas e em cada aba um ADVMemo. Como são 20 abas, são 20 ADVMemos. O que eu quero fazer? Tenho uma grid e nela várias tabelas. Quero que ao clicar 2X num registro, o nome da tabela seja jogado para um ADVMemo situado na aba ativa do AdvPageControl. Para isso estou fazendo o seguinte trabalho de doido:
Como eu poderia melhorar esse código para fazer o que preciso de forma bem mais profissional?
Grato,
Ilano.
-
Por cgm2k7
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. -
Por desenvolvedor Everest
Bom dia à todos!
Trabalho com uma aplicação, que faz uma consulta ao sistema Sintegra.
Em uma das telas da aplicação, há um componente TWebBrowser, que acessa o WebService do sistema Sintegra. Após o usuário consultar algum CNPJ/IE, é utilizado o mesmo componente TWebBrowser para coletar os dados da página referentes ao CNPJ/IE consultado e utilizar tais dados na aplicação.
Aí vem o problema...
Na maioria dos estados, após a consulta do CNPJ/IE, o TWebBrowser é redirecionado para uma nova página com as informações referentes. Até aí tudo bem, mas...
Alguns estados, esse direcionamento é feito para uma nova janela de navegação, ou seja, é aberto uma nova página em um navegador da internet (Chrome, IE, Mozilla, etc.) fora da minha aplicação... Com isso, eu não consigo baixar os dados da página para utilizar na aplicação...
Alguma idéia, sugestão, solução?
-